summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-01-14 21:03:59 -0600
committerCase Duckworth2022-01-14 21:03:59 -0600
commit6f20710673580a9583af7f4004fb8013880a58f1 (patch)
treedf81850700d55f4529cf72386228c371e995e5a9 /lisp
parentCh ch ch changes (diff)
parentDavid Bowie (diff)
downloademacs-6f20710673580a9583af7f4004fb8013880a58f1.tar.gz
emacs-6f20710673580a9583af7f4004fb8013880a58f1.zip
Turn and face the strange
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+browse-url.el21
-rw-r--r--lisp/+modeline.el4
-rw-r--r--lisp/elephant.el58
-rw-r--r--lisp/remember.el56
-rw-r--r--lisp/user-save.el12
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.
30Also create a `customize' setting in CUSTOM-GROUP for VIEWER's 31Also create a `customize' setting in CUSTOM-GROUP for VIEWER's
31arguments. DEFAULT-ARGS specifies the default arguments that 32arguments. DEFAULT-ARGS specifies the default arguments that
@@ -33,7 +34,10 @@ setting should have. PROMPT will be shown to user in the
33function's `interactive' spec, as an argument to 34function'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
35named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable 36named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable
36\"NAME-args\"." 37\"NAME-args\".
38
39If 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.
8ALIST contains cells of the form (SYMBOL . NEW-VALUE), where
9SYMBOL is a variable or mode name, and its value is what to set
10after `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.
19SYMBOLS is a plist: the properties are symbols or mode names, and
20their 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'.
29This map shadows the default map for `save-buffer'.") 29This 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'.
33This 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.
33This function is precisely the same as `save-buffer', but with 39This 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
41ARG is passed directly to `save-buffer'." 47ARG 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.