about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+completions.el65
-rw-r--r--lisp/+link-hint.el175
-rw-r--r--lisp/+org-capture.el49
-rw-r--r--lisp/+scratch.el75
-rw-r--r--lisp/acdw-chat.el206
-rw-r--r--lisp/acdw-mail.el439
-rw-r--r--lisp/acdw-org.el548
-rw-r--r--lisp/acdw-shell.el141
-rw-r--r--lisp/acdw-web.el374
-rw-r--r--lisp/acdw.el384
-rw-r--r--lisp/ical2org.el56
11 files changed, 0 insertions, 2512 deletions
diff --git a/lisp/+completions.el b/lisp/+completions.el deleted file mode 100644 index 9baaaf8..0000000 --- a/lisp/+completions.el +++ /dev/null
@@ -1,65 +0,0 @@
1;;; +completions.el --- Better default completions -*- lexical-binding: t; -*-
2
3;; From https://robbmann.io/posts/emacs-29-completions/
4
5(defun minibuffer@bindings ()
6 (unless vertico-mode
7 ;; Up/down when completing in the minibuffer
8 (define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion)
9 (define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion)
10
11 ;; Up/down when competing in a normal buffer
12 (define-key completion-in-region-mode-map (kbd "C-p")
13 #'minibuffer-previous-completion)
14 (define-key completion-in-region-mode-map (kbd "C-n")
15 #'minibuffer-next-completion)))
16
17(add-hook 'vertico-mode-hook #'minibuffer@bindings)
18
19(defun renz/sort-by-alpha-length (elems)
20 "Sort ELEMS first alphabetically, then by length."
21 (sort elems (lambda (c1 c2)
22 (or (string-version-lessp c1 c2)
23 (< (length c1) (length c2))))))
24
25(defun renz/sort-by-history (elems)
26 "Sort ELEMS by minibuffer history.
27Use `mct-sort-sort-by-alpha-length' if no history is available."
28 (if-let ((hist (and (not (eq minibuffer-history-variable t))
29 (symbol-value minibuffer-history-variable))))
30 (minibuffer--sort-by-position hist elems)
31 (renz/sort-by-alpha-length elems)))
32
33(defun renz/completion-category ()
34 "Return completion category."
35 (when-let ((window (active-minibuffer-window)))
36 (with-current-buffer (window-buffer window)
37 (completion-metadata-get
38 (completion-metadata (buffer-substring-no-properties
39 (minibuffer-prompt-end)
40 (max (minibuffer-prompt-end) (point)))
41 minibuffer-completion-table
42 minibuffer-completion-predicate)
43 'category))))
44
45(defun renz/sort-multi-category (elems)
46 "Sort ELEMS per completion category."
47 (pcase (renz/completion-category)
48 ('nil elems) ; no sorting
49 ('kill-ring elems)
50 ('project-file (renz/sort-by-alpha-length elems))
51 (_ (renz/sort-by-history elems))))
52
53(setq completion-auto-help 'always
54 completion-auto-select 'second-tab
55 completions-max-height 10
56 completions-header-format nil
57 completion-show-help nil
58 completions-format 'one-column
59 save-completions-file-name (etc/ "completions")
60 completions-sort #'renz/sort-multi-category)
61
62(add-hook 'completion-list-mode-hook #'truncate-lines-local-mode)
63
64(provide '+completions)
65;;; +completions.el ends here
diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 0e0b9b1..0000000 --- a/lisp/+link-hint.el +++ /dev/null
@@ -1,175 +0,0 @@
1;;; +link-hint.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'link-hint)
7
8(defgroup +link-hint nil
9 "Extra customizations for `link-hint'."
10 :group 'link-hint)
11
12(defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url
13 gnus-w3m-url
14 markdown-link
15 mu4e-attachment
16 mu4e-url
17 notmuch-hello
18 nov-link
19 org-link
20 shr-url
21 text-url
22 w3m-link
23 w3m-message-link)
24 "Link types to define `:open-secondary' for.")
25
26(defvar +link-hint-map (make-sparse-keymap)
27 "Keymap for `link-hint' functionality.")
28
29(cl-defmacro +link-hint-define-keyword (keyword handler docstring
30 &optional (types 'link-hint-types)
31 &rest rest
32 &key multiple &allow-other-keys)
33 "Set up a `link-hint' KEYWORD, with optional TYPES.
34If TYPES is not present, use `link-hint-types'.
35
36KEYWORD defines the link-hint type. It will be used to create a
37function for opening links of the form \"link-hint-openKEYWORD\".
38
39HANDLER is the function to open a link with.
40
41DOCSTRING is the macro's documentation.
42
43Keyword arguments are passed to `link-hint-define-type' prefixed
44with the KEYWORD."
45 (declare (indent 2)
46 (doc-string 3))
47 (let ((types (symbol-value types))
48 (func-sym (intern (format "+link-hint-open%s" keyword)))
49 (mult-sym (intern (format "%s-multiple" keyword)))
50 (expr))
51 ;; Define the type
52 (push `(dolist (type ',types)
53 (link-hint-define-type type
54 ,keyword ,handler
55 ,@(mapcar (lambda (el)
56 (if (eq el :multiple)
57 mult-sym
58 el))
59 rest)))
60 expr)
61 ;; Define an opener
62 (push `(defun ,func-sym ()
63 ,(format "%s\n\nDefined by `+link-hint-define'." docstring)
64 (interactive)
65 (avy-with link-hint-open-link
66 (link-hint--one ,keyword)))
67 expr)
68 ;; Handle `:multiple'
69 (when multiple
70 (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) ()
71 ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'."
72 func-sym)
73 (avy-with link-hint-open-multiple-links
74 (link-hint--multiple ,keyword)))
75 expr)
76 (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) ()
77 ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'."
78 func-sym)
79 (avy-with link-hint-open-all-links
80 (link-hint--all ,keyword)))
81 expr))
82 ;; Return the built expression
83 `(progn ,@(nreverse expr))))
84
85(+link-hint-define-keyword :secondary browse-url-secondary-browser-function
86 "Open a link in the secondary browser."
87 +link-hint-open-secondary-types
88 :multiple t)
89
90(progn
91 (dolist
92 (type
93 '(gnus-w3m-image-url gnus-w3m-url markdown-link mu4e-attachment mu4e-url notmuch-hello nov-link org-link shr-url text-url w3m-link w3m-message-link))
94 (link-hint-define-type type :download
95 (function +browse-url-download)
96 :download-multiple t))
97 (defun +link-hint-open:download nil "Download a link to `eww-download-directory'.
98
99Defined by `+link-hint-define'."
100 (interactive)
101 (avy-with link-hint-open-link
102 (link-hint--one :download)))
103 (defun +link-hint-open-multiple:download nil "Open multiple links with `+link-hint-open:download'.
104
105Defined by `+link-hint-define'."
106 (avy-with link-hint-open-multiple-links
107 (link-hint--multiple :download)))
108 (defun +link-hint-open-all:download nil "Open all visible links with `+link-hint-open:download'.
109
110Defined by `+link-hint-define'."
111 (avy-with link-hint-open-all-links
112 (link-hint--all :download))))
113
114;; (defun +link-hint-open-secondary-setup (&optional types)
115;; "Define the `:open-secondary' link-hint type for TYPES.
116;; If TYPES is nil, define it for `+link-hint-open-secondary-types'."
117;; (dolist (type (or types +link-hint-open-secondary-types))
118;; (link-hint-define-type type
119;; :open-secondary browse-url-secondary-browser-function
120;; :open-secondary-multiple t)))
121
122;; (defun +link-hint-open-secondary ()
123;; "Open a link in the secondary browser."
124;; (interactive)
125;; (avy-with link-hint-open-link
126;; (link-hint--one :open-secondary)))
127
128(+link-hint-define-keyword :chrome #'browse-url-chrome
129 "Open a link with `browse-url-chrome'."
130 +link-hint-open-secondary-types
131 :multiple t)
132
133;; (defun +link-hint-open-chrome-setup (&optional types)
134;; "Define the `:open-chrome' link-hint type for TYPES.
135;; If TYPES is nil, define it for `+link-hint-open-secondary-types'."
136;; (dolist (type (or types +link-hint-open-secondary-types))
137;; (link-hint-define-type type
138;; :open-chrome #'browse-url-chrome
139;; :open-chrome-multiple t)))
140
141;; (defun +link-hint-open-chrome ()
142;; "Open a link with chrome."
143;; (interactive)
144;; (avy-with link-hint-open-link
145;; (link-hint--one :open-chrome)))
146
147(defun +link-hint-open-link (prefix)
148 "Open a link.
149Without a PREFIX, open using `browse-url-browser-function'; with
150a PREFIX, use `browse-url-secondary-browser-function'."
151 (interactive "P")
152 (let ((current-prefix-arg nil))
153 (avy-with link-hint-open-link
154 (link-hint--one (if prefix :open-secondary :open)))))
155
156;; test: https://www.acdw.net
157
158(defun +link-hint-open-multiple-links (prefix)
159 "Open multiple links.
160Without a PREFIX, open using `browse-url-browser-function'; with
161a PREFIX, use `browse-url-secondary-browser-function'."
162 (interactive "P")
163 (avy-with link-hint-open-multiple-links
164 (link-hint--one (if prefix :open-secondary :open))))
165
166(defun +link-hint-open-all-links (prefix)
167 "Open all visible links.
168Without a PREFIX, open using `browse-url-browser-function'; with
169a PREFIX, use `browse-url-secondary-browser-function'."
170 (interactive "P")
171 (avy-with link-hint-open-all-links
172 (link-hint--one (if prefix :open-secondary :open))))
173
174(provide '+link-hint)
175;;; +link-hint.el ends here
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null
@@ -1,49 +0,0 @@
1;;; +org-capture.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll
7;; take a minute. Just let the compiler know that this variable exists.
8(defvar org-capture-templates nil)
9
10;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573
11(defun +org-capture-template-define (description &rest args)
12 "Define a capture template.
13Creates a list and adds it to `org-capture-templates', if it's
14not already there. ARGS is a plist, which in addition to the
15additional options `org-capture-templates' accepts (which see),
16takes the following and puts them in the right spot: `:keys',
17`:description', `:type', `:target', and `:template'."
18 (declare (indent 1))
19 (let* ((keys (plist-get args :keys))
20 (type (plist-get args :type))
21 (target (plist-get args :target))
22 (template (plist-get args :template))
23 (template-value (append
24 (list description)
25 (when (or type target template)
26 (list (or type 'entry) target template))
27 (cl-loop for i from 0 below (length args) by 2
28 unless (member (nth i args)
29 '(:keys :description :type
30 :target :template))
31 append (list (nth i args)
32 (plist-get args (nth i
33 args)))))))
34 ;; The only way I know how to do this properly (add a value to the end of
35 ;; the list, if it exists; otherwise update it) is to do this weird if-setf
36 ;; dance.
37 (if (seq-find (lambda (el) (equal (car el) keys))
38 org-capture-templates)
39 (setf (alist-get keys org-capture-templates nil nil #'equal)
40 template-value)
41 (setf org-capture-templates
42 (append org-capture-templates
43 (list (cons keys template-value)))))
44 ;; Regardless of what we do, return the new value of
45 ;; `org-capture-templates'.
46 org-capture-templates))
47
48(provide '+org-capture)
49;;; +org-capture.el
diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 5d749c6..0000000 --- a/lisp/+scratch.el +++ /dev/null
@@ -1,75 +0,0 @@
1;;; +scratch.el --- *scratch* improvements -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2023 Case Duckworth
4
5;; Author: Case Duckworth <case@acdw.net>
6;; Keywords: convenience
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <https://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;;
24
25;;; Code:
26
27(defcustom +scratch-save-dir (locate-user-emacs-file "scratch.d")
28 "Where to save scratch files."
29 :type 'file)
30
31(defcustom +scratch-max-age (* 60 60 24 365)
32 "Maximum age of a saved scratch buffer. Default: one year."
33 :type 'natnum)
34
35(defun +scratch@immortal ()
36 "Don't kill *scratch* with `kill-buffer'."
37 (if (equal (buffer-name) "*scratch*")
38 (progn (bury-buffer) nil)
39 t))
40
41(defun +scratch-save (time-format)
42 "Save *scratch* buffer to `+scratch-save-dir'.
43TIME-FORMAT will be used to name the buffer."
44 (interactive (list "%FT%H%z"))
45 (with-current-buffer (get-scratch-buffer-create)
46 (let ((buffer-file-name (expand-file-name (format "%s.%s"
47 (format-time-string
48 time-format)
49 (pcase major-mode
50 ('org-mode "org")
51 ('emacs-lisp-mode "el")
52 (_ "txt")))
53 +scratch-save-dir)))
54 (unless (string-equal (buffer-substring (point-min) (point-max))
55 initial-scratch-message)
56 (save-buffer 0)))))
57
58(defun +scratch-save-on-exit ()
59 (+scratch-save "%FT%T%z")
60 (+scratch-clean))
61
62(defun +scratch-clean ()
63 "Clean up saved scratches.
64Scratch files older than `+scratch-max-age' will be removed."
65 (dolist (f (directory-files +scratch-save-dir))
66 (when (and (not (equal f "."))
67 (not (equal f ".."))
68 (> (time-convert (file-attribute-modification-time
69 (file-attributes f))
70 'integer)
71 +scratch-max-age))
72 (delete-file (expand-file-name f +scratch-save-dir) :trash))))
73
74(provide '+scratch)
75;;; +scratch.el ends here
diff --git a/lisp/acdw-chat.el b/lisp/acdw-chat.el deleted file mode 100644 index 9294ffe..0000000 --- a/lisp/acdw-chat.el +++ /dev/null
@@ -1,206 +0,0 @@
1;;; acdw-chat.el --- Chat applications (mostly jabber) -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defcustom jabber-prefix-width 10
6 "Width of jabber prompts and other prefixes."
7 :type 'number
8 :group 'jabber)
9
10(defun jabber-ui-setup ()
11 "Setup the `jabber' user interface."
12 (visual-fill-column-mode)
13 (electric-pair-local-mode -1)
14 (auto-fill-mode -1)
15 (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20)
16 visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width)
17 . 1)))
18
19(defcustom jabber-biboumi-server "localhost"
20 "Biboumi server for `jabber-biboumi-muc-connect'."
21 :type 'string
22 :group 'jabber)
23
24(defcustom jabber-biboumi-irc-servers '("irc.libera.chat")
25 "IRC servers for the user to choose from with `jabber-biboumi-muc-connect'."
26 :type '(repeat string)
27 :group 'jabber)
28
29(defcustom jabber-biboumi-default-nick ""
30 "Default nick for biboumi rooms."
31 :type 'string
32 :group 'jabber)
33
34(defun jabber-biboumi-muc-connect (channel server nick &optional biboumi-server)
35 "Connect to a biboumi (IRC gateway) server MUC.
36CHANNEL, SERVER, NICK, and BIBOUMI-SERVER are passed to
37`jabber-muc-join'. If BIBOUMI-SERVER isn't given,
38`jabber-biboumi-server' is used."
39 (interactive (list (concat "#" (string-remove-prefix "#" (read-string
40 "Channel: ")))
41 (completing-read "Server: " jabber-biboumi-irc-servers)
42 (read-string (format "Nick [%s]: "
43 jabber-biboumi-default-nick)
44 nil nil jabber-biboumi-default-nick)))
45 (let ((room (format "%s%%%s@%s" channel server (or biboumi-server
46 jabber-biboumi-server))))
47 (if (assoc room *jabber-active-groupchats*)
48 (switch-to-buffer (jabber-muc-get-buffer room))
49 (jabber-muc-join (jabber-read-account)
50 room
51 nick
52 'popup))))
53
54(defalias 'jabber-irc-join 'jabber-biboumi-muc-connect)
55
56(defun jabber-connect-all* (&optional arg)
57 "Run `jabber-connect-all'.
58With a prefix ARG, disconnect first."
59 (interactive "p")
60 (when arg
61 (jabber-disconnect))
62 (jabber-connect-all))
63
64(defun jabber-group-yank-join-url ()
65 "Yank a url for joining the focused group."
66 (interactive)
67 (let ((s (format "xmpp:%s?join" jabber-group)))
68 (kill-new s)
69 (message s)))
70
71
72;;; Packages
73
74(use-package jabber
75 :load-path "~/src/jabber.el/"
76 :custom-face
77 (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
78 :foreground unspecified
79 :weight normal)))
80 (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local
81 :foreground unspecified
82 :weight bold)))
83 (jabber-chat-prompt-local ((t :inherit minibuffer-prompt
84 :foreground unspecified
85 :weight normal
86 :slant italic)))
87 (jabber-chat-prompt-foreign ((t :inherit warning
88 :foreground unspecified
89 :weight normal)))
90 (jabber-chat-prompt-system ((t :inherit font-lock-doc-face
91 :foreground unspecified)))
92 (jabber-rare-time-face ((t :inherit font-lock-comment-face
93 :foreground unspecified
94 :underline nil)))
95 :bind-keymap ("C-c j" . jabber-global-keymap)
96 :bind (("C-c C-SPC" . jabber-activity-switch-to))
97 :config
98 (setq jabber-account-list '(("acdw@hmm.st"))
99 jabber-auto-reconnect t
100 jabber-biboumi-server "irc.hmm.st"
101 jabber-biboumi-irc-servers '("irc.libera.chat"
102 "irc.oftc.net"
103 "irc.tilde.chat"
104 "tilde.town"
105 "m455.casa"
106 "irc.twitch.tv")
107 jabber-biboumi-default-nick "acdw"
108 jabber-last-read-marker (make-string fill-column ?.)
109 jabber-muc-decorate-presence-patterns
110 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
111 ("Mode #.*" . jabber-muc-presence-dim)
112 ("." . jabber-muc-presence-dim))
113 jabber-activity-make-strings #'jabber-activity-make-strings-shorten
114 jabber-rare-time-format " - - - - - - %H:%M %F"
115 jabber-chat-header-line-format
116 '("" (jabber-chat-buffer-show-avatar
117 (:eval
118 (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
119 (jabber-propertize " "
120 'display (get buddy 'avatar)))))
121 (:eval (replace-regexp-in-string "%" "%%"
122 (jabber-jid-displayname
123 jabber-chatting-with)))
124 "\t" (:eval (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
125 (propertize
126 (or
127 (cdr (assoc (get buddy 'show) jabber-presence-strings))
128 (get buddy 'show))
129 'face
130 (or (cdr (assoc (get buddy 'show) jabber-presence-faces))
131 'jabber-roster-user-online))))
132 "\t" (:eval (jabber-fix-status (get (jabber-jid-symbol jabber-chatting-with) 'status)))
133 "\t" jabber-events-message
134 "\t" jabber-chatstates-message)
135 jabber-muc-header-line-format
136 '(" " (:eval (replace-regexp-in-string "%" "%%"
137 (jabber-jid-displayname
138 jabber-group)))
139 " / " jabber-muc-topic)
140 ;; buffer name formats
141 jabber-chat-buffer-format "*xmpp* %n"
142 jabber-browse-buffer-format "*xmpp-browse* %n"
143 jabber-groupchat-buffer-format "*xmpp-muc* %n"
144 jabber-muc-private-buffer-format "*xmpp-muc-private* %n"
145 ;; "prompt" (speaker) formats
146 jabber-groupchat-prompt-format (format "%%>%dn . " jabber-prefix-width)
147 jabber-chat-local-prompt-format (format "%%>%dn . " jabber-prefix-width)
148 jabber-chat-foreign-prompt-format (format "%%>%dn . " jabber-prefix-width)
149 jabber-muc-private-foreign-prompt-format "\n%g/%n . ")
150 ;; jabber muc nick coloring
151 ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus)
152 ;; (setopt jabber-muc-nick-value 1.0
153 ;; jabber-muc-nick-saturation 1.0
154 ;; jabber-muc-colorize-local t
155 ;; jabber-muc-colorize-foreign t)
156 ;; When changing the above values, make sure to
157 ;; (setq jabber-muc-participant-colors nil)
158 (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup)
159 (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix
160 ;; For each binding in `jabber-global-keymap', also bind the non-control
161 ;; character (lowercase)
162 (map-keymap (lambda (key command)
163 (define-key jabber-global-keymap (vector (+ key #x60)) command))
164 jabber-global-keymap)
165 (define-key jabber-global-keymap "c" #'jabber-connect-all*)
166 (require 'jabber-httpupload nil t)
167 (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
168 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
169 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
170 (add-hook 'jabber-alert-muc-hooks
171 (defun jabber@highlight-acdw (&optional _ _ buf _ _)
172 (when buf
173 (with-current-buffer buf
174 (let ((regexp (rx word-boundary
175 "acdw" ; maybe get from the config?
176 word-boundary)))
177 (hi-lock-unface-buffer regexp)
178 (highlight-regexp regexp 'jabber-chat-prompt-local))))))
179 (add-hook 'jabber-chat-mode-hook
180 (defun jabber-chat@leave-when-kill ()
181 (add-hook 'kill-buffer-hook
182 (defun @jabber-leave@kill ()
183 (ignore-errors
184 (apply #'jabber-muc-leave (jabber-muc-argument-list))))
185 nil :local)))
186 (when (fboundp 'jabber-chat-update-focus)
187 (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))
188 (with-eval-after-load 'consult
189 (defvar jabber-chat-buffer-source
190 `( :name "Jabber"
191 :hidden nil
192 :narrow ?j
193 :category buffer
194 :state ,#'consult--buffer-state
195 :items ,(lambda ()
196 (mapcar #'buffer-name
197 (seq-filter (lambda (buf)
198 (with-current-buffer buf
199 (eq major-mode 'jabber-chat-mode)))
200 (buffer-list))))))
201 (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append)
202 (consult-customize
203 consult-buffer :preview-key "M-.")))
204
205(provide 'acdw-chat)
206;;; acdw-chat.el ends here
diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el deleted file mode 100644 index bf20c9b..0000000 --- a/lisp/acdw-mail.el +++ /dev/null
@@ -1,439 +0,0 @@
1;;; acdw-mail.el --- My email configuration -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'message)
7
8;;; Variables
9
10(defcustom +message-send-dispatch-rules nil
11 "Alist to set variables based on the current from address."
12 :group 'message
13 :type '(alist :key-type (string :tag "From address")
14 :value-type (alist :tag "Rules"
15 :key-type (symbol :tag "Variable")
16 :value-type (sexp :tag "Value"))))
17
18(defcustom +notmuch-spam-tags '("+spam -inbox -unread")
19 "List of tag changes to apply when marking a thread as spam."
20 :group 'notmuch
21 :type '(repeat string))
22
23;;; Functions
24
25(defun +message-send-set-variables ()
26 "Set variables for `message-send' depending on the From: header.
27Useful in `message-send-hook'."
28 (unless +message-send-dispatch-rules
29 (load notmuch-init-file)
30 (or +message-send-dispatch-rules
31 (error "`+message-send-dispatch-rules' isn't set!")))
32 (let ((from (message-fetch-field "from")))
33 (cl-loop for (var . val) in (cl-loop for (address . bindings)
34 in +message-send-dispatch-rules
35 if (string-match-p address from)
36 return bindings)
37 do (set (make-local-variable var) val))))
38
39;; Thanks to Alex Schroeder!
40;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically
41(defun +message-check-for-signature-change (&rest ignore)
42 "Check for a change in the To: or Cc: fields"
43 (when (and (message--in-tocc-p)
44 (not (buffer-narrowed-p)))
45 (save-excursion
46 (goto-char (point-max))
47 (let ((end (point)))
48 (when (re-search-backward message-signature-separator nil t)
49 (delete-region (1- (match-beginning 0)) end)))
50 (message-insert-signature))))
51
52(defun +message-signature-setup ()
53 (make-local-variable 'after-change-functions)
54 (push '+message-check-for-signature-change after-change-functions))
55
56(defun +notmuch-field-match-p (field regexp)
57 "Return whether message FIELD matches REGEXP."
58 (string-match-p regexp (or (message-fetch-field field) "")))
59
60(defun +notmuch-query-concat (&rest queries)
61 "Concatenate `notmuch' QUERIES with AND."
62 (mapconcat #'identity queries " AND "))
63
64;;;###autoload
65(defun +notmuch-goto (&optional prefix)
66 "Perform a saved `notmuch' search.
67Without a PREFIX argument, perform the first search in
68`notmuch-saved-searches'. With a single PREFIX argument
69(\\[universal-argument]), prompt the user as to which saved
70search to perform. With two PREFIX arguments, prompt the user
71for a free-form search. With any other PREFIX argument, open
72`notmuch-hello'."
73 (interactive "P")
74 (pcase prefix
75 ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query)))
76 ('(4) (notmuch-search
77 (plist-get (cl-find (completing-read "Saved search: "
78 (mapcar (lambda (elt)
79 (plist-get elt :name))
80 notmuch-saved-searches))
81 notmuch-saved-searches
82 :key (lambda (elt) (plist-get elt :name))
83 :test #'equal)
84 :query)))
85 ('(16) (notmuch-search))
86 (_ (notmuch-hello))))
87
88(defun +notmuch-search-mark-spam (&optional ham start end)
89 "Mark the current thread or region as spam.
90That is, add the tags in `+notmuch-spam-tags' to the message.
91With an optional HAM argument (interactively,
92\\[universal-argument]), mark the message as not-spam, or ham, by
93reversing the tag changes."
94 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
95 (when +notmuch-spam-tags
96 (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham)
97 start end))
98 (when (eq start end)
99 (notmuch-search-next-thread)))
100
101(defun +notmuch-tree-mark-spam (&optional ham _ _)
102 "Mark the current message as spam.
103That is, add the tags in `+notmuch-spam-tags' to the message.
104With an optional HAM argument (interactively,
105\\[universal-argument]), mark the message as not-spam, or ham, by
106reversing the tag changes."
107 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
108 (when +notmuch-spam-tags
109 (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham)))
110 (notmuch-tree-next-matching-message))
111
112(defun +notmuch-define-saved-search (name key search-type &rest queries)
113 "Wrapper to ease `notmuch-saved-searches' defining.
114NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in
115`notmuch-saved-searches', which see. QUERIES are all concatenated together with
116AND. If QUERIES is prepended with more keyword arguments, those are added to
117the saved search as well."
118 (declare (indent 3))
119 (let (extra-keywords)
120 (while (keywordp (car queries))
121 (push (cadr queries) extra-keywords)
122 (push (car queries) extra-keywords)
123 (setf queries (cddr queries)))
124 (add-to-list 'notmuch-saved-searches
125 (append (list :name name
126 :key key
127 :search-type search-type
128 :query (apply #'+notmuch-query-concat queries))
129 (reverse extra-keywords))
130 :append
131 (lambda (a b)
132 (equal (plist-get a :name)
133 (plist-get b :name))))))
134
135(defun notmuch-async-poll ()
136 "Run `notmuch-poll' in an async process."
137 (interactive)
138 (if (require 'async nil t)
139 (progn
140 (message "Polling mail (async)...")
141 (async-start
142 (lambda ()
143 (ignore-errors
144 (push "~/usr/share/emacs/site-lisp/" load-path)
145 (require 'notmuch-lib)
146 (notmuch-poll)))
147 (lambda (_)
148 (message "Polling mail (async)...done"))))
149 (user-error "Feature `async' not found!")
150 (notmuch-poll)))
151
152;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/
153
154(defun email-says-attach-p ()
155 "Return t if email suggests there could be an attachment."
156 (save-excursion
157 (goto-char (point-min))
158 (re-search-forward "attach" nil t)))
159
160(defun email-has-attachment-p ()
161 "Return t if the currently open email has an attachment."
162 (save-excursion
163 (goto-char (point-min))
164 (re-search-forward "<#part" nil t)))
165
166(defun email-pre-send-check-attachment ()
167 (when (and (email-says-attach-p)
168 (not (email-has-attachment-p)))
169 (unless
170 (y-or-n-p
171 "Your email suggests an attachment, but none was found. Send anyway?")
172 (error "No attachment. Aborting send."))))
173
174;;; Process ical attachments
175;; https://www.reddit.com/r/emacs/comments/8s1ion/comment/e0x5kgd/
176
177(defun ical2org (&optional replace output-buffer)
178 "Run ical2org on contents of this buffer.
179If REPLACE (interactive prefix argument), replace contents of the
180buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to
181minibuffer."
182 (interactive "P")
183 (shell-command-on-region (point-min) (point-max)
184 "ical2org.awk"
185 output-buffer
186 replace
187 "*ical2org errors*"
188 'display-errors))
189
190(defun ical2org-capture ()
191 "Run `ical2org' on this buffer, then `org-capture' the result.
192Leaves current buffer as-was afterwards."
193 (interactive)
194 (let ((buf (current-buffer))
195 (ics (buffer-string)))
196 (ical2org 'replace buf)
197 (mark-whole-buffer)
198 (org-capture nil "a")
199 (mark-whole-buffer)
200 (delete-region (point-min) (point-max))
201 (insert ics)))
202
203(defun notmuch-ics-refile (filename header)
204 "Refile the current ICS buffer to FILENAME, under HEADER."
205 (org-refile nil nil
206 (list header
207 filename
208 nil
209 (with-current-buffer (find-file-noselect filename)
210 (org-find-exact-headline-in-buffer header))))
211 (notmuch-ics-kill))
212
213(defun notmuch-ics-kill ()
214 "Kill the current ICS buffer and delete its file."
215 (let ((kill-buffer-hook nil)
216 (kill-buffer-query-functions nil)
217 (file (buffer-file-name)))
218 (set-buffer-modified-p nil)
219 (kill-buffer-and-window)
220 (delete-file file)))
221
222(defun notmuch-ics-cancel ()
223 "Cancel saving ICS buffer."
224 (interactive)
225 (notmuch-ics-kill))
226
227(define-derived-mode notmuch-save-ics-mode org-mode
228 "Org-mode but with a different keymap.")
229
230(defun notmuch-save-ics ()
231 ;; XXX: this is hacky as hell
232 "Save a .ics file in a message."
233 (interactive)
234 (with-current-notmuch-show-message
235 (notmuch-foreach-mime-part
236 (lambda (part)
237 (when (and (listp part)
238 (or (equal "application/ics" (caadr part))
239 ;; (equal "text/calendar" (caadr part))
240 ))
241 (let* ((filename (format "/dev/shm/notmuch-%s.ics"
242 (time-convert (current-time) 'integer))))
243 (mm-save-part-to-file part filename)
244 (message "Converting ICS to org ...")
245 (with-current-buffer (find-file-other-window filename)
246 (ical2org 'replace (current-buffer))
247 (deactivate-mark)
248 (let ((org-mode-hook nil))
249 (notmuch-save-ics-mode))
250 (local-set-key (kbd "C-c C-c")
251 (lambda () (interactive)
252 (notmuch-ics-refile (sync/ "org/diary.org") "Appointments")))
253 (local-set-key (kbd "C-c C-k") #'notmuch-ics-cancel)
254 (setq-local header-line-format
255 (concat "ICAL buffer. "
256 "Finish: `C-c C-c'. "
257 "Abort: `C-c C-k'."))))))
258 (mm-dissect-buffer t t))))
259
260(add-hook 'notmuch-show-hook #'notmuch-save-ics)
261
262
263;;; Fixes
264
265;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net
266
267(defun notmuch--indent-rigidly (start end count)
268 (cond
269 ((zerop count) t)
270 ((< count 0) (indent-rigidly start end count))
271 (t
272 (save-excursion
273 (let ((startpt (progn (goto-char start) (line-beginning-position)))
274 (endpt (progn (goto-char end) (line-end-position)))
275 (spaces (spaces-string count)))
276 (goto-char startpt)
277 (while
278 (progn
279 (insert spaces)
280 (cl-incf endpt count)
281 (and (zerop (forward-line 1)) (bolp)
282 (<= (point) endpt)))))))))
283
284(with-eval-after-load 'notmuch-show
285 ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way
286 ;; of doing this
287 (defun notmuch-show-lazy-part (part-args button)
288 ;; Insert the lazy part after the button for the part. We would just
289 ;; move to the start of the new line following the button and insert
290 ;; the part but that point might have text properties (eg colours
291 ;; from a message header etc) so instead we start from the last
292 ;; character of the button by adding a newline and finish by
293 ;; removing the extra newline from the end of the part.
294 (save-excursion
295 (goto-char (button-end button))
296 (insert "\n")
297 (let* ((inhibit-read-only t)
298 ;; We need to use markers for the start and end of the part
299 ;; because the part insertion functions do not guarantee
300 ;; to leave point at the end of the part.
301 (part-beg (copy-marker (point) nil))
302 (part-end (copy-marker (point) t))
303 ;; We have to save the depth as we can't find the depth
304 ;; when narrowed.
305 (depth (notmuch-show-get-depth)))
306 (save-restriction
307 (narrow-to-region part-beg part-end)
308 (delete-region part-beg part-end)
309 (apply #'notmuch-show-insert-bodypart-internal part-args)
310 (notmuch--indent-rigidly part-beg
311 part-end
312 (* notmuch-show-indent-messages-width depth)))
313 (goto-char part-end)
314 (delete-char 1)
315 (notmuch-show-record-part-information (cadr part-args)
316 (button-start button)
317 part-end)
318 ;; Create the overlay. If the lazy-part turned out to be empty/not
319 ;; showable this returns nil.
320 (notmuch-show-create-part-overlays button part-beg part-end))))
321 )
322
323
324;;; Packages
325
326(use-package bbdb
327 :ensure t
328 :config
329 (setopt bbdb-complete-mail-allow-cycling t
330 bbdb-file (private/ "bbdb"))
331 (add-hook 'custom-allowed-after-load-hook
332 (defun bbdb@after-custom ()
333 (require 'bbdb)
334 (require 'bbdb-message)
335 (bbdb-initialize 'message))))
336
337(use-package bbdb-vcard
338 :ensure t
339 :after bbdb)
340
341(use-package notmuch
342 :when (executable-find "notmuch")
343 :load-path "~/usr/share/emacs/site-lisp/"
344 :defer 30
345 :commands (notmuch-mua-new-mail
346 notmuch-search
347 notmuch-hello)
348 :preface (defdir notmuch/ (sync/ "emacs/notmuch/")
349 "Notmuch configuration directory."
350 :makedir)
351 :config
352 ;; Options
353 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
354 notmuch-address-save-filename (notmuch/ "addresses" t)
355 notmuch-address-use-company (featurep 'company)
356 notmuch-search-oldest-first nil
357 notmuch-archive-tags '("-inbox" "-unread")
358 notmuch-draft-tags '("+draft" "-inbox" "-unread")
359 +notmuch-spam-tags '("+spam")
360 mail-user-agent 'notmuch-user-agent
361 message-mail-user-agent t
362 notmuch-show-indent-content nil
363 message-kill-buffer-on-exit t
364 message-auto-save-directory nil
365 message-signature "Case Duckworth\nhttps://www.acdw.net"
366 send-mail-function #'sendmail-send-it
367 mail-specify-envelope-from t
368 message-sendmail-envelope-from 'header
369 message-envelope-from 'header
370 notmuch-saved-searches nil
371 notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option
372 )
373 (load notmuch-init-file)
374 ;; Key bindings
375 (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
376 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
377 (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread)
378 (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam)
379 ;; Saved searches
380 (+notmuch-define-saved-search "inbox+unread" "m" 'tree
381 "tag:inbox" "tag:unread" "NOT tag:Spam")
382 (+notmuch-define-saved-search "inbox" "i" 'tree
383 "tag:inbox" "NOT tag:Spam")
384 (+notmuch-define-saved-search "lists+unread" "l" 'tree
385 "tag:/List/" "tag:unread")
386 (+notmuch-define-saved-search "lists" "L" 'tree
387 "tag:/List/")
388 (+notmuch-define-saved-search "unread" "u" 'tree
389 "tag:unread" "NOT tag:Spam")
390 (+notmuch-define-saved-search "flagged" "f" 'tree
391 "tag:flagged")
392 (+notmuch-define-saved-search "sent" "t" 'tree
393 "tag:sent")
394 (+notmuch-define-saved-search "drafts" "d" 'tree
395 "tag:draft")
396 (+notmuch-define-saved-search "all mail" "a" 'tree "*")
397 ;; Hooks and advice
398 (add-hook 'message-send-hook #'+message-send-set-variables)
399 (add-hook 'message-send-hook #'email-pre-send-check-attachment)
400 (add-hook 'message-setup-hook #'+message-signature-setup)
401 (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
402 (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
403 (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode)
404
405 (define-advice notmuch-bury-or-kill-this-buffer (:after (&rest _) poll-async)
406 (call-process "swaymail"))
407
408 (define-advice notmuch-address-selection-function
409 (:override (prompt collection _) no-initial-input)
410 "Call `completing-read' with `notmuch-address-history'.
411This version doesn't add any initial-input."
412 (completing-read prompt collection nil nil nil 'notmuch-address-history))
413
414 (add-to-list 'notmuch-message-headers "List-Post" :append #'equal)
415 (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware)
416 "Make `notmuch-mua-new-reply' list-aware."
417 (let ((ml (notmuch-show-get-header :List-Post)))
418 (apply orig r)
419 (require 'message)
420 (when ml
421 (with-buffer-modified-unmodified
422 (message-remove-header "To")
423 (message-add-header
424 (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
425 ml)))
426 (message-goto-body)))))
427
428 (define-advice notmuch-tag (:filter-args (args) trim)
429 "Trim whitespace from ends of tags."
430 (list (car args) (mapcar #'string-trim (cadr args))))
431 ;; Load init file
432 (load notmuch-init-file :noerror))
433
434(use-package notmuch-tags
435 :load-path "~/src/emacs/notmuch-tags.el/"
436 :commands (notmuch-tags-mode))
437
438(provide 'acdw-mail)
439;;; acdw-mail.el ends here
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el deleted file mode 100644 index 2ec3339..0000000 --- a/lisp/acdw-org.el +++ /dev/null
@@ -1,548 +0,0 @@
1;;; acdw-org.el --- My org customizations -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7;;; Variables
8
9(defcustom org-agenda-skip-file-regexp nil
10 "Files matching this regexp are removed from `org-agenda-files'."
11 :group 'org-agenda
12 :type 'regexp)
13
14;;; Functions
15
16
17;;; DWIM
18
19;; https://github.com/alphapapa/unpackaged.el,
20;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
21(defun +org-return-dwim (&optional arg)
22 "A helpful replacement for `org-return'.
23When called interactively with \\[universal-argument], call `org-return'
24itself. Other values of ARG will call `newline' with that ARG."
25 (interactive "P")
26 ;; Auto-fill if enabled
27 (when auto-fill-function
28 (dolist (func (ensure-list auto-fill-function))
29 (funcall func)))
30 (cl-letf* ((el (org-element-at-point))
31 ((symbol-function 'el-child-of)
32 (lambda (&rest types)
33 (org-element-lineage el types t))))
34 (cond ; Figure out what we're going to do
35 (arg ; Handle prefix ARG
36 (pcase arg
37 ('(4) (org-return t nil t))
38 (_ (newline arg t))))
39 ((and org-return-follows-link ; Open a link
40 (el-child-of 'link))
41 (org-open-at-point-global))
42 ((org-at-heading-p) ; Open a paragraph after a heading
43 (let ((heading-start (org-entry-beginning-position)))
44 (goto-char (org-entry-end-position))
45 (cond ((and (org-at-heading-p) ; Entry is only a heading
46 (= heading-start (org-entry-beginning-position)))
47 (end-of-line)
48 (newline 2))
49 (:else ; Entry is more than a heading
50 (forward-line -1)
51 (end-of-line)
52 (when (org-at-heading-p)
53 ;; Open a paragraph
54 (forward-line)
55 (newline)
56 (forward-line -1))
57 (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil))
58 (newline))
59 (forward-line -1)))))
60 ((org-at-item-checkbox-p) ; Insert a new checkbox item
61 (end-of-line)
62 (org-insert-todo-heading nil))
63 ((org-in-item-p) ; Insert a new list item
64 (let* ((context (org-element-context el))
65 (first-item-p (eq 'plain-list (car context)))
66 (itemp (eq 'item (car context)))
67 (emptyp (or
68 ;; This (regular) list item is empty
69 (eq (org-element-property :contents-begin context)
70 (org-element-property :contents-end context))
71 ;; This (definition) list item is empty
72 (looking-at " *::")))
73 (item-child-p (el-child-of 'item)))
74 (cond ((and itemp emptyp)
75 ;; This test has to be here even though it's the same as the
76 ;; :else clause, because an item that's empty will also satisfy
77 ;; the next clause.
78 (delete-region (line-beginning-position) (line-end-position))
79 (newline))
80 ((or first-item-p
81 (and itemp (not emptyp))
82 item-child-p)
83 (org-end-of-item)
84 (org-insert-item))
85 (:else
86 (delete-region (line-beginning-position) (line-end-position))
87 (newline)))))
88 ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks
89 (org-inlinetask-in-task-p))
90 (org-return))
91 ((org-at-table-p) ; Insert a new table row
92 (cond ((save-excursion ; Empty row: end the table
93 (beginning-of-line)
94 (cl-loop with end = (line-end-position)
95 for cell = (org-element-table-cell-parser)
96 always (eq (org-element-property :contents-begin cell)
97 (org-element-property :contents-end cell))
98 while (re-search-forward "|" end t)))
99 (delete-region (line-beginning-position) (line-end-position))
100 (org-return))
101 (:else ; Non-empty row
102 (org-return))))
103 (:else ; Something else
104 (org-return)))))
105
106(defun +org-table-copy-down|+org-return-dwim (&optional n)
107 "Call `org-table-copy-down' or `+org-return' depending on context."
108 (interactive "P")
109 (if (org-table-check-inside-data-field 'noerror)
110 (org-table-copy-down (or n 1))
111 (+org-return-dwim n)))
112
113
114;;; Buffer view cleanup
115
116(defun +org-hide-drawers-except-point ()
117 "Hide all drawers except for the one point is in."
118 ;; Most of this bit is taken from `org-fold--hide-drawers'.
119 (let ((pt (point))
120 (begin (point-min))
121 (end (point-max)))
122 (save-excursion
123 (goto-char begin)
124 (while (and (< (point) end)
125 (re-search-forward org-drawer-regexp end t))
126 (if (org-fold-folded-p nil 'drawer)
127 (goto-char (org-fold-next-folding-state-change 'drawer nil end))
128 (let* ((drawer (org-element-at-point))
129 (type (org-element-type drawer))
130 (el-begin (org-element-property :begin drawer))
131 (el-end (org-element-property :end drawer)))
132 (when (memq type '(drawer property-drawer))
133 (org-fold-hide-drawer-toggle
134 (if (< el-begin pt el-end) 'off 'on)
135 nil drawer)
136 (goto-char el-end))))))))
137
138
139;;; Copy rich text to the keyboard
140
141;; Thanks to Oleh Krehel:
142;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
143;; So. Emacs can't do this itself because it doesn't support sending clipboard
144;; or selection contents as text/html. We have to use xclip instead.
145;; (defun org-to-html-to-clipboard (&rest org-export-args)
146;; "Export current org buffer to HTML, then copy it to the clipboard.
147;; ORG-EXPORT-ARGS are passed to `org-export-to-file'."
148;; (let ((f (make-temp-file "org-html-export")))
149;; (apply #'org-export-to-file 'html f org-export-args)
150;; (start-process "xclip" " *xclip*"
151;; "xclip" "-verbose" "-i" f
152;; "-t" "text/html" "-selection" "clipboard")
153;; (message "HTML pasted to clipboard.")))
154
155;; Wayland version.. TODO: make it work for both
156(defun org-to-html-to-clipboard (&rest org-export-args)
157 "Export current org buffer to HTML, then copy it to the clipboard.
158ORG-EXPORT-ARGS are passed to `org-export-to-file'."
159 (let ((buf (generate-new-buffer "*org-html-clipboard*" t)))
160 (apply #'org-export-to-buffer 'html buf org-export-args)
161 (with-current-buffer buf
162 (call-process-region (point-min) (point-max)
163 "wl-copy" nil nil nil
164 "-t" "text/html")
165 (kill-buffer-and-window))
166 (message "HTML copied to clipboard.")))
167
168(defun org-subtree-to-html-to-clipboard ()
169 "Export current subtree to HTML."
170 (interactive)
171 (org-to-html-to-clipboard nil :subtree))
172
173
174;;; Prompting
175
176(defun +org-prompt-for-property (property &optional clipboardp insert list)
177 "Prompt for PROPERTY and return a properly-formatted string.
178Pre-fill the input with clipboard contents if they match CLIPBOARDP. If
179CLIPBOARDP is nil or missing, don't pre-fill.
180
181If INSERT is non-nil, insert the property into the property
182drawer of the current org tree.
183
184If LIST is non-nil, return the result as a list instead of a string."
185 (let* ((kill (current-kill 0))
186 (value (read-string (concat property ": ")
187 (when (and clipboardp
188 (or (eq clipboardp t)
189 (funcall clipboardp kill)))
190 kill))))
191 (when insert
192 (org-set-property property value))
193 (if list
194 (list property value)
195 (format ":%s: %s" property value))))
196
197(defun +org-prompt-tags (&optional prompt global)
198 (let* ((buffer (org-capture-get :buffer))
199 (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
200 (org-last-tags-completion-table
201 (org-global-tags-completion-table
202 (if global (org-agenda-files) (list file))))
203 (org-add-colon-after-tag-completion t)
204 (ins (mapconcat
205 #'identity
206 (let ((crm-separator "[ \t]*:[ \t]*"))
207 (completing-read-multiple
208 (or prompt "Tags: ")
209 org-last-tags-completion-table nil nil nil
210 'org-tags-history))
211 ":")))
212 (when (org-string-nw-p ins)
213 (prog1 (concat
214 (unless (eq (char-before) ?:) ":")
215 ins
216 (unless (eq (char-after) ?:) ":"))
217 (when (org-at-heading-p) (org-align-tags))))))
218
219
220;;; Navigating headings
221
222(defun org-next-visible-heading-unfolding (arg)
223 (interactive "p")
224 (when (let ((pt (org-next-visible-heading arg)))
225 (and (buffer-narrowed-p)
226 (or (= (point) (point-min))
227 (and pt
228 (= pt (point-max))))))
229 (widen)
230 (org-next-visible-heading arg)
231 (org-narrow-to-subtree)))
232
233(defun org-previous-visible-heading-unfolding (arg)
234 (interactive "p")
235 (org-next-visible-heading-unfolding (- arg)))
236
237(defun org-up-heading-unfolding (arg)
238 (interactive "p")
239 (when (let ((pt (outline-up-heading arg)))
240 (and (buffer-narrowed-p)
241 (= (point) (point-min))))
242 (widen)
243 (org-up-heading-unfolding arg)
244 (org-narrow-to-subtree)))
245
246
247;;; Misc.
248
249(defun org-clock-in-or-out (prefix)
250 "If clocked in, clock out. Otherwise, clock in."
251 (interactive "P")
252 (if (org-clocking-p)
253 (org-clock-out prefix)
254 (org-clock-in prefix)))
255
256
257;;; Faces
258
259(defface org-bold '((t (:weight bold)))
260 "Bold face in `org-mode' documents.")
261
262(defface org-italic '((t (:slant italic)))
263 "Italic face in `org-mode' documents.")
264
265(defface org-underline '((t (:underline t)))
266 "Underline face in `org-mode' documents.")
267
268(defface org-strikethrough '((t (:strike-through t)))
269 "Strike-through face for `org-mode' documents.")
270
271
272;;; Packages
273
274(use-package org
275 :defer t
276 :custom-face
277 (org-level-1 ((t :inherit fixed-pitch
278 :weight bold
279 :slant italic
280 :height 1.0)))
281 (org-level-2 ((t :inherit fixed-pitch
282 :weight bold
283 :slant italic
284 :height 1.0)))
285 (org-level-3 ((t :inherit fixed-pitch
286 :weight bold
287 :height 1.0)))
288 (org-level-4 ((t :inherit org-level-3)))
289 (org-level-5 ((t :inherit org-level-4)))
290 (org-level-6 ((t :inherit org-level-5)))
291 (org-level-7 ((t :inherit org-level-6)))
292 (org-level-8 ((t :inherit org-level-7)))
293 (org-drawer ((t :inherit fixed-pitch)))
294 (org-property-value ((t :inherit fixed-pitch)))
295 (org-special-keyword ((t :inherit fixed-pitch)))
296 (org-indent ((t :inherit fixed-pitch)))
297 (org-table ((t :inherit fixed-pitch)))
298 :config
299 ;; Options
300 (setopt org-adapt-indentation nil
301 org-auto-align-tags t
302 org-archive-mark-done t
303 org-fold-catch-invisible-edits 'show-and-error
304 org-clock-clocked-in-display 'mode-line
305 org-clock-string-limit 0
306 org-clock-persist nil
307 org-confirm-babel-evaluate nil
308 org-cycle-separator-lines 0
309 org-deadline-warning-days 0
310 org-directory (sync/ "org/" t)
311 org-ellipsis (or (bound-and-true-p truncate-string-ellipsis) "…")
312 org-emphasis-alist
313 '(("*" org-bold)
314 ("/" org-italic)
315 ("_" org-underline)
316 ("=" org-verbatim)
317 ("~" org-code)
318 ("+" org-strikethrough))
319 org-fontify-done-headline t
320 org-fontify-quote-and-verse-blocks t
321 org-fontify-whole-heading-line t
322 org-hide-emphasis-markers t
323 org-html-coding-system 'utf-8-unix
324 org-image-actual-width (list (* (window-font-width)
325 (- fill-column 8)))
326 org-imenu-depth 3
327 org-indent-indentation-per-level 0
328 org-indent-mode-turns-on-hiding-stars nil
329 org-insert-heading-respect-content t
330 org-list-demote-modify-bullet '(("-" . "+")
331 ("+" . "-"))
332 org-log-done 'time
333 org-log-into-drawer t
334 org-num-skip-commented t
335 org-num-skip-unnumbered t
336 org-num-skip-footnotes t
337 org-outline-path-complete-in-steps nil
338 org-pretty-entities t
339 org-pretty-entities-include-sub-superscripts nil
340 org-refile-targets '((nil . (:maxlevel . 2))
341 (org-agenda-files . (:maxlevel . 1)))
342 org-refile-use-outline-path 'file
343 org-special-ctrl-a/e t
344 org-special-ctrl-k t
345 org-src-fontify-natively t
346 org-src-tab-acts-natively t
347 org-src-window-setup 'current-window
348 org-startup-truncated nil
349 org-startup-with-inline-images t
350 org-tags-column 0 ;(- 0 fill-column -3)
351 org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
352 "|" "DONE(d!)" "ASSIGNED(a@/!)")
353 (sequence "|" "CANCELED(k@)")
354 (sequence "MEETING(m)"))
355 org-use-fast-todo-selection 'auto
356 org-use-speed-commands t
357 org-element-use-cache nil)
358 ;; Keys
359 (keymap-set org-mode-map "C-M-k" #'kill-paragraph)
360 (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs)
361 (keymap-set org-mode-map "RET" #'+org-return-dwim)
362 (keymap-set org-mode-map "S-<return>" #'+org-table-copy-down|+org-return-dwim)
363 (keymap-unset org-mode-map "C-'" t)
364 (keymap-unset org-mode-map "C-," t)
365 (keymap-set org-mode-map "C-c C-n" #'org-next-visible-heading-unfolding)
366 (keymap-set org-mode-map "C-c C-p" #'org-previous-visible-heading-unfolding)
367 (keymap-set org-mode-map "C-c C-u" #'org-up-heading-unfolding)
368 ;; Hooks
369 (add-hook 'org-mode-hook
370 (defun org-mode@setup ()
371 (when (require 'visual-fill-column nil t)
372 (setq-local visual-fill-column-extra-text-width '(2 . 2))
373 (visual-fill-column-mode))
374 (variable-pitch-mode)
375 (turn-off-auto-fill)
376 (org-indent-mode)
377 (abbrev-mode)
378 (add-hook 'before-save-hook
379 (defun before-save@org-mode@before-save ()
380 (org-align-tags 'all)
381 (+org-hide-drawers-except-point)
382 )
383 nil :local)))
384 ;; Extra font-lock keywords
385 (font-lock-add-keywords
386 'org-mode
387 `(;; List markers => org-indent
388 (,(concat
389 "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)"
390 "\\(?:[ ]+\\|$\\)\\)"
391 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]"
392 "[ ]*\\)?"
393 "\\(?:\\(\\[[ X-]\\]\\)"
394 "\\(?:[ ]+\\|$\\)\\)?")
395 0 'org-indent))))
396
397(use-package org-clock
398 :bind (:map org-mode-map
399 ("<f8>" . org-clock-in-or-out))
400 :config
401 (setopt org-clock-clocked-in-display 'mode-line
402 ;; global-mode-string
403 ;; '((t jabber-activity-mode-string)
404 ;; (:eval (when (org-clocking-p) org-mode-line-string))
405 ;; (display-time-mode display-time-string))
406 )
407 ;; (add-hook 'org-clock-in-hook (defun org-clock@remove-from-global-mode-string ()
408 ;; (setq global-mode-string
409 ;; (delq 'org-mode-line-string global-mode-string))))
410 )
411
412(use-package org-agenda
413 :bind (("C-c a" . org-agenda))
414 :config
415 (setopt org-agenda-skip-deadline-if-done t
416 org-agenda-skip-scheduled-if-done t
417 org-agenda-span 10
418 org-agenda-block-separator ?─
419 org-agenda-time-grid '((daily today require-timed)
420 (800 1000 1200 1400 1600 1800 2000)
421 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
422 org-agenda-current-time-string "← now ───────────────"
423 org-agenda-include-diary nil ; I use the org-diary features
424 org-agenda-todo-ignore-deadlines 'near
425 org-agenda-todo-ignore-scheduled 'future
426 org-agenda-include-deadlines t
427 org-deadline-warning-days 0
428 org-agenda-show-future-repeats 'next
429 org-agenda-window-setup 'current-window
430 org-agenda-skip-file-regexp "sync-conflict"
431 org-agenda-inhibit-startup t
432 org-agenda-sticky t
433 org-agenda-follow-indirect t
434 org-stuck-projects '("TODO=\"WAIT\""
435 ("TODO" "NEXT")
436 nil
437 "")
438 org-agenda-custom-commands
439 `(("c" "Click Here Digital To-do"
440 ((agenda "" ((org-agenda-overriding-header "Tasks")
441 (org-agenda-span 'fortnight)
442 (org-agenda-start-day "+0")
443 (org-agenda-skip-function
444 '(org-agenda-skip-subtree-if 'todo
445 '("WAIT" "MCKENZIE" "RACHEL")))))
446 (stuck "" ((org-agenda-overriding-header "Waiting"))))
447 ((org-agenda-files ',(list (progn (require 'chd)
448 (chd/ "inbox-chd.org"))
449 (sync/ "org/diary.org")))))))
450 ;; Speedup agenda generation
451 ;; https://orgmode.org/manual/Speeding-Up-Your-Agendas.html
452 ;; https://orgmode.org/worg/agenda-optimization.html
453 (setopt org-agenda-dim-blocked-tasks nil
454 org-agenda-inhibit-startup t
455 org-agenda-use-tag-inheritance nil
456 org-agenda-ignore-properties '(effort appt stats category))
457 ;; Hooks and advice
458 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
459 (add-hook 'org-agenda-mode-hook #'hl-line-mode)
460 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)
461 ;; (add-hook 'org-agenda-after-show-hook #'+org-hide-drawers-except-point)
462 (define-advice org-agenda-files (:filter-return (files) skip-regexp)
463 "Filter some files from `org-agenda'."
464 (when org-agenda-skip-file-regexp
465 (setq files
466 (cl-remove-if (lambda (file)
467 (string-match-p org-agenda-skip-file-regexp
468 file))
469 files)))
470 files)
471 (define-advice org-agenda (:around (orig &rest r) inhibit-hooks)
472 (dlet ((org-mode-hook nil))
473 (apply orig r)))
474 (define-advice org-agenda-skip (:around (orig &rest r) fix-looking-at)
475 (dlet ((comment-start-skip "^\\s-*#\\(?: \\|$\\)"))
476 (apply orig r)))
477 ;; (advice-remove 'org-agenda 'org-agenda@inhibit-hooks)
478 (define-advice org-agenda-switch-to (:after (&rest _) do-hooks)
479 (run-hooks 'org-mode-hook))
480 (progress@around org-agenda-list "Building agenda")
481 (with-eval-after-load 'org-agenda
482 (add-to-list 'org-agenda-files (sync/ "org/diary.org"))))
483
484(use-package org-capture
485 :bind (("C-c c" . org-capture)))
486
487(use-package ol ; org-link
488 :after org
489 :preface
490 (defmacro +org-link-define-type (type args &rest body)
491 "Define an org link TYPE.
492A function named `+org-link-TYPE-open' will be created, with ARGS
493as its arguments and BODY as its body. BODY can be blank, in
494which case the user will be messaged (This is a good do-nothing
495effect for exporting link types)."
496 (declare (indent 2)
497 (doc-string 3)
498 (debug (sexp sexp def-body)))
499 (let ((fn (intern (format "+org-link-%s-open" type)))
500 (body (or body `((message ,(format "%S: %%S" type)
501 ,(car args)))))
502 (type-string (format "%S" type)))
503 `(prog1
504 (defun ,fn ,args ,@body)
505 (org-link-set-parameters ,type-string :follow #',fn))))
506 :config
507 (+org-link-define-type sms (number _))
508 (+org-link-define-type tel (number _)))
509
510(use-package ox ; org-export
511 :after org
512 :config
513 (require 'ox-md)
514 (setopt org-export-coding-system 'utf-8-unix
515 org-export-headline-levels 8
516 org-export-with-drawers nil
517 org-export-with-section-numbers nil
518 org-export-with-smart-quotes t
519 org-export-with-sub-superscripts t
520 org-export-with-toc nil))
521
522(use-package org-word-count
523 :load-path "~/src/org-word-count.el/"
524 :hook org-mode-hook)
525
526(use-package org-modern
527 :ensure t
528 :custom-face
529 (org-modern-label ((t :inherit fixed-pitch
530 :height 1.0)))
531 :hook (org-mode-hook)
532 :config
533 (setopt org-modern-star nil
534 org-modern-list '((43 . "◦")
535 (45 . "•")
536 (42 . "‣"))
537 org-hide-leading-stars nil
538 org-modern-hide-stars nil
539 org-tags-column 0
540 org-modern-keyword nil
541 org-modern-table nil))
542
543(use-package org-taskwise
544 :after org
545 :load-path "~/src/org-taskwise.el/")
546
547(provide 'acdw-org)
548;;; acdw-org.el ends here
diff --git a/lisp/acdw-shell.el b/lisp/acdw-shell.el deleted file mode 100644 index ce63bdc..0000000 --- a/lisp/acdw-shell.el +++ /dev/null
@@ -1,141 +0,0 @@
1;;; acdw-shell.el ---Shell config -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defvar eshell-buffer-format "*eshell:%s*"
6 "Format for eshell buffer names.")
7
8(defun eshell-rename-pwd ()
9 (rename-buffer (format eshell-buffer-format default-directory) t))
10
11(defun eshell-last-dir ()
12 (goto-char (point-max))
13 (insert "cd -")
14 (eshell-send-input))
15
16(defun eshellp (buffer-or-name)
17 (with-current-buffer buffer-or-name
18 (derived-mode-p 'eshell-mode)))
19
20(defun +eshell (&optional new)
21 (interactive "P")
22 (let ((dir default-directory)
23 (bname (format eshell-buffer-format default-directory))
24 (display-comint-buffer-action 'pop-to-buffer))
25 (if-let ((buf (and (not new)
26 (or (get-buffer bname)
27 (seq-find #'eshellp
28 (reverse (buffer-list)))))))
29 (pop-to-buffer buf)
30 (eshell new))
31 (eshell-rename-pwd)
32 (unless (equal default-directory dir)
33 (eshell/cd dir)
34 (eshell-send-input)
35 (goto-char (point-max)))))
36
37(defun +eshell-quit (&optional choose)
38 (interactive "P")
39 (if choose
40 (let* ((bufs (mapcar #'buffer-name
41 (seq-filter #'eshellp
42 (buffer-list))))
43 (buf (get-buffer
44 (completing-read "Eshell: "
45 bufs nil t nil nil (car bufs)))))
46 (quit-window)
47 (pop-to-buffer buf))
48 (quit-window)))
49
50(defun acdw/eshell-prompt ()
51 "My custom eshell prompt."
52 (concat (if (= 0 eshell-last-command-status)
53 "^_^ "
54 ";_; ")
55 (abbreviate-file-name (eshell/pwd))
56 (if (= (user-uid) 0) " # " " $ ")))
57
58
59;;; Packages
60
61(use-package eshell
62 :init
63 (add-hook 'eshell-post-command-hook #'eshell-rename-pwd)
64 (setopt eshell-modules-list
65 '(eshell-alias
66 eshell-basic
67 eshell-cmpl
68 eshell-dirs
69 eshell-elecslash
70 eshell-hist
71 eshell-ls
72 eshell-prompt
73 eshell-smart
74 eshell-extpipe
75 eshell-glob
76 eshell-hist
77 eshell-ls
78 eshell-pred
79 eshell-prompt
80 eshell-script
81 eshell-term
82 eshell-unix))
83 :commands eshell
84 :bind (("C-z" . +eshell)
85 :map eshell-mode-map
86 ("C-z" . +eshell-quit)
87 ("C-o" . eshell-last-dir))
88 :config
89 (require 'esh-module)
90 (require 'em-smart)
91 (require 'em-tramp)
92 (setq eshell-destroy-buffer-when-process-dies t
93 eshell-error-if-no-glob t
94 eshell-hist-ignoredups t
95 eshell-kill-on-exit t
96 eshell-prefer-lisp-functions t
97 eshell-prefer-lisp-variables t
98 eshell-scroll-to-bottom-on-input 'this
99 eshell-banner-message ""
100 eshell-hist-ignoredups 'erase
101 eshell-history-size 512
102 eshell-input-filter (lambda (input)
103 (or (eshell-input-filter-default input)
104 (eshell-input-filter-initial-space input)))
105 eshell-prompt-function #'acdw/eshell-prompt)
106 (add-hook 'eshell-mode-hook
107 (defun eshell-setup ()
108 (hungry-delete-mode -1)
109 (setq-local outline-regexp eshell-prompt-regexp
110 page-delimiter eshell-prompt-regexp
111 imenu-generic-expression
112 '(("Prompt" " $ \\(.*\\)" 1))
113 truncate-lines t)
114 (setenv "PAGER" "cat"))))
115
116(use-package eat
117 :ensure t
118 :hook (eshell-load-hook . eat-eshell-mode))
119
120(use-package exec-path-from-shell
121 :when (eq system-type 'gnu/linux)
122 :ensure t
123 :config
124 (add-to-list 'exec-path-from-shell-variables "SSH_AUTH_SOCK")
125 (add-to-list 'exec-path-from-shell-variables "SSH_AGENT_PID")
126 (add-to-list 'exec-path-from-shell-variables "GPG_AGENT_INFO")
127 (add-to-list 'exec-path-from-shell-variables "LANG")
128 (add-to-list 'exec-path-from-shell-variables "LC_CTYPE")
129 (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_HOME")
130 (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_DIRS")
131 (add-to-list 'exec-path-from-shell-variables "XDG_DATA_HOME")
132 (add-to-list 'exec-path-from-shell-variables "XDG_DATA_DIRS")
133 (add-to-list 'exec-path-from-shell-variables "XDG_CACHE_HOME")
134 (exec-path-from-shell-initialize))
135
136(use-package eshell-bookmark
137 :ensure t
138 :hook (eshell-mode-hook . eshell-bookmark-setup))
139
140(provide 'acdw-shell)
141;;; acdw-shell.el ends here
diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el deleted file mode 100644 index 3b78e4d..0000000 --- a/lisp/acdw-web.el +++ /dev/null
@@ -1,374 +0,0 @@
1;;; acdw.web.el --- Web browsing and such -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7(defcustom +browse-url-other-safe-browser-functions nil
8 "Other safe browser functions."
9 :type '(repeat function))
10
11(defun +browse-url-browser-function-safe-p (f)
12 "Return t if F is a safe browser function."
13 (memq f (append +browse-url-other-safe-browser-functions
14 (mapcar (lambda (i)
15 (plist-get (cdr i) :value))
16 (seq-filter (lambda (i)
17 (eq (car i) 'function-item))
18 (cdr (get 'browse-url-browser-function
19 'custom-type)))))))
20
21;;; URL matcher generators
22
23(defun +browse-url-matches (&rest regexps)
24 "Return a lambda that will determine if a url matches REGEXPS.
25Each regexp will be tested in turn. The first one that matches
26is returned by the lambda.
27
28This is a good function to use in key positions in `browse-url-handlers'."
29 `(lambda (url &optional new-window)
30 (cl-loop for regexp in ',regexps
31 if (string-match-p regexp url)
32 return regexp)))
33
34;;; External URL handlers
35
36(cl-defmacro +browse-url-make-external-viewer-handler
37 (viewer
38 &key
39 args
40 (prompt "URL: ")
41 (program (executable-find (format "%s" viewer)))
42 (name (intern (format "+browse-url-with-%s" viewer)))
43 doc
44 (var (intern (format "%s-args" name)))
45 vardoc
46 (custom-group '+browse-url)
47 (fallback '(function browse-url-generic)))
48 "Create a `browse-url' handler function calling PROGRAM on the URL.
49This macro also creates a `customize' setting in CUSTOM-GROUP for
50PROGRAM's command-line arguments. ARGS specifies the
51default arguments for this user option.
52
53PROGRAM defaults to the result of calling `executable-find' on VIEWER.
54
55PROMPT is shown to the user in the function's `interactive' spec, as an argument
56to `browse-url-interactive-arg'.
57
58The resulting function is named NAME, which defaults to
59`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults
60to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of
61the function and variable respectively; otherwise a basic default doc-string is
62used.
63
64If FALLBACK is non-nil (the default is `browse-url-generic'), the
65generated function will call FALLBACK if unable to start PROGRAM
66for some reason."
67 (declare (indent 1))
68 `(progn
69 (defcustom ,var ,args
70 ,(or vardoc (format "Arguments to pass to %s in `%s'."
71 viewer name))
72 :type '(repeat :tag "Command-line argument" string)
73 :group ',custom-group)
74 (defun ,name (url &optional new-window)
75 ,(or doc (format "Open URL in %s." viewer))
76 (interactive (browse-url-interactive-arg ,prompt))
77 (let* ((url (browse-url-encode-url url))
78 (process-environment (browse-url-process-environment)))
79 (message ,(format "Opening %%s in %s..." viewer) url)
80 (unless (ignore-errors (apply #'start-process
81 (format "%s %s" ',viewer url)
82 nil
83 ,program
84 (append ,var (list url))))
85 ,@(cond
86 (fallback `((funcall ,fallback url new-window)))
87 (:else `((message "Can't find viewer: %s" ,viewer)
88 nil))))))))
89
90;; Some default handlers
91
92(+browse-url-make-external-viewer-handler mpv
93 :args '("--cache-pause-wait=15"
94 "--cache-pause-initial=yes")
95 :prompt "Video URL: ")
96
97(+browse-url-make-external-viewer-handler miv
98 :program (executable-find "miv")
99 :prompt "Image URL: ")
100
101;;; External domains
102;; Some domains just don't open well in `eww'. The following function and user
103;; option define an easy way to automatically open those.
104
105(defcustom +browse-url-external-domains nil
106 "Domains to open in `browse-url-secondary-browser-function'.
107This is just a list of strings. They'll be regexp-escaped and
108passed to `+browse-url-external-url-p', which is a good function
109to put in `browse-url-handlers'.
110
111If an item in this list is a list itself, it should contain one string, a valid
112regexp that will not be regexp-quoted when matching against a url."
113 :type '(repeat (choice
114 (list :tag "Regexp" regexp)
115 (string :tag "Literal string"))))
116
117(with-eval-after-load 'custom-allowed
118 (add-to-list 'custom-allowed-variables '+browse-url-external-domains))
119
120(defun +browse-url-external-url-p (url)
121 "Return t if URL is a member of `+browse-url-external-domains'.
122This function only tests URL's domain."
123 (let ((host (url-host (url-generic-parse-url url))))
124 (cl-loop for domain in +browse-url-external-domains
125 if (string-match-p (if (stringp domain)
126 (regexp-quote domain)
127 (car domain))
128 host)
129 return t)))
130
131(defun +browse-url-external-domain-add (domain &optional regexp?)
132 "Add DOMAIN to `+browse-url-external-domains'.
133If REGEXP? is non-nil, it will note that the domain is a regexp.
134This function will also save `custom-file' with the updated value."
135 (interactive (pcase current-prefix-arg
136 (`nil
137 (list (read-from-minibuffer "Domain: ")
138 nil))
139 (`(4)
140 (list (read-from-minibuffer "Domain regex: ")
141 t))
142 (_
143 (list (read-from-minibuffer "Domain: ")
144 (y-or-n-p "Regex? ")))))
145 (let ((new (funcall (if regexp? #'list #'identity)
146 domain)))
147 (custom-set-variables
148 `(+browse-url-external-domains
149 ',(add-to-list '+browse-url-external-domains new)))
150 (with-current-buffer (find-file-noselect custom-file)
151 (custom-save-variables))
152 (message "%s added to `+browse-url-external-domains'."
153 domain)))
154
155;;; Downloading
156
157(defcustom +browse-url-download-open t
158 "Whether to open downloaded files after downloading."
159 :type 'boolean)
160
161(defun +browse-url-download (url &rest _)
162 "Download URL to `eww-download-directory'."
163 (interactive "sDownload URL: ")
164 (let ((dir eww-download-directory))
165 (when (functionp dir) (setq dir (funcall dir)))
166 (make-directory dir :parents)
167 (url-retrieve url
168 (lambda (s u d)
169 (let ((file (+browse-url-download-callback s u d)))
170 (when +browse-url-download-open
171 (browse-url-xdg-open file))))
172 (list url dir))))
173
174(defun +browse-url-download-callback (status url dir)
175 ;; A slight change to `eww-download-callback' that returns the downloaded
176 ;; filename.
177 (unless (plist-get status :error)
178 (let* ((obj (url-generic-parse-url url))
179 (path (directory-file-name (car (url-path-and-query obj))))
180 (file (eww-make-unique-file-name
181 (eww-decode-url-file-name (file-name-nondirectory path))
182 dir)))
183 (goto-char (point-min))
184 (re-search-forward "\r?\n\r?\n")
185 (let ((coding-system-for-write 'no-conversion))
186 (write-region (point) (point-max) file))
187 (message "Saved %s" file)
188 file)))
189
190;;; Unfucking the internet
191
192(defun eww-archiveis-url (url)
193 "Run URL through archive.is and browse the result."
194 (interactive (list (plist-get eww-data :url)))
195 (letrec ((nonce (lambda ()
196 (unwind-protect (eww-readable)
197 (remove-hook 'eww-after-render-hook nonce)))))
198 (add-hook 'eww-after-render-hook nonce)
199 (eww (format "https://archive.is/submit/?url=%s" url))))
200
201
202;;; Packages
203
204(use-package eww
205 :preface
206 (defun bookmark-eww--make ()
207 "Make eww bookmark record."
208 `((filename . ,(plist-get eww-data :url))
209 (title . ,(plist-get eww-data :title))
210 (time . ,(current-time-string))
211 (handler . ,#'bookmark-eww-handler)
212 (defaults . (,(concat
213 ;; url without the https and path
214 (replace-regexp-in-string
215 "/.*" ""
216 (replace-regexp-in-string
217 "\\`https?://" ""
218 (plist-get eww-data :url)))
219 " - "
220 ;; page title
221 (replace-regexp-in-string
222 "\\` +\\| +\\'" ""
223 (replace-regexp-in-string
224 "[\n\t\r ]+" " "
225 (plist-get eww-data :title))))))))
226 (defun bookmark-eww-handler (bm)
227 "Handler for eww bookmarks."
228 (eww-browse-url (alist-get 'filename bm)))
229 (defun bookmark-eww--setup ()
230 "Setup eww bookmark integration."
231 (setq-local bookmark-make-record-function #'bookmark-eww--make))
232 :commands (eww eww-browse-url)
233 :config
234 (setopt eww-use-browse-url ".")
235 (add-hook 'eww-mode-hook
236 (defun eww-mode@setup ()
237 (add-hook 'visual-fill-column-mode-hook
238 (defun visual-fill-column@eww-reload ()
239 (eww-reload :local))))
240 nil :local)
241 (keymap-set eww-mode-map "&"
242 (defun eww-browse-url-external (&optional url)
243 (interactive nil eww-mode)
244 (condition-case e
245 (funcall
246 browse-url-secondary-browser-function
247 (or url (plist-get eww-data :url)))
248 (:success (when (null url) (quit-window))) ; Interactive use
249 (t (signal (car e) (cdr e))))))
250 (add-hook 'eww-mode-hook #'bookmark-eww--setup)
251 (define-key eww-mode-map "b" #'bookmark-set)
252 (define-key eww-mode-map "B" #'bookmark-jump)
253 (define-key eww-mode-map (kbd "M-n") nil)
254 (define-key eww-mode-map (kbd "M-p") nil)
255 (define-key eww-mode-map (kbd "*") #'eww-archiveis-url))
256
257(use-package browse-url
258 :demand t
259 :config
260 (put 'browse-url-browser-function 'safe-local-variable
261 '+browse-url-browser-function-safe-p)
262 (setopt browse-url-browser-function #'eww-browse-url
263 browse-url-secondary-browser-function #'browse-url-firefox
264 browse-url-firefox-program (executable-find "firefox")
265 browse-url-firefox-arguments '("--new-tab")
266 ;; Dispatch browser based on URL
267 browse-url-handlers
268 `(;; Videos
269 (,(+browse-url-matches "youtube\\.com" "youtu\\.be"
270 "invidious" "yewtu\\.be"
271 "twitch\\.tv"
272 (rx "." (or "mp4" "gif" "mov" "MOV" "webm")
273 eos))
274 . +browse-url-with-mpv)
275 ;; Music
276 (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com"
277 (rx "." (or "ogg" "mp3" "opus" "m4a") eos))
278 . +browse-url-with-mpv)
279 ;; Images
280 (,(+browse-url-matches "pbs\\.twimg\\.com"
281 (rx "." (or "jpeg" "jpg" "png" "pn"
282 "bmp" "webp")
283 eos))
284 . +browse-url-with-miv)
285 ;; Blobs
286 (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos))
287 . +browse-url-download)
288 ;; External URLs --- see `+browse-url-external-domains'
289 (+browse-url-external-url-p
290 . ,browse-url-secondary-browser-function))
291 ;; External domains
292 ;; +browse-url-external-domains
293 ;; '("github.com" "gitlab.com" "codeberg.org"
294 ;; "tildegit.org" "git.tilde.town"
295 ;; "google.com" "imgur.com" "twitch.tv"
296 ;; "pixelfed" "instagram.com"
297 ;; "bibliogram.art" "reddit.com"
298 ;; "teddit.net" "libreddit.de"
299 ;; "streamable.com" "spotify.com"
300 ;; "hetzner.cloud" "melpa.org"
301 ;; "twitter.com" ("^t\\.co$")
302 ;; "nitter.snopyta.org" "nitter.net")
303 )
304 ;; External browsers: firefox > chromium > chrome
305 (when-let ((firefox (choose-executable "firefox"
306 "firefox-esr")))
307 (setopt browse-url-firefox-program firefox
308 browse-url-firefox-new-window-is-tab t
309 browse-url-firefox-arguments '("--new-tab")
310 browse-url-generic-program firefox
311 browse-url-generic-args browse-url-firefox-arguments))
312 (when-let ((chromium (choose-executable "chromium"
313 "chromium-browser")))
314 (setopt browse-url-chromium-program chromium
315 browse-url-generic-program chromium))
316 (when-let ((chrome (choose-executable "chrome"
317 "google-chrome-stable")))
318 (setopt browse-url-chrome-program chrome
319 browse-url-generic-program chrome)))
320
321(use-package browse-url-transform
322 :after browse-url
323 :load-path "~/src/browse-url-transform.el/"
324 :config
325 (setopt browse-url-transform-alist
326 `(;; Privacy-respecting alternatives
327 ("twitter\\.com" . "nitter.snopyta.org")
328 ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de")
329 ("medium\\.com" . "scribe.rip")
330 (".*substack\\.com.*" . ,substack-proxy)
331 ;; Text-mode of non-text-mode sites
332 ("www\\.npr\\.org" . "text.npr.org")
333 ;; Ask for raw versions of paste sites
334 ("^.*dpaste\\.com.*$" . "\\&.txt")
335 ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1")
336 ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2")
337 ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2")
338 ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2")))
339 (browse-url-transform-mode))
340
341;;; Link hint
342
343(use-package link-hint
344 :ensure t :demand t
345 :preface (keymap-global-unset "M-l")
346 :bind
347 (("M-l M-l" . +link-hint-open-link)
348 ("M-l l" . +link-hint-open-link)
349 ("M-l M-o" . +link-hint-open:secondary)
350 ("M-l o" . +link-hint-open:secondary)
351 ("M-l M-m" . +link-hint-open-multiple-links)
352 ("M-l m" . +link-hint-open-multiple-links)
353 ("M-l M-w" . link-hint-copy-link)
354 ("M-l w" . link-hint-copy-link)
355 ("M-l M-c" . +link-hint-open:chrome)
356 ("M-l c" . +link-hint-open:chrome)
357 ("M-l M-d" . +link-hint-open:download)
358 ("M-l d" . +link-hint-open:download))
359 :config
360 (require '+link-hint)
361 (setopt link-hint-avy-style 'at-full
362 link-hint-avy-all-windows t)
363 ;; For some reason, `link-hint-completion-list-candidate' freezes Emacs.
364 ;; Removing it fixes the problem, so ... that's what I've done. It's quite
365 ;; possible this problem isn't caused by `link-hint' at all, but rather by
366 ;; another package's configuration, but I don't care enough to fix it.
367 (setq link-hint-types
368 (delq 'link-hint-completion-list-candidate link-hint-types))
369 ;; (+link-hint-open-secondary-setup)
370 ;; (+link-hint-open-chrome-setup)
371 )
372
373(provide 'acdw-web)
374;;; acdw-web.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index b76b947..0000000 --- a/lisp/acdw.el +++ /dev/null
@@ -1,384 +0,0 @@
1;;; acdw.el --- My Emacs extras -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'seq)
7
8(defmacro defdir (name directory &optional docstring makedir)
9 "Define a variable and a function NAME expanding to DIRECTORY.
10DOCSTRING is applied to the variable; its default is DIRECTORY's
11path. If MAKEDIR is non-nil, the directory and its parents will
12be created."
13 (declare (indent 2) (doc-string 3))
14 `(progn
15 (defvar ,name (expand-file-name ,directory)
16 ,(concat (or docstring (format "%s" directory)) "\n"
17 "Defined by `defdir'."))
18 (defun ,name (file &optional mkdir)
19 ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
20 "If MKDIR is non-nil, parent directories are created.\n"
21 "Defined by `defdir'.")
22 (let ((file-name (expand-file-name
23 (convert-standard-filename file) ,name)))
24 (when mkdir
25 (make-directory (file-name-directory file-name) :parents))
26 file-name))
27 ,(if makedir
28 `(make-directory ,directory :parents)
29 `(unless (file-exists-p ,directory)
30 (warn "Directory `%s' doesn't exist." ,directory)))))
31
32(defun choose-executable (&rest programs)
33 "Return the first of PROGRAMS that exists in the system's $PATH.
34Each of PROGRAMS can be a single string, or a list. If it's a list then its car
35will be tested with `executable-find', and the entire list returned. This
36enables passing arguments to a calling function."
37 (catch 'found
38 (dolist (prog programs)
39 (let ((exec (executable-find (car (ensure-list prog))))
40 (args (cdr-safe prog)))
41 (when exec
42 (throw 'found (if args (cons exec args) exec)))))))
43
44(defun file-string (file)
45 "Return the contents of FILE as a string."
46 (with-current-buffer (find-file-noselect file)
47 (buffer-string)))
48
49(defun unsmartify-region (begin end)
50 "Replace \"smart\" punctuation with \"dumb\" counterparts."
51 (interactive "*r")
52 (save-excursion
53 (goto-char begin)
54 (while (re-search-forward "[“”‘’–—]" end t)
55 (let ((replace (pcase (match-string 0)
56 ((or "“" "”") "\"")
57 ((or "‘" "’") "'")
58 ("–" "--")
59 ("—" "---"))))
60 (replace-match replace nil nil)))))
61
62(defun unsmartify-dwim ()
63 "Unsmartify the current region or the entire buffer."
64 (interactive)
65 (if (region-active-p)
66 (unsmartify-region (region-beginning) (region-end))
67 (unsmartify-region (point-min) (point-max))))
68
69(defun ++concat (func strings)
70 "Concat STRINGS processed by FUNC.
71Each of STRINGS can be a bare string or a list. Strings are
72passed through as-is, but lists are passed to FUNC first as
73arguments. Finally, all the resulting strings are `mapconcat'-ed
74together.
75
76As a special case, if `:separator' is the first of STRINGS, the
77string following will be used as a separator. Otherwise, a
78newline will be used."
79 (let (separator)
80 (when (eq (car strings) :separator)
81 (setq separator (cadr strings)
82 strings (cddr strings)))
83 (mapconcat (lambda (s)
84 (cond
85 ((listp s) (apply func s))
86 ((stringp s) s)
87 (t (user-error "Bad argument: %S" s))))
88 strings
89 (or separator "\n"))))
90
91(defun format-concat (&rest strings)
92 "Concatenate formatted STRINGS.
93Each of STRINGS can be a bare string or a list. Bare strings are passed as-is
94to `mapconcat' for concatenation and separation. Lists, however, are passed to
95`format' first.
96
97If `:separator' is the first of STRINGS, the next string will be
98used as a separator."
99 (++concat #'format strings))
100
101(defun list-append-removing-duplicates (&rest lists)
102 "Append LISTS, removing duplicates from the result.
103Any keyword arguments to `cl-remove-duplicates' should come
104before the LISTS."
105 (let (cl-remove-duplicates-args)
106 (while (keywordp (car lists))
107 (push (pop lists) cl-remove-duplicates-args)
108 (push (pop lists) cl-remove-duplicates-args))
109 (apply #'cl-remove-duplicates (apply #'append lists)
110 (nreverse cl-remove-duplicates-args))))
111
112(defun mapc-buffers (func &optional predicate)
113 "Map FUNC over buffers matching PREDICATE.
114Both FUNC and PREDICATE will be executed with no arguments and in
115the context of each buffer.
116
117If PREDICATE is nil or not given, map FUNC over all buffers."
118 (cl-loop for buf being the buffers
119 do (with-current-buffer buf
120 (when (and predicate
121 (funcall predicate))
122 (funcall func)))))
123
124(defun mapc-buffers-modes (func &rest modes)
125 "Map FUNC over buffers derived from MODES.
126FUNC will be executed with no arguments and in the context of
127each buffer."
128 (mapc-buffers func
129 (lambda ()
130 (apply #'derived-mode-p modes))))
131
132(defun find-font (&rest fonts)
133 "Return the first font of FONTS that is installed."
134 (cl-loop with ffl = (font-family-list)
135 for font in fonts
136 if (member font ffl)
137 return font))
138
139(defmacro progress@around (fn message &optional name)
140 "Define :around advice for functions adding a simple progress reporter."
141 (let ((orig (gensym))
142 (args (gensym))
143 (prog (gensym)))
144 `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress))
145 ,(format "Add a simple progress reporter to %s." fn)
146 (let ((,prog (make-progress-reporter
147 ,(format "%s..." (string-remove-suffix "..." message)))))
148 (apply ,orig ,args)
149 (progress-reporter-done ,prog)))))
150
151
152
153;;; Ispell in .dir-locals
154
155;; Let Emacs know a list of strings is safe
156(defun +ispell-safe-local-p (list)
157 (and (listp list)
158 (seq-every-p #'stringp list)))
159
160;; Can I instruct ispell to insert LocalWords in a different file?
161;; https://emacs.stackexchange.com/q/31396/2264
162
163;; How can I move all my file-local LocalWords to .dir-locals.el?
164;; https://emacs.stackexchange.com/q/31419
165
166;; Adapted from ispell.el:ispell-buffer-local-words
167(defun +ispell-buffer-local-words-list ()
168 (let (words)
169 (or ispell-buffer-local-name
170 (setf ispell-buffer-local-name (buffer-name)))
171 (save-excursion
172 (goto-char (point-min))
173 (while (search-forward ispell-words-keyword nil t)
174 (let ((end (point-at-eol))
175 (ispell-casechars (ispell-get-casechars))
176 string)
177 (while (re-search-forward " *\\([^ ]+\\)" end t)
178 (setf string (match-string-no-properties 1))
179 (if (and (< 1 (length string))
180 (equal 0 (string-match ispell-casechars string)))
181 (push string words))))))
182 words))
183
184;;;###autoload
185(defun +ispell-move-buffer-words-to-dir-locals (&optional arg)
186 "Move the current buffer-local words to .dir-locals.el.
187This function prompts the user to save .dir-locals.el, unless
188prefix ARG is non-nil; then it just saves them."
189 (interactive "P")
190 (unless (buffer-file-name)
191 (user-error "Buffer not attached to file"))
192 (hack-dir-local-variables)
193 (let ((print-level nil)
194 (print-length nil)
195 (before-save-hook nil)
196 (after-save-hook nil))
197 (when-let ((new-words (cl-remove-if
198 (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
199 ; where this came from
200 (list-append-removing-duplicates
201 :test #'string=
202 ispell-buffer-session-localwords
203 (alist-get 'ispell-buffer-session-localwords
204 dir-local-variables-alist)
205 (alist-get 'ispell-buffer-session-localwords
206 file-local-variables-alist)
207 (+ispell-buffer-local-words-list)))))
208 (save-excursion
209 (add-dir-local-variable
210 major-mode
211 'ispell-buffer-session-localwords
212 (setf ispell-buffer-session-localwords
213 new-words))
214 (when (or arg
215 (y-or-n-p "Save .dir-locals.el?"))
216 (save-buffer))
217 (bury-buffer))
218 (or ispell-buffer-local-name
219 (setf ispell-buffer-local-name (buffer-name)))
220 (save-excursion
221 (goto-char (point-min))
222 (while (search-forward ispell-words-keyword nil t)
223 (delete-region (point-at-bol) (1+ (point-at-eol))))))))
224
225;;;###autoload
226(defun +ispell-move-buffer-words-to-dir-locals-hook ()
227 "Convenience function for binding to a hook."
228 (+ispell-move-buffer-words-to-dir-locals t))
229
230
231;;; Comment-or-uncomment-sexp
232;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
233
234(defun +lisp-uncomment-sexp (&optional n)
235 "Uncomment N sexps around point."
236 (interactive "P")
237 (let* ((initial-point (point-marker))
238 (inhibit-field-text-motion t)
239 (p)
240 (end (save-excursion
241 (when (elt (syntax-ppss) 4)
242 (re-search-backward comment-start-skip
243 (line-beginning-position)
244 t))
245 (setq p (point-marker))
246 (comment-forward (point-max))
247 (point-marker)))
248 (beg (save-excursion
249 (forward-line 0)
250 (while (and (not (bobp))
251 (= end (save-excursion
252 (comment-forward (point-max))
253 (point))))
254 (forward-line -1))
255 (goto-char (line-end-position))
256 (re-search-backward comment-start-skip
257 (line-beginning-position)
258 t)
259 (ignore-errors
260 (while (looking-at-p comment-start-skip)
261 (forward-char -1)))
262 (point-marker))))
263 (unless (= beg end)
264 (uncomment-region beg end)
265 (goto-char p)
266 ;; Indentify the "top-level" sexp inside the comment.
267 (while (and (ignore-errors (backward-up-list) t)
268 (>= (point) beg))
269 (skip-chars-backward (rx (syntax expression-prefix)))
270 (setq p (point-marker)))
271 ;; Re-comment everything before it.
272 (ignore-errors
273 (comment-region beg p))
274 ;; And everything after it.
275 (goto-char p)
276 (forward-sexp (or n 1))
277 (skip-chars-forward "\r\n[:blank:]")
278 (if (< (point) end)
279 (ignore-errors
280 (comment-region (point) end))
281 ;; If this is a closing delimiter, pull it up.
282 (goto-char end)
283 (skip-chars-forward "\r\n[:blank:]")
284 (when (eq 5 (car (syntax-after (point))))
285 (delete-indentation))))
286 ;; Without a prefix, it's more useful to leave point where
287 ;; it was.
288 (unless n
289 (goto-char initial-point))))
290
291(defun +lisp-comment-sexp--raw ()
292 "Comment the sexp at point or ahead of point."
293 (pcase (or (bounds-of-thing-at-point 'sexp)
294 (save-excursion
295 (skip-chars-forward "\r\n[:blank:]")
296 (bounds-of-thing-at-point 'sexp)))
297 (`(,l . ,r)
298 (goto-char r)
299 (skip-chars-forward "\r\n[:blank:]")
300 (save-excursion
301 (comment-region l r))
302 (skip-chars-forward "\r\n[:blank:]"))))
303
304(defun +lisp-comment-or-uncomment-sexp (&optional n)
305 "Comment the sexp at point and move past it.
306If already inside (or before) a comment, uncomment instead.
307With a prefix argument N, (un)comment that many sexps."
308 (interactive "P")
309 (if (or (elt (syntax-ppss) 4)
310 (< (save-excursion
311 (skip-chars-forward "\r\n[:blank:]")
312 (point))
313 (save-excursion
314 (comment-forward 1)
315 (point))))
316 (+lisp-uncomment-sexp n)
317 (dotimes (_ (or n 1))
318 (+lisp-comment-sexp--raw))))
319
320
321;;; Random shit
322
323(defun insert-iso-date (&optional arg)
324 "Insert current date formatted ISO-8601 style.
325When called with \\[universal-argument] \\[insert-iso-date],
326include the time. When called with \\[universal-argument]
327\\[universal-argument] \\[insert-iso-date], prompt the user for the
328`format-time-string' format to use."
329 (interactive "P")
330 (insert (format-time-string (pcase arg
331 ('nil "%F")
332 ('(4) "%FT%T%z")
333 (_ (read-string "Time format: "))))))
334
335(defun unfill-paragraph ()
336 "Unfill the current paragraph."
337 (interactive)
338 (let ((fill-column most-positive-fixnum)
339 (fill-paragraph-function nil))
340 (fill-paragraph)))
341
342(defun fill-with-double-spaced-sentences-dwim (&optional start end)
343 "Fill paragraph or region, double-spacing sentences."
344 (interactive)
345 (let ((sentence-end-double-space t))
346 (unless (region-active-p)
347 (mark-paragraph))
348 (repunctuate-sentences :no-query
349 (region-beginning)
350 (region-end))
351 (fill-region (region-beginning)
352 (region-end))))
353
354(defun fill-with-double-spaced-sentences-dwim (&optional start end)
355 "Fill from START to END, double-spacing sentences.
356If START to END aren't given, or if a region isn't in use, fill
357the current paragraph."
358 (interactive "*r")
359 (let ((sentence-end-double-space t))
360 (save-mark-and-excursion
361 (save-restriction
362 (unless (region-active-p)
363 (setq start (progn (start-of-paragraph-text)
364 (point))
365 end (progn (end-of-paragraph-text)
366 (point))))
367 (narrow-to-region start end)
368 (goto-char (point-min))
369 (repunctuate-sentences :no-query)
370 (fill-region (point-min)
371 (point-max))))))
372
373(defun acdw-elisp-package-prepare (&optional file)
374 "Do all the elisp-package-preparing stuff on FILE.
375If FILE is nil or not given, do it on the current buffer."
376 (with-current-buffer (if file (find-file-noselect file) (current-buffer))
377 (check-parens)
378 (checkdoc)
379 (package-lint-buffer)
380 ;; TODO: use `lm-commentary' to write to README.org
381 ))
382
383(provide 'acdw)
384;;; acdw.el ends here
diff --git a/lisp/ical2org.el b/lisp/ical2org.el deleted file mode 100644 index 2716787..0000000 --- a/lisp/ical2org.el +++ /dev/null
@@ -1,56 +0,0 @@
1;;; ical2org.el --- Run ical2org in Emacs -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; based on code from this reddit thread:
6;; https://www.reddit.com/r/emacs/comments/8s1ion/ical2org_integrations/
7;;
8;; see also: icalendar.org (converts to diary format, might be all I need)
9;;
10;; XXX: This code currently imports into gnus, which isn't what I want.
11
12;;; Code:
13
14(defun ical2org (&optional replace output-buffer)
15 "Run ical2org on contents of this buffer.
16If REPLACE (interactive prefix argument), replace contents of the
17buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to
18minibuffer."
19 (interactive "P")
20 (shell-command-on-region (point-min) (point-max)
21 "ical2org"
22 output-buffer
23 replace
24 "*ical2org errors*"
25 'display-errors))
26
27(defun ical2org-capture ()
28 "Run `ical2org' on this buffer, then `org-capture' the result.
29Leaves current buffer as-was afterwards."
30 (interactive)
31 (let ((buf (current-buffer))
32 (ics (buffer-string)))
33 (ical2org 'replace)
34 (mark-whole-buffer)
35 (call-interactively #'org-capture)
36 (with-current-buffer buf
37 (delete-region (point-min) (point-max))
38 (insert ics))))
39
40(defun my-gnus-org-capture-icalendar ()
41 "Capture any text/calendar invites with org."
42 (interactive)
43 (with-current-buffer gnus-article-buffer ;;; XXX
44 (save-excursion
45 (dolist (part gnus-article-mime-handle-alist)
46 (when (and (>= (length part) 3)
47 (listp (caddr part))
48 (or (equal "application/ics" (caaddr part))
49 (equal "text/calendar" (caaddr part))))
50 (save-window-excursion
51 (gnus-mime-copy-part (cdr part))
52 (ical2org-capture)))))))
53(add-hook 'gnus-article-prepare-hook #'my-gnus-org-capture-icalendar)
54
55(provide 'ical2org)
56;;; ical2org.el ends here