changelog shortlog graph tags branches files raw help

Mercurial > infra > home / changeset: merge from ellis@zor

changeset 35: 20209a75a410
parent 29: 614d9cfe96a2 (current diff)
parent 34: 6eef2d50b7fd (diff)
child 36: 963513ec0fcd
author: Richard Westhaver <ellis@rwest.io>
date: Mon, 03 Jun 2024 19:40:43 -0400
files:
description: merge from ellis@zor
     1.1--- a/.emacs.d/ellis.el	Sat Jun 01 23:39:05 2024 -0400
     1.2+++ b/.emacs.d/ellis.el	Mon Jun 03 19:40:43 2024 -0400
     1.3@@ -33,7 +33,7 @@
     1.4 
     1.5 (setopt default-theme 'modus-vivendi-tritanopia
     1.6         user-lab-directory (join-paths user-home-directory "lab")
     1.7-        company-source-directory (join-paths user-lab-directory "comp"))
     1.8+        company-source-directory (join-paths user-home-directory "comp"))
     1.9 
    1.10 (unless (display-graphic-p) (setq default-theme 'wheatgrass))
    1.11 
    1.12@@ -52,11 +52,11 @@
    1.13 (keymap-set user-map "e c" #'edit-emacs-config)
    1.14 (keymap-set emacs-lisp-mode-map "C-c C-l" #'load-file)
    1.15 (keymap-set emacs-lisp-mode-map "C-c M-k" #'elisp-byte-compile-file)
    1.16+(keymap-set user-map "v t" #'org-tags-view)
    1.17 
    1.18 (require 'paredit)
    1.19-(add-hook 'common-lisp-mode-hook #'enable-paredit-mode)
    1.20-(add-hook 'emacs-lisp-mode-hook #'enable-paredit-mode)
    1.21-
    1.22+(add-hook 'lisp-mode-hook #'enable-paredit-mode)
    1.23+(add-hook 'slime-editing-mode-hook #'enable-paredit-mode)
    1.24 (repeat-mode)
    1.25 
    1.26 (defun remember-project ()
    1.27@@ -68,6 +68,10 @@
    1.28   (interactive)
    1.29   (project-remember-projects-under user-lab-directory t))
    1.30 
    1.31+(defun remember-comp-projects ()
    1.32+  (interactive)
    1.33+  (project-remember-projects-under company-source-directory t))
    1.34+
    1.35 (keymap-global-set "C-<tab>" #'hippie-expand)
    1.36 (keymap-set minibuffer-local-map "C-<tab>" #'hippie-expand)
    1.37 (keymap-set ctl-x-x-map "p p" #'remember-project)
    1.38@@ -242,6 +246,7 @@
    1.39 			     (lisp . t)
    1.40 			     (org . t)
    1.41 			     (eshell . t)
    1.42+                             (calc . t)
    1.43 			     (sed . t)
    1.44 			     (awk . t)
    1.45 			     (dot . t)
    1.46@@ -286,5 +291,287 @@
    1.47 ;; strangerdanger
    1.48 (setq slime-enable-evaluate-in-emacs t)
    1.49 
    1.50+(defun org-word-count (beg end
    1.51+                           &optional count-latex-macro-args?
    1.52+                           count-footnotes?)
    1.53+  "Report the number of words in the Org mode buffer or selected region.
    1.54+Ignores:
    1.55+- comments
    1.56+- tables
    1.57+- source code blocks (#+BEGIN_SRC ... #+END_SRC, and inline blocks)
    1.58+- hyperlinks (but does count words in hyperlink descriptions)
    1.59+- tags, priorities, and TODO keywords in headers
    1.60+- sections tagged as 'not for export'.
    1.61+
    1.62+The text of footnote definitions is ignored, unless the optional argument
    1.63+COUNT-FOOTNOTES? is non-nil.
    1.64+
    1.65+If the optional argument COUNT-LATEX-MACRO-ARGS? is non-nil, the word count
    1.66+includes LaTeX macro arguments (the material between {curly braces}).
    1.67+Otherwise, and by default, every LaTeX macro counts as 1 word regardless
    1.68+of its arguments."
    1.69+  (interactive "r")
    1.70+  (unless mark-active
    1.71+    (setf beg (point-min)
    1.72+          end (point-max)))
    1.73+  (let ((wc 0)
    1.74+        (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}"))
    1.75+    (save-excursion
    1.76+      (goto-char beg)
    1.77+      (while (< (point) end)
    1.78+        (cond
    1.79+         ;; Ignore comments.
    1.80+         ((or (org-in-commented-line) (org-at-table-p))
    1.81+          nil)
    1.82+         ;; Ignore hyperlinks. But if link has a description, count
    1.83+         ;; the words within the description.
    1.84+         ((looking-at org-bracket-link-analytic-regexp)
    1.85+          (when (match-string-no-properties 5)
    1.86+            (let ((desc (match-string-no-properties 5)))
    1.87+              (save-match-data
    1.88+                (cl-incf wc (length (remove "" (org-split-string
    1.89+                                             desc "\\W")))))))
    1.90+          (goto-char (match-end 0)))
    1.91+         ((looking-at org-any-link-re)
    1.92+          (goto-char (match-end 0)))
    1.93+         ;; Ignore source code blocks.
    1.94+         ((org-in-regexps-block-p "^#\\+BEGIN_SRC\\W" "^#\\+END_SRC\\W")
    1.95+          nil)
    1.96+         ;; Ignore inline source blocks, counting them as 1 word.
    1.97+         ((save-excursion
    1.98+            (backward-char)
    1.99+            (looking-at org-babel-inline-src-block-regexp))
   1.100+          (goto-char (match-end 0))
   1.101+          (setf wc (+ 2 wc)))
   1.102+         ;; Count latex macros as 1 word, ignoring their arguments.
   1.103+         ((save-excursion
   1.104+            (backward-char)
   1.105+            (looking-at latex-macro-regexp))
   1.106+          (goto-char (if count-latex-macro-args?
   1.107+                         (match-beginning 2)
   1.108+                       (match-end 0)))
   1.109+          (setf wc (+ 2 wc)))
   1.110+         ;; Ignore footnotes.
   1.111+         ((and (not count-footnotes?)
   1.112+               (or (org-footnote-at-definition-p)
   1.113+                   (org-footnote-at-reference-p)))
   1.114+          nil)
   1.115+         (t
   1.116+          (let ((contexts (org-context)))
   1.117+            (cond
   1.118+             ;; Ignore tags and TODO keywords, etc.
   1.119+             ((or (assoc :todo-keyword contexts)
   1.120+                  (assoc :priority contexts)
   1.121+                  (assoc :keyword contexts)
   1.122+                  (assoc :checkbox contexts))
   1.123+              nil)
   1.124+             ;; Ignore sections marked with tags that are
   1.125+             ;; excluded from export.
   1.126+             ((assoc :tags contexts)
   1.127+              (if (intersection (org-get-tags-at) org-export-exclude-tags
   1.128+                                :test 'equal)
   1.129+                  (org-forward-same-level 1)
   1.130+                nil))
   1.131+             (t
   1.132+              (cl-incf wc))))))
   1.133+        (re-search-forward "\\w+\\W*")))
   1.134+    (message (format "%d words in %s." wc
   1.135+                     (if mark-active "region" "buffer")))))
   1.136+
   1.137+(defun org-check-misformatted-subtree ()
   1.138+  "Check misformatted entries in the current buffer."
   1.139+  (interactive)
   1.140+  (show-all)
   1.141+  (org-map-entries
   1.142+   (lambda ()
   1.143+     (when (and (move-beginning-of-line 2)
   1.144+                (not (looking-at org-heading-regexp)))
   1.145+       (if (or (and (org-get-scheduled-time (point))
   1.146+                    (not (looking-at (concat "^.*" org-scheduled-regexp))))
   1.147+               (and (org-get-deadline-time (point))
   1.148+                    (not (looking-at (concat "^.*" org-deadline-regexp)))))
   1.149+           (when (y-or-n-p "Fix this subtree? ")
   1.150+             (message "Call the function again when you're done fixing this subtree.")
   1.151+             (recursive-edit))
   1.152+         (message "All subtrees checked."))))))
   1.153+
   1.154+(defun org-sort-list-by-checkbox-type ()
   1.155+  "Sort list items according to Checkbox state."
   1.156+  (interactive)
   1.157+  (org-sort-list
   1.158+   nil ?f
   1.159+   (lambda ()
   1.160+     (if (looking-at org-list-full-item-re)
   1.161+         (cdr (assoc (match-string 3)
   1.162+                     '(("[X]" . 1) ("[-]" . 2) ("[ ]" . 3) (nil . 4))))
   1.163+       4))))
   1.164+
   1.165+(defun org-time-string-to-seconds (s)
   1.166+  "Convert a string HH:MM:SS to a number of seconds."
   1.167+  (cond
   1.168+   ((and (stringp s)
   1.169+         (string-match "\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
   1.170+    (let ((hour (string-to-number (match-string 1 s)))
   1.171+          (min (string-to-number (match-string 2 s)))
   1.172+          (sec (string-to-number (match-string 3 s))))
   1.173+      (+ (* hour 3600) (* min 60) sec)))
   1.174+   ((and (stringp s)
   1.175+         (string-match "\\([0-9]+\\):\\([0-9]+\\)" s))
   1.176+    (let ((min (string-to-number (match-string 1 s)))
   1.177+          (sec (string-to-number (match-string 2 s))))
   1.178+      (+ (* min 60) sec)))
   1.179+   ((stringp s) (string-to-number s))
   1.180+   (t s)))
   1.181+
   1.182+(defun org-time-seconds-to-string (secs)
   1.183+  "Convert a number of seconds to a time string."
   1.184+  (cond ((>= secs 3600) (format-seconds "%h:%.2m:%.2s" secs))
   1.185+        ((>= secs 60) (format-seconds "%m:%.2s" secs))
   1.186+        (t (format-seconds "%s" secs))))
   1.187+
   1.188+(defmacro with-time (time-output-p &rest exprs)
   1.189+  "Evaluate an org-table formula, converting all fields that look
   1.190+like time data to integer seconds.  If TIME-OUTPUT-P then return
   1.191+the result as a time value."
   1.192+  (list
   1.193+   (if time-output-p 'org-time-seconds-to-string 'identity)
   1.194+   (cons 'progn
   1.195+         (mapcar
   1.196+          (lambda (expr)
   1.197+            `,(cons (car expr)
   1.198+                    (mapcar
   1.199+                     (lambda (el)
   1.200+                       (if (listp el)
   1.201+                           (list 'with-time nil el)
   1.202+                         (org-time-string-to-seconds el)))
   1.203+                     (cdr expr))))
   1.204+          `,@exprs))))
   1.205+
   1.206+(defun org-hex-strip-lead (str)
   1.207+  (if (and (> (length str) 2) (string= (substring str 0 2) "0x"))
   1.208+      (substring str 2) str))
   1.209+
   1.210+(defun org-hex-to-hex (int)
   1.211+  (format "0x%x" int))
   1.212+
   1.213+(defun org-hex-to-dec (str)
   1.214+  (cond
   1.215+   ((and (stringp str)
   1.216+         (string-match "\\([0-9a-f]+\\)" (setf str (org-hex-strip-lead str))))
   1.217+    (let ((out 0))
   1.218+      (mapc
   1.219+       (lambda (ch)
   1.220+         (setf out (+ (* out 16)
   1.221+                      (if (and (>= ch 48) (<= ch 57)) (- ch 48) (- ch 87)))))
   1.222+       (coerce (match-string 1 str) 'list))
   1.223+      out))
   1.224+   ((stringp str) (string-to-number str))
   1.225+   (t str)))
   1.226+
   1.227+(defmacro with-hex (hex-output-p &rest exprs)
   1.228+  "Evaluate an org-table formula, converting all fields that look
   1.229+    like hexadecimal to decimal integers.  If HEX-OUTPUT-P then
   1.230+    return the result as a hex value."
   1.231+  (list
   1.232+   (if hex-output-p 'org-hex-to-hex 'identity)
   1.233+   (cons 'progn
   1.234+         (mapcar
   1.235+          (lambda (expr)
   1.236+            `,(cons (car expr)
   1.237+                    (mapcar (lambda (el)
   1.238+                              (if (listp el)
   1.239+                                  (list 'with-hex nil el)
   1.240+                                (org-hex-to-dec el)))
   1.241+                            (cdr expr))))
   1.242+          `,@exprs))))
   1.243+
   1.244+(require 'mm-url) ; to include mm-url-decode-entities-string
   1.245+
   1.246+(defun org-insert-link-with-title ()
   1.247+  "Insert org link where default description is set to html title."
   1.248+  (interactive)
   1.249+  (let* ((url (read-string "URL: "))
   1.250+         (title (get-html-title-from-url url)))
   1.251+    (org-insert-link nil url title)))
   1.252+
   1.253+(defun get-html-title-from-url (url)
   1.254+  "Return content in <title> tag."
   1.255+  (let (x1 x2 (download-buffer (url-retrieve-synchronously url)))
   1.256+    (save-excursion
   1.257+      (set-buffer download-buffer)
   1.258+      (beginning-of-buffer)
   1.259+      (setq x1 (search-forward "<title>"))
   1.260+      (search-forward "</title>")
   1.261+      (setq x2 (search-backward "<"))
   1.262+      (mm-url-decode-entities-string (buffer-substring-no-properties x1 x2)))))
   1.263+
   1.264+(defun org-remove-empty-propert-drawers ()
   1.265+  "*Remove all empty property drawers in current file."
   1.266+  (interactive)
   1.267+  (unless (eq major-mode 'org-mode)
   1.268+    (error "You need to turn on Org mode for this function."))
   1.269+  (save-excursion
   1.270+    (goto-char (point-min))
   1.271+    (while (re-search-forward ":PROPERTIES:" nil t)
   1.272+      (save-excursion
   1.273+        (org-remove-empty-drawer-at "PROPERTIES" (match-beginning 0))))))
   1.274+
   1.275+(defun check-for-clock-out-note ()
   1.276+      (interactive)
   1.277+      (save-excursion
   1.278+        (org-back-to-heading)
   1.279+        (let ((tags (org-get-tags)))
   1.280+          (and tags (message "tags: %s " tags)
   1.281+               (when (member "clocknote" tags)
   1.282+                 (org-add-note))))))
   1.283+
   1.284+(add-hook 'org-clock-out-hook 'check-for-clock-out-note)
   1.285+
   1.286+(defun org-list-files (dirs ext)
   1.287+  "Function to create list of org files in multiple subdirectories.
   1.288+This can be called to generate a list of files for
   1.289+org-agenda-files or org-refile-targets.
   1.290+
   1.291+DIRS is a list of directories.
   1.292+
   1.293+EXT is a list of the extensions of files to be included."
   1.294+  (let ((dirs (if (listp dirs)
   1.295+                  dirs
   1.296+                (list dirs)))
   1.297+        (ext (if (listp ext)
   1.298+                 ext
   1.299+               (list ext)))
   1.300+        files)
   1.301+    (mapc
   1.302+     (lambda (x)
   1.303+       (mapc
   1.304+        (lambda (y)
   1.305+          (setq files
   1.306+                (append files
   1.307+                        (file-expand-wildcards
   1.308+                         (concat (file-name-as-directory x) "*" y)))))
   1.309+        ext))
   1.310+     dirs)
   1.311+    (mapc
   1.312+     (lambda (x)
   1.313+       (when (or (string-match "/.#" x)
   1.314+                 (string-match "#$" x))
   1.315+         (setq files (delete x files))))
   1.316+     files)
   1.317+    files))
   1.318+
   1.319+(defvar org-agenda-directories (list org-directory user-lab-directory)
   1.320+  "List of directories containing org files.")
   1.321+(defvar org-agenda-extensions '(".org")
   1.322+  "List of extensions of agenda files")
   1.323+
   1.324+(defun org-set-agenda-files ()
   1.325+  (interactive)
   1.326+  (setq org-agenda-files (org-list-files
   1.327+                          org-agenda-directories
   1.328+                          org-agenda-extensions)))
   1.329+
   1.330+(add-hook 'after-init-hook 'org-set-agenda-files)
   1.331+
   1.332 (provide 'ellis)
   1.333 ;;; ellis.el ends here
     2.1--- a/.sbclrc	Sat Jun 01 23:39:05 2024 -0400
     2.2+++ b/.sbclrc	Mon Jun 03 19:40:43 2024 -0400
     2.3@@ -1,24 +1,19 @@
     2.4 ;;; .sbclrc --- sbcl init file -*- mode: common-lisp; -*-
     2.5 (require :asdf)
     2.6-;;; If a fasl was stale, try to recompile and load (once).
     2.7-(defmethod asdf:perform :around ((o asdf:load-op)
     2.8-                                 (c asdf:cl-source-file))
     2.9-  (handler-case (call-next-method o c)
    2.10-    ;; If a fasl was stale, try to recompile and load (once).
    2.11-    (sb-ext:invalid-fasl ()
    2.12-      (asdf:perform (make-instance 'asdf:compile-op) c)
    2.13-      (call-next-method))))
    2.14-
    2.15+(in-package :cl-user)
    2.16 (setq *debug-beginner-help-p* nil
    2.17       ;; *print-case* :downcase
    2.18       *print-level* 32
    2.19       *print-length* 256)
    2.20 
    2.21+(defvar *quicklisp-setup* (or (probe-file #P"/usr/local/share/lisp/quicklisp/setup.lisp")
    2.22+                              (probe-file (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))))
    2.23+
    2.24 #-quicklisp
    2.25-(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))))
    2.26-  (when (probe-file quicklisp-init)
    2.27-    (load quicklisp-init)))
    2.28+(when *quicklisp-setup*
    2.29+  (load *quicklisp-setup*))
    2.30 ;; (ql:quickload :clouseau)
    2.31+
    2.32 (defun include-projects-from (path)
    2.33   "Add PATH to QL;*LOCAL-PROJECT-DIRECTORIES* and ASDF:*CENTRAL-REGISTRY*."
    2.34   (pushnew path ql:*local-project-directories*)