about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2022-11-15 19:51:52 -0600
committerCase Duckworth2022-11-15 19:52:00 -0600
commit8c7871fec56b6c464bd06ba114225d7971c4699a (patch)
treef6cb5a19b151d0655148a440c99a4df5c97b90e2
parentAdd link-hint (diff)
downloademacs-8c7871fec56b6c464bd06ba114225d7971c4699a.tar.gz
emacs-8c7871fec56b6c464bd06ba114225d7971c4699a.zip
meh yoke
-rw-r--r--.gitignore1
-rw-r--r--init.el347
-rw-r--r--lisp/+emacs.el6
-rw-r--r--lisp/acdw.el80
-rw-r--r--lisp/dawn.el84
-rw-r--r--lisp/yoke.el88
6 files changed, 511 insertions, 95 deletions
diff --git a/.gitignore b/.gitignore index a61fa52..a40481b 100644 --- a/.gitignore +++ b/.gitignore
@@ -26,3 +26,4 @@ lisp/*-autoloads.el
26 26
27# put random stuff in here 27# put random stuff in here
28scratch.el 28scratch.el
29jabber-avatar-cache/ \ No newline at end of file
diff --git a/init.el b/init.el index bf52e4f..c73e169 100644 --- a/init.el +++ b/init.el
@@ -68,9 +68,29 @@
68 "M-o" #'other-window|switch-buffer 68 "M-o" #'other-window|switch-buffer
69 "C-M-;" #'+lisp-comment-or-uncomment-sexp 69 "C-M-;" #'+lisp-comment-or-uncomment-sexp
70 "C-x 5 z" #'suspend-frame 70 "C-x 5 z" #'suspend-frame
71 "M-@" #'dictionary-search) 71 "M-@" #'dictionary-search
72 "C-x f" #'find-file)
72 (define-key* text-mode-map 73 (define-key* text-mode-map
73 "C-M-k" #'kill-paragraph) 74 "C-M-k" #'kill-paragraph
75 "C-o" (defun open-paragraph (&optional arg)
76 "Open a paragraph after paragraph at point.
77A paragraph is defined as continguous non-empty lines of text
78surrounded by empty lines, so opening a paragraph means to make
79three blank lines, then place the point on the second one.
80
81Called with prefix ARG, open a paragraph before point."
82 ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down.
83 (interactive "*P")
84 ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because
85 ;; that's weird with org, and I'm guessing other modes too.
86 (unless (looking-at "^$") (forward-line (if arg -1 +1)))
87 (while (and (not (looking-at "^$"))
88 (= 0 (forward-line (if arg -1 +1)))))
89 (newline)
90 (when arg (newline) (forward-line -2))
91 (delete-blank-lines)
92 (newline 2)
93 (previous-line)))
74 ;; Hooks 94 ;; Hooks
75 (add-hook 'after-save-hook 95 (add-hook 'after-save-hook
76 #'executable-make-buffer-file-executable-if-script-p) 96 #'executable-make-buffer-file-executable-if-script-p)
@@ -86,8 +106,7 @@
86 "Don't close quits on `keyboard-escape-quit'." 106 "Don't close quits on `keyboard-escape-quit'."
87 (let ((buffer-quit-function #'ignore)) 107 (let ((buffer-quit-function #'ignore))
88 (apply fn r))) 108 (apply fn r)))
89 ;; Themes 109 ;; Faces
90 (load-theme 'modus-operandi)
91 (set-face-attribute 'default nil :family "Comic Code" :height 100) 110 (set-face-attribute 'default nil :family "Comic Code" :height 100)
92 (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold) 111 (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold)
93 (set-face-attribute 'variable-pitch nil :family "Comic Code") 112 (set-face-attribute 'variable-pitch nil :family "Comic Code")
@@ -104,6 +123,22 @@
104 (eval-after init 123 (eval-after init
105 (+custom-load-some-customizations :noerror))) 124 (+custom-load-some-customizations :noerror)))
106 125
126(yoke modus-themes
127 (setf modus-themes-bold-constructs t
128 modus-themes-italic-constructs t
129 modus-themes-headings '((1 monochrome bold italic)
130 (2 monochrome bold)
131 (3 monochrom italic)
132 (t monochrome)))
133 (cond ((require 'dawn nil :noerrer)
134 (add-hook* '+custom-after-load-hook
135 (defun dawn@custom ()
136 (load-theme 'modus-operandi :noconfirm :noenable)
137 (load-theme 'modus-vivendi :noconfirm :noenable)
138 (dawn-schedule #'modus-themes-load-operandi
139 #'modus-themes-load-vivendi))))
140 (:else (load-theme 'modus-operandi))))
141
107(yoke time 142(yoke time
108 (setf display-time-mail-function 143 (setf display-time-mail-function
109 (defun +notmuch-new-mail-p () 144 (defun +notmuch-new-mail-p ()
@@ -115,6 +150,8 @@
115 :count)) 150 :count))
116 display-time-use-mail-icon t 151 display-time-use-mail-icon t
117 read-mail-command #'+notmuch-goto 152 read-mail-command #'+notmuch-goto
153 display-time-format " %a %-e, %H:%M"
154 ;; `display-time-format' makes these unnecessary, but I'll keep em
118 display-time-24hr-format t 155 display-time-24hr-format t
119 display-time-day-and-date t 156 display-time-day-and-date t
120 display-time-default-load-average nil) 157 display-time-default-load-average nil)
@@ -229,7 +266,8 @@
229 (setq-local-hook dired-mode-hook 266 (setq-local-hook dired-mode-hook
230 truncate-lines t) 267 truncate-lines t)
231 (define-key* (current-global-map) 268 (define-key* (current-global-map)
232 "C-x C-j" #'dired-jump) 269 "C-x C-j" #'dired-jump
270 [remap list-directory] #'dired)
233 (eval-after dired 271 (eval-after dired
234 (define-key* dired-mode-map 272 (define-key* dired-mode-map
235 "<backspace>" #'dired-up-directory 273 "<backspace>" #'dired-up-directory
@@ -262,7 +300,7 @@
262 (advice-add #'register-preview :override #'consult-register-window) 300 (advice-add #'register-preview :override #'consult-register-window)
263 (define-key* (current-global-map) 301 (define-key* (current-global-map)
264 ;; Etc 302 ;; Etc
265 "C-x m" #'consult-mode-command 303 "M-S-x" #'consult-mode-command
266 ;; C-c bindings (mode-specific-map) 304 ;; C-c bindings (mode-specific-map)
267 "C-c h" #'consult-history 305 "C-c h" #'consult-history
268 "C-c b" #'consult-bookmark 306 "C-c b" #'consult-bookmark
@@ -351,25 +389,17 @@
351 (marginalia-mode)) 389 (marginalia-mode))
352 390
353(yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep") 391(yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep")
354 (require 'wgrep)) 392 (require 'wgrep)
355 393 (define-key* grep-mode-map
356;; (yoke (slime "https://github.com/slime/slime") 394 "C-x C-q" #'wgrep-change-to-wgrep-mode))
357;; ;; r7rs-swank 395
358;; (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank"))) 396(yoke (slime "https://github.com/slime/slime")
359;; (cond 397 :when (executable-find "sbcl")
360;; ((executable-find "chibi-scheme") 398 (setf inferior-lisp-program (executable-find "sbcl"))
361;; (defun chibi-scheme-start-swank (file encoding) 399 (eval-after slime
362;; (format "%S\n\n" `(start-swank ,file))) 400 (setf slime-completion-at-point-functions
363;; (setq slime-lisp-implementations 401 (delq 'slime-c-p-c-completion-at-point
364;; (cons `(chibi-scheme 402 slime-completion-at-point-functions))))
365;; ("chibi-scheme" ,(format "-A%s" r7rsloc)
366;; "-m" "(chibi-swank)")
367;; :init chibi-scheme-start-swank)
368;; (bound-and-true-p slime-lisp-implementations)))
369;; ;; (add-hook* 'scheme-mode-hook #'slime-mode)
370;; (setf slime-completion-at-point-functions
371;; (delq 'slime-c-p-c-completion-at-point
372;; slime-completion-at-point-functions))))))
373 403
374(yoke (puni "https://github.com/amaikinono/puni") 404(yoke (puni "https://github.com/amaikinono/puni")
375 (define-key* puni-mode-map 405 (define-key* puni-mode-map
@@ -537,7 +567,21 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
537 "RET" #'+org-return-dwim 567 "RET" #'+org-return-dwim
538 "S-<return>" #'+org-table-copy-down|+org-return 568 "S-<return>" #'+org-table-copy-down|+org-return
539 "C-c C-o" #'+org-open-at-point-dwim) 569 "C-c C-o" #'+org-open-at-point-dwim)
540 (org-clock-persistence-insinuate))) 570 (org-clock-persistence-insinuate))
571 (eval-after ol ; org-link
572 (defmacro define-org-link-type (type args &rest body)
573 "Define an org link TYPE with ARGS that does something.
574 If BODY is blank, message the user about the link."
575 (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body)))
576 (let ((fn (intern (format "org-%s-open" type)))
577 (body (or body `((message ,(format "%s: %%S" type) ,(car args)))))
578 (type-string (format "%s" type)))
579 `(prog1
580 (defun ,fn ,args
581 ,@body)
582 (org-link-set-parameters ,type-string :follow #',fn))))
583 (define-org-link-type sms (number _))
584 (define-org-link-type tel (number _))))
541 585
542(yoke org-agenda nil 586(yoke org-agenda nil
543 (setq org-agenda-skip-deadline-if-done t 587 (setq org-agenda-skip-deadline-if-done t
@@ -556,7 +600,18 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
556 org-agenda-include-deadlines t 600 org-agenda-include-deadlines t
557 org-deadline-warning-days 0 601 org-deadline-warning-days 0
558 org-agenda-show-future-repeats 'next 602 org-agenda-show-future-repeats 'next
559 org-agenda-window-setup 'current-window) 603 org-agenda-window-setup 'current-window
604 org-agenda-file-skip-regexp "sync-conflict")
605 (defcustom org-agenda-file-skip-regexp nil
606 "Files matching this regexp are removed from `org-agenda-files'."
607 :group 'org-agenda)
608 (define-advice org-agenda-files (:filter-return (files) skip-regexp)
609 (when org-agenda-file-skip-regexp
610 (setq files (seq-remove (lambda (file)
611 (string-match-p org-agenda-file-skip-regexp
612 file))
613 files)))
614 files)
560 (setq-local-hook org-agenda-mode-hook 615 (setq-local-hook org-agenda-mode-hook
561 truncate-lines t 616 truncate-lines t
562 electric-pair-pairs (append electric-pair-pairs 617 electric-pair-pairs (append electric-pair-pairs
@@ -574,17 +629,17 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
574 '+org-capture)) 629 '+org-capture))
575 630
576(yoke ox ; org-export 631(yoke ox ; org-export
577 (eval-after org (require 'ox)) 632 (eval-after org (require 'ox))
578 (eval-after ox 633 (eval-after ox
579 (require* '+ox '(ox-md nil t)) 634 (require* '+ox '(ox-md nil t))
580 (+org-export-pre-hooks-insinuate)) 635 (+org-export-pre-hooks-insinuate))
581 (setq org-export-coding-system 'utf-8-unix 636 (setq org-export-coding-system 'utf-8-unix
582 org-export-headline-levels 8 637 org-export-headline-levels 8
583 org-export-with-drawers nil 638 org-export-with-drawers nil
584 org-export-with-section-numbers nil 639 org-export-with-section-numbers nil
585 org-export-with-smart-quotes t 640 org-export-with-smart-quotes t
586 org-export-with-sub-superscripts t 641 org-export-with-sub-superscripts t
587 org-export-with-toc nil)) 642 org-export-with-toc nil))
588 643
589(yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el") 644(yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el")
590 (setq electric-cursor-alist '((overwrite-mode . hbar) 645 (setq electric-cursor-alist '((overwrite-mode . hbar)
@@ -683,6 +738,7 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
683 "@" #'dictionary-search))) 738 "@" #'dictionary-search)))
684 739
685(yoke (anzu "https://github.com/emacsorphanage/anzu") 740(yoke (anzu "https://github.com/emacsorphanage/anzu")
741 (require 'anzu)
686 (global-anzu-mode) 742 (global-anzu-mode)
687 (define-key* (current-global-map) 743 (define-key* (current-global-map)
688 [remap query-replace] #'anzu-query-replace-regexp 744 [remap query-replace] #'anzu-query-replace-regexp
@@ -693,9 +749,11 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
693 (defun anzu-qr@window (fn &rest r) 749 (defun anzu-qr@window (fn &rest r)
694 "ADVICE to query-replace from the beginning of the window." 750 "ADVICE to query-replace from the beginning of the window."
695 (let ((scroll-margin 0)) 751 (let ((scroll-margin 0))
696 (save-excursion 752 (cond ((region-active-p)
697 (goto-char (window-start)) 753 (apply fn r))
698 (apply fn r)))) 754 (:else (save-excursion
755 (goto-char (window-start))
756 (apply fn r))))))
699 (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window) 757 (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window)
700 (advice-add 'anzu-query-replace :around #'anzu-qr@window)) 758 (advice-add 'anzu-query-replace :around #'anzu-qr@window))
701 759
@@ -704,6 +762,10 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
704 762
705(yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0") 763(yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0")
706 (setf 0x0-default-server 'ttm) 764 (setf 0x0-default-server 'ttm)
765 (define-advice 0x0-shorten-uri (:around (fn server uri) use-0x0)
766 (interactive (list (cdr (assq 'envs 0x0-servers))
767 (read-string "URI: ")))
768 (funcall fn server uri))
707 (eval-after embark 769 (eval-after embark
708 (define-key* embark-region-map 770 (define-key* embark-region-map
709 "U" #'0x0-dwim))) 771 "U" #'0x0-dwim)))
@@ -759,8 +821,24 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
759 :when (executable-find "keychain") 821 :when (executable-find "keychain")
760 (keychain-refresh-environment)) 822 (keychain-refresh-environment))
761 823
824(yoke (exec-path-from-shell "https://github.com/purcell/exec-path-from-shell")
825 :when (eq system-type 'gnu/linux)
826 (require 'exec-path-from-shell)
827 (dolist (var '("SSH_AUTH_SOCK"
828 "SSH_AGENT_PID"
829 "GPG_AGENT_INFO"
830 "LANG"
831 "LC_CTYPE"
832 "XDG_CONFIG_HOME"
833 "XDG_CONFIG_DIRS"
834 "XDG_DATA_HOME"
835 "XDG_DATA_DIRS"
836 "XDG_CACHE_HOME"))
837 (add-to-list 'exec-path-from-shell-variables var))
838 (exec-path-from-shell-initialize))
839
762(yoke (sophomore "https://codeberg.org/acdw/sophomore.el") 840(yoke (sophomore "https://codeberg.org/acdw/sophomore.el")
763 (sophomore-enable #'narrow-to-region) 841 (sophomore-enable-all)
764 (sophomore-disable #'view-hello-file 842 (sophomore-disable #'view-hello-file
765 #'describe-gnu-project) 843 #'describe-gnu-project)
766 (sophomore-disable-with 'confirm #'save-buffers-kill-terminal)) 844 (sophomore-disable-with 'confirm #'save-buffers-kill-terminal))
@@ -844,12 +922,20 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
844 message-sendmail-envelope-from 'header 922 message-sendmail-envelope-from 'header
845 message-envelope-from 'header) 923 message-envelope-from 'header)
846 ;; Extras 924 ;; Extras
925 (define-advice mm-save-part-to-file (:before (_handle file) create-directory)
926 (let ((directory (file-name-directory file)))
927 (when (yes-or-no-p (format "Directory %s doesn't exist. Create?" directory))
928 (make-directory directory :parents))))
847 (eval-after notmuch 929 (eval-after notmuch
848 (require '+notmuch) 930 (require '+notmuch)
849 (load notmuch-init-file :noerror) 931 (load notmuch-init-file :noerror)
850 (add-hook 'message-setup-hook #'+message-signature-setup) 932 (add-hook 'message-setup-hook #'+message-signature-setup)
851 (add-hook 'message-send-hook #'+send-mail-dispatch) 933 (add-hook 'message-send-hook #'+send-mail-dispatch)
852 (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) 934 (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags)
935 (advice-add 'notmuch-bury-or-kill-this-buffer :after
936 (defun +display-time@notmuch (&rest _)
937 ;; (display-time-event-handler)
938 (display-time-update)))
853 (setf notmuch-saved-searches (list 939 (setf notmuch-saved-searches (list
854 (list :name "inbox+unread" 940 (list :name "inbox+unread"
855 :query (+notmuch-query-concat 941 :query (+notmuch-query-concat
@@ -906,6 +992,152 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
906 (sesman "https://github.com/vspinu/sesman")) 992 (sesman "https://github.com/vspinu/sesman"))
907 :when (executable-find "clojure")) 993 :when (executable-find "clojure"))
908 994
995(yoke (web-mode "https://github.com/fxbois/web-mode")
996 (setf (alist-get (rx "." (or "htm" "html" "phtml" "tpl.php"
997 "asp" "gsp" "jsp" "ascx" "aspx"
998 "erb" "mustache" "djhtml")
999 eos)
1000 auto-mode-alist nil nil #'string=)
1001 'web-mode))
1002
1003(yoke (chicken-geiser "https://gitlab.com/emacs-geiser/chicken")
1004 :depends ((geiser "https://gitlab.com/emacs-geiser/geiser"
1005 :load "elisp"))
1006 :when (executable-find "csi")
1007 :pre ((autoload 'geiser-activate-implementation "geiser-impl"))
1008 (autoload 'geiser "geiser" nil :interactive)
1009 (add-hook 'scheme-mode-hook 'geiser-mode))
1010
1011(yoke (zoom-frm "https://github.com/emacsmirror/zoom-frm")
1012 :depends ((frame-cmds "https://github.com/emacsmirror/frame-cmds")
1013 (frame-fns "https://github.com/emacsmirror/frame-fns"))
1014 (define-key* (current-global-map)
1015 "M-+" #'zoom-frm-in
1016 "M-_" #'zoom-frm-out))
1017
1018(yoke (jabber "https://codeberg.org/acdw/emacs-jabber")
1019 :depends ((srv "https://github.com/legoscia/srv.el")
1020 (fsm "https://elpa.gnu.org/packages/fsm-0.2.1.el" :type 'http))
1021 (setf jabber-account-list '(("acdw@hmm.st"))
1022 jabber-auto-reconnect t
1023 jabber-chat-buffer-format "xmpp:%n"
1024 jabber-browse-buffer-format "xmpp-browse:%n"
1025 jabber-groupchat-buffer-format "xmpp-muc:%n"
1026 jabber-muc-private-buffer-format "xmpp-muc-private:%n"
1027 jabber-groupchat-prompt-format "%>10n │ "
1028 jabber-chat-local-prompt-format "%>10n │ "
1029 jabber-chat-system-prompt-format " * * * * * *"
1030 jabber-chat-foreign-prompt-format "%>10n │ "
1031 jabber-muc-private-foreign-prompt-format "%g/%n "
1032 jabber-last-read-marker "----------------------------------------"
1033 jabber-muc-header-line-format '("" jabber-muc-topic)
1034 jabber-muc-decorate-presence-patterns
1035 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
1036 ("." . jabber-muc-presence-dim))
1037 jabber-activity-make-strings
1038 #'jabber-activity-make-strings-shorten
1039 ;; (defun +jabber-activity-make-strings (jids)
1040 ;; (mapcar (lambda (jid)
1041 ;; (cons jid
1042 ;; (let ((s (jabber-activity-make-string-default jid)))
1043 ;; (cond
1044 ;; ((string-match-p "%" s)
1045 ;; (replace-regexp-in-string "%.*" "" s))
1046 ;; (:else s)))))
1047 ;; jids))
1048 jabber-rare-time-format " - - - - - - %H:00 %F")
1049 (defun +electric-pair-disable-local-mode ()
1050 (electric-pair-local-mode -1))
1051 (add-hook* '(jabber-chat-mode-hook
1052 jabber-browse-mode-hook
1053 jabber-roster-mode-hook
1054 jabber-console-mode-hook)
1055 #'visual-fill-column-mode
1056 #'+electric-pair-disable-local-mode)
1057 (defun +jabber-fix-keybinds-dammit ()
1058 "Jabber autoloads keybinds which is really annoying."
1059 (define-key* (current-global-map)
1060 "C-x C-j" #'dired-jump
1061 "C-c j" jabber-global-keymap
1062 "C-c C-SPC" #'jabber-activity-switch-to))
1063 (eval-after init (+jabber-fix-keybinds-dammit))
1064 (eval-after jabber
1065 (require 'jabber-httpupload nil :noerror)
1066 (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
1067 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
1068 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
1069 (add-hook 'jabber-alert-muc-hooks
1070 (defun jabber@highlight-acdw (&optional _nick _group buf _text _title)
1071 (when buf
1072 (with-current-buffer buf
1073 (let ((regexp (rx word-boundary
1074 "acdw" ; maybe get from the config?
1075 word-boundary)))
1076 (hi-lock-unface-buffer regexp)
1077 (highlight-regexp regexp 'hi-blue))))))
1078 (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)
1079 (+jabber-fix-keybinds-dammit))
1080 ;; (add-hook* 'jabber-activity-mode-hook
1081 ;; (defun +jabber-activity-mode@move-to-end-of-mode-line ()
1082 ;; (setf global-mode-string
1083 ;; (append (delete '(t jabber-activity-mode-string)
1084 ;; global-mode-string)
1085 ;; '((t jabber-activity-mode-string))))))
1086 (setq-local-hook jabber-chat-mode-hook
1087 wrap-prefix (format "%10s " " ")
1088 mode-line-buffer-identification
1089 (pcase (buffer-name)
1090 ((rx "%") ; biboumi irc channel
1091 ;; xmpp-muc:#scheme%irc.libera.chat@irc.hmm.st
1092 (propertized-buffer-identification
1093 (replace-regexp-in-string "xmpp-muc:\\([^%]*\\)%\\([^@]*\\)@.*"
1094 "\\1@\\2"
1095 (buffer-name))))
1096 (_ ; xmpp channel
1097 (propertized-buffer-identification "%12b"))))
1098 (defun jabber-chat@after-modus-themes-load ()
1099 (modus-themes-with-colors
1100 (custom-set-faces
1101 `(jabber-chat-prompt-foreign ((t :foreground unspecified
1102 :inherit modus-themes-bold))
1103 :now)
1104 `(jabber-chat-prompt-local ((t :foreground unspecified
1105 :inherit modus-themes-bold))
1106 :now)
1107 `(jabber-chat-prompt-system ((t :foreground unspecified
1108 :inherit modus-themes-bold))
1109 :now)
1110 `(jabber-activity-face ((t :slant italic)))
1111 `(jabber-activity-personal-face ((t :slant italic :weight bold)))
1112 `(jabber-rare-time-face ((t :inherit font-lock-comment-face)))))
1113 (setq jabber-muc-nick-value
1114 (pcase (frame--current-backround-mode (selected-frame))
1115 ('light 0.5)
1116 ('dark 1.0))))
1117 (eval-after modus-themes
1118 (add-hook 'modus-themes-after-load-theme-hook
1119 #'jabber-chat@after-modus-themes-load))
1120 (when (or (custom-theme-enabled-p 'modus-operandi)
1121 (custom-theme-enabled-p 'modus-vivendi))
1122 (jabber-chat@after-modus-themes-load))
1123 (eval-after (consult jabber)
1124 ;; Jabber.el chat buffers source for `consult-buffer'
1125 (defvar jabber-chat-buffer-source
1126 `( :name "Jabber"
1127 :hidden nil
1128 :narrow ?j
1129 :category buffer
1130 :state ,#'consult--buffer-state
1131 :items ,(lambda ()
1132 (mapcar #'buffer-name
1133 (seq-filter (lambda (buf)
1134 (with-current-buffer buf
1135 (eq major-mode 'jabber-chat-mode)))
1136 (buffer-list))))))
1137 (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append)
1138 ;; Also hide xmpp buffers from regular buffer list
1139 (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal)))
1140
909(yoke (link-hint "https://github.com/noctuid/link-hint.el/") 1141(yoke (link-hint "https://github.com/noctuid/link-hint.el/")
910 :depends ((avy "https://github.com/abo-abo/avy")) 1142 :depends ((avy "https://github.com/abo-abo/avy"))
911 (require '+link-hint) 1143 (require '+link-hint)
@@ -921,6 +1153,21 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
921 "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link 1153 "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link
922 "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome)) 1154 "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome))
923 1155
1156(yoke (elpher "git://thelambdalab.xyz/elpher.git")
1157 (eval-after elpher
1158 (define-key* elpher-mode-map
1159 "l" #'elpher-back)))
1160
1161(yoke (epithet "https://github.com/oantolin/epithet")
1162 (add-hook* '(Info-selection-hook
1163 help-mode-hook
1164 occur-mode-hook
1165 shell-mode-hook)
1166 #'epithet-rename-buffer)
1167 (cond ((boundp 'eww-auto-rename-buffer)
1168 (setf eww-auto-rename-buffer 'title))
1169 (:else (add-hook 'eww-after-render-hook #'epithet-rename-buffer))))
1170
924(yoke browse-url 1171(yoke browse-url
925 (require '+browse-url) 1172 (require '+browse-url)
926 (setf browse-url-browser-function #'eww-browse-url 1173 (setf browse-url-browser-function #'eww-browse-url
@@ -994,3 +1241,19 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
994 (define-key* eww-mode-map 1241 (define-key* eww-mode-map
995 "&" #'+eww-browse-with-external-browser)) 1242 "&" #'+eww-browse-with-external-browser))
996 1243
1244(yoke tab-bar
1245 (setf tab-bar-show t
1246 global-mode-string
1247 '((jabber-activity-mode jabber-activity-mode-string)
1248 " â‹…"
1249 display-time-string
1250 "|"))
1251 (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
1252 (add-to-list 'tab-bar-format 'tab-bar-format-global :append)
1253 (tab-bar-mode))
1254
1255(yoke (pdf-tools "https://github.com/vedang/pdf-tools"
1256 :load "lisp")
1257 :depends ((tablist "https://github.com/politza/tablist/"))
1258 :when (executable-find "epdfinfo") ; installed from Debian repos
1259 (pdf-tools-install))
diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 8817c19..870e4e2 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el
@@ -108,12 +108,10 @@ Do this only if the buffer is not visiting a file."
108 regexp-search-ring-max 200 108 regexp-search-ring-max 200
109 save-interprogram-paste-before-kill t 109 save-interprogram-paste-before-kill t
110 save-some-buffers-default-predicate #'+save-some-buffers-p 110 save-some-buffers-default-predicate #'+save-some-buffers-p
111 scroll-conservatively 101 111 scroll-conservatively 25
112 scroll-down-aggressively 0.01 112 scroll-margin 0
113 scroll-margin 2
114 scroll-preserve-screen-position 1 113 scroll-preserve-screen-position 1
115 scroll-step 1 114 scroll-step 1
116 scroll-up-aggressively 0.01
117 search-ring-max 200 115 search-ring-max 200
118 search-ring-max 200 116 search-ring-max 200
119 sentence-end-double-space t 117 sentence-end-double-space t
diff --git a/lisp/acdw.el b/lisp/acdw.el index 6e298b2..75e1755 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -1,7 +1,5 @@
1;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- 1;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*-
2;; by C. Duckworth <acdw@acdw.net> 2;; by C. Duckworth <acdw@acdw.net>
3(provide 'acdw)
4
5(require 'cl-lib) 3(require 'cl-lib)
6 4
7;;; Define both a directory and a function expanding to a file in that directory 5;;; Define both a directory and a function expanding to a file in that directory
@@ -30,7 +28,6 @@ the filesystem, unless INHIBIT-MKDIR is non-nil."
30 28
31;;; Evaluating things after other things 29;;; Evaluating things after other things
32 30
33
34(defun eval-after-init (fn) 31(defun eval-after-init (fn)
35 "Evaluate FN after inititation, or now if Emacs is initialized. 32 "Evaluate FN after inititation, or now if Emacs is initialized.
36FN is called with no arguments." 33FN is called with no arguments."
@@ -78,12 +75,12 @@ Convenience wrapper around `define-key'."
78(unless (fboundp 'ensure-list) 75(unless (fboundp 'ensure-list)
79 ;; Just in case we're using an old version of Emacs. 76 ;; Just in case we're using an old version of Emacs.
80 (defun ensure-list (object) 77 (defun ensure-list (object)
81 "Return OBJECT as a list. 78 "Return OBJECT as a list.
82If OBJECT is already a list, return OBJECT itself. If it's 79If OBJECT is already a list, return OBJECT itself. If it's
83not a list, return a one-element list containing OBJECT." 80not a list, return a one-element list containing OBJECT."
84 (if (listp object) 81 (if (listp object)
85 object 82 object
86 (list object)))) 83 (list object))))
87 84
88(defun add-to-list* (lists &rest things) 85(defun add-to-list* (lists &rest things)
89 "Add THINGS to LISTS. 86 "Add THINGS to LISTS.
@@ -130,8 +127,8 @@ without any separator."
130Each feature of FEATURES can also be a list of the arguments to 127Each feature of FEATURES can also be a list of the arguments to
131pass to `require', which see." 128pass to `require', which see."
132 (condition-case e 129 (condition-case e
133 (dolist (feature features) 130 (dolist (feature features)
134 (apply #'require (ensure-list feature))) 131 (apply #'require (ensure-list feature)))
135 (:success (mapcar (lambda (f) (car (ensure-list f))) features)) 132 (:success (mapcar (lambda (f) (car (ensure-list f))) features))
136 (t (signal (car e) (cdr e))))) 133 (t (signal (car e) (cdr e)))))
137 134
@@ -153,22 +150,33 @@ pass to `require', which see."
153 (add-hook 'before-save-hook #',internal-name nil :local)) 150 (add-hook 'before-save-hook #',internal-name nil :local))
154 (add-hook ',hook #',external-name)))) 151 (add-hook ',hook #',external-name))))
155 152
156(defmacro setq-local-hook (hook &rest args) 153(defmacro setq-local-hook (hooks &rest args)
157 "Run `setq-local' on ARGS when running HOOK." 154 "Run `setq-local' on ARGS when running HOOKs."
155 ;; FIXME: this is pretty messy, i think...
156 ;; The settings should be stored in an alist so that they can be deduplicated
158 (declare (indent 1)) 157 (declare (indent 1))
159 (let ((fn (intern (format "%s-setq-local" hook)))) 158 `(progn
160 (when (and (fboundp fn) 159 ,@(cl-loop for hook in (ensure-list hooks)
161 (functionp fn)) 160 collect
162 (setf args (append (function-get fn 'setq-local-hook-settings) args))) 161 (let ((fn (intern (format "%s-setq-local" hook))))
163 (unless (and (< 0 (length args)) 162 (when (and (fboundp fn)
164 (zerop (mod (length args) 2))) 163 (functionp fn))
165 (user-error "Wrong number of arguments: %S" (length args))) 164 (setf args (append (function-get fn 'setq-local-hook-settings) args)))
166 `(progn 165 (unless (and (< 0 (length args))
167 (defun ,fn () 166 (zerop (mod (length args) 2)))
168 ,(format "Set local variables after `%s'." hook) 167 (user-error "Wrong number of arguments: %S" (length args)))
169 (setq-local ,@args)) 168 `(progn
170 (function-put ',fn 'setq-local-hook-settings ',args) 169 (defun ,fn ()
171 (add-hook ',hook #',fn)))) 170 ,(format "Set local variables after `%s'." hook)
171 (setq-local ,@args))
172 (function-put ',fn 'setq-local-hook-settings ',args)
173 (dolist (buf (buffer-list))
174 (with-current-buffer buf
175 (when (derived-mode-p
176 ',(intern (replace-regexp-in-string
177 "-hook" "" (format "%s" hook))))
178 (,fn))))
179 (add-hook ',hook #',fn))))))
172 180
173(defmacro with-message (message &rest body) 181(defmacro with-message (message &rest body)
174 "Execute BODY, with MESSAGE. 182 "Execute BODY, with MESSAGE.
@@ -182,6 +190,13 @@ If body executes without errors, MESSAGE...Done will be displayed."
182 (:success (message "%s...done" ,msg)) 190 (:success (message "%s...done" ,msg))
183 (t (signal (car e) (cdr e))))))) 191 (t (signal (car e) (cdr e)))))))
184 192
193(defmacro either (&rest clauses)
194 "Return the first of CLAUSES that returns non-nil."
195 (let* ((this (gensym "either")))
196 (unless (null clauses)
197 `(let* ((,this ,(car clauses)))
198 (if ,this ,this (either ,@(cdr clauses)))))))
199
185;; https://emacs.stackexchange.com/a/39324/37239 200;; https://emacs.stackexchange.com/a/39324/37239
186;; XXX: This shit don't work rn 201;; XXX: This shit don't work rn
187(defun ignore-invisible-overlays (fn) 202(defun ignore-invisible-overlays (fn)
@@ -189,13 +204,13 @@ If body executes without errors, MESSAGE...Done will be displayed."
189FN should return a point." 204FN should return a point."
190 (let ((overlay nil) 205 (let ((overlay nil)
191 (point nil)) 206 (point nil))
192 (setq point (and (funcall fn) (point))) 207 (setq point (and (funcall fn) (point)))
193 (setq overlay (car (overlays-at (point)))) 208 (setq overlay (car (overlays-at (point))))
194 (while (and overlay (member 'invisible (overlay-properties overlay))) 209 (while (and overlay (member 'invisible (overlay-properties overlay)))
195 (goto-char (overlay-end overlay)) 210 (goto-char (overlay-end overlay))
196 (setq point (and (funcall fn) (point))) 211 (setq point (and (funcall fn) (point)))
197 (setq overlay (car (overlays-at (point))))) 212 (setq overlay (car (overlays-at (point)))))
198 point)) 213 point))
199 214
200;;; Extras 215;;; Extras
201;; Trying to avoid a whole install of crux ... 216;; Trying to avoid a whole install of crux ...
@@ -217,3 +232,6 @@ When called with prefix ARG, unconditionally switch buffer."
217 (if (or arg (one-window-p)) 232 (if (or arg (one-window-p))
218 (switch-to-buffer (other-buffer) nil t) 233 (switch-to-buffer (other-buffer) nil t)
219 (other-window 1))) 234 (other-window 1)))
235
236(provide 'acdw)
237;;; acdw.el ends here
diff --git a/lisp/dawn.el b/lisp/dawn.el new file mode 100644 index 0000000..806c422 --- /dev/null +++ b/lisp/dawn.el
@@ -0,0 +1,84 @@
1;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; There is also circadian.el, but it doesn't quite work for me.
6;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
7;; somewhere else (which I've forgotten) and my own brain :)
8
9;;; Code:
10
11(require 'calendar)
12(require 'cl-lib)
13(require 'solar)
14
15(defvar dawn--dawn-timer nil
16 "Timer for dawn-command.")
17
18(defvar dawn--dusk-timer nil
19 "Timer for dusk-command.")
20
21(defvar dawn--reset-timer nil
22 "Timer to reset dawn at midnight.")
23
24(defun dawn-encode-time (f)
25 "Encode fractional time F."
26 (let ((hhmm (cl-floor f))
27 (date (cdddr (decode-time))))
28 (encode-time
29 (append (list 0
30 (round (* 60 (cadr hhmm)))
31 (car hhmm)
32 )
33 date))))
34
35(defun dawn-midnight ()
36 "Return the time of the /next/ midnight."
37 (let ((date (cdddr (decode-time))))
38 (encode-time
39 (append (list 0 0 0 (1+ (car date))) (cdr date)))))
40
41(defun dawn-sunrise ()
42 "Return the time of today's sunrise."
43 (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
44
45(defun dawn-sunset ()
46 "Return the time of today's sunset."
47 (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
48
49(defun dawn-schedule (dawn-command dusk-command)
50 "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
51RESET is an argument for internal use."
52 (when (or (null calendar-longitude)
53 (null calendar-latitude))
54 (user-error "`dawn' won't work without setting %s!"
55 (cond ((and (null calendar-longitude)
56 (null calendar-latitude))
57 "`calendar-longitude' and `calendar-latitude'")
58 ((null calendar-longitude)
59 "`calendar-longitude'")
60 ((null calendar-latitude)
61 "`calendar-latitude'"))))
62 (let ((dawn (dawn-sunrise))
63 (dusk (dawn-sunset)))
64 (cond
65 ((time-less-p nil dawn)
66 ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule
67 ;; DAWN-COMMAND and DUSK-COMMAND for later.
68 (funcall dusk-command)
69 (run-at-time dawn nil dawn-command)
70 (run-at-time dusk nil dusk-command))
71 ((time-less-p nil dusk)
72 ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule
73 ;; DUSK-COMMAND.
74 (funcall dawn-command)
75 (run-at-time dusk nil dusk-command))
76 (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
77 (funcall dusk-command)))
78 ;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
79 ;(unless reset)
80 (run-at-time (dawn-midnight) nil
81 #'dawn-schedule dawn-command dusk-command)))
82
83(provide 'dawn)
84;;; dawn.el ends here
diff --git a/lisp/yoke.el b/lisp/yoke.el index 1e1bc60..f9c4d49 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el
@@ -64,8 +64,8 @@ Execute BODY afterward.
64 (url (cond ((consp package) (cdr package)) 64 (url (cond ((consp package) (cdr package))
65 (:else nil))) 65 (:else nil)))
66 (pname (intern (format "yoke:%s" pkg))) 66 (pname (intern (format "yoke:%s" pkg)))
67 (dirvar (gensym "yoke-dir-")) 67 (dirvar '$yoke-dir)
68 ;; Keyword args 68 ;; Keyword args --- TODO: Naming could probably be better.
69 (after (plist-get body :after)) 69 (after (plist-get body :after))
70 (depends (plist-get body :depends)) 70 (depends (plist-get body :depends))
71 (whenp (plist-member body :when)) 71 (whenp (plist-member body :when))
@@ -77,6 +77,7 @@ Execute BODY afterward.
77 (autoload (cond ((plist-member body :autoload) 77 (autoload (cond ((plist-member body :autoload)
78 (plist-get body :autoload)) 78 (plist-get body :autoload))
79 (:else t))) 79 (:else t)))
80 (pre (plist-get body :pre))
80 ;; Body 81 ;; Body
81 (body (cl-loop for (this next) on body by #'cddr 82 (body (cl-loop for (this next) on body by #'cddr
82 unless (keywordp this) 83 unless (keywordp this)
@@ -102,12 +103,17 @@ Execute BODY afterward.
102 `((when ,unless (cl-return-from ,pname 103 `((when ,unless (cl-return-from ,pname
103 (format "%s (abort) :unless %S" 104 (format "%s (abort) :unless %S"
104 ',pname ',unless)))))) 105 ',pname ',unless))))))
106 ;; Evaluate `:pre' forms
107 ,@pre
105 ;; Get prerequisite packages 108 ;; Get prerequisite packages
106 ,@(cl-loop 109 ,@(cl-loop
107 for (pkg* . yoke-get-args) in depends 110 for (pkg* . yoke-get-args) in depends
108 collect `(or 111 collect `(or
109 (let ((dir (yoke-get ,@yoke-get-args 112 (let* ((pkg-spec (yoke-get ,@yoke-get-args
110 :dir ,(format "%s" pkg*)))) 113 :dir ,(format "%s" pkg*)))
114 (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load)
115 "")
116 (car pkg-spec))))
111 (and dir 117 (and dir
112 ,@(if autoload 118 ,@(if autoload
113 `((yoke-generate-autoloads ',pkg* dir)) 119 `((yoke-generate-autoloads ',pkg* dir))
@@ -118,13 +124,16 @@ Execute BODY afterward.
118 ',pkg*)))) 124 ',pkg*))))
119 ;; Download the package, generate autoloads 125 ;; Download the package, generate autoloads
120 ,@(when url 126 ,@(when url
121 `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg)))) 127 `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg)))
128 (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load)
129 "")
130 (car pkg-spec))))
122 ,@(when autoload 131 ,@(when autoload
123 `((yoke-generate-autoloads ',pkg ,dirvar))) 132 `((yoke-generate-autoloads ',pkg ,dirvar)))
124 (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) 133 (add-to-list 'yoke-dirs ,dirvar nil #'string=))))
125 ;; Evaluate the body, optionally after the features in `:after' 134 ;; Evaluate the body, optionally after the features in `:after'
126 ,@(cond (after 135 ,@(cond (after
127 `((eval-after ,after ,@body))) 136 `((yoke-eval-after ,after ,@body)))
128 (:else body))) 137 (:else body)))
129 (:success ',package) 138 (:success ',package)
130 (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) 139 (t (message "%s: %s (%s)" ',pname (car err) (cdr err))
@@ -144,7 +153,7 @@ ARGS is a plist with the following possible keys:
144 download URL." 153 download URL."
145 (let* ((dir (plist-get args :dir)) 154 (let* ((dir (plist-get args :dir))
146 (load (plist-get args :load)) 155 (load (plist-get args :load))
147 (type (plist-get args :type)) 156 (type (or (plist-get args :type)))
148 (path (cond 157 (path (cond
149 ((eq type 'http) (yoke-get-http url dir)) 158 ((eq type 'http) (yoke-get-http url dir))
150 ((or (eq type 'git) 159 ((or (eq type 'git)
@@ -159,7 +168,7 @@ ARGS is a plist with the following possible keys:
159 (cond 168 (cond
160 ((file-exists-p path) 169 ((file-exists-p path)
161 (add-to-list 'load-path (expand-file-name (or load "") path)) 170 (add-to-list 'load-path (expand-file-name (or load "") path))
162 path) 171 (cons path args))
163 (:else (error "Directory \"%s\" doesn't exist." path) 172 (:else (error "Directory \"%s\" doesn't exist." path)
164 nil)))) 173 nil))))
165 174
@@ -178,7 +187,18 @@ If DIR isn't given, it's guessed from the final component of the
178URL's path and placed under `yoke-dir'." 187URL's path and placed under `yoke-dir'."
179 (let* ((dir (yoke-get--guess-directory url dir)) 188 (let* ((dir (yoke-get--guess-directory url dir))
180 (basename (file-name-nondirectory url)) 189 (basename (file-name-nondirectory url))
181 (filename (expand-file-name basename dir))) 190 ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have
191 ;; a parameter (either dynamic var or passed in) that would give the
192 ;; name of the downloaded file. But that would take a bit of
193 ;; re-engineering, I think. So for now, it stays thus.
194 (filename (expand-file-name
195 (replace-regexp-in-string
196 (rx "-" (+ digit) ; major version
197 (+ (group "." (+ digit))) ; following version numbers
198 (group "." (+ (not space)))) ; extension
199 "\\2"
200 basename)
201 dir)))
182 (cond ((file-exists-p filename) 202 (cond ((file-exists-p filename)
183 dir) 203 dir)
184 (:else 204 (:else
@@ -187,6 +207,8 @@ URL's path and placed under `yoke-dir'."
187 (url-retrieve-synchronously url)) 207 (url-retrieve-synchronously url))
188 (condition-case e 208 (condition-case e
189 (progn 209 (progn
210 (goto-char (point-min))
211 (delete-region (point) (+ 1 (re-search-forward "^$")))
190 (make-directory dir :parents) 212 (make-directory dir :parents)
191 (write-file filename 1) 213 (write-file filename 1)
192 (message "Downloading %s... Done" url)) 214 (message "Downloading %s... Done" url))
@@ -264,7 +286,7 @@ BODY after Emacs is finished initializing."
264 (rest (cdr features))) 286 (rest (cdr features)))
265 (cond ((eq this 'init) 287 (cond ((eq this 'init)
266 `(yoke--eval-after-init 288 `(yoke--eval-after-init
267 (lambda () (eval-after ,rest ,@body)))) 289 (lambda () (yoke-eval-after ,rest ,@body))))
268 (:else 290 (:else
269 `(with-eval-after-load ',this 291 `(with-eval-after-load ',this
270 (yoke-eval-after ,rest ,@body))))))) 292 (yoke-eval-after ,rest ,@body)))))))
@@ -277,21 +299,51 @@ BODY after Emacs is finished initializing."
277 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) 299 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
278 (list (rx (: "(yoke" (+ space) (? "(") 300 (list (rx (: "(yoke" (+ space) (? "(")
279 (group (+ (not (or "(" " " "\t" "\n")))) 301 (group (+ (not (or "(" " " "\t" "\n"))))
280 (+ space) 302 (* any)))
281 (group (+ (not space)))))
282 1))) 303 1)))
283 304
284(defun yoke-compile () 305;;; Package maintenance
306
307(defvar yoke--all "*all*"
308 "Value that `yoke--prompt-for-package' uses for all packages.")
309
310(defun yoke--choose-packages (prompt &optional onep)
311 "Choose from all of yoke's installed packages."
312 (funcall (if onep #'completing-read #'completing-read-multiple)
313 prompt
314 (cons yoke--all yoke-dirs)
315 nil :require-match nil nil
316 (unless onep yoke--all)))
317
318(defun yoke--choices (&optional selections)
319 "Either the SELECTIONS given, or all of `yoke-dirs'.
320If `yoke--all' is part of SELECTIONS, or if it's not given,
321return the full list of `yoke-dirs'."
322 (cond ((or (null selections)
323 (member yoke--all selections))
324 yoke-dirs)
325 (:else selections)))
326
327(defun yoke-compile (&rest packages)
285 "Compile all elisp files in `yoke-dirs'." 328 "Compile all elisp files in `yoke-dirs'."
286 (interactive) 329 (interactive (yoke--choose-packages "Compile packages: "))
287 (dolist (dir yoke-dirs) 330 (dolist (dir (yoke--choices packages))
288 (byte-recompile-directory dir 0))) 331 (byte-recompile-directory dir 0)))
289 332
333(defun yoke-update-autoloads (&rest packages)
334 "Update the autoloads in PACKAGES' directories."
335 (interactive (yoke--choose-packages "Generate autoloads for packages: "))
336 (dolist (dir (yoke--choices packages))
337 (message "Generating autoloads for %s..." dir)
338 (yoke-generate-autoloads (file-name-nondirectory dir) dir)
339 (message "Generating autoloads for %s... Done" dir)))
340
290(defun yoke-remove (dir) 341(defun yoke-remove (dir)
342 "Remove DIR from `yoke-dir'."
291 (interactive 343 (interactive
292 (completing-read "Remove: " yoke-dirs 344 (list (completing-read "Remove: " yoke-dirs
293 nil :require-match)) 345 nil :require-match)))
294 (delete-file dir :trash)) 346 (delete-directory dir :recursive :trash))
295 347
296(provide 'yoke) 348(provide 'yoke)
297;;; yoke.el ends here 349;;; yoke.el ends here