diff options
author | Case Duckworth | 2022-01-14 17:20:23 -0600 |
---|---|---|
committer | Case Duckworth | 2022-01-14 17:20:23 -0600 |
commit | 4b2e57e396314e63d70558e0aa5ad32c1cf87532 (patch) | |
tree | bcd7ccb4c2fac92f7b93702e2c9ec5fa21e4a068 /lisp | |
parent | Merge branch 'main' of https://tildegit.org/acdw/emacs (diff) | |
download | emacs-4b2e57e396314e63d70558e0aa5ad32c1cf87532.tar.gz emacs-4b2e57e396314e63d70558e0aa5ad32c1cf87532.zip |
David Bowie
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/+browse-url.el | 21 | ||||
-rw-r--r-- | lisp/+modeline.el | 4 | ||||
-rw-r--r-- | lisp/elephant.el | 58 | ||||
-rw-r--r-- | lisp/remember.el | 56 | ||||
-rw-r--r-- | lisp/user-save.el | 12 |
5 files changed, 84 insertions, 67 deletions
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el index 89b21e4..cf0742b 100644 --- a/lisp/+browse-url.el +++ b/lisp/+browse-url.el | |||
@@ -25,7 +25,8 @@ that the latter is deprecated in Emacs 28+." | |||
25 | (viewer default-args &optional (prompt "URL: ") | 25 | (viewer default-args &optional (prompt "URL: ") |
26 | &key | 26 | &key |
27 | (custom-group '+browse-url) | 27 | (custom-group '+browse-url) |
28 | (name (format "+browse-url-with-%s" viewer))) | 28 | (name (format "+browse-url-with-%s" viewer)) |
29 | (fallback #'browse-url-generic)) | ||
29 | "Create a `browse-url' handler function that calls VIEWER on the url. | 30 | "Create a `browse-url' handler function that calls VIEWER on the url. |
30 | Also create a `customize' setting in CUSTOM-GROUP for VIEWER's | 31 | Also create a `customize' setting in CUSTOM-GROUP for VIEWER's |
31 | arguments. DEFAULT-ARGS specifies the default arguments that | 32 | arguments. DEFAULT-ARGS specifies the default arguments that |
@@ -33,7 +34,10 @@ setting should have. PROMPT will be shown to user in the | |||
33 | function's `interactive' spec, as an argument to | 34 | function's `interactive' spec, as an argument to |
34 | `browse-url-interactive-arg'. The resulting function will be | 35 | `browse-url-interactive-arg'. The resulting function will be |
35 | named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable | 36 | named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable |
36 | \"NAME-args\"." | 37 | \"NAME-args\". |
38 | |||
39 | If FALLBACK is non-nil, it's a function to fallback on if the | ||
40 | `start-process' call fails in anyway." | ||
37 | (declare (indent 1)) | 41 | (declare (indent 1)) |
38 | `(progn | 42 | `(progn |
39 | (defcustom ,(intern (format "%s-args" name)) | 43 | (defcustom ,(intern (format "%s-args" name)) |
@@ -41,16 +45,19 @@ named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable | |||
41 | ,(format "Arguments to pass to %s in `%s'." viewer name) | 45 | ,(format "Arguments to pass to %s in `%s'." viewer name) |
42 | :type '(repeat :tag "Command-line argument" string) | 46 | :type '(repeat :tag "Command-line argument" string) |
43 | :group ',custom-group) | 47 | :group ',custom-group) |
44 | (defun ,(intern name) (url &optional _new-window) | 48 | (defun ,(intern name) (url &optional new-window) |
45 | ,(format "Open URL in %s." viewer) | 49 | ,(format "Open URL in %s." viewer) |
46 | (interactive (browse-url-interactive-arg ,prompt)) | 50 | (interactive (browse-url-interactive-arg ,prompt)) |
47 | (let* ((url (browse-url-encode-url url)) | 51 | (let* ((url (browse-url-encode-url url)) |
48 | (process-environment (browse-url-process-environment))) | 52 | (process-environment (browse-url-process-environment))) |
49 | (message ,(format "Opening %%s in %s..." viewer) url) | 53 | (message ,(format "Opening %%s in %s..." viewer) url) |
50 | (apply #'start-process | 54 | (unless (ignore-errors |
51 | (concat ,viewer " " url) nil | 55 | (apply #'start-process |
52 | ,viewer | 56 | (concat ,viewer " " url) nil |
53 | (append ,(intern (format "%s-args" name)) (list url))))))) | 57 | ,viewer |
58 | (append ,(intern (format "%s-args" name)) | ||
59 | (list url)))) | ||
60 | (funcall fallback url new-window)))))) | ||
54 | 61 | ||
55 | ;; Reference implementation: mpv | 62 | ;; Reference implementation: mpv |
56 | (+browse-url-make-external-viewer-handler "mpv" nil "Video URL: ") | 63 | (+browse-url-make-external-viewer-handler "mpv" nil "Video URL: ") |
diff --git a/lisp/+modeline.el b/lisp/+modeline.el index 3d7b6b7..7683269 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el | |||
@@ -61,7 +61,9 @@ This function makes a lambda, so you can throw it straight into | |||
61 | "Display the buffer name." | 61 | "Display the buffer name." |
62 | (concat (or spacer +modeline-default-spacer) | 62 | (concat (or spacer +modeline-default-spacer) |
63 | (propertize | 63 | (propertize |
64 | (+string-align (buffer-name) 20 :ellipsis nil) | 64 | (truncate-string-to-width (buffer-name) |
65 | (min 24 (/ (window-width) 3)) | ||
66 | nil ?\ t) | ||
65 | 'help-echo (or (buffer-file-name) | 67 | 'help-echo (or (buffer-file-name) |
66 | (buffer-name)) | 68 | (buffer-name)) |
67 | 'mouse-face 'mode-line-highlight))) | 69 | 'mouse-face 'mode-line-highlight))) |
diff --git a/lisp/elephant.el b/lisp/elephant.el new file mode 100644 index 0000000..3cae17a --- /dev/null +++ b/lisp/elephant.el | |||
@@ -0,0 +1,58 @@ | |||
1 | ;;; elephant.el --- Remember variables and modes -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (defmacro elephant-remember (alist) | ||
6 | "Setup a closure remembering symbols to apply with | ||
7 | `remember-reset'. The variables will be renamed using TEMPLATE. | ||
8 | ALIST contains cells of the form (SYMBOL . NEW-VALUE), where | ||
9 | SYMBOL is a variable or mode name, and its value is what to set | ||
10 | after `remember-set'." | ||
11 | (unless lexical-binding | ||
12 | (user-error "`elephant' requires lexical binding.")) | ||
13 | |||
14 | (let* ((template (format "elephant--%s-%%s" (gensym))) | ||
15 | (reset-fn (intern (format template "reset")))) | ||
16 | (cl-destructuring-bind (let-list fn-set-list fn-reset-list) | ||
17 | (cl-loop | ||
18 | for (sym . val) in (if (symbolp alist) (symbol-value alist) alist) | ||
19 | as rem = (intern (format template sym)) | ||
20 | |||
21 | collect (list rem sym) | ||
22 | into let-list | ||
23 | |||
24 | collect (cond ((eq val 'enable) | ||
25 | `(,sym +1)) | ||
26 | ((eq val 'disable) | ||
27 | `(,sym -1)) | ||
28 | (t `(setq-local ,sym ,val))) | ||
29 | into fn-set-list | ||
30 | |||
31 | collect (cond ((memq val '(enable disable)) | ||
32 | `(progn (,sym (if ,rem +1 -1)) | ||
33 | (fmakunbound ',rem))) | ||
34 | (t `(progn (setq-local ,sym ,rem) | ||
35 | (makunbound ',rem)))) | ||
36 | into fn-reset-list | ||
37 | |||
38 | finally return (list let-list | ||
39 | fn-set-list | ||
40 | fn-reset-list)) | ||
41 | `(progn | ||
42 | (defvar-local ,reset-fn nil | ||
43 | "Function to recall values from `elephant-remember'.") | ||
44 | (let ,let-list | ||
45 | (setf (symbol-function ',reset-fn) | ||
46 | (lambda () | ||
47 | ,@fn-reset-list | ||
48 | (redraw-display) | ||
49 | (fmakunbound ',reset-fn)))) | ||
50 | ,@fn-set-list | ||
51 | ',reset-fn)))) | ||
52 | |||
53 | (defun elephant-forget () | ||
54 | "Forget all symbols generated by `elephant-remember'." | ||
55 | ) | ||
56 | |||
57 | (provide 'elephant) | ||
58 | ;;; elephant.el ends here | ||
diff --git a/lisp/remember.el b/lisp/remember.el deleted file mode 100644 index a759419..0000000 --- a/lisp/remember.el +++ /dev/null | |||
@@ -1,56 +0,0 @@ | |||
1 | ;;; remember.el --- Remember variables and modes -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (defmacro remember-remember (alist) | ||
6 | (let* ((template (format "remember--%s-%%s" (gensym))) | ||
7 | (reset-fn (intern (format template "recall"))) | ||
8 | (things (cl-loop for (sym . newval) in alist | ||
9 | as rem = (intern (format template sym)) | ||
10 | |||
11 | ;; Collect original values | ||
12 | |||
13 | ))))) | ||
14 | |||
15 | |||
16 | (defmacro remember-set (&rest symbols) | ||
17 | "Setup a closure remembering symbols to apply with | ||
18 | `remember-reset'. The variables will be renamed using TEMPLATE. | ||
19 | SYMBOLS is a plist: the properties are symbols or mode names, and | ||
20 | their values what to set after `remember-setup'." | ||
21 | (let* ((template (format "remember--%s-%%s" (gensym))) | ||
22 | (reset-fn (intern (format template "reset"))) | ||
23 | (list (cl-loop for sym in symbols by #'cddr | ||
24 | collect `(,(intern (format template sym)) | ||
25 | ,sym) | ||
26 | into let-list | ||
27 | collect (let ((val (plist-get symbols sym))) | ||
28 | (cond ((eq val 'enable) | ||
29 | `(,sym +1)) | ||
30 | ((eq val 'disable) | ||
31 | `(,sym -1)) | ||
32 | (t `(setq-local ,sym ,val)))) | ||
33 | into fn-set-list | ||
34 | collect (let ((val (plist-get symbols sym)) | ||
35 | (rem (intern (format template sym)))) | ||
36 | (cond ((memq val '(enable disable)) | ||
37 | `(,sym (if ,rem +1 -1))) | ||
38 | (t `(setq-local ,sym ,rem)))) | ||
39 | into fn-reset-list | ||
40 | finally return (list let-list | ||
41 | fn-reset-list | ||
42 | fn-set-list)))) | ||
43 | `(progn | ||
44 | (defvar-local ,reset-fn nil | ||
45 | "Function to recall values from `remember-set'.") | ||
46 | (let ,(cl-first list) | ||
47 | (setf (symbol-function ',reset-fn) | ||
48 | (lambda () | ||
49 | ,@(cl-second list)))) | ||
50 | ,@(cl-third list) | ||
51 | ',reset-fn))) | ||
52 | |||
53 | ;; test | ||
54 | |||
55 | (set 'fn (remember-set display-fill-column-indicator-mode disable)) | ||
56 | (funcall fn) | ||
diff --git a/lisp/user-save.el b/lisp/user-save.el index 63fe424..1284547 100644 --- a/lisp/user-save.el +++ b/lisp/user-save.el | |||
@@ -28,6 +28,12 @@ Emacs is killed." | |||
28 | "Keymap for `user-save-mode'. | 28 | "Keymap for `user-save-mode'. |
29 | This map shadows the default map for `save-buffer'.") | 29 | This map shadows the default map for `save-buffer'.") |
30 | 30 | ||
31 | (defun user-save-run-hooks (&rest _) | ||
32 | "Run the hooks in `user-save-hook'. | ||
33 | This does /not/ also save the buffer." | ||
34 | (with-demoted-errors "User-save-hook error: %S" | ||
35 | (run-hooks 'user-save-hook))) | ||
36 | |||
31 | (defun user-save-buffer (&optional arg) | 37 | (defun user-save-buffer (&optional arg) |
32 | "Save current buffer in visited file if modified. | 38 | "Save current buffer in visited file if modified. |
33 | This function is precisely the same as `save-buffer', but with | 39 | This function is precisely the same as `save-buffer', but with |
@@ -40,10 +46,10 @@ run all the time, put them in `user-save-hook'. | |||
40 | 46 | ||
41 | ARG is passed directly to `save-buffer'." | 47 | ARG is passed directly to `save-buffer'." |
42 | (interactive '(called-interactively)) | 48 | (interactive '(called-interactively)) |
43 | (message "Saving the buffer...") | 49 | (message "User-Saving the buffer...") |
44 | (with-demoted-errors (run-hooks 'user-save-hook)) | 50 | (user-save-run-hooks) |
45 | (save-buffer arg) | 51 | (save-buffer arg) |
46 | (message "Saving the buffer...Done.")) | 52 | (message "User-Saving the buffer...Done.")) |
47 | 53 | ||
48 | (defun user-save-some-buffers (&optional pred) | 54 | (defun user-save-some-buffers (&optional pred) |
49 | "Save some buffers as though the user saved them. | 55 | "Save some buffers as though the user saved them. |