changelog shortlog graph tags branches changeset files revisions annotate raw help

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

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