diff options
author | Case Duckworth | 2022-11-15 19:51:52 -0600 |
---|---|---|
committer | Case Duckworth | 2022-11-15 19:52:00 -0600 |
commit | 8c7871fec56b6c464bd06ba114225d7971c4699a (patch) | |
tree | f6cb5a19b151d0655148a440c99a4df5c97b90e2 | |
parent | Add link-hint (diff) | |
download | emacs-yoke.tar.gz emacs-yoke.zip |
meh yoke
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | init.el | 347 | ||||
-rw-r--r-- | lisp/+emacs.el | 6 | ||||
-rw-r--r-- | lisp/acdw.el | 80 | ||||
-rw-r--r-- | lisp/dawn.el | 84 | ||||
-rw-r--r-- | lisp/yoke.el | 88 |
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 |
28 | scratch.el | 28 | scratch.el |
29 | jabber-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. | ||
77 | A paragraph is defined as continguous non-empty lines of text | ||
78 | surrounded by empty lines, so opening a paragraph means to make | ||
79 | three blank lines, then place the point on the second one. | ||
80 | |||
81 | Called 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. |
36 | FN is called with no arguments." | 33 | FN 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. |
82 | If OBJECT is already a list, return OBJECT itself. If it's | 79 | If OBJECT is already a list, return OBJECT itself. If it's |
83 | not a list, return a one-element list containing OBJECT." | 80 | not 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." | |||
130 | Each feature of FEATURES can also be a list of the arguments to | 127 | Each feature of FEATURES can also be a list of the arguments to |
131 | pass to `require', which see." | 128 | pass 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." | |||
189 | FN should return a point." | 204 | FN 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. | ||
51 | RESET 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 | |||
178 | URL's path and placed under `yoke-dir'." | 187 | URL'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'. | ||
320 | If `yoke--all' is part of SELECTIONS, or if it's not given, | ||
321 | return 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 |