about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/+link-hint.el83
-rw-r--r--lisp/+scratch.el75
-rw-r--r--lisp/acdw-chat.el174
-rw-r--r--lisp/acdw-mail.el113
-rw-r--r--lisp/acdw-org.el77
-rw-r--r--lisp/acdw-web.el101
-rw-r--r--lisp/acdw.el45
-rw-r--r--lisp/ical2org.el56
8 files changed, 655 insertions, 69 deletions
diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el index 469ed15..0e0b9b1 100644 --- a/lisp/+link-hint.el +++ b/lisp/+link-hint.el
@@ -87,33 +87,62 @@ with the KEYWORD."
87 +link-hint-open-secondary-types 87 +link-hint-open-secondary-types
88 :multiple t) 88 :multiple t)
89 89
90(defun +link-hint-open-secondary-setup (&optional types) 90(progn
91 "Define the `:open-secondary' link-hint type for TYPES. 91 (dolist
92If TYPES is nil, define it for `+link-hint-open-secondary-types'." 92 (type
93 (dolist (type (or types +link-hint-open-secondary-types)) 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 94 (link-hint-define-type type :download
95 :open-secondary browse-url-secondary-browser-function 95 (function +browse-url-download)
96 :open-secondary-multiple t))) 96 :download-multiple t))
97 97 (defun +link-hint-open:download nil "Download a link to `eww-download-directory'.
98(defun +link-hint-open-secondary () 98
99 "Open a link in the secondary browser." 99Defined by `+link-hint-define'."
100 (interactive) 100 (interactive)
101 (avy-with link-hint-open-link 101 (avy-with link-hint-open-link
102 (link-hint--one :open-secondary))) 102 (link-hint--one :download)))
103 103 (defun +link-hint-open-multiple:download nil "Open multiple links with `+link-hint-open:download'.
104(defun +link-hint-open-chrome-setup (&optional types) 104
105 "Define the `:open-chrome' link-hint type for TYPES. 105Defined by `+link-hint-define'."
106If TYPES is nil, define it for `+link-hint-open-secondary-types'." 106 (avy-with link-hint-open-multiple-links
107 (dolist (type (or types +link-hint-open-secondary-types)) 107 (link-hint--multiple :download)))
108 (link-hint-define-type type 108 (defun +link-hint-open-all:download nil "Open all visible links with `+link-hint-open:download'.
109 :open-chrome #'browse-url-chrome 109
110 :open-chrome-multiple t))) 110Defined by `+link-hint-define'."
111 111 (avy-with link-hint-open-all-links
112(defun +link-hint-open-chrome () 112 (link-hint--all :download))))
113 "Open a link with chrome." 113
114 (interactive) 114;; (defun +link-hint-open-secondary-setup (&optional types)
115 (avy-with link-hint-open-link 115;; "Define the `:open-secondary' link-hint type for TYPES.
116 (link-hint--one :open-chrome))) 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)))
117 146
118(defun +link-hint-open-link (prefix) 147(defun +link-hint-open-link (prefix)
119 "Open a link. 148 "Open a link.
diff --git a/lisp/+scratch.el b/lisp/+scratch.el new file mode 100644 index 0000000..5d749c6 --- /dev/null +++ b/lisp/+scratch.el
@@ -0,0 +1,75 @@
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 new file mode 100644 index 0000000..62dcf72 --- /dev/null +++ b/lisp/acdw-chat.el
@@ -0,0 +1,174 @@
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(defun jabber-group-yank-join-url ()
55 "Yank a url for joining the focused group."
56 (interactive)
57 (let ((s (format "xmpp:%s?join" jabber-group)))
58 (kill-new s)
59 (message s)))
60
61
62;;; Packages
63
64(use-package jabber
65 :load-path "~/src/emacs/jabber/"
66 :custom-face
67 (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
68 :foreground unspecified
69 :weight normal)))
70 (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local
71 :foreground unspecified
72 :weight bold)))
73 (jabber-chat-prompt-local ((t :inherit minibuffer-prompt
74 :foreground unspecified
75 :weight normal
76 :slant italic)))
77 (jabber-chat-prompt-foreign ((t :inherit warning
78 :foreground unspecified
79 :weight normal)))
80 (jabber-chat-prompt-system ((t :inherit font-lock-doc-face
81 :foreground unspecified)))
82 (jabber-rare-time-face ((t :inherit font-lock-comment-face
83 :foreground unspecified
84 :underline nil)))
85 :bind-keymap ("C-c j" . jabber-global-keymap)
86 :bind (("C-c C-SPC" . jabber-activity-switch-to))
87 :config
88 (setopt jabber-account-list '(("acdw@hmm.st"))
89 jabber-auto-reconnect t
90 jabber-biboumi-server "irc.hmm.st"
91 jabber-biboumi-irc-servers '("irc.libera.chat"
92 "irc.tilde.chat"
93 "tilde.town"
94 "m455.casa"
95 "irc.twitch.tv")
96 jabber-biboumi-default-nick "acdw"
97 jabber-last-read-marker (make-string fill-column ?.)
98 jabber-muc-decorate-presence-patterns
99 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
100 ("Mode #.*" . jabber-muc-presence-dim)
101 ("." . jabber-muc-presence-dim))
102 jabber-activity-make-strings #'jabber-activity-make-strings-shorten
103 jabber-rare-time-format " - - - - - - %H:%M %F"
104 jabber-muc-header-line-format
105 '(" " (:eval (replace-regexp-in-string "%" "%%"
106 (jabber-jid-displayname
107 jabber-group)))
108 " / " jabber-muc-topic)
109 ;; buffer name formats
110 jabber-chat-buffer-format "*xmpp* %n"
111 jabber-browse-buffer-format "*xmpp-browse* %n"
112 jabber-groupchat-buffer-format "*xmpp-muc* %n"
113 jabber-muc-private-buffer-format "*xmpp-muc-private* %n"
114 ;; "prompt" (speaker) formats
115 jabber-groupchat-prompt-format (format "%%>%dn . " jabber-prefix-width)
116 jabber-chat-local-prompt-format (format "%%>%dn . " jabber-prefix-width)
117 jabber-chat-foreign-prompt-format (format "%%>%dn . " jabber-prefix-width)
118 jabber-muc-private-foreign-prompt-format "\n%g/%n . ")
119 ;; jabber muc nick coloring
120 ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus)
121 ;; (setopt jabber-muc-nick-value 1.0
122 ;; jabber-muc-nick-saturation 1.0
123 ;; jabber-muc-colorize-local t
124 ;; jabber-muc-colorize-foreign t)
125 ;; When changing the above values, make sure to
126 ;; (setq jabber-muc-participant-colors nil)
127 (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup)
128 (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix
129 ;; For each binding in `jabber-global-keymap', also bind the non-control
130 ;; character (lowercase)
131 (map-keymap (lambda (key command)
132 (define-key jabber-global-keymap (vector (+ key #x60)) command))
133 jabber-global-keymap)
134 (require 'jabber-httpupload nil t)
135 (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
136 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
137 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
138 (add-hook 'jabber-alert-muc-hooks
139 (defun jabber@highlight-acdw (&optional _ _ buf _ _)
140 (when buf
141 (with-current-buffer buf
142 (let ((regexp (rx word-boundary
143 "acdw" ; maybe get from the config?
144 word-boundary)))
145 (hi-lock-unface-buffer regexp)
146 (highlight-regexp regexp 'jabber-chat-prompt-local))))))
147 (add-hook 'jabber-chat-mode-hook
148 (defun jabber-chat@leave-when-kill ()
149 (add-hook 'kill-buffer-hook
150 (defun @jabber-leave@kill ()
151 (ignore-errors
152 (apply #'jabber-muc-leave (jabber-muc-argument-list))))
153 nil :local)))
154 (when (fboundp 'jabber-chat-update-focus)
155 (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))
156 (with-eval-after-load 'consult
157 (defvar jabber-chat-buffer-source
158 `( :name "Jabber"
159 :hidden nil
160 :narrow ?j
161 :category buffer
162 :state ,#'consult--buffer-state
163 :items ,(lambda ()
164 (mapcar #'buffer-name
165 (seq-filter (lambda (buf)
166 (with-current-buffer buf
167 (eq major-mode 'jabber-chat-mode)))
168 (buffer-list))))))
169 (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append)
170 (consult-customize
171 consult-buffer :preview-key "M-.")))
172
173(provide 'acdw-chat)
174;;; acdw-chat.el ends here
diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el index 2a7d128..f8111e7 100644 --- a/lisp/acdw-mail.el +++ b/lisp/acdw-mail.el
@@ -25,6 +25,10 @@
25(defun +message-send-set-variables () 25(defun +message-send-set-variables ()
26 "Set variables for `message-send' depending on the From: header. 26 "Set variables for `message-send' depending on the From: header.
27Useful in `message-send-hook'." 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!")))
28 (let ((from (message-fetch-field "from"))) 32 (let ((from (message-fetch-field "from")))
29 (cl-loop for (var . val) in (cl-loop for (address . bindings) 33 (cl-loop for (var . val) in (cl-loop for (address . bindings)
30 in +message-send-dispatch-rules 34 in +message-send-dispatch-rules
@@ -145,6 +149,112 @@ the saved search as well."
145 ;;(user-error "Feature `async' not found!") 149 ;;(user-error "Feature `async' not found!")
146 (notmuch-poll))) 150 (notmuch-poll)))
147 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
176(defun notmuch-save-ics ()
177 "Save a .ics file in a message."
178 (interactive)
179 (with-current-notmuch-show-message
180 (notmuch-foreach-mime-part
181 (lambda (part)
182 (message "%S" part)
183 (when (and (listp part)
184 (or (equal "application/ics" (caadr part))
185 ;; (equal "text/calendar" (caadr part))
186 ))
187 (save-window-excursion
188 (let* ((filename "/tmp/notmuch.ics")
189 (buf (find-file-noselect filename)))
190 (delete-file filename)
191 (kill-buffer (get-file-buffer filename))
192 (mm-save-part-to-file part filename)
193 (icalendar-import-file filename diary-file)
194 (kill-buffer buf)))))
195 (mm-dissect-buffer t t))))
196
197
198;;; Fixes
199
200;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net
201
202(defun notmuch--indent-rigidly (start end count)
203 (cond
204 ((zerop count) t)
205 ((< count 0) (indent-rigidly start end count))
206 (t
207 (save-excursion
208 (let ((startpt (progn (goto-char start) (line-beginning-position)))
209 (endpt (progn (goto-char end) (line-end-position)))
210 (spaces (spaces-string count)))
211 (goto-char startpt)
212 (while
213 (progn
214 (insert spaces)
215 (cl-incf endpt count)
216 (and (zerop (forward-line 1)) (bolp)
217 (<= (point) endpt)))))))))
218
219(with-eval-after-load 'notmuch-show
220 ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way
221 ;; of doing this
222 (defun notmuch-show-lazy-part (part-args button)
223 ;; Insert the lazy part after the button for the part. We would just
224 ;; move to the start of the new line following the button and insert
225 ;; the part but that point might have text properties (eg colours
226 ;; from a message header etc) so instead we start from the last
227 ;; character of the button by adding a newline and finish by
228 ;; removing the extra newline from the end of the part.
229 (save-excursion
230 (goto-char (button-end button))
231 (insert "\n")
232 (let* ((inhibit-read-only t)
233 ;; We need to use markers for the start and end of the part
234 ;; because the part insertion functions do not guarantee
235 ;; to leave point at the end of the part.
236 (part-beg (copy-marker (point) nil))
237 (part-end (copy-marker (point) t))
238 ;; We have to save the depth as we can't find the depth
239 ;; when narrowed.
240 (depth (notmuch-show-get-depth)))
241 (save-restriction
242 (narrow-to-region part-beg part-end)
243 (delete-region part-beg part-end)
244 (apply #'notmuch-show-insert-bodypart-internal part-args)
245 (notmuch--indent-rigidly part-beg
246 part-end
247 (* notmuch-show-indent-messages-width depth)))
248 (goto-char part-end)
249 (delete-char 1)
250 (notmuch-show-record-part-information (cadr part-args)
251 (button-start button)
252 part-end)
253 ;; Create the overlay. If the lazy-part turned out to be empty/not
254 ;; showable this returns nil.
255 (notmuch-show-create-part-overlays button part-beg part-end))))
256 )
257
148 258
149;;; Packages 259;;; Packages
150 260
@@ -173,7 +283,6 @@ the saved search as well."
173 :preface (defdir notmuch/ (sync/ "emacs/notmuch/") 283 :preface (defdir notmuch/ (sync/ "emacs/notmuch/")
174 "Notmuch configuration directory." 284 "Notmuch configuration directory."
175 :makedir) 285 :makedir)
176 :bind (("C-c m" . notmuch-mua-new-mail))
177 :config 286 :config
178 ;; Options 287 ;; Options
179 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) 288 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
@@ -196,6 +305,7 @@ the saved search as well."
196 notmuch-saved-searches nil 305 notmuch-saved-searches nil
197 notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option 306 notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option
198 ) 307 )
308 (load notmuch-init-file)
199 ;; Key bindings 309 ;; Key bindings
200 (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) 310 (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
201 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) 311 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
@@ -221,6 +331,7 @@ the saved search as well."
221 (+notmuch-define-saved-search "all mail" "a" 'tree "*") 331 (+notmuch-define-saved-search "all mail" "a" 'tree "*")
222 ;; Hooks and advice 332 ;; Hooks and advice
223 (add-hook 'message-send-hook #'+message-send-set-variables) 333 (add-hook 'message-send-hook #'+message-send-set-variables)
334 (add-hook 'message-send-hook #'email-pre-send-check-attachment)
224 (add-hook 'message-setup-hook #'+message-signature-setup) 335 (add-hook 'message-setup-hook #'+message-signature-setup)
225 (autoload 'visual-fill-column-mode "visual-fill-column" nil t) 336 (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
226 (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) 337 (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 566deed..f961dda 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el
@@ -203,6 +203,16 @@ If LIST is non-nil, return the result as a list instead of a string."
203 (when (org-at-heading-p) (org-align-tags)))))) 203 (when (org-at-heading-p) (org-align-tags))))))
204 204
205 205
206;;; Misc.
207
208(defun org-clock-in-or-out (prefix)
209 "If clocked in, clock out. Otherwise, clock in."
210 (interactive "P")
211 (if (org-clocking-p)
212 (org-clock-out prefix)
213 (org-clock-in prefix)))
214
215
206;;; Faces 216;;; Faces
207 217
208(defface org-bold '((t (:weight bold))) 218(defface org-bold '((t (:weight bold)))
@@ -225,10 +235,12 @@ If LIST is non-nil, return the result as a list instead of a string."
225 :custom-face 235 :custom-face
226 (org-level-1 ((t :inherit fixed-pitch 236 (org-level-1 ((t :inherit fixed-pitch
227 :weight bold 237 :weight bold
228 :height 1.2))) 238 :slant italic
239 :height 1.0)))
229 (org-level-2 ((t :inherit fixed-pitch 240 (org-level-2 ((t :inherit fixed-pitch
230 :weight bold 241 :weight bold
231 :height 1.1))) 242 :slant italic
243 :height 1.0)))
232 (org-level-3 ((t :inherit fixed-pitch 244 (org-level-3 ((t :inherit fixed-pitch
233 :weight bold 245 :weight bold
234 :height 1.0))) 246 :height 1.0)))
@@ -299,17 +311,20 @@ If LIST is non-nil, return the result as a list instead of a string."
299 (sequence "|" "CANCELED(k@)") 311 (sequence "|" "CANCELED(k@)")
300 (sequence "MEETING(m)")) 312 (sequence "MEETING(m)"))
301 org-use-fast-todo-selection 'auto 313 org-use-fast-todo-selection 'auto
302 org-use-speed-commands t) 314 org-use-speed-commands t
315 org-element-use-cache nil)
303 ;; Keys 316 ;; Keys
304 (keymap-set org-mode-map "C-M-k" #'kill-paragraph) 317 (keymap-set org-mode-map "C-M-k" #'kill-paragraph)
305 (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs) 318 (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs)
306 (keymap-set org-mode-map "RET" #'+org-return-dwim) 319 (keymap-set org-mode-map "RET" #'+org-return-dwim)
307 (keymap-set org-mode-map "S-<return>" #'+org-table-copy-down|+org-return-dwim) 320 (keymap-set org-mode-map "S-<return>" #'+org-table-copy-down|+org-return-dwim)
321 (keymap-unset org-mode-map "C-'" t)
322 (keymap-unset org-mode-map "C-," t)
308 ;; Hooks 323 ;; Hooks
309 (add-hook 'org-mode-hook 324 (add-hook 'org-mode-hook
310 (defun org-mode@setup () 325 (defun org-mode@setup ()
311 (when (require 'visual-fill-column nil t) 326 (when (require 'visual-fill-column nil t)
312 (setq-local visual-fill-column-extra-text-width '(8 . 8)) 327 (setq-local visual-fill-column-extra-text-width '(2 . 2))
313 (visual-fill-column-mode)) 328 (visual-fill-column-mode))
314 (variable-pitch-mode) 329 (variable-pitch-mode)
315 (turn-off-auto-fill) 330 (turn-off-auto-fill)
@@ -325,19 +340,17 @@ If LIST is non-nil, return the result as a list instead of a string."
325 'org-mode 340 'org-mode
326 `(;; List markers => org-indent 341 `(;; List markers => org-indent
327 (,(concat 342 (,(concat
328 "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)" 343 "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)"
329 "\\(?:[ ]+\\|$\\)\\)" 344 "\\(?:[ ]+\\|$\\)\\)"
330 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]" 345 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]"
331 "[ ]*\\)?" 346 "[ ]*\\)?"
332 "\\(?:\\(\\[[ X-]\\]\\)" 347 "\\(?:\\(\\[[ X-]\\]\\)"
333 "\\(?:[ ]+\\|$\\)\\)?") 348 "\\(?:[ ]+\\|$\\)\\)?")
334 0 'org-indent)))) 349 0 'org-indent))))
335 350
336(use-package org-clock 351(use-package org-clock
337 :bind (("M-<f9>" . org-clock-out) 352 :bind (:map org-mode-map
338 :map org-mode-map 353 ("<f8>" . org-clock-in-or-out))
339 ("<f8>" . org-clock-in)
340 ("<f9>" . org-clock-out))
341 :config 354 :config
342 (setopt org-clock-clocked-in-display 'mode-line 355 (setopt org-clock-clocked-in-display 'mode-line
343 global-mode-string 356 global-mode-string
@@ -355,13 +368,11 @@ If LIST is non-nil, return the result as a list instead of a string."
355 org-agenda-skip-scheduled-if-done t 368 org-agenda-skip-scheduled-if-done t
356 org-agenda-span 10 369 org-agenda-span 10
357 org-agenda-block-separator ?─ 370 org-agenda-block-separator ?─
358 org-agenda-time-grid 371 org-agenda-time-grid '((daily today require-timed)
359 '((daily today require-timed) 372 (800 1000 1200 1400 1600 1800 2000)
360 (800 1000 1200 1400 1600 1800 2000) 373 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
361 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") 374 org-agenda-current-time-string "← now ───────────────"
362 org-agenda-current-time-string 375 org-agenda-include-diary t ; I use the org-diary features
363 "← now ─────────────────────────────────────────────────"
364 org-agenda-include-diary nil ; I use the org-diary features
365 org-agenda-todo-ignore-deadlines 'near 376 org-agenda-todo-ignore-deadlines 'near
366 org-agenda-todo-ignore-scheduled 'future 377 org-agenda-todo-ignore-scheduled 'future
367 org-agenda-include-deadlines t 378 org-agenda-include-deadlines t
@@ -371,7 +382,29 @@ If LIST is non-nil, return the result as a list instead of a string."
371 org-agenda-skip-file-regexp "sync-conflict" 382 org-agenda-skip-file-regexp "sync-conflict"
372 org-agenda-inhibit-startup t 383 org-agenda-inhibit-startup t
373 org-agenda-sticky t 384 org-agenda-sticky t
374 org-agenda-follow-indirect t) 385 org-agenda-follow-indirect t
386 org-stuck-projects '("TODO=\"WAIT\""
387 ("TODO" "NEXT")
388 nil
389 "")
390 org-agenda-custom-commands
391 `(("c" "Click Here Digital To-do"
392 ((agenda "" ((org-agenda-overriding-header "Tasks")
393 (org-agenda-span 'fortnight)
394 (org-agenda-start-day "+0")
395 (org-agenda-skip-function
396 '(org-agenda-skip-subtree-if 'todo
397 '("WAIT" "MCKENZIE" "RACHEL")))))
398 (stuck "" ((org-agenda-overriding-header "Waiting"))))
399 ((org-agenda-files ',(list (progn (require 'chd)
400 (chd/ "inbox-chd.org"))))))))
401 ;; Speedup agenda generation
402 ;; https://orgmode.org/manual/Speeding-Up-Your-Agendas.html
403 ;; https://orgmode.org/worg/agenda-optimization.html
404 (setopt org-agenda-dim-blocked-tasks nil
405 org-agenda-inhibit-startup t
406 org-agenda-use-tag-inheritance nil
407 org-agenda-ignore-properties '(effort appt stats category))
375 ;; Hooks and advice 408 ;; Hooks and advice
376 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) 409 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
377 (add-hook 'org-agenda-mode-hook #'hl-line-mode) 410 (add-hook 'org-agenda-mode-hook #'hl-line-mode)
@@ -440,6 +473,7 @@ effect for exporting link types)."
440 :custom-face 473 :custom-face
441 (org-modern-label ((t :inherit fixed-pitch 474 (org-modern-label ((t :inherit fixed-pitch
442 :height 1.0))) 475 :height 1.0)))
476 :hook (org-mode-hook)
443 :config 477 :config
444 (setopt org-modern-star nil 478 (setopt org-modern-star nil
445 org-modern-list '((43 . "◦") 479 org-modern-list '((43 . "◦")
@@ -449,8 +483,7 @@ effect for exporting link types)."
449 org-modern-hide-stars nil 483 org-modern-hide-stars nil
450 org-tags-column 0 484 org-tags-column 0
451 org-modern-keyword nil 485 org-modern-keyword nil
452 org-modern-table nil) 486 org-modern-table nil))
453 (global-org-modern-mode))
454 487
455(use-package org-taskwise 488(use-package org-taskwise
456 :after org 489 :after org
diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el index 36a5ba4..40e1a3d 100644 --- a/lisp/acdw-web.el +++ b/lisp/acdw-web.el
@@ -114,6 +114,9 @@ regexp that will not be regexp-quoted when matching against a url."
114 (list :tag "Regexp" regexp) 114 (list :tag "Regexp" regexp)
115 (string :tag "Literal string")))) 115 (string :tag "Literal string"))))
116 116
117(with-eval-after-load 'custom-allowed
118 (add-to-list 'custom-allowed-variables '+browse-url-external-domains))
119
117(defun +browse-url-external-url-p (url) 120(defun +browse-url-external-url-p (url)
118 "Return t if URL is a member of `+browse-url-external-domains'. 121 "Return t if URL is a member of `+browse-url-external-domains'.
119This function only tests URL's domain." 122This function only tests URL's domain."
@@ -125,6 +128,29 @@ This function only tests URL's domain."
125 host) 128 host)
126 return t))) 129 return t)))
127 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)))
128 154
129;;; Downloading 155;;; Downloading
130 156
@@ -165,6 +191,34 @@ This function only tests URL's domain."
165;;; Packages 191;;; Packages
166 192
167(use-package eww 193(use-package eww
194 :preface
195 (defun bookmark-eww--make ()
196 "Make eww bookmark record."
197 `((filename . ,(plist-get eww-data :url))
198 (title . ,(plist-get eww-data :title))
199 (time . ,(current-time-string))
200 (handler . ,#'bookmark-eww-handler)
201 (defaults . (,(concat
202 ;; url without the https and path
203 (replace-regexp-in-string
204 "/.*" ""
205 (replace-regexp-in-string
206 "\\`https?://" ""
207 (plist-get eww-data :url)))
208 " - "
209 ;; page title
210 (replace-regexp-in-string
211 "\\` +\\| +\\'" ""
212 (replace-regexp-in-string
213 "[\n\t\r ]+" " "
214 (plist-get eww-data :title))))))))
215 (defun bookmark-eww-handler (bm)
216 "Handler for eww bookmarks."
217 (eww-browse-url (alist-get 'filename bm)))
218 (defun bookmark-eww--setup ()
219 "Setup eww bookmark integration."
220 (setq-local bookmark-make-record-function #'bookmark-eww--make))
221 :commands (eww eww-browse-url)
168 :config 222 :config
169 (setopt eww-use-browse-url ".") 223 (setopt eww-use-browse-url ".")
170 (add-hook 'eww-mode-hook 224 (add-hook 'eww-mode-hook
@@ -181,7 +235,12 @@ This function only tests URL's domain."
181 browse-url-secondary-browser-function 235 browse-url-secondary-browser-function
182 (or url (plist-get eww-data :url))) 236 (or url (plist-get eww-data :url)))
183 (:success (when (null url) (quit-window))) ; Interactive use 237 (:success (when (null url) (quit-window))) ; Interactive use
184 (t (signal (car e) (cdr e))))))) 238 (t (signal (car e) (cdr e))))))
239 (add-hook 'eww-mode-hook #'bookmark-eww--setup)
240 (define-key eww-mode-map "b" #'bookmark-set)
241 (define-key eww-mode-map "B" #'bookmark-jump)
242 (define-key eww-mode-map (kbd "M-n") nil)
243 (define-key eww-mode-map (kbd "M-p") nil))
185 244
186(use-package browse-url 245(use-package browse-url
187 :demand t 246 :demand t
@@ -204,7 +263,8 @@ This function only tests URL's domain."
204 . +browse-url-with-mpv) 263 . +browse-url-with-mpv)
205 ;; Images 264 ;; Images
206 (,(+browse-url-matches "pbs\\.twimg\\.com" 265 (,(+browse-url-matches "pbs\\.twimg\\.com"
207 (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") 266 (rx "." (or "jpeg" "jpg" "png" "pn"
267 "bmp" "webp")
208 eos)) 268 eos))
209 . +browse-url-with-mpv-image) 269 . +browse-url-with-mpv-image)
210 ;; Blobs 270 ;; Blobs
@@ -214,16 +274,18 @@ This function only tests URL's domain."
214 (+browse-url-external-url-p 274 (+browse-url-external-url-p
215 . ,browse-url-secondary-browser-function)) 275 . ,browse-url-secondary-browser-function))
216 ;; External domains 276 ;; External domains
217 +browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org" 277 ;; +browse-url-external-domains
218 "tildegit.org" "git.tilde.town" 278 ;; '("github.com" "gitlab.com" "codeberg.org"
219 "google.com" "imgur.com" "twitch.tv" 279 ;; "tildegit.org" "git.tilde.town"
220 "pixelfed" "instagram.com" 280 ;; "google.com" "imgur.com" "twitch.tv"
221 "bibliogram.art" "reddit.com" 281 ;; "pixelfed" "instagram.com"
222 "teddit.net" "libreddit.de" 282 ;; "bibliogram.art" "reddit.com"
223 "streamable.com" "spotify.com" 283 ;; "teddit.net" "libreddit.de"
224 "hetzner.cloud" "melpa.org" 284 ;; "streamable.com" "spotify.com"
225 "twitter.com" ("^t\\.co$") 285 ;; "hetzner.cloud" "melpa.org"
226 "nitter.snopyta.org" "nitter.net")) 286 ;; "twitter.com" ("^t\\.co$")
287 ;; "nitter.snopyta.org" "nitter.net")
288 )
227 ;; External browsers: firefox > chromium > chrome 289 ;; External browsers: firefox > chromium > chrome
228 (when-let ((firefox (choose-executable "firefox" 290 (when-let ((firefox (choose-executable "firefox"
229 "firefox-esr"))) 291 "firefox-esr")))
@@ -268,14 +330,16 @@ This function only tests URL's domain."
268 :bind 330 :bind
269 (("M-l M-l" . +link-hint-open-link) 331 (("M-l M-l" . +link-hint-open-link)
270 ("M-l l" . +link-hint-open-link) 332 ("M-l l" . +link-hint-open-link)
271 ("M-l M-o" . +link-hint-open-secondary) 333 ("M-l M-o" . +link-hint-open:secondary)
272 ("M-l o" . +link-hint-open-secondary) 334 ("M-l o" . +link-hint-open:secondary)
273 ("M-l M-m" . +link-hint-open-multiple-links) 335 ("M-l M-m" . +link-hint-open-multiple-links)
274 ("M-l m" . +link-hint-open-multiple-links) 336 ("M-l m" . +link-hint-open-multiple-links)
275 ("M-l M-w" . link-hint-copy-link) 337 ("M-l M-w" . link-hint-copy-link)
276 ("M-l w" . link-hint-copy-link) 338 ("M-l w" . link-hint-copy-link)
277 ("M-l M-c" . +link-hint-open-chrome) 339 ("M-l M-c" . +link-hint-open:chrome)
278 ("M-l c" . +link-hint-open-chrome)) 340 ("M-l c" . +link-hint-open:chrome)
341 ("M-l M-d" . +link-hint-open:download)
342 ("M-l d" . +link-hint-open:download))
279 :config 343 :config
280 (require '+link-hint) 344 (require '+link-hint)
281 (setopt link-hint-avy-style 'at-full 345 (setopt link-hint-avy-style 'at-full
@@ -286,8 +350,9 @@ This function only tests URL's domain."
286 ;; another package's configuration, but I don't care enough to fix it. 350 ;; another package's configuration, but I don't care enough to fix it.
287 (setq link-hint-types 351 (setq link-hint-types
288 (delq 'link-hint-completion-list-candidate link-hint-types)) 352 (delq 'link-hint-completion-list-candidate link-hint-types))
289 (+link-hint-open-secondary-setup) 353 ;; (+link-hint-open-secondary-setup)
290 (+link-hint-open-chrome-setup)) 354 ;; (+link-hint-open-chrome-setup)
355 )
291 356
292(provide 'acdw-web) 357(provide 'acdw-web)
293;;; acdw-web.el ends here 358;;; acdw-web.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el index 46079f6..63291d3 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -184,7 +184,9 @@ prefix ARG is non-nil; then it just saves them."
184 (user-error "Buffer not attached to file")) 184 (user-error "Buffer not attached to file"))
185 (hack-dir-local-variables) 185 (hack-dir-local-variables)
186 (let ((print-level nil) 186 (let ((print-level nil)
187 (print-length nil)) 187 (print-length nil)
188 (before-save-hook nil)
189 (after-save-hook nil))
188 (when-let ((new-words (cl-remove-if 190 (when-let ((new-words (cl-remove-if
189 (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA 191 (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
190 ; where this came from 192 ; where this came from
@@ -330,5 +332,46 @@ include the time. When called with \\[universal-argument]
330 (fill-paragraph-function nil)) 332 (fill-paragraph-function nil))
331 (fill-paragraph))) 333 (fill-paragraph)))
332 334
335(defun fill-with-double-spaced-sentences-dwim (&optional start end)
336 "Fill paragraph or region, double-spacing sentences."
337 (interactive)
338 (let ((sentence-end-double-space t))
339 (unless (region-active-p)
340 (mark-paragraph))
341 (repunctuate-sentences :no-query
342 (region-beginning)
343 (region-end))
344 (fill-region (region-beginning)
345 (region-end))))
346
347(defun fill-with-double-spaced-sentences-dwim (&optional start end)
348 "Fill from START to END, double-spacing sentences.
349If START to END aren't given, or if a region isn't in use, fill
350the current paragraph."
351 (interactive "*r")
352 (let ((sentence-end-double-space t))
353 (save-mark-and-excursion
354 (save-restriction
355 (unless (region-active-p)
356 (setq start (progn (start-of-paragraph-text)
357 (point))
358 end (progn (end-of-paragraph-text)
359 (point))))
360 (narrow-to-region start end)
361 (goto-char (point-min))
362 (repunctuate-sentences :no-query)
363 (fill-region (point-min)
364 (point-max))))))
365
366(defun acdw-elisp-package-prepare (&optional file)
367 "Do all the elisp-package-preparing stuff on FILE.
368If FILE is nil or not given, do it on the current buffer."
369 (with-current-buffer (if file (find-file-noselect file) (current-buffer))
370 (check-parens)
371 (checkdoc)
372 (package-lint-buffer)
373 ;; TODO: use `lm-commentary' to write to README.org
374 ))
375
333(provide 'acdw) 376(provide 'acdw)
334;;; acdw.el ends here 377;;; acdw.el ends here
diff --git a/lisp/ical2org.el b/lisp/ical2org.el new file mode 100644 index 0000000..2716787 --- /dev/null +++ b/lisp/ical2org.el
@@ -0,0 +1,56 @@
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