Wiki

  1;;; javier_pacheco utilities.el --- Some useful utilities  -*- lexical-binding: t; -*-
  2(defun +org--insert-item (direction)
  3  (let ((context (org-element-lineage
  4                  (org-element-context)
  5                  '(table table-row headline inlinetask item plain-list)
  6                  t)))
  7    (pcase (org-element-type context)
  8      ;; Add a new list item (carrying over checkboxes if necessary)
  9      ((or `item `plain-list)
 10       (let ((orig-point (point)))
 11         ;; Position determines where org-insert-todo-heading and `org-insert-item'
 12         ;; insert the new list item.
 13         (if (eq direction 'above)
 14             (org-beginning-of-item)
 15           (end-of-line))
 16         (let* ((ctx-item? (eq 'item (org-element-type context)))
 17                (ctx-cb (org-element-property :contents-begin context))
 18                ;; Hack to handle edge case where the point is at the
 19                ;; beginning of the first item
 20                (beginning-of-list? (and (not ctx-item?)
 21                                         (= ctx-cb orig-point)))
 22                (item-context (if beginning-of-list?
 23                                  (org-element-context)
 24                                context))
 25                ;; Horrible hack to handle edge case where the
 26                ;; line of the bullet is empty
 27                (ictx-cb (org-element-property :contents-begin item-context))
 28                (empty? (and (eq direction 'below)
 29                             ;; in case contents-begin is nil, or contents-begin
 30                             ;; equals the position end of the line, the item is
 31                             ;; empty
 32                             (or (not ictx-cb)
 33                                 (= ictx-cb
 34                                    (1+ (point))))))
 35                (pre-insert-point (point)))
 36           ;; Insert dummy content, so that `org-insert-item'
 37           ;; inserts content below this item
 38           (when empty?
 39             (insert " "))
 40           (org-insert-item (org-element-property :checkbox context))
 41           ;; Remove dummy content
 42           (when empty?
 43             (delete-region pre-insert-point (1+ pre-insert-point))))))
 44      ;; Add a new table row
 45      ((or `table `table-row)
 46       (pcase direction
 47         ('below (save-excursion (org-table-insert-row t))
 48                 (org-table-next-row))
 49         ('above (save-excursion (org-shiftmetadown))
 50                 (+org/table-previous-row))))
 51
 52      ;; Otherwise, add a new heading, carrying over any todo state, if
 53      ;; necessary.
 54      (_
 55       (let ((level (or (org-current-level) 1)))
 56         ;; I intentionally avoid `org-insert-heading' and the like because they
 57         ;; impose unpredictable whitespace rules depending on the cursor
 58         ;; position. It's simpler to express this command's responsibility at a
 59         ;; lower level than work around all the quirks in org's API.
 60         (pcase direction
 61           (`below
 62            (let (org-insert-heading-respect-content)
 63              (goto-char (line-end-position))
 64              (org-end-of-subtree)
 65              (insert "\n" (make-string level ?*) " ")))
 66           (`above
 67            (org-back-to-heading)
 68            (insert (make-string level ?*) " ")
 69            (save-excursion (insert "\n"))))
 70         (run-hooks 'org-insert-heading-hook)
 71         (when-let* ((todo-keyword (org-element-property :todo-keyword context))
 72                     (todo-type    (org-element-property :todo-type context)))
 73           (org-todo
 74            (cond ((eq todo-type 'done)
 75                   ;; Doesn't make sense to create more "DONE" headings
 76                   (car (+org-get-todo-keywords-for todo-keyword)))
 77                  (todo-keyword)
 78                  ('todo)))))))
 79
 80    (when (org-invisible-p)
 81      (org-show-hidden-entry))
 82    (when (and (bound-and-true-p evil-local-mode)
 83               (not (evil-emacs-state-p)))
 84      (evil-insert 1))))
 85
 86;;;###autoload
 87(defun +org/insert-item-below (count)
 88  "Inserts a new heading, table cell or item below the current one."
 89  (interactive "p")
 90  (dotimes (_ count) (+org--insert-item 'below)))
 91
 92;;;###autoload
 93(defun +org/insert-item-above (count)
 94  "Inserts a new heading, table cell or item above the current one."
 95  (interactive "p")
 96  (dotimes (_ count) (+org--insert-item 'above)))
 97
 98
 99(defun org-make-olist (arg)
100  (interactive "P")
101  (let ((n (or arg 1)))
102    (when (region-active-p)
103      (setq n (count-lines (region-beginning)
104                           (region-end)))
105      (goto-char (region-beginning)))
106    (dotimes (i n)
107      (beginning-of-line)
108      (insert (concat (number-to-string (1+ i)) ". "))
109      (forward-line))))

1(defun meain/evil-yank-advice (orig-fn beg end &rest args)
2  (pulse-momentary-highlight-region beg end 'mode-line-active)
3  (apply orig-fn beg end args))
4(advice-add 'evil-yank :around 'meain/evil-yank-advice)

1(defun jp/org-font-setup ()
2  ;; Replace list hyphen with dot
3  (font-lock-add-keywords 'org-mode
4                          '(("^ *\\([-]\\) "
5                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) "•")))))))
6
7(jp/org-font-setup)

 1;;;; org-id
 2(declare-function org-id-add-location "org")
 3(declare-function org-with-point-at "org")
 4(declare-function org-entry-get "org")
 5(declare-function org-id-new "org")
 6(declare-function org-entry-put "org")
 7
 8;; Copied from this article (with minor tweaks from my side):
 9;; https://writequit.org/articles/emacs-org-mode-generate-ids.html.
10(defun jp/org--id-get (&optional pom create prefix)
11  "Get the CUSTOM_ID property of the entry at point-or-marker POM.
12If POM is nil, refer to the entry at point.  If the entry does
13not have an CUSTOM_ID, the function returns nil.  However, when
14CREATE is non nil, create a CUSTOM_ID if none is present already.
15PREFIX will be passed through to `org-id-new'.  In any case, the
16CUSTOM_ID of the entry is returned."
17  (org-with-point-at pom
18    (let ((id (org-entry-get nil "CUSTOM_ID")))
19      (cond
20       ((and id (stringp id) (string-match \\S- id))
21        id)
22       (create
23        (setq id (org-id-new (concat prefix "h")))
24        (org-entry-put pom "CUSTOM_ID" id)
25        (org-id-add-location id (format "%s" (buffer-file-name (buffer-base-buffer))))
26        id)))))
27
28(declare-function org-map-entries "org")
29
30;;;###autoload
31(defun jp/org-id-headlines ()
32  "Add missing CUSTOM_ID to all headlines in current file."
33  (interactive)
34  (org-map-entries
35   (lambda () (jp/org--id-get (point) t))))
36
37;;;###autoload
38(defun jp/org-id-headline ()
39  "Add missing CUSTOM_ID to headline at point."
40  (interactive)
41  (jp/org--id-get (point) t))

1(defun jp/org-id-store-link-for-headers ()
2  "Run `org-id-store-link' for each header in the current buffer."
3  (interactive)
4  (save-excursion
5    (goto-char (point-min))
6    (while (re-search-forward org-heading-regexp nil t)
7      (org-id-store-link))))

 1(defun jp/org-toggle-emphasis-markers (&optional arg)
 2  "Toggle emphasis markers and display a message."
 3  (interactive "p")
 4  (let ((markers org-hide-emphasis-markers)
 5        (msg ""))
 6    (when markers
 7      (setq-local org-hide-emphasis-markers nil)
 8      (setq msg "Emphasis markers are now visible."))
 9    (unless markers
10      (setq-local org-hide-emphasis-markers t)
11      (setq msg "Emphasis markers are now hidden."))
12    (message "%s" msg)
13    (when arg
14      (font-lock-fontify-buffer))))

 1(defun export-org-email ()
 2  "Export the current email org buffer and copy it to the
 3clipboard"
 4  (interactive)
 5  (let ((org-export-show-temporary-export-buffer nil)
 6        (org-html-head (org-email-html-head)))
 7    (org-html-export-as-html)
 8    (with-current-buffer "*Org HTML Export*"
 9      (kill-new (buffer-string)))
10    (message "HTML copied to clipboard")))
11(global-set-key (kbd "C-c C-x C-e") 'export-org-email)

 1(defun org-email-html-head ()
 2  "Create the header with CSS for use with email"
 3  (concat
 4   "<style type=\"text/css\">\n"
 5   "<!--/*--><![CDATA[/*><!--*/\n"
 6   (with-temp-buffer
 7     (insert-file-contents
 8      "~/.emacs.d/src/css/org2outlook.css")
 9     (buffer-string))
10   "/*]]>*/-->\n"
11   "</style>\n"))

 1(defun org-todo-if-needed (state)
 2  "Change header state to STATE unless the current item is in STATE already."
 3  (unless (string-equal (org-get-todo-state) state)
 4    (org-todo state)))
 5
 6(defun ct/org-summary-todo-cookie (n-done n-not-done)
 7  "Switch header state to DONE when all subentries are DONE, to TODO when none are DONE, and to DOING otherwise"
 8  (let (org-log-done org-log-states)   ; turn off logging
 9    (org-todo-if-needed (cond ((= n-done 0)
10                               "TODO")
11                              ((= n-not-done 0)
12                               "DONE")
13                              (t
14                               "DOING")))))
15(add-hook 'org-after-todo-statistics-hook #'ct/org-summary-todo-cookie)
16
17(defun ct/org-summary-checkbox-cookie ()
18  "Switch header state to DONE when all checkboxes are ticked, to TODO when none are ticked, and to DOING otherwise"
19  (let (beg end)
20    (unless (not (org-get-todo-state))
21      (save-excursion
22        (org-back-to-heading t)
23        (setq beg (point))
24        (end-of-line)
25        (setq end (point))
26        (goto-char beg)
27        ;; Regex group 1: %-based cookie
28        ;; Regex group 2 and 3: x/y cookie
29        (if (re-search-forward "\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
30                               end t)
31            (if (match-end 1)
32                ;; [xx%] cookie support
33                (cond ((equal (match-string 1) "100%")
34                       (org-todo-if-needed "DONE"))
35                      ((equal (match-string 1) "0%")
36                       (org-todo-if-needed "TODO"))
37                      (t
38                       (org-todo-if-needed "DOING")))
39              ;; [x/y] cookie support
40              (if (> (match-end 2) (match-beginning 2)) ; = if not empty
41                  (cond ((equal (match-string 2) (match-string 3))
42                         (org-todo-if-needed "DONE"))
43                        ((or (equal (string-trim (match-string 2)) "")
44                             (equal (match-string 2) "0"))
45                         (org-todo-if-needed "TODO"))
46                        (t
47                         (org-todo-if-needed "DOING")))
48                (org-todo-if-needed "DOING"))))))))
49(add-hook 'org-checkbox-statistics-hook #'ct/org-summary-checkbox-cookie)

1(defun new-scratch-pad ()
2  "Create a new org-mode buffer for random stuff."
3  (interactive)
4  (progn
5    (let ((buffer (generate-new-buffer "Org-scratch-buffer")))
6      (switch-to-buffer buffer)
7      (setq buffer-offer-save t)
8      (org-mode)
9      (olivetti-mode t))))

 1;; Toggle *scratch* buffer.
 2(defun toggle-scratch-buffer ()
 3  "Toggle the *scratch* buffer"
 4  (interactive)
 5  (if (string= (buffer-name) "*scratch*")
 6      (bury-buffer)
 7    (switch-to-buffer (get-buffer-create "*scratch*"))))
 8
 9(defun toggle-org-buffer ()
10  "Toggle the Org-scratch-buffer buffer"
11  (interactive)
12  (if (equal (buffer-name (current-buffer)) "Org-scratch-buffer")
13      (if (one-window-p t)
14          (switch-to-buffer (other-buffer))
15        (delete-window))
16    (if (get-buffer "Org-scratch-buffer")
17        (if (get-buffer-window "Org-scratch-buffer")
18            (progn
19              (bury-buffer "Org-scratch-buffer")
20              (delete-window (get-buffer-window "Org-scratch-buffer")))
21          (switch-to-buffer "Org-scratch-buffer"))
22      (new-scratch-pad))))
23
24;; Toggle *eshell* buffer.
25(defun toggle-eshell-buffer ()
26  "Toggle the *eshell* buffer"
27  (interactive)
28  (if (string= (buffer-name) "*eshell*")
29      (bury-buffer)
30    (switch-to-buffer (get-buffer-create "*eshell*"))))

1(defun my-show-doc-or-describe-symbol ()
2  "Show LSP UI doc if LSP is active, otherwise describe symbol at point."
3  (interactive)
4  (if (bound-and-true-p lsp-mode)
5      (lsp-ui-doc-glance)
6    (describe-symbol-at-point)))

 1(defun duplicate-line ()
 2  (interactive)
 3  (let ((line-text (thing-at-point 'line t)))
 4    (save-excursion
 5      (move-end-of-line 1)
 6      (newline)
 7      (insert line-text)))
 8  (forward-line 1))
 9
10(defun move-line-up ()
11  (interactive)
12  (when (not (= (line-number-at-pos) 1))
13    (transpose-lines 1)
14    (forward-line -2)))
15
16(defun move-line-down ()
17  (interactive)
18  (forward-line 1)
19  (when (not (= (line-number-at-pos) (point-max)))
20    (transpose-lines 1))
21  (forward-line -1))

 1;; Define a custom face for the highlight
 2(defface my-highlight-face
 3  '((t (:foreground "gray"))) ; Change "red" to your desired color
 4  "Face for highlighting !!word!! patterns.")
 5
 6;; Function to replace matched text with asterisks
 7(defun replace-with-asterisks (limit)
 8  "Replace !!word!! with asterisks up to LIMIT."
 9  (while (re-search-forward "!!\\(.*?\\)!!" limit t)
10    (let* ((match (match-string 1))
11           (start (match-beginning 0))
12           (end (match-end 0))
13           (asterisks (make-string (length match) ?*)))
14      (add-text-properties start end `(display ,asterisks face my-highlight-face)))))
15
16;; Add custom keyword for font-lock in org-mode
17(defun my/org-mode-custom-font-lock ()
18  "Add custom font-lock keywords for org-mode."
19  (font-lock-add-keywords nil
20                          '((replace-with-asterisks))))
21
22;; Hook the custom font-lock configuration into org-mode
23(add-hook 'org-mode-hook 'my/org-mode-custom-font-lock)

 1(defun describe-symbol-at-point ()
 2  "Display the documentation of the symbol at point, if it exists."
 3  (interactive)
 4  (let ((symbol (symbol-at-point)))
 5    (if symbol
 6        (cond
 7         ((fboundp symbol) (describe-function symbol))
 8         ((boundp symbol) (describe-variable symbol))
 9         (t (message "No documentation found for symbol at point: %s" symbol)))
10      (message "No symbol at point"))))

 1(defun custom-jp-themes (&optional theme-dir)
 2
 3  (defun custom-jp-themes (&optional theme-dir)
 4    "Return a list of custom themes from a specified directory.
 5Search the directory for files named FOO-theme.el, and return a list of FOO symbols,
 6excluding the 'default' theme and any internal themes.
 7
 8If THEME-DIR is nil, it defaults to `~/.emacs.d/lisp/jp-themes/'."
 9    (let ((suffix "-theme\\.el\\'")
10          (directory (or theme-dir "~/.emacs.d/lisp/jp-themes/"))
11          themes)
12      ;; Ensure the directory exists
13      (when (file-directory-p directory)
14        ;; Iterate over all theme files in the directory
15        (dolist (file (directory-files directory nil suffix))
16          (let ((theme (intern (substring file 0 (string-match-p suffix file)))))
17            ;; Add to the list if it's valid, and exclude Emacs built-in "default" theme
18            (and (not (eq theme 'default))  ;; Ensure "default" is excluded
19               (not (memq theme themes))  ;; Avoid duplicates
20               (push theme themes)))))
21      (nreverse themes)))
22
23  (defcustom fz-themes nil
24    "List of themes (symbols or regexps) to be presented for selection.
25nil shows all `custom-available-themes'."
26    :type '(repeat (choice symbol regexp)))
27
28  (defun fz-theme (theme)
29    "Disable current themes and enable THEME from `fz-themes`.
30
31The command supports previewing the currently selected theme."
32    (interactive
33     (list
34      (let* ((regexp (consult--regexp-filter
35                      (mapcar (lambda (x) (if (stringp x) x (format "\\`%s\\'" x)))
36                              fz-themes)))
37             (avail-themes (seq-filter
38                            (lambda (x) (string-match-p regexp (symbol-name x)))
39                            (custom-jp-themes)))  ;; Only use themes from custom-jp-themes
40             (saved-theme (car custom-enabled-themes)))
41        (consult--read
42         (mapcar #'symbol-name avail-themes)
43         :prompt "Theme: "
44         :require-match t
45         :category 'theme
46         :history 'consult--theme-history
47         :lookup (lambda (selected &rest _)
48                   (setq selected (and selected (intern-soft selected)))
49                   (or (and selected (car (memq selected avail-themes)))
50                      saved-theme))
51         :state (lambda (action theme)
52                  (pcase action
53                    ('return (fz-theme (or theme saved-theme)))
54                    ((and 'preview (guard theme)) (fz-theme theme))))
55         :default (symbol-name (or saved-theme 'default))))))
56    (when (eq theme 'default) (setq theme nil))
57    (unless (eq theme (car custom-enabled-themes))
58      (mapc #'disable-theme custom-enabled-themes)
59      (when theme
60        (if (custom-theme-p theme)
61            (enable-theme theme)
62          (load-theme theme :no-confirm)))))

 1;; Open files in the lisp folder
 2(require 'find-lisp)
 3(defun open-lisp-and-org-files ()
 4  "Open a Lisp or Org file from ~/.emacs.d/lisp directory, including subfolders."
 5  (interactive)
 6  (let* ((directory "~/.emacs.d/lisp")
 7         (el-files (find-lisp-find-files directory ".*\\.el$"))
 8         (org-files (find-lisp-find-files directory ".*\\.org$"))
 9         (all-files (append el-files org-files))
10         (file (completing-read "Select file: " all-files nil t)))
11    (find-file file)))
12
13;; Follow urls in the buffer
14(defun list-and-open-url-in-buffer ()
15  "List all URLs in the current buffer, display them in the minibuffer, and open a selected URL in the browser."
16  (interactive)
17  (let (urls)
18    (save-excursion
19      (goto-char (point-min))
20      (while (re-search-forward "\\(http\\|https\\|ftp\\|file\\|mailto\\):[^ \t\n]+" nil t)
21        (push (match-string 0) urls)))
22    (if urls
23        (let ((url (completing-read "Select URL to open: " (reverse urls) nil t)))
24          (browse-url url))
25      (message "No URLs found in the buffer."))))
26
27;; Export org files to pdf using tectonic
28(defun org-export-to-latex-and-compile-with-tectonic ()
29  "Export the current Org file to LaTeX, then compile with tectonic using shell-escape."
30  (interactive)
31  (let* ((org-file (buffer-file-name))
32         (tex-file (concat (file-name-sans-extension org-file) ".tex"))
33         (tectonic-command (concat "tectonic -Z shell-escape " tex-file)))
34    ;; Export Org file to LaTeX
35    (org-latex-export-to-latex)
36    ;; Run tectonic command in a temporary buffer to avoid displaying the output
37    (with-temp-buffer
38      (shell-command tectonic-command (current-buffer)))
39    (message "Compiled %s to PDF with Tectonic." tex-file)))
40
41(global-set-key (kbd "C-c e l") 'org-export-to-latex-and-compile-with-tectonic)
42
43;; Update my web-page
44(defun publish-my-blog ()
45  "Export all subtrees with Hugo, then run the publish blog script within Emacs and display a success message in the minibuffer."
46  (interactive)
47  (let ((commit-msg (read-string "Enter commit message: ")))
48    ;; Export all subtrees with Hugo
49    (org-hugo-export-wim-to-md :all-subtrees)
50    ;; Run the publish script
51    (let ((process (start-process-shell-command
52                    "publish-blog"                       ; Process name
53                    "*publish-blog-output*"              ; Output buffer
54                    (format "~/webdev/jpachecoxyz.github.io/hugo/publish.sh \"%s\"" commit-msg))))  ; Run the script with the commit message
55      ;; Set up the process sentinel to check the process status
56      (set-process-sentinel
57       process
58       (lambda (process event)
59         (when (string= event "finished\n")
60           (message "jpacheco.xyz was correctly updated!")))))))
61
62(global-set-key (kbd "C-c u b") 'publish-my-blog)
63
64;; Search roam
65(defun jp/search-roam ()
66  "Run consult-ripgrep on the org roam directory"
67  (interactive)
68  (consult-ripgrep org-roam-directory nil))
69(global-set-key (kbd "C-c n s") 'jp/search-roam)
70
71(defun jp/yt-shorts-timer ()
72  (interactive)
73  (org-timer-set-timer "55s"))
74(global-set-key (kbd "<f4>") 'jp/yt-shorts-timer)

1pip install --no-cache-dir --trusted-host pypi.org --trusted-host pypi.python.org --trusted-host files.pythonhosted.org <program>

 1@echo off
 2setlocal
 3
 4rem Prompt the user for new IP address
 5set /p newIP="Enter the new IP address: "
 6set "newSubnetMask=255.255.255.0"
 7
 8rem Set the new IP address while keeping existing subnet mask and gateway
 9netsh interface ipv4 set address name="Ethernet" static %newIP% %newSubnetMask%
10
11rem Display the new IP configuration
12
13if %errorlevel% equ 0 (
14    echo IP address changed successfully.
15) else (
16    echo Failed to change IP address. Please make sure you have administrative privileges.
17)
18
19endlocal