changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > infra > home / .emacs.d/ellis.el

changeset 83: 8bd50ea9a546
parent: 4ff9d125b31f
child: 862659891933
author: Richard Westhaver <ellis@rwest.io>
date: Mon, 12 Aug 2024 21:50:44 -0400
permissions: -rw-r--r--
description: zor updates
1 ;;; ellis.el --- Richard's custom Emacs config
2 
3 ;; Copyright (C) 2024
4 
5 ;; Author: Richard Westhaver <ellis@rwest.io>
6 
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
11 
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
16 
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
19 
20 ;;; Commentary:
21 
22 ;; This is an example of what you may want to add to your custom
23 ;; config file. Feel free to rip.
24 
25 ;;; Code:
26 (require 'inbox)
27 (require 'sk)
28 (require 'sxp)
29 (require 'ulang)
30 
31 (defalias 'make #'compile)
32 
33 (setopt default-theme 'modus-vivendi-tritanopia
34  user-lab-directory (join-paths user-home-directory "lab")
35  company-source-directory (join-paths user-home-directory "comp"))
36 
37 ;; (unless (display-graphic-p) (setq default-theme 'wheatgrass))
38 
39 (when (linux-p) (setq dired-listing-switches "-alsh"))
40 
41 (defvar emacs-config-source (join-paths company-source-directory "core/emacs"))
42 
43 ;;;###autoload
44 (defun edit-emacs-config (&optional src)
45  (interactive (list current-prefix-arg))
46  (let ((file (if src
47  (expand-file-name "default.el" emacs-config-source)
48  user-custom-file)))
49  (find-file file)))
50 
51 (keymap-set user-map "e c" #'edit-emacs-config)
52 (keymap-set emacs-lisp-mode-map "C-c C-l" #'load-file)
53 (keymap-set emacs-lisp-mode-map "C-c M-k" #'elisp-byte-compile-file)
54 (keymap-set user-map "v t" #'org-tags-view)
55 
56 (require 'paredit)
57 (repeat-mode)
58 
59 (keymap-set lisp-mode-shared-map "C-(" #'paredit-open-round)
60 (keymap-set lisp-mode-shared-map "M-(" #'paredit-wrap-sexp)
61 (keymap-set lisp-mode-shared-map "M-;" #'paredit-comment-dwim)
62 (keymap-set lisp-mode-shared-map "C-{" #'paredit-backward-barf-sexp)
63 (keymap-set lisp-mode-shared-map "C-}" #'paredit-forward-barf-sexp)
64 (keymap-set lisp-mode-shared-map "C-M-{" #'paredit-forward-slurp-sexp)
65 (keymap-set lisp-mode-shared-map "C-M-}" #'paredit-backward-slurp-sexp)
66 
67 (defun remember-project ()
68  (interactive)
69  (project-remember-project (project-current))
70  project--list)
71 
72 (defun remember-lab-projects ()
73  (interactive)
74  (project-remember-projects-under user-lab-directory t))
75 
76 (defun remember-comp-projects ()
77  (interactive)
78  (project-remember-projects-under company-source-directory t))
79 
80 (keymap-global-set "C-<tab>" #'hippie-expand)
81 (keymap-set minibuffer-local-map "C-<tab>" #'hippie-expand)
82 (keymap-set ctl-x-x-map "p p" #'remember-project)
83 (keymap-set ctl-x-x-map "p l" #'remember-lab-projects)
84 
85 (add-hook 'prog-mode-hook #'skel-minor-mode)
86 (add-hook 'org-mode-hook #'skel-minor-mode)
87 ;; (add-hook 'prog-mode-hook #'company-mode)
88 
89 (add-hook 'notmuch-message-mode-hook #'turn-on-orgtbl)
90 
91 (use-package markdown-mode :ensure t)
92 
93 (use-package ol-notmuch :ensure t)
94 
95 (use-package notmuch
96  :ensure t
97  :init
98  (setopt
99  mail-user-agent 'message-user-agent
100  smtpmail-smtp-server "smtp.gmail.com"
101  message-send-mail-function 'message-smtpmail-send-it
102  smtpmail-debug-info t
103  message-default-mail-headers "Cc: \nBcc: \n"
104  message-kill-buffer-on-exit t
105  user-mail-address "richard.westhaver@gmail.com"
106  user-full-name "Richard Westhaver"
107  notmuch-hello-sections '(notmuch-hello-insert-saved-searches
108  notmuch-hello-insert-search
109  notmuch-hello-insert-recent-searches
110  notmuch-hello-insert-alltags)
111  notmuch-show-logo nil
112  notmuch-search-oldest-first nil
113  notmuch-hello-hide-tags '("kill")
114  notmuch-saved-searches '((:name "inbox" :query "tag:inbox" :key "i")
115  (:name "unread" :query "tag:unread" :key "u")
116  (:name "new" :query "tag:new" :key "n")
117  (:name "sent" :query "tag:sent" :key "e")
118  (:name "drafts" :query "tag:draft" :key "d")
119  (:name "all mail" :query "*" :key "a")
120  (:name "todo" :query "tag:todo" :key "t")))
121  :config
122  ;;;###autoload
123  (defun notmuch-exec-offlineimap ()
124  "execute offlineimap command and tag new mail with notmuch"
125  (interactive)
126  (start-process-shell-command "offlineimap"
127  "*offlineimap*"
128  "offlineimap -o")
129  (notmuch-refresh-all-buffers))
130 
131  (defun offlineimap-get-password (host port)
132  (let* ((netrc (netrc-parse (expand-file-name "~/.netrc.gpg")))
133  (hostentry (netrc-machine netrc host port port)))
134  (when hostentry (netrc-get hostentry "password"))))
135 
136  (defun mark-as-read ()
137  "mark message as read."
138  (interactive)
139  (notmuch-search-tag '("-new" "-unread" "-inbox")))
140 
141  (defun mark-as-todo ()
142  "mark message as todo."
143  (interactive)
144  (mark-as-read)
145  (notmuch-search-tag '("-new" "-unread" "-inbox" "+todo")))
146 
147  (defun mark-as-spam ()
148  "mark message as spam."
149  (interactive)
150  (mark-as-read)
151  (notmuch-search-tag (list "+spam")))
152 
153  (keymap-set user-map "e m" #'notmuch)
154  (keymap-set user-map "e M" #'notmuch-exec-offlineimap)
155  (keymap-set notmuch-search-mode-map "S" #'mark-as-spam)
156  (keymap-set notmuch-search-mode-map "R" #'mark-as-read)
157  (keymap-set notmuch-search-mode-map "T" #'mark-as-todo))
158 
159 (use-package elfeed
160  :ensure t
161  :custom
162  elfeed-feeds
163  '(("http://threesixty360.wordpress.com/feed/" blog math)
164  ("http://www.50ply.com/atom.xml" blog dev)
165  ("http://blog.cryptographyengineering.com/feeds/posts/default" blog)
166  ("http://abstrusegoose.com/feed.xml" comic)
167  ("http://accidental-art.tumblr.com/rss" image math)
168  ("http://researchcenter.paloaltonetworks.com/unit42/feed/" security)
169  ("http://curiousprogrammer.wordpress.com/feed/" blog dev)
170  ("http://feeds.feedburner.com/amazingsuperpowers" comic)
171  ("http://amitp.blogspot.com/feeds/posts/default" blog dev)
172  ("http://pages.cs.wisc.edu/~psilord/blog/rssfeed.rss" blog)
173  ("http://www.anticscomic.com/?feed=rss2" comic)
174  ("http://feeds.feedburner.com/blogspot/TPQSS" blog dev)
175  ("http://techchrunch.com/feeds" tech news)
176  ("https://rss.nytimes.com/services/xml/rss/nyt/Technology.xml" tech news)
177  ("https://static.fsf.org/fsforg/rss/news.xml" tech news)
178  ("https://feeds.npr.org/1001/rss.xml" news)
179  ("https://search.cnbc.com/rs/search/combinedcms/view.xml?partnerId=wrss01&id=10000664" fin news)
180  ("https://search.cnbc.com/rs/search/combinedcms/view.xml?partnerId=wrss01&id=19854910" tech news)
181  ("https://search.cnbc.com/rs/search/combinedcms/view.xml?partnerId=wrss01&id=100003114" us news)
182  ("http://arxiv.org/rss/cs" cs rnd)
183  ("http://arxiv.org/rss/math" math rnd)
184  ("http://arxiv.org/rss/q-fin" q-fin rnd)
185  ("http://arxiv.org/rss/stat" stat rnd)
186  ("http://arxiv.org/rss/econ" econ rnd)
187  ;; John Wiegley
188  ("http://newartisans.com/rss.xml" dev blog)
189  ;; comp
190  ;; ("https://lab.rwest.io/comp.atom?feed_token=pHu9qwLkjy4CWJHx9rrJ" comp vc)
191  ("https://www.reddit.com/r/listentothis/.rss" music reddit)
192  ("https://www.ftc.gov/feeds/press-release-consumer-protection.xml" gov ftc)
193  ("https://api2.fcc.gov/edocs/public/api/v1/rss/" gov fcc)
194  )
195  :init
196  (defun yt-dl-it (url)
197  "Downloads the URL in an async shell"
198  (let ((default-directory user-stash-directory))
199  (async-shell-command (format "yt-dlp %s" url))))
200 
201  (defun elfeed-youtube-dl (&optional use-generic-p)
202  "Youtube-DL link"
203  (interactive "P")
204  (let ((entries (elfeed-search-selected)))
205  (cl-loop for entry in entries
206  do (elfeed-untag entry 'unread)
207  when (elfeed-entry-link entry)
208  do (yt-dl-it it))
209  (mapc #'elfeed-search-update-entry entries)
210  (unless (use-region-p) (forward-line))))
211  :config
212  (keymap-set elfeed-search-mode-map "d" 'elfeed-youtube-dl)
213  (keymap-set user-map "e f" #'elfeed)
214  (keymap-set user-map "e F" #'elfeed-update))
215 
216 (use-package elfeed-tube
217  :ensure t
218  :after elfeed
219  :config
220  ;; (elfeed-tube-setup)
221  (elfeed-tube-add-feeds '("detroit techno" "boiler room dj" "brad mehldau" "chris 'daddy' dave"))
222  :bind (:map elfeed-show-mode-map
223  ("F" . elfeed-tube-fetch)
224  ([remap save-buffer] . elfeed-tube-save)
225  :map elfeed-search-mode-map
226  ("F" . elfeed-tube-fetch)
227  ([remap save-buffer] . elfeed-tube-save)))
228 
229 (use-package elfeed-tube-mpv
230  :ensure t
231  :bind (:map elfeed-show-mode-map
232  ("C-c C-f" . elfeed-tube-mpv-follow-mode)
233  ("C-c C-w" . elfeed-tube-mpv-where)))
234 
235 (use-package org-mime :ensure t)
236 
237 (use-package sh-script
238  :hook (sh-mode . flymake-mode))
239 
240 ;;; Org Config
241 (setq publish-dir "/ssh:rurik:/srv/http/compiler.company")
242 (keymap-set user-map "t" #'org-todo)
243 
244 ;; populate org-babel
245 (org-babel-do-load-languages
246  ;; TODO 2021-10-24: bqn, apl, k
247  'org-babel-load-languages '((shell . t)
248  (emacs-lisp . t)
249  (lisp . t)
250  (org . t)
251  (eshell . t)
252  (calc . t)
253  (sed . t)
254  (awk . t)
255  (dot . t)
256  (js . t)
257  (C . t)
258  (python . t)
259  (lua . t)
260  (lilypond . t)))
261 ;;; IRC
262 (setq erc-format-nick-function 'erc-format-@nick)
263 
264 (defun start-erc ()
265  "Connect to IRC."
266  (interactive)
267  (erc-tls :server "irc.libera.chat" :port 6697
268  :client-certificate '("/mnt/y/data/private/krypt/libera.pem"))
269  (setq erc-autojoin-channels-alist '(("irc.libera.chat" "#emacs")
270  ("irc.libera.chat" "#linux")
271  ("irc.libera.chat" "#rust")
272  ("irc.libera.chat" "#btrfs")
273  ("irc.libera.chat" "#lisp")
274  ("irc.libera.chat" "#sbcl")
275  ("irc.oftc.net" "#llvm"))))
276 ;;; Tags
277 ;;;###autoload
278 (defun refresh-tags ()
279  "Refresh TAGS database in `user-emacs-directory'."
280  (interactive)
281  (let ((default-directory user-emacs-directory))
282  (async-shell-command
283  "etags ./*.el \\
284 ./lib/*.el \\
285 ~/comp/core/emacs/*.el \\
286 ~/comp/core/emacs/lib/*.el \\
287 -o TAGS")))
288 
289 (unless (string-equal "hyde" system-name)
290  (add-hook 'dired-mode-hook #'all-the-icons-dired-mode)
291  (add-hook 'ibuffer-mode-hook #'all-the-icons-ibuffer-mode))
292 
293 ;; strangerdanger
294 ;; (setq slime-enable-evaluate-in-emacs t)
295 
296 (defun org-word-count (beg end
297  &optional count-latex-macro-args?
298  count-footnotes?)
299  "Report the number of words in the Org mode buffer or selected region.
300 Ignores:
301 - comments
302 - tables
303 - source code blocks (#+BEGIN_SRC ... #+END_SRC, and inline blocks)
304 - hyperlinks (but does count words in hyperlink descriptions)
305 - tags, priorities, and TODO keywords in headers
306 - sections tagged as 'not for export'.
307 
308 The text of footnote definitions is ignored, unless the optional argument
309 COUNT-FOOTNOTES? is non-nil.
310 
311 If the optional argument COUNT-LATEX-MACRO-ARGS? is non-nil, the word count
312 includes LaTeX macro arguments (the material between {curly braces}).
313 Otherwise, and by default, every LaTeX macro counts as 1 word regardless
314 of its arguments."
315  (interactive "r")
316  (unless mark-active
317  (setf beg (point-min)
318  end (point-max)))
319  (let ((wc 0)
320  (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}"))
321  (save-excursion
322  (goto-char beg)
323  (while (< (point) end)
324  (cond
325  ;; Ignore comments.
326  ((or (org-in-commented-line) (org-at-table-p))
327  nil)
328  ;; Ignore hyperlinks. But if link has a description, count
329  ;; the words within the description.
330  ((looking-at org-bracket-link-analytic-regexp)
331  (when (match-string-no-properties 5)
332  (let ((desc (match-string-no-properties 5)))
333  (save-match-data
334  (cl-incf wc (length (remove "" (org-split-string
335  desc "\\W")))))))
336  (goto-char (match-end 0)))
337  ((looking-at org-any-link-re)
338  (goto-char (match-end 0)))
339  ;; Ignore source code blocks.
340  ((org-in-regexps-block-p "^#\\+BEGIN_SRC\\W" "^#\\+END_SRC\\W")
341  nil)
342  ;; Ignore inline source blocks, counting them as 1 word.
343  ((save-excursion
344  (backward-char)
345  (looking-at org-babel-inline-src-block-regexp))
346  (goto-char (match-end 0))
347  (setf wc (+ 2 wc)))
348  ;; Count latex macros as 1 word, ignoring their arguments.
349  ((save-excursion
350  (backward-char)
351  (looking-at latex-macro-regexp))
352  (goto-char (if count-latex-macro-args?
353  (match-beginning 2)
354  (match-end 0)))
355  (setf wc (+ 2 wc)))
356  ;; Ignore footnotes.
357  ((and (not count-footnotes?)
358  (or (org-footnote-at-definition-p)
359  (org-footnote-at-reference-p)))
360  nil)
361  (t
362  (let ((contexts (org-context)))
363  (cond
364  ;; Ignore tags and TODO keywords, etc.
365  ((or (assoc :todo-keyword contexts)
366  (assoc :priority contexts)
367  (assoc :keyword contexts)
368  (assoc :checkbox contexts))
369  nil)
370  ;; Ignore sections marked with tags that are
371  ;; excluded from export.
372  ((assoc :tags contexts)
373  (if (intersection (org-get-tags-at) org-export-exclude-tags
374  :test 'equal)
375  (org-forward-same-level 1)
376  nil))
377  (t
378  (cl-incf wc))))))
379  (re-search-forward "\\w+\\W*")))
380  (message (format "%d words in %s." wc
381  (if mark-active "region" "buffer")))))
382 
383 (defun org-check-misformatted-subtree ()
384  "Check misformatted entries in the current buffer."
385  (interactive)
386  (show-all)
387  (org-map-entries
388  (lambda ()
389  (when (and (move-beginning-of-line 2)
390  (not (looking-at org-heading-regexp)))
391  (if (or (and (org-get-scheduled-time (point))
392  (not (looking-at (concat "^.*" org-scheduled-regexp))))
393  (and (org-get-deadline-time (point))
394  (not (looking-at (concat "^.*" org-deadline-regexp)))))
395  (when (y-or-n-p "Fix this subtree? ")
396  (message "Call the function again when you're done fixing this subtree.")
397  (recursive-edit))
398  (message "All subtrees checked."))))))
399 
400 (defun org-sort-list-by-checkbox-type ()
401  "Sort list items according to Checkbox state."
402  (interactive)
403  (org-sort-list
404  nil ?f
405  (lambda ()
406  (if (looking-at org-list-full-item-re)
407  (cdr (assoc (match-string 3)
408  '(("[X]" . 1) ("[-]" . 2) ("[ ]" . 3) (nil . 4))))
409  4))))
410 
411 (defun org-time-string-to-seconds (s)
412  "Convert a string HH:MM:SS to a number of seconds."
413  (cond
414  ((and (stringp s)
415  (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
416  (let ((hour (string-to-number (match-string 1 s)))
417  (min (string-to-number (match-string 2 s)))
418  (sec (string-to-number (match-string 3 s))))
419  (+ (* hour 3600) (* min 60) sec)))
420  ((and (stringp s)
421  (string-match "\\([0-9]+\\):\\([0-9]+\\)" s))
422  (let ((min (string-to-number (match-string 1 s)))
423  (sec (string-to-number (match-string 2 s))))
424  (+ (* min 60) sec)))
425  ((stringp s) (string-to-number s))
426  (t s)))
427 
428 (defun org-time-seconds-to-string (secs)
429  "Convert a number of seconds to a time string."
430  (cond ((>= secs 3600) (format-seconds "%h:%.2m:%.2s" secs))
431  ((>= secs 60) (format-seconds "%m:%.2s" secs))
432  (t (format-seconds "%s" secs))))
433 
434 (defmacro with-time (time-output-p &rest exprs)
435  "Evaluate an org-table formula, converting all fields that look
436 like time data to integer seconds. If TIME-OUTPUT-P then return
437 the result as a time value."
438  (list
439  (if time-output-p 'org-time-seconds-to-string 'identity)
440  (cons 'progn
441  (mapcar
442  (lambda (expr)
443  `,(cons (car expr)
444  (mapcar
445  (lambda (el)
446  (if (listp el)
447  (list 'with-time nil el)
448  (org-time-string-to-seconds el)))
449  (cdr expr))))
450  `,@exprs))))
451 
452 (defun org-hex-strip-lead (str)
453  (if (and (> (length str) 2) (string= (substring str 0 2) "0x"))
454  (substring str 2) str))
455 
456 (defun org-hex-to-hex (int)
457  (format "0x%x" int))
458 
459 (defun org-hex-to-dec (str)
460  (cond
461  ((and (stringp str)
462  (string-match "\\([0-9a-f]+\\)" (setf str (org-hex-strip-lead str))))
463  (let ((out 0))
464  (mapc
465  (lambda (ch)
466  (setf out (+ (* out 16)
467  (if (and (>= ch 48) (<= ch 57)) (- ch 48) (- ch 87)))))
468  (coerce (match-string 1 str) 'list))
469  out))
470  ((stringp str) (string-to-number str))
471  (t str)))
472 
473 (defmacro with-hex (hex-output-p &rest exprs)
474  "Evaluate an org-table formula, converting all fields that look
475  like hexadecimal to decimal integers. If HEX-OUTPUT-P then
476  return the result as a hex value."
477  (list
478  (if hex-output-p 'org-hex-to-hex 'identity)
479  (cons 'progn
480  (mapcar
481  (lambda (expr)
482  `,(cons (car expr)
483  (mapcar (lambda (el)
484  (if (listp el)
485  (list 'with-hex nil el)
486  (org-hex-to-dec el)))
487  (cdr expr))))
488  `,@exprs))))
489 
490 (require 'mm-url) ; to include mm-url-decode-entities-string
491 
492 (defun org-insert-link-with-title ()
493  "Insert org link where default description is set to html title."
494  (interactive)
495  (let* ((url (read-string "URL: "))
496  (title (get-html-title-from-url url)))
497  (org-insert-link nil url title)))
498 
499 (defun get-html-title-from-url (url)
500  "Return content in <title> tag."
501  (let (x1 x2 (download-buffer (url-retrieve-synchronously url)))
502  (save-excursion
503  (set-buffer download-buffer)
504  (beginning-of-buffer)
505  (setq x1 (search-forward "<title>"))
506  (search-forward "</title>")
507  (setq x2 (search-backward "<"))
508  (mm-url-decode-entities-string (buffer-substring-no-properties x1 x2)))))
509 
510 (defun org-remove-empty-propert-drawers ()
511  "*Remove all empty property drawers in current file."
512  (interactive)
513  (unless (eq major-mode 'org-mode)
514  (error "You need to turn on Org mode for this function."))
515  (save-excursion
516  (goto-char (point-min))
517  (while (re-search-forward ":PROPERTIES:" nil t)
518  (save-excursion
519  (org-remove-empty-drawer-at "PROPERTIES" (match-beginning 0))))))
520 
521 (defun check-for-clock-out-note ()
522  (interactive)
523  (save-excursion
524  (org-back-to-heading)
525  (let ((tags (org-get-tags)))
526  (and tags (message "tags: %s " tags)
527  (when (member "clocknote" tags)
528  (org-add-note))))))
529 
530 (add-hook 'org-clock-out-hook 'check-for-clock-out-note)
531 
532 (defun org-list-files (dirs ext)
533  "Function to create list of org files in multiple subdirectories.
534 This can be called to generate a list of files for
535 org-agenda-files or org-refile-targets.
536 
537 DIRS is a list of directories.
538 
539 EXT is a list of the extensions of files to be included."
540  (let ((dirs (if (listp dirs)
541  dirs
542  (list dirs)))
543  (ext (if (listp ext)
544  ext
545  (list ext)))
546  files)
547  (mapc
548  (lambda (x)
549  (mapc
550  (lambda (y)
551  (setq files
552  (append files
553  (file-expand-wildcards
554  (concat (file-name-as-directory x) "*" y)))))
555  ext))
556  dirs)
557  (mapc
558  (lambda (x)
559  (when (or (string-match "/.#" x)
560  (string-match "#$" x))
561  (setq files (delete x files))))
562  files)
563  files))
564 
565 (defvar org-agenda-directories (list org-directory
566  (join-paths user-lab-directory "org")
567  (join-paths company-source-directory "org/*"))
568  "List of directories containing org files.")
569 (defvar org-agenda-extensions '(".org")
570  "List of extensions of agenda files")
571 
572 (defun org-set-agenda-files ()
573  (interactive)
574  (setq org-agenda-files
575  (org-list-files
576  org-agenda-directories
577  org-agenda-extensions)))
578 
579 (with-eval-after-load 'org
580  (org-set-agenda-files))
581 
582 ;;; Skel Config
583 (use-package skel
584  :requires skel
585  :load-path user-emacs-lib-directory
586  :custom
587  tempo-interactive t
588  auto-insert 'no-modify
589  auto-insert-query nil)
590 
591 (use-package skt
592  :requires (skel skt)
593  :load-path user-emacs-lib-directory
594  :custom
595  skt-enable-tempo-elements t
596  skt-delete-duplicate-marks t
597  :config
598  (defvar skt-default-version "0.1.0")
599  (keymap-set skt-minor-mode-map "b" #'tempo-backward-mark)
600  (keymap-set skt-minor-mode-map "f" #'tempo-forward-mark)
601  (keymap-set skt-minor-mode-map "SPC" #'tempo-complete-tag)
602  (keymap-set skt-minor-mode-map "t" #'skt-add-tag)
603 
604  (defvar skt-skeleton-path-function #'abbreviate-file-name
605  "Function to be called when expanding file-header skeletons. Useful to
606 rebind locally inside a project or module, where you want to delete some
607 prefix or replace it.")
608 
609  (defun skt-buffer-path (&optional function)
610  (let ((path (or buffer-file-name (format "%s.lisp" (gensym "scratch-")))))
611  (funcall (or function skt-skeleton-path-function) path)))
612 
613  (defun skt-skelfile-path ()
614  (if (string= (file-name-nondirectory buffer-file-name) "skelfile")
615  "skelfile"
616  (skt-buffer-path)))
617 
618  ;; functions
619  (skt-define-function capture (:abbrev "capture" :tag t) org-capture)
620  (skt-define-function agenda (:abbrev "agenda" :tag t) org-agenda)
621  (skt-define-function mjump (:abbrev "mjump" :tag t) bookmark-jump)
622  (skt-define-function bjump (:abbrev "bjump" :tag t) ibuffer-jump)
623  (skt-define-function rjump (:abbrev "rjump" :tag t)
624  (lambda () (jump-to-register (read-char "register: "))))
625  (skt-define-function pjump (:abbrev "pjump" :tag t) (lambda () (project-switch-project default-directory)))
626 
627  ;; templates
628  (skt-define-template readme (:mode org-mode :tag t)
629  "#+title: " (p "title: ") n
630  "#+description: " (p "description: ") n
631  "#+author: " user-full-name n
632  "#+email:" user-mail-address n
633  "#+setupfile: clean.theme" n
634  "#+export_file_name: index" n>
635  p n> n>
636  ":info:" n>
637  "+ version :: " skt-default-version n
638  ":end:" n>)
639 
640  (skt-define-template clean.theme (:mode org-mode :tag t)
641  "#+setupfile: " (join-paths company-cdn-url "org/clean.theme"))
642 
643  ;; TODO 2024-06-04:
644  ;; (skt-define-template defsystem (:mode lisp-mode :tag t :abbrev "defsystem"))
645  ;; (skt-define-template defpackage (:mode lisp-mode :tag t :abbrev "defpackage"))
646  ;; (skt-define-template defpkg (:mode lisp-mode :tag t :abbrev "defpkg"))
647 
648  (skt-define-template defmacro (:abbrev "(defmacro" :tag t :mode lisp-mode)
649  "(defmacro " (p "Name: ") " (" (p "Args: ") ")" > n> r ")")
650 
651  (skt-define-template defun (:abbrev "(defun" :tag t :mode lisp-mode)
652  "(defun " (p "Name: ") " (" (p "Args: ") ")" > n> r ")")
653 
654  (skt-define-template defvar (:abbrev "(defvar" :tag t :mode lisp-mode)
655  > "(defvar " > r ")")
656 
657  ;; skeletons
658  (skt-define-skeleton head (:abbrev "head" :mode lisp-mode)
659  "description: "
660  ";;; " (skt-buffer-path 'file-name-nondirectory) " --- " str \n \n ";; " _ \n \n ";;; Code:" \n >)
661 
662  (skt-define-skeleton head (:abbrev "head" :mode skel-mode)
663  "description: "
664  ";;; " (skt-skelfile-path) " --- " str " -*- mode: skel; -*-" \n _)
665 
666  (skt-define-skeleton head (:abbrev "head" :mode org-mode)
667  "title: "
668  "#+title: " str \n
669  "#+author: " (skeleton-read "author: ") \n
670  "#+description: " (skeleton-read "description: ") \n
671  "#+setupfile: clean.theme" \n > _)
672 
673  (skt-define-skeleton head (:abbrev "head" :mode rust-mode)
674  "description: "
675  "//! " (skt-buffer-path 'file-name-nondirectory) " --- " str \n \n "// " _ \n \n "//! Code: " \n >)
676 
677  (skt-define-skeleton system-head (:abbrev "system-head" :mode lisp-mode)
678  "system-name: "
679  ";;; " (skt-buffer-path) " --- "
680  '(setq v1 (file-name-base (skt-buffer-path))) (capitalize v1)
681  " Sytem Definitions" \n
682  > "(defsystem :" v1 \n
683  > ":depends-on (:std :log)" \n
684  > ":components ((:file \"pkg\")" _ "))")
685 
686  (skt-define-skeleton pkg-head (:abbrev "pkg-head" :mode lisp-mode)
687  "ignored"
688  ";;; " (skt-buffer-path 'file-name-nondirectory) " --- "
689  '(setq v1 (skeleton-read "name: ")) v1 " Package Definitions" \n
690  > "(defpkg :" v1 \n
691  > ":use (:std :log))" \n \n
692  > "(in-package :" v1 ")" \n >)
693 
694  (skt-define-skeleton crate-head (:abbrev "crate-head" :mode conf-toml-mode)
695  "ignored"
696  "### " (skt-buffer-path 'file-name-nondirectory) " --- "
697  '(setq v1 (skeleton-read "name: ")) v1 " Cargo Manifest" \n >
698  "[package]" \n
699  "name = \"" v1 "\"" \n
700  "version = \"" skt-default-version "\"" \n
701  "[dependencies]" \n >)
702 
703  (skt-define-skeleton local-vars
704  (:tag t :abbrev "local-vars"
705  :docstring "Insert a local variables section. Use current comment syntax if any.")
706  (completing-read "Mode: " obarray
707  (lambda (symbol)
708  (if (commandp symbol)
709  (string-match "-mode$" (symbol-name symbol))))
710  t)
711  '(save-excursion
712  (if (re-search-forward page-delimiter nil t)
713  (error "Not on last page")))
714  comment-start "Local Variables:" comment-end \n
715  comment-start "mode: " str
716  & -5 | '(kill-line 0) & -1 | comment-end \n
717  ( (completing-read (format "Variable, %s: " skeleton-subprompt)
718  obarray
719  (lambda (symbol)
720  (or (eq symbol 'eval)
721  (custom-variable-p symbol)))
722  t)
723  comment-start str ": "
724  (read-from-minibuffer "Expression: " nil read-expression-map nil
725  'read-expression-history) | _
726  comment-end \n)
727  resume:
728  comment-start "End:" comment-end \n)
729 
730  ;; autoinsert
731  (skt-register-auto-insert "skelfile" #'skt-template-skel-head)
732  (skt-register-auto-insert "readme.org" #'skt-template-org-readme)
733  (skt-register-auto-insert "Cargo.toml" #'skt-template-conf-toml-crate-head)
734  (skt-register-auto-insert "pkg.lisp" #'skt-template-lisp-pkg-head)
735  (skt-register-auto-insert ".*[.]asd" #'skt-template-lisp-system-head)
736  (skt-register-auto-insert ".*[.]lisp" #'skt-template-lisp-head)
737  (skt-register-auto-insert ".*[.].rs" #'skt-template-rust-head)
738  (auto-insert-mode t)
739  (keymap-set skel-minor-mode-map "C-<return>" 'company-tempo))
740 
741 ;;; dictionary
742 ;; requires dictd server running
743 (setq dictionary-server "compiler.company")
744 ;;; ispell
745 ;; requires aspell and a hunspell dictionary (hunspell-en_us)
746 (setq-default ispell-program-name "aspell")
747 (add-hook 'mail-send-hook #'ispell-message)
748 ;;; glossary
749 (with-eval-after-load 'org-glossary
750  (setq org-glossary-collection-root (join-paths company-source-directory "org/meta/"))
751  (cl-pushnew '("Terms" . glossary) org-glossary-headings)
752  (cl-pushnew '("Acronyms" . acronym) org-glossary-headings))
753 
754 (provide 'ellis)
755 ;;; ellis.el ends here