" #'man)))
12 | (apply fn args)))
13 |
14 | (advice-add 'read-shell-command :around #'use-man-for-local-help)
15 |
16 | (provide 'man-help)
17 |
--------------------------------------------------------------------------------
/my-lisp/message-extras.el:
--------------------------------------------------------------------------------
1 | ;;; message-extras.el --- Miscellaneous commands for email -*- lexical-binding: t; -*-
2 |
3 | (require 'message)
4 | (require 'smtpmail)
5 |
6 | ;; The functions here depend on the following variable, which should
7 | ;; be set to an alist associating each user mail address with its smtp
8 | ;; data (a plist with keys :server, :type and :port). I set mine in a
9 | ;; private configuration package.
10 | (defvar all-user-mail-addresses)
11 |
12 | (defun cycle-from-address ()
13 | "Cycle between my email addresses."
14 | (interactive)
15 | (save-excursion
16 | (let ((from (cadr
17 | (mail-extract-address-components
18 | (message-field-value "From"))))
19 | (emails (mapcar #'car all-user-mail-addresses)))
20 | (message-goto-from)
21 | (delete-region (point) (search-backward ":"))
22 | (insert ": "
23 | (message-make-from
24 | user-full-name
25 | (elt emails (mod (1+ (seq-position emails from))
26 | (length emails))))))))
27 |
28 | (defun set-smtp-server ()
29 | "Set the stmp server according to the from field.
30 | Add to `message-send-hook'."
31 | (when-let* ((from (cadr
32 | (mail-extract-address-components
33 | (message-field-value "From"))))
34 | (server (cdr (assoc from all-user-mail-addresses))))
35 | (setq smtpmail-smtp-user (or (plist-get server :user) from)
36 | smtpmail-smtp-server (plist-get server :server)
37 | smtpmail-stream-type (plist-get server :type)
38 | smtpmail-smtp-service (plist-get server :port))))
39 |
40 | (defun message-lint ()
41 | "Check for missing subject or attachments.
42 | Add to `message-send-hook'."
43 | (unless (message-field-value "Subject")
44 | (message-goto-subject)
45 | (user-error "Add a subject line"))
46 | (cl-flet ((containsp (re) (save-excursion
47 | (message-goto-body)
48 | (re-search-forward re nil t))))
49 | (when (and (containsp "attach\\|adjunt")
50 | (not (containsp "disposition=attachment"))
51 | (not (y-or-n-p "Send mail without attachments? ")))
52 | (user-error "Attach some files"))))
53 |
54 | (provide 'message-extras)
55 |
--------------------------------------------------------------------------------
/my-lisp/narrow-extras.el:
--------------------------------------------------------------------------------
1 | ;;; narrow-extras.el --- Miscellaneous narrowing commands -*- lexical-binding: t; -*-
2 |
3 | (declare-function org-edit-src-code 'org-src)
4 | (declare-function org-edit-src-exit 'org-src)
5 | (declare-function TeX-narrow-to-group 'tex)
6 | (declare-function LaTeX-narrow-to-environment 'latex)
7 |
8 | (defun narrow-or-widen-dwim (p)
9 | "Widen if buffer is narrowed, narrow-dwim otherwise.
10 | Dwim means: region, org-src-block, org-subtree, or defun,
11 | whichever applies first. Narrowing to org-src-block actually
12 | calls `org-edit-src-code'.
13 |
14 | With prefix P, don't widen, just narrow even if buffer is
15 | already narrowed."
16 | (interactive "P")
17 | (declare (interactive-only))
18 | (cond ((and (buffer-narrowed-p) (not p)) (widen))
19 | ((and (bound-and-true-p org-src-mode) (not p))
20 | (org-edit-src-exit))
21 | ((region-active-p)
22 | (narrow-to-region (region-beginning) (region-end)))
23 | ((derived-mode-p 'org-mode)
24 | (or (ignore-errors (org-edit-src-code))
25 | (ignore-errors (org-narrow-to-block))
26 | (org-narrow-to-subtree)))
27 | ((derived-mode-p 'latex-mode)
28 | (LaTeX-narrow-to-environment))
29 | ((derived-mode-p 'tex-mode)
30 | (TeX-narrow-to-group))
31 | (t (narrow-to-defun))))
32 |
33 | (defun narrow-to-point ()
34 | "Narrow to point, useful for yanking a rectangle."
35 | (interactive)
36 | (narrow-to-region (point) (point)))
37 |
38 | (defun narrow-to-sexp ()
39 | "Narrow to sexp containing point."
40 | (interactive)
41 | (narrow-to-region
42 | (save-excursion (up-list -1 t t) (point))
43 | (save-excursion (up-list +1 t t) (point))))
44 |
45 | (provide 'narrow-extras)
46 |
--------------------------------------------------------------------------------
/my-lisp/org-async-init.el:
--------------------------------------------------------------------------------
1 | ;;; -*- lexical-binding: t; -*-
2 |
3 | (require 'package)
4 | (setq package-enable-at-startup nil)
5 | (package-initialize)
6 |
7 | (setq make-backup-files nil)
8 |
9 | (require 'org)
10 | (require 'ox)
11 | (require 'ox-beamer)
12 |
13 | (when (executable-find "latexmk")
14 | (setq org-latex-pdf-process '("latexmk -pdf %f")))
15 |
16 | (setq org-export-with-smart-quotes t
17 | org-confirm-babel-evaluate nil)
18 |
19 | (add-to-list 'load-path "~/.private/")
20 | (add-to-list 'load-path "~/.emacs.d/my-lisp")
21 |
22 | (require 'org-config)
23 |
--------------------------------------------------------------------------------
/my-lisp/org-extras.el:
--------------------------------------------------------------------------------
1 | ;;; org-extras.el --- Miscellaneous Org extras -*- lexical-binding: t; -*-
2 |
3 | ;;; arXiv links
4 |
5 | (require 'org)
6 |
7 | (defun org-extras--link-exporter
8 | (path-regexp url-format title-format-1 &optional title-format-2)
9 | (lambda (path description backend)
10 | (when (and (memq backend '(latex html))
11 | (string-match path-regexp path))
12 | (format (pcase backend
13 | ((or 'latex 'beamer) "\\href{%s}{%s}")
14 | ('html "%s"))
15 | (format url-format (match-string 1 path))
16 | (or description
17 | (format (pcase backend
18 | ((or 'latex 'beamer) "\\texttt{%s}")
19 | ('html "%s
"))
20 | (format (if (match-string 2 path)
21 | title-format-2
22 | title-format-1)
23 | (match-string 1 path)
24 | (match-string 2 path))))))))
25 |
26 | (let ((arxiv-regexp "^\\(.*?\\)\\(?:/\\(.*\\)\\)?$")
27 | (arxiv-url-format "https://arxiv.org/abs/%s"))
28 | (org-link-set-parameters
29 | "arXiv"
30 | :face 'org-link
31 | :follow (lambda (path in-emacs)
32 | (when-let (((string-match arxiv-regexp path))
33 | (url (format arxiv-url-format (match-string 1 path))))
34 | (if in-emacs (eww url) (browse-url url))))
35 | :export (org-extras--link-exporter
36 | arxiv-regexp arxiv-url-format "arXiv:%s" "arXiv:%s [%s]")))
37 |
38 | ;;; doi links
39 |
40 | (defun beamer-is-latex (args)
41 | "Treat Beamer backend same as LaTeX."
42 | (pcase-let ((`(,path ,desc ,backend ,info) args))
43 | `(,path ,desc ,(if (eq backend 'beamer) 'latex backend) ,info)))
44 |
45 | (defun default-doi-desc (args)
46 | "If no description is given use doi:... format."
47 | (pcase-let ((`(,path ,desc ,backend ,info) args))
48 | `(,path ,(or desc (concat "doi:" path)) ,backend ,info)))
49 |
50 | (advice-add 'org-link-doi-export :filter-args #'beamer-is-latex)
51 | (advice-add 'org-link-doi-export :filter-args #'default-doi-desc)
52 |
53 | ;;; Inline JavaScript
54 |
55 | (add-to-list 'org-src-lang-modes '("inline-js" . javascript))
56 |
57 | (defvar org-babel-default-header-args:inline-js
58 | '((:results . "html")
59 | (:exports . "results")))
60 |
61 | (defun org-babel-execute:inline-js (body _params)
62 | (format "" body))
63 |
64 | ;;; Source blocks for declaring LaTeX macros
65 |
66 | (add-to-list 'org-src-lang-modes '("latex-macros" . latex))
67 |
68 | (defvar org-babel-default-header-args:latex-macros
69 | '((:results . "raw")
70 | (:exports . "results")))
71 |
72 | (defun prefix-all-lines (pre body)
73 | (with-temp-buffer
74 | (insert body)
75 | (string-insert-rectangle (point-min) (point-max) pre)
76 | (buffer-string)))
77 |
78 | (defun org-babel-execute:latex-macros (body _params)
79 | (concat
80 | (prefix-all-lines "#+LATEX_HEADER: " body)
81 | "\n#+HTML_HEAD_EXTRA: \\(\n"
82 | (prefix-all-lines "#+HTML_HEAD_EXTRA: " body)
83 | "\n#+HTML_HEAD_EXTRA: \\)
\n"))
84 |
85 | (defun no-short-tags (tags)
86 | "Do not offer very short tags as completion candidates.
87 | Use as `:filter-return' advice for `org-get-buffer-tags'."
88 | (mapcar (lambda (group)
89 | (seq-filter (lambda (tag) (> (length tag) 2)) group))
90 | tags))
91 |
92 | (advice-add 'org-get-buffer-tags :filter-return #'no-short-tags)
93 |
94 | (provide 'org-extras)
95 |
--------------------------------------------------------------------------------
/my-lisp/org-ql-usual-files.el:
--------------------------------------------------------------------------------
1 | ;;; org-ql-usual-files --- Search in the usual files -*- lexical-binding: t; -*-
2 |
3 | ;; I usually want to search both agenda files and refile targets
4 |
5 | (require 'org-ql-find)
6 | (require 'org-capture)
7 |
8 | (defcustom org-ql-usual-files
9 | (seq-union
10 | (seq-union (mapcan #'seq-copy (mapcar #'car org-refile-targets))
11 | org-agenda-files)
12 | (cl-loop for (_ _ _ (type file . _) _) in org-capture-templates
13 | when (string-prefix-p "file" (symbol-name type))
14 | collect (abbreviate-file-name
15 | (expand-file-name file org-directory))))
16 | "Org files I usually want to search with `org-ql-find'."
17 | :type '(repeat file)
18 | :group 'org-ql)
19 |
20 | (defun org-ql-usual-files ()
21 | "Return list of org files I usually want to search.
22 | This returns `org-ql-usual-files' plus the current buffer if
23 | it's in `org-mode'."
24 | (append
25 | (when (and (derived-mode-p 'org-mode)
26 | (not (and (buffer-file-name)
27 | (member (abbreviate-file-name (buffer-file-name))
28 | org-ql-usual-files))))
29 | (list (current-buffer)))
30 | org-ql-usual-files))
31 |
32 | (defun org-ql-usual-files-find ()
33 | "Call `org-ql-find' on current buffer and `org-ql-usual-files'."
34 | (interactive)
35 | (org-ql-find (org-ql-usual-files) :widen t))
36 |
37 | (defun org-ql-usual-files-open-link ()
38 | "Call `org-ql-open-link' on current buffer and `org-ql-usual-files'."
39 | (interactive)
40 | (org-ql-open-link (org-ql-usual-files)))
41 |
42 | (provide 'org-ql-usual-files)
43 |
--------------------------------------------------------------------------------
/my-lisp/shr-heading.el:
--------------------------------------------------------------------------------
1 | ;;; shr-heading.el --- Navigation by heading -*- lexical-binding: t; -*-
2 |
3 | (defun shr-heading-next (&optional arg)
4 | "Move forward by ARG headings (any h1-h4).
5 | If ARG is negative move backwards, ARG defaults to 1."
6 | (interactive "p")
7 | (unless arg (setq arg 1))
8 | (catch 'return
9 | (dotimes (_ (abs arg))
10 | (when (> arg 0) (end-of-line))
11 | (if-let ((match
12 | (funcall (if (> arg 0)
13 | #'text-property-search-forward
14 | #'text-property-search-backward)
15 | 'face '(shr-h1 shr-h2 shr-h3 shr-h4)
16 | (lambda (tags face)
17 | (cl-loop for x in (if (consp face) face (list face))
18 | thereis (memq x tags))))))
19 | (goto-char
20 | (if (> arg 0) (prop-match-beginning match) (prop-match-end match)))
21 | (throw 'return nil))
22 | (when (< arg 0) (beginning-of-line)))
23 | (beginning-of-line)
24 | (point)))
25 |
26 | (defun shr-heading-previous (&optional arg)
27 | "Move backward by ARG headings (any h1-h4).
28 | If ARG is negative move forwards instead, ARG defaults to 1."
29 | (interactive "p")
30 | (shr-heading-next (- (or arg 1))))
31 |
32 | (defun shr-heading--line-at-point ()
33 | "Return the current line."
34 | (buffer-substring (line-beginning-position) (line-end-position)))
35 |
36 | (defun shr-heading-setup-imenu ()
37 | "Setup imenu for h1-h4 headings in eww buffer.
38 | Add this function to appropriate major mode hooks such as
39 | `eww-mode-hook' or `elfeed-show-mode-hook'."
40 | (setq-local
41 | imenu-prev-index-position-function #'shr-heading-previous
42 | imenu-extract-index-name-function #'shr-heading--line-at-point))
43 |
44 | (defvar shr-heading-repeat-map
45 | (let ((map (make-sparse-keymap)))
46 | (define-key map "n" #'shr-heading-next)
47 | (define-key map "\C-n" #'shr-heading-next)
48 | (define-key map "p" #'shr-heading-previous)
49 | (define-key map "\C-p" #'shr-heading-previous)
50 | map)
51 | "Keymap used to repeat shr heading key sequences. Used in `repeat-mode'.")
52 |
53 | (put 'shr-heading-next 'repeat-map 'shr-heading-repeat-map)
54 | (put 'shr-heading-previous 'repeat-map 'shr-heading-repeat-map)
55 |
56 | (provide 'shr-heading)
57 |
--------------------------------------------------------------------------------
/my-lisp/text-extras.el:
--------------------------------------------------------------------------------
1 | ;;; text-extras.el --- Miscellaneous text editing commands -*- lexical-binding: t; -*-
2 |
3 | ;;; the most miscellaneous commands of all
4 |
5 | (defun unfill-paragraph ()
6 | "Join a paragraph into a single line."
7 | (interactive)
8 | (let ((fill-column (point-max))
9 | (emacs-lisp-docstring-fill-column t))
10 | (fill-paragraph nil t)))
11 |
12 | (defun copy-word-from-above (arg)
13 | "Copy ARG words from the nonblank line above. With a negative
14 | argument, copy the rest of the line."
15 | (interactive "p")
16 | (let ((p (point))
17 | (c (current-column)))
18 | (beginning-of-line)
19 | (backward-char 1)
20 | (skip-chars-backward " \t\n\r")
21 | (move-to-column c)
22 | (let* ((beg (point))
23 | (lim (line-end-position))
24 | (end (if (< arg 0) lim (forward-word arg) (point))))
25 | (goto-char p)
26 | (insert (buffer-substring beg (min end lim))))))
27 |
28 | (defun duplicate-line-kill-word ()
29 | "Duplicate the current line and kill the word at point in the duplicate."
30 | (interactive)
31 | (let ((column (current-column)))
32 | (forward-line)
33 | (open-line 1)
34 | (copy-from-above-command)
35 | (beginning-of-line)
36 | (forward-char column)
37 | (unless (looking-at "\\<")
38 | (backward-word))
39 | (kill-word 1)))
40 |
41 | (defun goto-random-line ()
42 | "Goto a random line in the buffer."
43 | (interactive)
44 | (push-mark)
45 | (goto-char (point-min))
46 | (forward-line (random (count-lines (point-min) (point-max)))))
47 |
48 | (defvar-keymap random-line-map
49 | :doc "Repeat map for `goto-random-line'"
50 | "r" #'goto-random-line)
51 |
52 | (put 'goto-random-line 'repeat-map 'random-line-map)
53 |
54 | (defun pipe-region (start end command)
55 | "Pipe region through shell command. If the mark is inactive,
56 | pipe whole buffer."
57 | (interactive (append
58 | (if (use-region-p)
59 | (list (region-beginning) (region-end))
60 | (list (point-min) (point-max)))
61 | (list (read-shell-command "Pipe through: "))))
62 | (let ((exit-status (call-shell-region start end command t t)))
63 | (unless (equal 0 exit-status)
64 | (let ((error-msg (string-trim-right (buffer-substring (mark) (point)))))
65 | (undo)
66 | (cond
67 | ((null exit-status)
68 | (message "Unknown error"))
69 | ((stringp exit-status)
70 | (message "Signal %s" exit-status))
71 | (t
72 | (message "[%d] %s" exit-status error-msg)))))))
73 |
74 | (defun forward-to-whitespace (arg)
75 | "Move forward to the end of the next sequence of non-whitespace
76 | characters. With argument, do this that many times."
77 | (interactive "^p")
78 | (re-search-forward
79 | (if (> arg 0)
80 | "[^[:blank:]\n]\\(?:[[:blank:]\n]\\|\\'\\)"
81 | "\\(?:[[:blank:]\n]\\|\\`\\)[^[:blank:]\n]")
82 | nil t arg)
83 | (unless (= (point) (if (> arg 0) (point-max) (point-min)))
84 | (forward-char (if (> arg 0) -1 1))))
85 |
86 | (defun backward-to-whitespace (arg)
87 | "Move backward to the beginning of the previous sequence of
88 | non-whitespace characters. With argument, do this that many
89 | times."
90 | (interactive "^p")
91 | (forward-to-whitespace (- arg)))
92 |
93 | ;;; marking things
94 |
95 | (defmacro define-thing-marker (fn-name things forward-thing &rest extra)
96 | `(defun ,fn-name (&optional arg allow-extend)
97 | ,(format "Mark ARG %s starting with the current one. If ARG is negative,
98 | mark -ARG %s ending with the current one.
99 |
100 | Interactively (or if ALLOW-EXTEND is non-nil), if this command is
101 | repeated or (in Transient Mark mode) if the mark is active, it
102 | marks the next ARG %s after the ones already marked." things things things)
103 | (interactive "p\np")
104 | (unless arg (setq arg 1))
105 | (if (and allow-extend
106 | (or (and (eq last-command this-command) (mark t))
107 | (and transient-mark-mode mark-active)))
108 | (set-mark
109 | (save-excursion
110 | (goto-char (mark))
111 | (,forward-thing arg)
112 | (point)))
113 | ,(plist-get extra :pre)
114 | (,forward-thing arg)
115 | ,(plist-get extra :post)
116 | (push-mark nil t t)
117 | (,forward-thing (- arg)))))
118 |
119 | (define-thing-marker mark-line "lines" forward-line
120 | :post (unless (= (preceding-char) ?\n)
121 | (setq arg (1- arg))))
122 |
123 | (define-thing-marker mark-char "characters" forward-char)
124 |
125 | (define-thing-marker mark-my-word "words" forward-word
126 | :pre (when (and (looking-at "\\>") (> arg 0))
127 | (forward-word -1)))
128 |
129 | (define-thing-marker mark-non-whitespace "vim WORDS"
130 | forward-to-whitespace)
131 |
132 | ;;; case change commands
133 |
134 | (defmacro define-case-changer (case)
135 | "Define a CASE change command that does what I want.
136 | The defined command will change the case of: the region if
137 | active, and of the next prefix argument many words, starting with
138 | the word point is either on or right after (the \"or right
139 | after\" bit is the only difference with the built-in case-dwim
140 | commands)."
141 | (cl-flet ((case-fn (suffix) (intern (format "%s-%s" case suffix))))
142 | `(defun ,(case-fn 'dwiw) (arg)
143 | ,(format "%s active region or next ARG words.
144 | If called without a prefix argument and no active region with
145 | point at the end of a word, then %s the previous word. This is
146 | the only difference between this command and %s-dwim."
147 | (capitalize (symbol-name case)) case case)
148 | (interactive "*p")
149 | (if (use-region-p)
150 | (,(case-fn 'region)
151 | (region-beginning) (region-end) (region-noncontiguous-p))
152 | (when (and (eolp) (= arg 1))
153 | (setq arg -1))
154 | (,(case-fn 'word) arg)))))
155 |
156 | (define-case-changer upcase)
157 | (define-case-changer downcase)
158 | (define-case-changer capitalize)
159 |
160 | ;;; poor man's paredit
161 |
162 | (defun mark-inside-sexp ()
163 | "Mark inside a sexp."
164 | (interactive)
165 | (let (beg end)
166 | (backward-up-list 1 t t)
167 | (setq beg (1+ (point)))
168 | (forward-sexp)
169 | (setq end (1- (point)))
170 | (goto-char beg)
171 | (push-mark)
172 | (goto-char end))
173 | (activate-mark))
174 |
175 | (defun kill-inside-sexp ()
176 | "Kill inside a sexp."
177 | (interactive)
178 | (mark-inside-sexp)
179 | (kill-region (mark) (point)))
180 |
181 | (defun unwrap-sexp ()
182 | "Unwrap a sexp."
183 | (interactive)
184 | (let (end)
185 | (mark-inside-sexp)
186 | (delete-char 1)
187 | (setq end (1- (point)))
188 | (goto-char (mark))
189 | (delete-char -1)
190 | (set-mark end)))
191 |
192 | (defun unwrap-mark-sexp ()
193 | "Unwrap a sexp and mark the contents."
194 | (interactive)
195 | (unwrap-sexp)
196 | (setq deactivate-mark nil))
197 |
198 | ;;; Continue dabbreving with the greatest of ease
199 |
200 | (defun dabbrev-next (arg)
201 | "Insert the next ARG words from where previous expansion was found."
202 | (interactive "p")
203 | (dotimes (_ arg)
204 | (insert " ")
205 | (dabbrev-expand 1))
206 | (setq this-command 'dabbrev-expand))
207 |
208 | (defun dabbrev-complete-next ()
209 | "Choose a continuation for the previous expansion with completion."
210 | (interactive)
211 | (insert " ")
212 | (dabbrev-completion))
213 |
214 | ;;; pop up a buffer for text to send to clipboard
215 |
216 | (defun text-to-clipboard--done ()
217 | "Copy buffer contents to clipboard and quit window."
218 | (interactive)
219 | (gui-set-selection
220 | 'CLIPBOARD
221 | (buffer-substring-no-properties (point-min) (point-max)))
222 | (quit-window :kill))
223 |
224 | (defvar-keymap text-to-clipboard-minor-mode-map
225 | "C-c C-c" #'text-to-clipboard--done)
226 |
227 | (define-minor-mode text-to-clipboard-minor-mode
228 | "Minor mode binding a key to quit window and copy buffer to clipboard.")
229 |
230 | (defun text-to-clipboard ()
231 | "Pop up a temporary buffer to collect text to send to the clipboard.
232 | The pop up buffer is in `markdown-mode' and uses the TeX input
233 | method. Use \\\\[text-to-clipboard--done] to send the buffer contents to the clipboard
234 | and quit the window, killing the buffer.
235 |
236 | If the region is active, use the region as the initial contents
237 | for the pop up buffer."
238 | (interactive)
239 | (let ((region (when (use-region-p)
240 | (buffer-substring-no-properties
241 | (region-beginning) (region-end)))))
242 | (pop-to-buffer (generate-new-buffer "*clipboard*"))
243 | (when region (insert region)))
244 | (if (fboundp 'markdown-mode) (markdown-mode) (text-mode))
245 | (text-to-clipboard-minor-mode))
246 |
247 | (defun apply-macro-to-rest-of-paragraph ()
248 | "Apply last keyboard macro to each line in the rest of the current paragraph."
249 | (interactive)
250 | (when defining-kbd-macro (kmacro-end-macro nil))
251 | (apply-macro-to-region-lines
252 | (line-beginning-position 2)
253 | (save-excursion (end-of-paragraph-text) (point))))
254 |
255 | (defun echo-area-tooltips ()
256 | "Show tooltips in the echo area automatically for current buffer."
257 | (setq-local help-at-pt-display-when-idle t
258 | help-at-pt-timer-delay 0)
259 | (help-at-pt-cancel-timer)
260 | (help-at-pt-set-timer))
261 |
262 | (provide 'text-extras)
263 |
--------------------------------------------------------------------------------
/my-lisp/tmp-buffer.el:
--------------------------------------------------------------------------------
1 | ;;; tmp-buffer.el --- Temporary buffers in specified major mode -*- lexical-binding: t; -*-
2 |
3 | (defcustom tmp-buffer-mode-alist
4 | '((?o . org-mode)
5 | (?t . text-mode)
6 | (?m . markdown-mode)
7 | (?l . lisp-interaction-mode)
8 | (?x . LaTeX-mode)
9 | (?f . fundamental-mode)
10 | (?= . tmp-buffer-current-mode)
11 | (?? . tmp-buffer-prompt-for-mode))
12 | "List of major modes for temporary buffers and their hotkeys."
13 | :type '(alist :key-type character :value-type symbol)
14 | :group 'tmp-buffer)
15 |
16 | (defvar tmp-buffer-mode-history nil)
17 |
18 | (defun tmp-buffer-prompt-for-mode ()
19 | "Prompt for a major mode and switch to it."
20 | (funcall
21 | (intern
22 | (completing-read
23 | "Mode: "
24 | (cl-loop for m being the symbols
25 | when (and (commandp m) (string-suffix-p "-mode" (symbol-name m)))
26 | collect m)
27 | nil t nil 'tmp-buffer-mode-history))))
28 |
29 | (defun tmp-buffer (spec)
30 | "Open temporary buffer in specified major mode."
31 | (interactive "c")
32 | (if (eq spec ?\C-h)
33 | (progn
34 | (help-setup-xref (list #'tmp-buffer ?\C-h)
35 | (called-interactively-p 'interactive))
36 | (with-output-to-temp-buffer (help-buffer)
37 | (princ "Temporary buffers:\n\nKey\tMode\n")
38 | (dolist (km tmp-buffer-mode-alist)
39 | (princ (format " %c\t%s\n" (car km) (cdr km))))))
40 | (let ((mode (cdr (assoc spec tmp-buffer-mode-alist))))
41 | (if (not mode)
42 | (user-error "Unknown mode for temporary buffer.")
43 | (when (eq mode 'tmp-buffer-current-mode)
44 | (setq mode major-mode))
45 | (let ((region (when (use-region-p)
46 | (buffer-substring-no-properties
47 | (region-beginning) (region-end)))))
48 | (pop-to-buffer (generate-new-buffer "*tmp*"))
49 | (when region (insert region)))
50 | (funcall mode)))))
51 |
52 | (provide 'tmp-buffer)
53 |
--------------------------------------------------------------------------------
/my-lisp/topaz-paste.el:
--------------------------------------------------------------------------------
1 | ;;; topaz-paste.el --- Generate topaz paste URLs -*- lexical-binding: t; -*-
2 |
3 | ;; https://topaz.github.io/paste/ is a "client side paste service",
4 | ;; which can be used to share snippets of text. All the data is
5 | ;; encoded in the URL as a Base64-encoded LZMA-compressed string.
6 | ;; Since both Base64 and LZMA are pretty standard this means you don't
7 | ;; actually need the website to generate a URL!
8 |
9 | (defun topaz-paste-region (begin end)
10 | "Save topaz paste URL for region contents on the kill-ring."
11 | (interactive "r")
12 | (kill-new
13 | (concat "https://topaz.github.io/paste/#"
14 | (string-replace
15 | "\n" ""
16 | (with-output-to-string
17 | (call-shell-region begin end "xz -zc --format=lzma | base64"
18 | nil standard-output)))))
19 | (message "topaz paste url saved"))
20 |
21 | (defun topaz-paste-buffer ()
22 | "Save topaz paste URL for buffer contents on the kill-ring."
23 | (interactive)
24 | (topaz-paste-region (point-min) (point-max)))
25 |
26 | (provide 'topaz-paste)
27 |
--------------------------------------------------------------------------------
/my-lisp/vc-extras.el:
--------------------------------------------------------------------------------
1 | ;;; vc-extras --- Miscellaneous commands to use with VC -*- lexical-binding: t; -*-
2 |
3 | (require 'log-view)
4 | (require 'log-edit)
5 | (require 'vc-git)
6 |
7 | (defun clear-log-edit-buffer (&optional _)
8 | "Clear the buffer if it is in `log-edit-mode'.
9 | Intended to be used as advice for `consult-history'."
10 | (when (derived-mode-p 'log-edit-mode)
11 | (erase-buffer)))
12 |
13 | (defun log-view-save-commit-hash ()
14 | "Save commit hash of log entry at point to `kill-ring'."
15 | ;; This is Protesilaos' prot-vc-log-kill-hash function
16 | (interactive)
17 | (let ((commit (cadr (log-view-current-entry (point) t))))
18 | (kill-new (format "%s" commit))
19 | (message "Copied: %s" commit)))
20 |
21 | (defun vc-git-commit (message)
22 | "Run git commit -m MESSAGE.
23 | Interactively MESSAGE is just \"Merge resolving conflicts\", but
24 | with a prefix argument you are prompted for a message."
25 | (interactive
26 | (list (if current-prefix-arg
27 | (read-from-minibuffer "Commit message: " "Merge")
28 | "Merge resolving conflicts")))
29 | (vc-git-command nil 0 nil "commit" "-m" message)
30 | (message "Commited with message: %s" message)
31 | (when (derived-mode-p 'vc-dir-mode)
32 | (revert-buffer)))
33 |
34 | (provide 'vc-extras)
35 |
--------------------------------------------------------------------------------
/my-lisp/vimgolf.el:
--------------------------------------------------------------------------------
1 | ;;; vimgolf.el --- Play VimGolf in Emacs -*- lexical-binding: t; -*-
2 |
3 | (require 'json)
4 |
5 | (defun vimgolf ()
6 | "Setup buffers for vimgolf challenge."
7 | (interactive)
8 | (goto-char (point-min))
9 | (let ((json (json-read)))
10 | (switch-to-buffer "*VimGolf B*")
11 | (insert (cdr (assoc 'data (cdr (assoc 'out json)))))
12 | (goto-char (point-min))
13 | (split-window-horizontally)
14 | (switch-to-buffer "*VimGolf A*")
15 | (insert (cdr (assoc 'data (cdr (assoc 'in json)))))
16 | (goto-char (point-min))))
17 |
18 | (provide 'vimgolf)
19 |
--------------------------------------------------------------------------------
/my-lisp/visiting-buffer.el:
--------------------------------------------------------------------------------
1 | ;;; visiting-buffer.el --- When deleting or renaming files deal with buffer too -*- lexical-binding: t; -*-
2 |
3 | (defun visiting-buffer-rename (file newname &optional _ok-if-already-exists)
4 | "Rename buffer visiting FILE to NEWNAME.
5 | Intended as :after advice for `rename-file'."
6 | (when (called-interactively-p 'any)
7 | (when-let ((old (get-file-buffer file)))
8 | (with-current-buffer old
9 | (set-visited-file-name newname nil t)))
10 | (when-let ((new (get-file-buffer newname)))
11 | (with-current-buffer new
12 | (when (derived-mode-p 'emacs-lisp-mode)
13 | (save-excursion
14 | (let* ((base (file-name-nondirectory file))
15 | (sans (file-name-sans-extension base))
16 | (newbase (file-name-nondirectory newname))
17 | (newsans (file-name-sans-extension newbase)))
18 | (goto-char (point-min))
19 | (while (search-forward-regexp (format "^;;; %s" base) nil t)
20 | (replace-match (concat ";;; " newbase)))
21 | (goto-char (point-max))
22 | (when
23 | (search-backward-regexp (format "^(provide '%s)" sans) nil t)
24 | (replace-match (format "(provide '%s)" newsans))))))))))
25 |
26 | (advice-add 'rename-file :after 'visiting-buffer-rename)
27 | (advice-add 'vc-rename-file :after 'visiting-buffer-rename)
28 |
29 | (defun visiting-buffer-kill (file &optional _trash)
30 | "Kill buffer visiting FILE.
31 | Intended as :after advice for `delete-file'."
32 | (when (called-interactively-p 'any)
33 | (when-let ((buffer (get-file-buffer file)))
34 | (kill-buffer buffer))))
35 |
36 | (advice-add 'delete-file :after 'visiting-buffer-kill)
37 | (advice-add 'vc-delete-file :after 'visiting-buffer-kill)
38 |
39 | (provide 'visiting-buffer)
40 |
--------------------------------------------------------------------------------
/my-lisp/webjump-extras.el:
--------------------------------------------------------------------------------
1 | ;;; webjump-extras.el --- webjump-sites = eww-bookmarks + searches -*- lexical-binding: t; -*-
2 |
3 | (require 'webjump)
4 | (require 'eww)
5 |
6 | (defcustom webjump-search-engines
7 | '(("DuckDuckGo" . "https://html.duckduckgo.com/html/?q=")
8 | ("Google" . "https://google.com/?q=")
9 | ("Wikipedia" . "https://en.wikipedia.org/wiki/")
10 | ("DLE RAE" . "https://dle.rae.es/")
11 | ("IMDb" . "https://www.imdb.com/find?q=")
12 | ("YouTube" . "https://www.youtube.com/results?search_query=")
13 | ("Merriam-Webster" . "https://www.merriam-webster.com/dictionary/")
14 | ("Collins" . "https://www.collinsdictionary.com/dictionary/english/")
15 | ("arXiv" . "https://arxiv.org/search/?searchtype=all&query=")
16 | ("math.??" . "https://arxiv.org/list/math. /recent"))
17 | "Search engines to add to `webjump-sites' as `simply-query' sites."
18 | :group 'webjump
19 | :type '(alist :key-type (string :tag "Name")
20 | :value-type (string :tag "URL")))
21 |
22 | (defun webjump-reload ()
23 | "Reload `webjump-sites' from eww bookmarks and `webjump-search-engines'."
24 | (interactive)
25 | (setq webjump-sites
26 | (append
27 | (progn
28 | (eww-read-bookmarks)
29 | (mapcar (lambda (bm)
30 | (cons (plist-get bm :title) (plist-get bm :url)))
31 | eww-bookmarks))
32 | (mapcar (pcase-lambda (`(,name . ,url))
33 | (setq url (split-string url " "))
34 | `(,name . [simple-query
35 | ,(when (string-match "^.*://[^/]+" (car url))
36 | (match-string 0 (car url)))
37 | ,(car url) ,(or (cadr url) "")]))
38 | webjump-search-engines))))
39 |
40 | (defun webjump-in-eww (fn &rest args)
41 | (let ((browse-url-browser-function
42 | (if current-prefix-arg #'browse-url-default-browser #'eww)))
43 | (apply fn args)))
44 |
45 | (advice-add 'webjump :around #'webjump-in-eww)
46 |
47 | (provide 'webjump-extras)
48 |
--------------------------------------------------------------------------------
/my-lisp/window-extras.el:
--------------------------------------------------------------------------------
1 | ;;; window-extras.el --- Miscellaneous window commands -*- lexical-binding: t; -*-
2 |
3 | (defun toggle-window-split ()
4 | "Toggle window split from vertical to horizontal."
5 | (interactive)
6 | (if (> (length (window-list)) 2)
7 | (error "Can't toggle with more than 2 windows.")
8 | (let ((was-full-height (window-full-height-p)))
9 | (delete-other-windows)
10 | (if was-full-height
11 | (split-window-vertically)
12 | (split-window-horizontally))
13 | (save-selected-window
14 | (other-window 1)
15 | (switch-to-buffer (other-buffer))))))
16 |
17 | (defun transpose-windows ()
18 | "Swap the buffers shown in current and next window."
19 | (interactive)
20 | (let ((this-buffer (window-buffer))
21 | (next-window (next-window nil :no-minibuf nil)))
22 | (set-window-buffer nil (window-buffer next-window))
23 | (set-window-buffer next-window this-buffer)
24 | (select-window next-window)))
25 |
26 | ;; Modified slightly from alphapapa's original at:
27 | ;; https://www.reddit.com/r/emacs/comments/idz35e/emacs_27_can_take_svg_screenshots_of_itself/g2c2c6y
28 | (defun screenshot (arg)
29 | "Save a screenshot of the current frame to ~/Downloads.
30 | By default save a PNG, but with a prefix argument, save a an SVG."
31 | (interactive "P")
32 | (let* ((type (if arg 'svg 'png))
33 | (filename (make-temp-file
34 | "~/Downloads/Emacs" nil (format ".%s" type)
35 | (x-export-frames nil type))))
36 | (kill-new filename)
37 | (message "Saved %s" filename)))
38 |
39 | (defun toggle-mode-line ()
40 | "Toggle visibility of the mode line."
41 | (interactive)
42 | (if mode-line-format
43 | (setq-local mode-line-format nil)
44 | (kill-local-variable 'mode-line-format)
45 | (force-mode-line-update)))
46 |
47 | (provide 'window-extras)
48 |
--------------------------------------------------------------------------------
/viper:
--------------------------------------------------------------------------------
1 | (setq viper-inhibit-startup-message 't)
2 | (setq viper-expert-level '5)
3 | (setq viper-want-ctl-h-help t)
4 | (setq viper-ex-style-motion nil)
5 | (define-key viper-minibuffer-map (kbd "RET") nil)
6 | (viper-buffer-search-enable)
7 |
--------------------------------------------------------------------------------