diff options
author | Case Duckworth | 2021-12-13 10:29:50 -0600 |
---|---|---|
committer | Case Duckworth | 2021-12-13 10:29:50 -0600 |
commit | b11adad984e8160e366d7e154d12c378a9545b9a (patch) | |
tree | 72c23feb56d4d05107ac8285537429786efcda0d /lisp | |
parent | Mostley add +key.el (but of course other stuff) (diff) | |
download | emacs-b11adad984e8160e366d7e154d12c378a9545b9a.tar.gz emacs-b11adad984e8160e366d7e154d12c378a9545b9a.zip |
Lots of changes, most interestingly browse-url stuff
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/+browse-url.el | 117 | ||||
-rw-r--r-- | lisp/+elfeed.el | 24 | ||||
-rw-r--r-- | lisp/+emacs.el | 1 | ||||
-rw-r--r-- | lisp/+key.el | 14 | ||||
-rw-r--r-- | lisp/+modeline.el | 8 | ||||
-rw-r--r-- | lisp/+org.el | 55 | ||||
-rw-r--r-- | lisp/+util.el | 8 |
7 files changed, 223 insertions, 4 deletions
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el new file mode 100644 index 0000000..fad0826 --- /dev/null +++ b/lisp/+browse-url.el | |||
@@ -0,0 +1,117 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | |||
7 | (defgroup +browse-url nil | ||
8 | "Group for my `browse-url' extras." | ||
9 | :group 'browse-url) | ||
10 | |||
11 | ;;; URL Handlers | ||
12 | |||
13 | (defun +browse-url-set-handlers (handlers) | ||
14 | "Set handlers for `browse-url'. | ||
15 | Set `browse-url-handlers', if they exist; else | ||
16 | `browse-url-browser-function'. The reason for this switch is | ||
17 | that the latter is deprecated in Emacs 28+." | ||
18 | (set-default (if (boundp 'browse-url-handlers) | ||
19 | 'browse-url-handlers | ||
20 | 'browse-url-browser-function) | ||
21 | handlers)) | ||
22 | |||
23 | (cl-defmacro +browse-url-make-external-viewer-handler | ||
24 | (viewer default-args &optional (prompt "URL: ") | ||
25 | &key | ||
26 | (custom-group '+browse-url) | ||
27 | (name (format "+browse-url-with-%s" viewer))) | ||
28 | "Create a `browse-url' handler function that calls VIEWER on the url. | ||
29 | Also create a `customize' setting in CUSTOM-GROUP for VIEWER's | ||
30 | arguments. DEFAULT-ARGS specifies the default arguments that | ||
31 | setting should have. PROMPT will be shown to user in the | ||
32 | function's `interactive' spec, as an argument to | ||
33 | `browse-url-interactive-arg'. The resulting function will be | ||
34 | named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable | ||
35 | \"NAME-args\"." | ||
36 | (declare (indent 1)) | ||
37 | `(progn | ||
38 | (defcustom ,(intern (format "%s-args" name)) | ||
39 | ,default-args | ||
40 | ,(format "Arguments to pass to %s in `%s'." viewer name) | ||
41 | :type '(repeat :tag "Command-line argument" string) | ||
42 | :group ',custom-group) | ||
43 | (defun ,(intern name) (url &optional _new-window) | ||
44 | ,(format "Open URL in %s." viewer) | ||
45 | (interactive (browse-url-interactive-arg ,prompt)) | ||
46 | (let* ((url (browse-url-encode-url url)) | ||
47 | (process-environment (browse-url-process-environment))) | ||
48 | (message ,(format "Opening %%s in %s..." viewer) url) | ||
49 | (apply #'start-process | ||
50 | (concat ,viewer " " url) nil | ||
51 | ,viewer | ||
52 | (append ,(intern (format "%s-args" name)) (list url))))))) | ||
53 | |||
54 | ;; Reference implementation: mpv | ||
55 | (+browse-url-make-external-viewer-handler "mpv" nil "Video URL: ") | ||
56 | ;; And feh too | ||
57 | (+browse-url-make-external-viewer-handler "feh" '("--auto-zoom" | ||
58 | "--geometry" "800x600")) | ||
59 | ;; And ... mpv, but for images | ||
60 | (+browse-url-make-external-viewer-handler "mpv" | ||
61 | '("--image-display-duration=inf") | ||
62 | "Image URL: " | ||
63 | :name "+browse-image-with-mpv") | ||
64 | |||
65 | ;;; URL Transformation Functions | ||
66 | ;; There's a lot of bad websites out there. Luckily we can easily redirect | ||
67 | ;; requests to more privacy-respecting, or just less javascript-ridden, sites | ||
68 | ;; using some basic regex magic. Inspired by add-ons like | ||
69 | ;; https://einaregilsson.com/redirector/. | ||
70 | |||
71 | (defcustom +browse-url-transformations nil | ||
72 | "Transformation rules for various URLs. | ||
73 | This is an alist, the keys of which are regexen to match URLs | ||
74 | against, and the values are how to transform them. Match capture | ||
75 | data will be used in the transformations." | ||
76 | :type | ||
77 | '(alist :key-type (string :tag "URL regex match") | ||
78 | :value-type (string :tag "URL regex transformation")) | ||
79 | :group '+browse-url) | ||
80 | |||
81 | (defun +browse-url-transform-advice (url &rest args) | ||
82 | "ADVICE to transform URL for later opening by `browse-url'. | ||
83 | ARGS are ignored here, but passed on for later processing." | ||
84 | ;; Basically, loop through `+browse-url-transformations' until finding a CAR | ||
85 | ;; that matches the URL. If one is found, transform it using `replace-match' | ||
86 | ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged, | ||
87 | ;; along with the rest of the args, in a list to the original caller (probably | ||
88 | ;; `browse-url'.) | ||
89 | (apply 'list | ||
90 | (cl-loop with url = (substring-no-properties | ||
91 | (if (consp url) (car url) url)) | ||
92 | for (regex . transformation) in +browse-url-transformations | ||
93 | if (string-match regex url) | ||
94 | return (replace-match transformation nil nil url) | ||
95 | ;; else | ||
96 | finally return url) | ||
97 | args)) | ||
98 | |||
99 | (define-minor-mode +browse-url-transform-url-mode | ||
100 | "Minor mode to transform a URL before passing it to `browse-url'. | ||
101 | This can be used to \"redirect\" URLs, for example from an | ||
102 | information silo to a more privacy-respecting one (e.g., | ||
103 | \"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. | ||
104 | |||
105 | When using this mode, ensure that the transformed URL is also in | ||
106 | `browse-url-handlers', since that's what `browse-url' will see." | ||
107 | :lighter " Xurl" | ||
108 | :keymap nil | ||
109 | (if +browse-url-transform-url-mode | ||
110 | (advice-add 'browse-url :filter-args '+browse-url-transform-advice) | ||
111 | (advice-remove 'browse-url '+browse-url-transform-advice))) | ||
112 | |||
113 | (define-global-minor-mode +browse-url-transform-url-global-mode | ||
114 | +browse-url-transform-url-mode +browse-url-transform-url-mode) | ||
115 | |||
116 | (provide '+browse-url) | ||
117 | ;;; +browse-url.el ends here | ||
diff --git a/lisp/+elfeed.el b/lisp/+elfeed.el new file mode 100644 index 0000000..823902b --- /dev/null +++ b/lisp/+elfeed.el | |||
@@ -0,0 +1,24 @@ | |||
1 | ;;; +elfeed.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'elfeed) | ||
6 | |||
7 | (defun +elfeed-scroll-up-command (&optional arg) | ||
8 | "Scroll up or go to next feed item in Elfeed" | ||
9 | (interactive "^P") | ||
10 | (let ((scroll-error-top-bottom nil)) | ||
11 | (condition-case-unless-debug nil | ||
12 | (scroll-up-command arg) | ||
13 | (error (elfeed-show-next))))) | ||
14 | |||
15 | (defun +elfeed-scroll-down-command (&optional arg) | ||
16 | "Scroll up or go to next feed item in Elfeed" | ||
17 | (interactive "^P") | ||
18 | (let ((scroll-error-top-bottom nil)) | ||
19 | (condition-case-unless-debug nil | ||
20 | (scroll-down-command arg) | ||
21 | (error (elfeed-show-prev))))) | ||
22 | |||
23 | (provide '+elfeed) | ||
24 | ;;; +elfeed.el ends here | ||
diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 147bb76..a858cf6 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el | |||
@@ -69,7 +69,6 @@ Do this only if the buffer is not visiting a file." | |||
69 | kill-do-not-save-duplicates t | 69 | kill-do-not-save-duplicates t |
70 | kill-read-only-ok t | 70 | kill-read-only-ok t |
71 | kill-ring-max 500 | 71 | kill-ring-max 500 |
72 | kill-whole-line t | ||
73 | kmacro-ring-max 20 | 72 | kmacro-ring-max 20 |
74 | load-prefer-newer t | 73 | load-prefer-newer t |
75 | major-mode '+set-major-mode-from-buffer-name | 74 | major-mode '+set-major-mode-from-buffer-name |
diff --git a/lisp/+key.el b/lisp/+key.el index 5b4f467..7a51be1 100644 --- a/lisp/+key.el +++ b/lisp/+key.el | |||
@@ -14,6 +14,9 @@ | |||
14 | 14 | ||
15 | ;;; Code: | 15 | ;;; Code: |
16 | 16 | ||
17 | (require 'easy-mmode) | ||
18 | (require 'setup nil t) | ||
19 | |||
17 | ;; I need to define this map before the proper mode map. | 20 | ;; I need to define this map before the proper mode map. |
18 | (defvar +key-leader-map (let ((map (make-sparse-keymap)) | 21 | (defvar +key-leader-map (let ((map (make-sparse-keymap)) |
19 | (c-z (global-key-binding "\C-z"))) | 22 | (c-z (global-key-binding "\C-z"))) |
@@ -30,13 +33,18 @@ | |||
30 | (define-minor-mode +key-mode | 33 | (define-minor-mode +key-mode |
31 | "A minor mode with keybindings that will override every other mode." | 34 | "A minor mode with keybindings that will override every other mode." |
32 | :init-value t | 35 | :init-value t |
33 | :lighter " +" | 36 | :lighter " +") |
34 | :keymap +key-mode-map) | 37 | (add-to-list 'emulation-mode-map-alists `((+key-mode . ,+key-mode-map))) |
35 | 38 | ||
36 | ;;;###autoload | 39 | ;;;###autoload |
37 | (define-globalized-minor-mode +key-global-mode +key-mode +key-mode) | 40 | (define-globalized-minor-mode +key-global-mode +key-mode +key-mode) |
38 | 41 | ||
39 | (add-to-list 'emulation-mode-map-alists `((+key-mode . ,+key-mode-map))) | 42 | ;;;###autoload |
43 | (defun +key-setup () | ||
44 | "Setup `+key-mode' after everything else." | ||
45 | (if after-init-time | ||
46 | (+key-global-mode +1) | ||
47 | (add-hook 'after-init-hook '+key-global-mode))) | ||
40 | 48 | ||
41 | (defun turn-off-+key-mode () | 49 | (defun turn-off-+key-mode () |
42 | "Turn off `+key-mode'." | 50 | "Turn off `+key-mode'." |
diff --git a/lisp/+modeline.el b/lisp/+modeline.el index 0dc34c7..7c74f76 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el | |||
@@ -153,5 +153,13 @@ The order of elements matters: whichever one matches first is applied." | |||
153 | "Display `anzu--update-mode-line'." | 153 | "Display `anzu--update-mode-line'." |
154 | (concat " " (anzu--update-mode-line))) | 154 | (concat " " (anzu--update-mode-line))) |
155 | 155 | ||
156 | (defun +modeline-text-scale () | ||
157 | "Display text scaling level." | ||
158 | ;; adapted from https://github.com/seagle0128/doom-modeline | ||
159 | (when (and (boundp 'text-scale-mode-amount) | ||
160 | (/= text-scale-mode-amount 0)) | ||
161 | (format (if (> text-scale-mode-amount 0) " (%+d)" " (%-d)") | ||
162 | text-scale-mode-amount))) | ||
163 | |||
156 | (provide '+modeline) | 164 | (provide '+modeline) |
157 | ;;; +modeline.el ends here | 165 | ;;; +modeline.el ends here |
diff --git a/lisp/+org.el b/lisp/+org.el index a4ce230..9a91ef1 100644 --- a/lisp/+org.el +++ b/lisp/+org.el | |||
@@ -337,5 +337,60 @@ the deletion might narrow the column." | |||
337 | (backward-delete-char-untabify N) | 337 | (backward-delete-char-untabify N) |
338 | (org-fix-tags-on-the-fly)))) | 338 | (org-fix-tags-on-the-fly)))) |
339 | 339 | ||
340 | ;;; Smarter {super,sub}scripts | ||
341 | ;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/ | ||
342 | ;; I don't use this currently because I found out about | ||
343 | ;; `org-pretty-entities-include-sub-superscripts', which really does exactly | ||
344 | ;; what I wanted. | ||
345 | |||
346 | (defface +org-script-markers '((t :inherit shadow)) | ||
347 | "Face to be used for sub/superscripts markers i.e., ^, _, {, }.") | ||
348 | |||
349 | ;; Hiding the super and subscript markers is extremely annoying | ||
350 | ;; since any remotely complex equation becomes a chore. And leaving | ||
351 | ;; it not raised is jarring to the eye. So this fontifies the | ||
352 | ;; buffer just like how auctex does -- use a muted colour to | ||
353 | ;; highlight the markup and raise the script. | ||
354 | (defun +org-raise-scripts (limit) | ||
355 | "Differences from `org-raise-scripts' are: | ||
356 | |||
357 | - It doesn't actually hide the markup used for super and subscript. | ||
358 | - It uses a custom face to highlight the markup: +org-script-markers. | ||
359 | - It doesn't require `org-pretty-entities' to be t." | ||
360 | (when (and org-pretty-entities-include-sub-superscripts | ||
361 | (re-search-forward | ||
362 | (if (eq org-use-sub-superscripts t) | ||
363 | org-match-substring-regexp | ||
364 | org-match-substring-with-braces-regexp) | ||
365 | limit t)) | ||
366 | (let* ((pos (point)) table-p comment-p | ||
367 | (mpos (match-beginning 3)) | ||
368 | (emph-p (get-text-property mpos 'org-emphasis)) | ||
369 | (link-p (get-text-property mpos 'mouse-face)) | ||
370 | (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) | ||
371 | (goto-char (point-at-bol)) | ||
372 | (setq table-p (looking-at-p org-table-dataline-regexp) | ||
373 | comment-p (looking-at-p "^[ \t]*#[ +]")) | ||
374 | (goto-char pos) | ||
375 | ;; Handle a_b^c | ||
376 | (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) | ||
377 | (unless (or comment-p emph-p link-p keyw-p) | ||
378 | (put-text-property (match-beginning 3) (match-end 0) | ||
379 | 'display | ||
380 | (if (equal (char-after (match-beginning 2)) ?^) | ||
381 | ;; (nth (if table-p 3 1) org-script-display) | ||
382 | (nth 3 org-script-display) | ||
383 | ;; (nth (if table-p 2 0) org-script-display) | ||
384 | (nth 2 org-script-display))) | ||
385 | (put-text-property (match-beginning 2) (match-end 2) | ||
386 | 'face 'vz/org-script-markers) | ||
387 | (when (and (eq (char-after (match-beginning 3)) ?{) | ||
388 | (eq (char-before (match-end 3)) ?})) | ||
389 | (put-text-property (match-beginning 3) (1+ (match-beginning 3)) | ||
390 | 'face '+org-script-markers) | ||
391 | (put-text-property (1- (match-end 3)) (match-end 3) | ||
392 | 'face '+org-script-markers))) | ||
393 | t))) | ||
394 | |||
340 | (provide '+org) | 395 | (provide '+org) |
341 | ;;; +org.el ends here | 396 | ;;; +org.el ends here |
diff --git a/lisp/+util.el b/lisp/+util.el index 0184a48..fb77278 100644 --- a/lisp/+util.el +++ b/lisp/+util.el | |||
@@ -79,6 +79,14 @@ ALIGNMENT can be one of these: | |||
79 | 79 | ||
80 | ;;; COMMANDS | 80 | ;;; COMMANDS |
81 | 81 | ||
82 | (defun +dos2unix (buffer) | ||
83 | "Replace \r\n with \n in BUFFER." | ||
84 | (interactive "*b") | ||
85 | (save-excursion | ||
86 | (with-current-buffer buffer | ||
87 | (goto-char (point-min)) | ||
88 | (while (search-forward (string ?\C-m ?\C-j) nil t) | ||
89 | (replace-match (string ?\C-j) nil t))))) | ||
82 | 90 | ||
83 | (provide '+util) | 91 | (provide '+util) |
84 | ;;; +util.el ends here | 92 | ;;; +util.el ends here |