# HG changeset patch
# User Richard Westhaver <ellis@rwest.io>
# Date 1717458043 14400
# Node ID 20209a75a410210b211f719730b19d447b9809d6
# Parent  614d9cfe96a2da5bd9d780a6409462208fe3e543# Parent  6eef2d50b7fda52a838350d0c5d4d89e7e70bd51
merge from ellis@zor

diff -r 614d9cfe96a2 -r 20209a75a410 .emacs.d/ellis.el
--- a/.emacs.d/ellis.el	Sat Jun 01 23:39:05 2024 -0400
+++ b/.emacs.d/ellis.el	Mon Jun 03 19:40:43 2024 -0400
@@ -33,7 +33,7 @@
 
 (setopt default-theme 'modus-vivendi-tritanopia
         user-lab-directory (join-paths user-home-directory "lab")
-        company-source-directory (join-paths user-lab-directory "comp"))
+        company-source-directory (join-paths user-home-directory "comp"))
 
 (unless (display-graphic-p) (setq default-theme 'wheatgrass))
 
@@ -52,11 +52,11 @@
 (keymap-set user-map "e c" #'edit-emacs-config)
 (keymap-set emacs-lisp-mode-map "C-c C-l" #'load-file)
 (keymap-set emacs-lisp-mode-map "C-c M-k" #'elisp-byte-compile-file)
+(keymap-set user-map "v t" #'org-tags-view)
 
 (require 'paredit)
-(add-hook 'common-lisp-mode-hook #'enable-paredit-mode)
-(add-hook 'emacs-lisp-mode-hook #'enable-paredit-mode)
-
+(add-hook 'lisp-mode-hook #'enable-paredit-mode)
+(add-hook 'slime-editing-mode-hook #'enable-paredit-mode)
 (repeat-mode)
 
 (defun remember-project ()
@@ -68,6 +68,10 @@
   (interactive)
   (project-remember-projects-under user-lab-directory t))
 
+(defun remember-comp-projects ()
+  (interactive)
+  (project-remember-projects-under company-source-directory t))
+
 (keymap-global-set "C-<tab>" #'hippie-expand)
 (keymap-set minibuffer-local-map "C-<tab>" #'hippie-expand)
 (keymap-set ctl-x-x-map "p p" #'remember-project)
@@ -242,6 +246,7 @@
 			     (lisp . t)
 			     (org . t)
 			     (eshell . t)
+                             (calc . t)
 			     (sed . t)
 			     (awk . t)
 			     (dot . t)
@@ -286,5 +291,287 @@
 ;; strangerdanger
 (setq slime-enable-evaluate-in-emacs t)
 
+(defun org-word-count (beg end
+                           &optional count-latex-macro-args?
+                           count-footnotes?)
+  "Report the number of words in the Org mode buffer or selected region.
+Ignores:
+- comments
+- tables
+- source code blocks (#+BEGIN_SRC ... #+END_SRC, and inline blocks)
+- hyperlinks (but does count words in hyperlink descriptions)
+- tags, priorities, and TODO keywords in headers
+- sections tagged as 'not for export'.
+
+The text of footnote definitions is ignored, unless the optional argument
+COUNT-FOOTNOTES? is non-nil.
+
+If the optional argument COUNT-LATEX-MACRO-ARGS? is non-nil, the word count
+includes LaTeX macro arguments (the material between {curly braces}).
+Otherwise, and by default, every LaTeX macro counts as 1 word regardless
+of its arguments."
+  (interactive "r")
+  (unless mark-active
+    (setf beg (point-min)
+          end (point-max)))
+  (let ((wc 0)
+        (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}"))
+    (save-excursion
+      (goto-char beg)
+      (while (< (point) end)
+        (cond
+         ;; Ignore comments.
+         ((or (org-in-commented-line) (org-at-table-p))
+          nil)
+         ;; Ignore hyperlinks. But if link has a description, count
+         ;; the words within the description.
+         ((looking-at org-bracket-link-analytic-regexp)
+          (when (match-string-no-properties 5)
+            (let ((desc (match-string-no-properties 5)))
+              (save-match-data
+                (cl-incf wc (length (remove "" (org-split-string
+                                             desc "\\W")))))))
+          (goto-char (match-end 0)))
+         ((looking-at org-any-link-re)
+          (goto-char (match-end 0)))
+         ;; Ignore source code blocks.
+         ((org-in-regexps-block-p "^#\\+BEGIN_SRC\\W" "^#\\+END_SRC\\W")
+          nil)
+         ;; Ignore inline source blocks, counting them as 1 word.
+         ((save-excursion
+            (backward-char)
+            (looking-at org-babel-inline-src-block-regexp))
+          (goto-char (match-end 0))
+          (setf wc (+ 2 wc)))
+         ;; Count latex macros as 1 word, ignoring their arguments.
+         ((save-excursion
+            (backward-char)
+            (looking-at latex-macro-regexp))
+          (goto-char (if count-latex-macro-args?
+                         (match-beginning 2)
+                       (match-end 0)))
+          (setf wc (+ 2 wc)))
+         ;; Ignore footnotes.
+         ((and (not count-footnotes?)
+               (or (org-footnote-at-definition-p)
+                   (org-footnote-at-reference-p)))
+          nil)
+         (t
+          (let ((contexts (org-context)))
+            (cond
+             ;; Ignore tags and TODO keywords, etc.
+             ((or (assoc :todo-keyword contexts)
+                  (assoc :priority contexts)
+                  (assoc :keyword contexts)
+                  (assoc :checkbox contexts))
+              nil)
+             ;; Ignore sections marked with tags that are
+             ;; excluded from export.
+             ((assoc :tags contexts)
+              (if (intersection (org-get-tags-at) org-export-exclude-tags
+                                :test 'equal)
+                  (org-forward-same-level 1)
+                nil))
+             (t
+              (cl-incf wc))))))
+        (re-search-forward "\\w+\\W*")))
+    (message (format "%d words in %s." wc
+                     (if mark-active "region" "buffer")))))
+
+(defun org-check-misformatted-subtree ()
+  "Check misformatted entries in the current buffer."
+  (interactive)
+  (show-all)
+  (org-map-entries
+   (lambda ()
+     (when (and (move-beginning-of-line 2)
+                (not (looking-at org-heading-regexp)))
+       (if (or (and (org-get-scheduled-time (point))
+                    (not (looking-at (concat "^.*" org-scheduled-regexp))))
+               (and (org-get-deadline-time (point))
+                    (not (looking-at (concat "^.*" org-deadline-regexp)))))
+           (when (y-or-n-p "Fix this subtree? ")
+             (message "Call the function again when you're done fixing this subtree.")
+             (recursive-edit))
+         (message "All subtrees checked."))))))
+
+(defun org-sort-list-by-checkbox-type ()
+  "Sort list items according to Checkbox state."
+  (interactive)
+  (org-sort-list
+   nil ?f
+   (lambda ()
+     (if (looking-at org-list-full-item-re)
+         (cdr (assoc (match-string 3)
+                     '(("[X]" . 1) ("[-]" . 2) ("[ ]" . 3) (nil . 4))))
+       4))))
+
+(defun org-time-string-to-seconds (s)
+  "Convert a string HH:MM:SS to a number of seconds."
+  (cond
+   ((and (stringp s)
+         (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
+    (let ((hour (string-to-number (match-string 1 s)))
+          (min (string-to-number (match-string 2 s)))
+          (sec (string-to-number (match-string 3 s))))
+      (+ (* hour 3600) (* min 60) sec)))
+   ((and (stringp s)
+         (string-match "\\([0-9]+\\):\\([0-9]+\\)" s))
+    (let ((min (string-to-number (match-string 1 s)))
+          (sec (string-to-number (match-string 2 s))))
+      (+ (* min 60) sec)))
+   ((stringp s) (string-to-number s))
+   (t s)))
+
+(defun org-time-seconds-to-string (secs)
+  "Convert a number of seconds to a time string."
+  (cond ((>= secs 3600) (format-seconds "%h:%.2m:%.2s" secs))
+        ((>= secs 60) (format-seconds "%m:%.2s" secs))
+        (t (format-seconds "%s" secs))))
+
+(defmacro with-time (time-output-p &rest exprs)
+  "Evaluate an org-table formula, converting all fields that look
+like time data to integer seconds.  If TIME-OUTPUT-P then return
+the result as a time value."
+  (list
+   (if time-output-p 'org-time-seconds-to-string 'identity)
+   (cons 'progn
+         (mapcar
+          (lambda (expr)
+            `,(cons (car expr)
+                    (mapcar
+                     (lambda (el)
+                       (if (listp el)
+                           (list 'with-time nil el)
+                         (org-time-string-to-seconds el)))
+                     (cdr expr))))
+          `,@exprs))))
+
+(defun org-hex-strip-lead (str)
+  (if (and (> (length str) 2) (string= (substring str 0 2) "0x"))
+      (substring str 2) str))
+
+(defun org-hex-to-hex (int)
+  (format "0x%x" int))
+
+(defun org-hex-to-dec (str)
+  (cond
+   ((and (stringp str)
+         (string-match "\\([0-9a-f]+\\)" (setf str (org-hex-strip-lead str))))
+    (let ((out 0))
+      (mapc
+       (lambda (ch)
+         (setf out (+ (* out 16)
+                      (if (and (>= ch 48) (<= ch 57)) (- ch 48) (- ch 87)))))
+       (coerce (match-string 1 str) 'list))
+      out))
+   ((stringp str) (string-to-number str))
+   (t str)))
+
+(defmacro with-hex (hex-output-p &rest exprs)
+  "Evaluate an org-table formula, converting all fields that look
+    like hexadecimal to decimal integers.  If HEX-OUTPUT-P then
+    return the result as a hex value."
+  (list
+   (if hex-output-p 'org-hex-to-hex 'identity)
+   (cons 'progn
+         (mapcar
+          (lambda (expr)
+            `,(cons (car expr)
+                    (mapcar (lambda (el)
+                              (if (listp el)
+                                  (list 'with-hex nil el)
+                                (org-hex-to-dec el)))
+                            (cdr expr))))
+          `,@exprs))))
+
+(require 'mm-url) ; to include mm-url-decode-entities-string
+
+(defun org-insert-link-with-title ()
+  "Insert org link where default description is set to html title."
+  (interactive)
+  (let* ((url (read-string "URL: "))
+         (title (get-html-title-from-url url)))
+    (org-insert-link nil url title)))
+
+(defun get-html-title-from-url (url)
+  "Return content in <title> tag."
+  (let (x1 x2 (download-buffer (url-retrieve-synchronously url)))
+    (save-excursion
+      (set-buffer download-buffer)
+      (beginning-of-buffer)
+      (setq x1 (search-forward "<title>"))
+      (search-forward "</title>")
+      (setq x2 (search-backward "<"))
+      (mm-url-decode-entities-string (buffer-substring-no-properties x1 x2)))))
+
+(defun org-remove-empty-propert-drawers ()
+  "*Remove all empty property drawers in current file."
+  (interactive)
+  (unless (eq major-mode 'org-mode)
+    (error "You need to turn on Org mode for this function."))
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward ":PROPERTIES:" nil t)
+      (save-excursion
+        (org-remove-empty-drawer-at "PROPERTIES" (match-beginning 0))))))
+
+(defun check-for-clock-out-note ()
+      (interactive)
+      (save-excursion
+        (org-back-to-heading)
+        (let ((tags (org-get-tags)))
+          (and tags (message "tags: %s " tags)
+               (when (member "clocknote" tags)
+                 (org-add-note))))))
+
+(add-hook 'org-clock-out-hook 'check-for-clock-out-note)
+
+(defun org-list-files (dirs ext)
+  "Function to create list of org files in multiple subdirectories.
+This can be called to generate a list of files for
+org-agenda-files or org-refile-targets.
+
+DIRS is a list of directories.
+
+EXT is a list of the extensions of files to be included."
+  (let ((dirs (if (listp dirs)
+                  dirs
+                (list dirs)))
+        (ext (if (listp ext)
+                 ext
+               (list ext)))
+        files)
+    (mapc
+     (lambda (x)
+       (mapc
+        (lambda (y)
+          (setq files
+                (append files
+                        (file-expand-wildcards
+                         (concat (file-name-as-directory x) "*" y)))))
+        ext))
+     dirs)
+    (mapc
+     (lambda (x)
+       (when (or (string-match "/.#" x)
+                 (string-match "#$" x))
+         (setq files (delete x files))))
+     files)
+    files))
+
+(defvar org-agenda-directories (list org-directory user-lab-directory)
+  "List of directories containing org files.")
+(defvar org-agenda-extensions '(".org")
+  "List of extensions of agenda files")
+
+(defun org-set-agenda-files ()
+  (interactive)
+  (setq org-agenda-files (org-list-files
+                          org-agenda-directories
+                          org-agenda-extensions)))
+
+(add-hook 'after-init-hook 'org-set-agenda-files)
+
 (provide 'ellis)
 ;;; ellis.el ends here
diff -r 614d9cfe96a2 -r 20209a75a410 .sbclrc
--- a/.sbclrc	Sat Jun 01 23:39:05 2024 -0400
+++ b/.sbclrc	Mon Jun 03 19:40:43 2024 -0400
@@ -1,24 +1,19 @@
 ;;; .sbclrc --- sbcl init file -*- mode: common-lisp; -*-
 (require :asdf)
-;;; If a fasl was stale, try to recompile and load (once).
-(defmethod asdf:perform :around ((o asdf:load-op)
-                                 (c asdf:cl-source-file))
-  (handler-case (call-next-method o c)
-    ;; If a fasl was stale, try to recompile and load (once).
-    (sb-ext:invalid-fasl ()
-      (asdf:perform (make-instance 'asdf:compile-op) c)
-      (call-next-method))))
-
+(in-package :cl-user)
 (setq *debug-beginner-help-p* nil
       ;; *print-case* :downcase
       *print-level* 32
       *print-length* 256)
 
+(defvar *quicklisp-setup* (or (probe-file #P"/usr/local/share/lisp/quicklisp/setup.lisp")
+                              (probe-file (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))))
+
 #-quicklisp
-(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))))
-  (when (probe-file quicklisp-init)
-    (load quicklisp-init)))
+(when *quicklisp-setup*
+  (load *quicklisp-setup*))
 ;; (ql:quickload :clouseau)
+
 (defun include-projects-from (path)
   "Add PATH to QL;*LOCAL-PROJECT-DIRECTORIES* and ASDF:*CENTRAL-REGISTRY*."
   (pushnew path ql:*local-project-directories*)