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*)