;;;;;;;;;;;;;;;;;;;;;; -*- lexical-binding: t -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; .emacs file (http://svn.red-bean.com/repos/kfogel/trunk/.emacs) ;;; ;;; ;;; ;;; Summary: Some decades' worth of Emacs customizations. ;;; ;;; ;;; ;;; Copyright (C) 1992-2023 Karl Fogel ;;; ;;; ;;; ;;; This software is released under the GNU General Public License as ;;; ;;; published by the Free Software Foundation, either version 3 of the ;;; ;;; License, or (at your option) any later version. ;;; ;;; ;;; ;;; This software is distributed in the hope that it will be useful, ;;; ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; ;;; GNU General Public License for more details. ;;; ;;; ;;; ;;; ===================================================================== ;;; ;;; ;;; ;;; (This descends from Jim Blandy's even more ancient .emacs, but I ;;; ;;; don't think he keeps his online.) ;;; ;;; ;;; ;;; Where to start: ;;; ;;; --------------- ;;; ;;; ;;; ;;; Much of this is miscelleaneous editing helpers, customizations, ;;; ;;; and convenience functions, but there are some larger multi-function ;;; ;;; subsystems too. The `kf-' prefix is just to make a namespace, but ;;; ;;; note that some things with that prefix were actually contributed by ;;; ;;; by others. Detailed history is available from the repository via ;;; ;;; 'svn blame https://svn.red-bean.com/repos/kfogel/trunk/.emacs'. ;;; ;;; ;;; ;;; The custom functions I use most often are the following: ;;; ;;; ;;; ;;; - `kf-flush-lines' ;;; ;;; - `kf-remove-line-break-in-paragraph' ;;; ;;; - `kf-jump-there' ;;; ;;; - `kf-surround-with' ;;; ;;; - `kf-push-to-column' ;;; ;;; - `kf-prefixed-yank' ;;; ;;; - `kf-inspire-url' ;;; ;;; - `kf-show-change' ;;; ;;; - `kf-delete-blank-or-header-char' ;;; ;;; - `kf-fix-previous-transposition' ;;; ;;; - `kf-log-message' ;;; ;;; - `kf-find-usual-suspect' ;;; ;;; - `kf-org-add-level' ;;; ;;; - `kf-browse-region' and `kf-browse-buffer' ;;; ;;; - `kf-browse-markdown' ;;; ;;; - `kf-number-lines' ;;; ;;; - `kf-uniqify' ;;; ;;; - `kf-sort-lines' ;;; ;;; - `kf-count-fold-lines' ;;; ;;; - `kf-reverse-lines-region' ;;; ;;; - `kf-switch-handler-i' ;;; ;;; - `kf-switch-handler-u' ;;; ;;; - `kf-switch-handler-y' ;;; ;;; - `kf-remove-text-properties' ;;; ;;; ;;; ;;; For more, look in the section "Custom keybindings", which shows all ;;; ;;; the custom interactive functions that I've bound to a key. ;;; ;;; ;;; ;;; For sheer weirdness, see `kf-gene-translate-region'. If you edit ;;; ;;; Chinese but are not a native reader/writer, `kf-pinyin-from-char' ;;; ;;; and `kf-pinyin-from-region' might be useful. ;;; ;;; ;;; ;;; There are also some functions that I wrote, and which I frequently ;;; ;;; use, that live in my company's Emacs Lisp customization repository: ;;; ;;; https://code.librehq.com/ots/ots-tools/-/blob/main/emacs-tools/ots.el ;;; ;;; In particular, see `ots-day-from-date', `ots-copy-link', the various ;;; ;;; Org Mode extensions (especially `ots-org-display-headings-to-point'), ;;; ;;; `ots-increment-date-at-point', and `ots-decrement-date-at-point'. ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 2016-09-05: I haven't really gotten into ELPA yet -- I usually ;; install non-stock packages from upstream source -- but ELPA seems ;; like a Good Thing and is probably The Future (for example, see ;; http://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00780.html). ;; So having ELPA initialization in my .emacs is an acknowledgement of ;; the inevitability of that future, even if I'm not living in it yet. ;; ;; See https://elpa.gnu.org/, https://www.emacswiki.org/emacs/ELPA, ;; and http://ergoemacs.org/emacs/emacs_package_system.html for more. ;; ;; Added by Package.el. This must come before configurations of ;; installed packages. Don't delete this line. If you don't want it, ;; just comment it out by adding a semicolon to the start of the line. ;; You may delete these explanatory comments. ;; ;; (package-initialize) ;; Sorry, font-lock was too slow and too easy to confuse. Hey ;; everybody, I've got an idea -- let's write a syntax-aware text ;; editor using a Lisp variant that garbage collects in slow motion ;; and that had the idea of text-properties tacked on as an ;; afterthought late in its career! Yeah! ;; ;; 15 Aug 2000: No wait, it's gotten better, let's try it. (or (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version) (global-font-lock-mode 1)) ;; In fact, try it everywhere (setq font-lock-maximum-size (list (cons 'change-log-mode nil) (cons t (if (boundp 'font-lock-maximum-size) font-lock-maximum-size 256000)))) ;; Yes, I want the full details of my misfortunes: (setq garbage-collection-messages t) ;; The warning came far, far too late for me anyway. (setq initial-scratch-message nil) ;; Emacs should just have code that automatically sets this threshold ;; according to some function involving a constant, the current date, ;; and Moore's Law. (setq large-file-warning-threshold 500000000) ;; I don't want the bell to play loudly out of the big speakers I ;; might be playing beautiful Scarlatti on. (setq ring-bell-function 'ignore) ;; That was a surprise I didn't need. (setq authinfo-hidden nil) ;; Okay, granted this would be a little silly if uncommented as-is. ;; But I just wanted it here so that later, if I decide to change the ;; settings for those interactive security checks for TLS and whatnot, ;; I'll stand some chance of finding this. ;; ;; (setq network-security-protocol-checks ;; network-security-protocol-checks) ;; ;; See also these recent entries in etc/NEWS: ;; ;; +++ ;; ** The Network Security Manager now allows more fine-grained control ;; of what checks to run via the 'network-security-protocol-checks' ;; variable. ;; ;; +++ ;; ** TLS connections have their security tightened by default. ;; Most of the checks for outdated, believed-to-be-weak TLS algorithms ;; and ciphers are now switched on by default. (In addition, several new ;; TLS weaknesses are now warned about.) By default, the NSM will ;; flag connections using these weak algorithms and ask users whether to ;; allow them. To get the old behavior back (where certificates are ;; checked for validity, but no warnings about weak cryptography are ;; issued), you can either set 'network-security-protocol-checks' to nil, ;; or adjust the elements in that variable to only happen on the 'high' ;; security level (assuming you use the 'medium' level). ;; ;; +++ ;; ** Native GnuTLS connections can now use client certificates. ;; Previously, this support was only available when using the external ;; 'gnutls-cli' command. Call 'open-network-stream' with ;; ':client-certificate t' to trigger looking up of per-server ;; certificates via 'auth-source'. ;; At maxb's request. (when (string-match "^\\(new\\)?sp\\." (system-name)) (setq make-backup-files nil)) ;; At my request. (defun kf-backup-enable-predicate (abs_path) "Return t iff backups should be made for this buffer's file. You can use this function as a value of `backup-enable-predicate'." (let ((basename (file-name-nondirectory abs_path))) (if (catch 'match (save-match-data (dolist (regexp (list "svn-commit\\..*tmp" "svn-prop\\..*tmp" "logv.out")) (when (string-match regexp basename) (throw 'match t))))) nil (normal-backup-enable-predicate abs_path)))) (setq backup-enable-predicate 'kf-backup-enable-predicate) (defconst kf-laptop (save-match-data (let ((sysname (system-name))) (if (or (string-match "kwork" sysname) (string-match "klen" sysname) (string-match "kwarm" sysname) (string-match "ktab" sysname) (string-match "knet" sysname) (string-match "klib" sysname) (string-match "hereford" sysname) (string-match "ktravel" sysname) (string-match "kslab" sysname)) (match-string 0 sysname) nil))) "The short hostname if this is one of my standard laptops, else nil.") (defconst kf-prod-box (or kf-laptop (string-match "floss" (system-name)) (string-match "mused" (system-name)) (string-match "kwork" (system-name)) (string-match "hlen" (system-name)) (string-match "khip" (system-name)) (string-match "khmed" (system-name)) (string-match "hummy" (system-name)) (string-match "hereford" (system-name)) (string-match "khpd" (system-name)) (string-match "mcfan" (system-name)) (string-match "tcs" (system-name)) (string-match "tcd" (system-name)) (string-match "opzibn" (system-name)) (string-match "libq" (system-name)) ) "Non-nil iff this one of my standard production boxes.") ;;; I have joined the Org Mode cult. See http://OrgMode.org/. ;; Use the latest org mode code and documentation, if available. ;; Git repos is git://orgmode.org/org-mode.git, in case you want it. ;; ;; But if there is a file named "STOP" at the top level of the local ;; org source tree, then just use the Org Mode that ships with Emacs. ;; This is so that when something is (hopefully temporarily) wonky ;; with the latest upstream Org Mode, I can just "turn it off" ;; (without actually removing it, since I do want to check on it from ;; time to time) and get my regular work done. An example of how ;; something might be wonky would be the time on 2022-08-25 (with ;; emacs-repository-version 34686263b7459f) when trying to build Org ;; Mode commit 3c11e9df6e8353a with that Emacs resulted in errors: ;; ;; $ cd ~/src/org-mode ;; $ make ;; [... blah blah blah ...] ;; make[1]: Entering directory '/home/kfogel/src/org-mode/lisp' ;; rm -f org-version.el org-loaddefs.el org-version.elc org-loaddefs.elc org-install.elc ;; org-version: 9.5.4 (release_9.5.4-758-g3c11e9) ;; Loading /home/kfogel/src/org-mode/lisp/org-compat.el (source)... ;; ;; Error: error ("Eager macro-expansion failure: (void-function byte-compile-warn-obsolete)") ;; mapbacktrace(#f(compiled-function (evald func args flags) #)) ;; debug-early-backtrace() ;; debug-early(error (error "Eager macro-expansion failure: (void-function byte-compile-warn-obsolete)")) ;; signal(error ("Eager macro-expansion failure: (void-function byte-compile-warn-obsolete)")) ;; error("Eager macro-expansion failure: %S" (void-function byte-compile-warn-obsolete)) ;; internal-macroexpand-for-load((defalias 'org-string-width #'(lambda [... blah blah blah...] ))) ;; eval-buffer(# nil "/home/kfogel/src/org-mode/lisp/org-macs.el" nil t) ;; load-with-code-conversion("/home/kfogel/src/org-mode/lisp/org-macs.el" "/home/kfogel/src/org-mode/lisp/org-macs.el" nil t) ;; require(org-macs) ;; eval-buffer(# nil "/home/kfogel/src/org-mode/lisp/org-compat.el" nil t) ;; load-with-code-conversion("/home/kfogel/src/org-mode/lisp/org-compat.el" "/home/kfogel/src/org-mode/lisp/org-compat.el" nil nil) ;; load("org-compat.el") ;; eval((load "org-compat.el") t) ;; command-line-1(("--eval" "(setq vc-handled-backends nil org-startup-folded nil org-element-cache-persistent nil)" "--eval" "(add-to-list 'load-path \".\")" "--eval" "(load \"org-compat.el\")" "--eval" "(load \"../mk/org-fixup.el\")" "--eval" "(org-make-org-version \"9.5.4\" \"release_9.5.4-758-g3c11e9\")")) ;; command-line() ;; normal-top-level() ;; Eager macro-expansion failure: (void-function byte-compile-warn-obsolete) ;; make[1]: *** [Makefile:72: org-version.el] Error 255 ;; make[1]: Leaving directory '/home/kfogel/src/org-mode/lisp' ;; make: *** [mk/targets.mk:96: compile] Error 2 ;; ;; I had no idea what was going on, and didn't have time to find out. ;; I just needed my Emacs working. Hence this "STOP" file mechanism, ;; which, in case you hadn't guessed by now, is motivated by the ;; events described in the above example :-). (let* ((local-org (expand-file-name "~/src/org-mode")) (local-org-stop (expand-file-name "~/src/org-mode/STOP")) (local-org-lisp (concat local-org "/lisp")) (local-org-contrib (concat local-org "/contrib/lisp")) (local-org-version (concat local-org-lisp "/org-version.el")) (local-org-autoloads (concat local-org-lisp "/org-loaddefs.el"))) (when (and (file-exists-p local-org) (not (file-exists-p local-org-stop))) (if (not (and (file-exists-p local-org-version) (file-exists-p local-org-autoloads))) (error (concat "Run 'make autoloads' in ~/src/org-mode/.\n" "See http://orgmode.org/org.html#Installation for why.")) (add-to-list 'load-path local-org-contrib) (add-to-list 'load-path local-org-lisp) (load-file local-org-version) (load-file local-org-autoloads) (add-to-list 'Info-default-directory-list (expand-file-name "/home/kfogel/src/org-mode/info"))))) ;; ".org" is the standard suffix. (add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode)) ;; I have global-font-lock-mode on anyway, but setting this just in case. (add-hook 'org-mode-hook 'turn-on-font-lock) (defun kf-org-insert-src-block () "Put an Org Mode src block at the current indentation level. If the region is active, surround it with an appropriately indented src block; else insert a new src block at the current indentation level and leave point inside the block at that indentation level." (interactive) (if (region-active-p) (save-excursion (let ((start (copy-marker (car (car (region-bounds))))) (end (copy-marker (cdr (car (region-bounds)))))) ;; For bonus points, ask `region-noncontiguous-p' and DTRT? (goto-char start) (beginning-of-line) (skip-chars-forward " \t") (let ((pad-str (make-string (current-column) ? ))) (insert "#+BEGIN_SRC\n" pad-str) (goto-char end) (insert pad-str "#+END_SRC\n")))) (kf-prefixed-yank "#+BEGIN_SRC\n\n#+END_SRC") (forward-line -1) (end-of-line))) (defun kf-org-mode-hook () "Custom hooks run on entering Org Mode." (kf-override-key "C-" 'org-insert-heading-respect-content 'kf-worship-frame) ;; Regarding this next one, see: ;; From: Karl Fogel ;; To: Org Mode Mailing List ;; Subject: PROPOSAL: Bind `org-fold-hide-subtree' by default in Org Mode. ;; Date: Wed, 22 Feb 2023 01:29:12 -0600 ;; Message-ID: <87k00aw43b.fsf@red-bean.com> (kf-override-key "C-c TAB" 'org-ctrl-c-tab 'kf-org-ctrl-c-tab) (kf-override-key "C-c " 'org-table-blank-field 'kf-push-to-column) (kf-override-key "C-c C--" nil 'kf-org-insert-src-block)) (add-hook 'org-mode-hook 'kf-org-mode-hook) (setq org-return-follows-link t) (setq org-yank-folded-subtrees nil) ; (setq org-startup-folded 'overview) ; (setq org-startup-with-inline-images t) ; The default setting of `t' means that a ~/.emacs.d/org-persist/ ; directory will be created. I'm not doing anything for which this ; cache would be helpful, and I'd rather not have a directory created ; for no reason, so let's just call the whole thing off. (setq org-element-cache-persistent nil) ;; I don't really get why the Markdown backend isn't available by ;; default for `org-export-dispatch'. (require 'ox-md) ;; Don't put tables of contents in exports; that's gratuitous. (setq org-export-with-toc nil) ;; TODO: This is the start of some configuration changes that will ;; make isearch in Org Mode match hidden text (e.g., in links). ;; But on the way to learning more about it, I shaved so many yaks ;; that my living room rug is now covered in yak hair, viz.: ;; ;; https://list.orgmode.org/87czmcccrp.fsf@red-bean.com/T/#u ;; https://list.orgmode.org/orgmode/878rx0cci6.fsf@red-bean.com/ ;; https://lists.gnu.org/archive/html/emacs-devel/2021-12/msg00366.html ;; ;; SO I'll come back to this later, when the yaks have moved on for ;; the season. ;; ;; (setq search-invisible ...) ;; Org Mode sometimes thinks things are links that are not. For ;; example, a file I'm exporting might contain text like this: ;; ;; grep -v '^[[:space:]]*\(#\|$\)' foo ;; ;; I just want an export. If I wanted a link check, I'd ask for one. (setq org-export-with-broken-links t) ;; This is the default anyway, but ensure it stays so. See ;; https://daringfireball.net/projects/markdown/basics for ;; the difference between `atx'- and `setext'-style headers. (setq org-md-headline-style 'atx) ;; I believe these are also defaults, but likewise ensure them. (setq org-export-with-timestamps t) (setq org-export-time-stamp-file nil) ;; This, on the other hand, unbreaks a broken default. (defun kf-org-export-timestamp-filter (text backend info) "Org Mode's Markdown export is built on its HTML export. The code in 'ox-html.el' inserts wrapper elements unconditionally, such that timestamps get exported -- even in Markdown -- looking like this: \\ [2020-03-27] This is questionable enough as a default for HTML export, and almost certainly the wrong default for Markdown export. In an ideal world, I'd see if upstream were interested in a patch to conditionalize this based on some new variable. However, time is limited, so I decided to just undo the damage by adding a function to `org-export-filter-timestamp-functions' (see the node \"Advanced Export Configuration\" in the Org Mode manual)." (when (org-export-derived-backend-p backend 'md) ;; Oddly, there are `org-match-string-no-properties' and ;; `org-no-properties' functions, which in theory would be ;; convenient to use here. But I'm not sure this code should ;; depend on what are probably internel helpers in Org Mode. (setq text (substring-no-properties text)) (save-match-data (setq new-text (replace-regexp-in-string "\\s-+$" " " ;; fold trailing whitespace to one space when done (replace-regexp-in-string (regexp-quote "") "" (replace-regexp-in-string (regexp-quote "") "" (replace-regexp-in-string (regexp-quote "" ) "" text)))))))) (add-to-list 'org-export-filter-timestamp-functions 'kf-org-export-timestamp-filter) (defun kf-org-ctrl-c-tab (parg) "Widen and call `org-ctrl-c-tab', presumably to fold a subtree. This is useful because often I'm inside a narrowed subtree in Org Mode (i.e., I called `org-narrow-to-subtree') and once I'm done I just want to fold up that subtree and return to a non-narrowed view. This does that all in one step. We use `org-ctrl-c-tab' instead of calling `org-fold-hide-subtree' or `org-fold-hide-sublevels' directly because Org Mode already binds 'C-c TAB' to `org-ctrl-c-tab' and we'd like to stay as close to default Org Mode behavior as possible. I don't know if I'll ever want the context-specific behavior in which `org-ctrl-c-tab' dispatches to `org-table-toggle-column-width' when in a table; we'll cross that bridge if we ever come to it. I don't use Org Mode tables much anyway, so it might never affect me." (interactive "p") (widen) ;; note: preserves any labeled `with-restriction' (org-ctrl-c-tab parg)) (defun kf-org-add-level (&optional n) "Add N (default 1) Org Mode nesting levels at this line. If on a heading line, add an asterisk at the start. If on a non-heading non-whitespace line, add a space at the start. If on a blank line, do nothing. This function is only useful if you usually indent the text body under an Org Mode heading to the same column as the first character of the heading's text. For example, if your Org Mode buffers look like this... ** Some heading Text under this heading goes here, indented to the same column as the \"S\" in \"Some\". *** Look, it's a subheading And notice how the text here is indented one more column. **** Et cetera Et cetera. ...then this function is useful (e.g., in a keyboard macro) for moving a section deeper while preserving that style. However, if your Org Mode buffers look like this... ** Some heading Text under this heading goes here, indented to the same column as the \"S\" in \"Some\". *** Look, it's a subheading And notice how the text here is indented one more column. **** Et cetera Et cetera. ...then you don't need this function. You'd just add asterisks to heading markers as appropriate and be done." (interactive "p") (beginning-of-line) (save-match-data (cond ((looking-at "^\\*.*") (insert (make-string n ?*))) ((looking-at "^.*\\S-.*") (insert (make-string n ? ))) ((looking-at "^\\s-*$") nil) ; do nothing (t (error "Impossible case."))))) ;; To know where you've been, it helps to know where you're going. (setq org-todo-keywords '((sequence "TODO" "STARTED" "|" "DONE"))) ;; Keepin' it together -- that's what Org Mode is all about. (setq org-directory (expand-file-name "~/private/org")) (defun kf-org-demote-heading-tags () "Demote tags from the ends of heading lines to under the headings. For example, this... ** Some org mode heading text here. :FOO:BAR:BAZ: Blah blah blah. ...would become this: ** Some org mode heading text here. Foo, Bar, Baz Blah blah blah. This operates on the whole buffer, but you can narrow if you want." (interactive) (fundamental-mode) (goto-char (point-min)) (dlet ((case-fold-search nil)) (while (re-search-forward "\\s-+:[A-Z:]+:\\s-*$" nil t) (if (progn (forward-char -1) (org-at-heading-p)) (progn (re-search-backward "\\s-+:") (just-one-space) (delete-char -1) (let* ((beg (point)) (end (progn (end-of-line) (point))) (str (buffer-substring-no-properties beg end)) (lvl (org-outline-level))) (delete-region beg end) (insert "\n") (insert (make-string (1+ lvl) ? )) (let ((here (point))) ;; Strip off the leading and trailing colons. (insert (substring str 1 (1- (length str)))) (replace-string-in-region ":" ", " here (point)) (capitalize-region here (point))) (insert "\n")))))) (org-mode)) ;; "Nevertheless, she persisted." Look, I'm glad when Elizabeth ;; Warren persists, but less glad when Org Mode suddenly (2022-04-04) ;; starts persisting when it never did before. Exiting Emacs -- ;; which, admittedly, I only do once in a blue moon, but still, when I ;; do it I don't want it to be slow! -- just took way longer than it ;; should because Org was busy persisting data to disk (specifically, ;; see ~/.cache/org-persist/*, especially the 'index' file). I did ;; not ask for this to happen; it just started happening. I need to ;; learn why. In the meantime, these variables might be involved? ;; ;; (setq org-persist-before-write-hook ...) ;; (setq org-persist-before-read-hook ...) ;; (setq org-persist-after-read-hook ...) ;; See where OTS elisp is handled, for some more Org Mode stuff. ;;; I might be joining the AUCTeX cult. I haven't decided yet. ;;; But actually loading AUCTeX is probably the place to start. (load "auctex" t) ;; What I'd really like is a way to get "\numberedsection" into the ;; association list `font-latex-built-in-keyword-classes' that ;; font-latex.el uses to decide how to display the various section ;; headings. But that's a larger research project; for now, I'll ;; settle for just switching from variant sizes to variant colors. ;; This at least avoids the problem by which "\subsection" and the ;; levels below it show up in a larger font than "\numberedsection" ;; (which is the equivalent of "\section") does. (setq font-latex-fontify-sectioning 'color) ;;; Trying out company-mode completion. ;; ;; Use the latest company code if available. The Git repository is ;; https://github.com/company-mode/company-mode/, by the way. (let* ((local-company (expand-file-name "~/src/company-mode"))) (when (file-exists-p local-company) (add-to-list 'load-path local-company) (require 'company))) ;; Thanks to Austin Bingham for his excellent article on writing ;; Company Mode backends: ;; http://sixty-north.com/blog/writing-the-simplest-emacs-company-mode-backend ;; Get Bash configurable completion working in Emacs. ;; https://github.com/szermatt/emacs-bash-completion (let ((local-ebc (expand-file-name "~/src/emacs-bash-completion"))) (when (file-exists-p local-ebc) (add-to-list 'load-path local-ebc) (require 'bash-completion) (bash-completion-setup))) ;; Try out Markdown Mode ;; http://jblevins.org/projects/markdown-mode/ ;; https://github.com/jrblevin/markdown-mode (let ((local-mdm (expand-file-name "~/src/markdown-mode"))) (when (file-exists-p local-mdm) (add-to-list 'load-path local-mdm) (autoload 'markdown-mode "markdown-mode" "Major mode for editing Markdown files" t))) ;; Thanks, Noah Friedman: (defun valbits (&optional n) "Returns the number of binary bits required to represent n. If n is not specified, this is effectively the number of valbits emacs uses to represent ints---including the sign bit. Negative values of n will always require VALBITS bits, the number of bits emacs actually uses for its integer values, since the highest bit is used for the sign; use (abs n) to ignore the sign." (or n (setq n -1)) (let ((b 0)) (while (not (zerop n)) (setq n (lsh n -1)) (setq b (1+ b))) b)) ;; Let's get this right from the start. (prefer-coding-system 'utf-8) (defun kf-require (feature &optional filename noerror) "Portable implementation of `require', for FSF Emacs and XEmacs. Has the calling discipline from FSF Emacs, which is: (require FEATURE &optional FILENAME NOERROR)" (if (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version) (require feature filename) (require feature filename noerror))) (defmacro kf-ensure-ordering (b e) "Ensure that buffer locations B and E are in smaller->greater order." ;; Which is more likely: being bitten by lack of hygienic macros, or ;; by integer overflow? The Lady or the Tiger? Pick your door... ;; `(when (< ,e ,b) (setq ,b (+ ,b ,e) ,e (- ,b ,e) ,b (- ,b ,e))) `(when (< ,e ,b) (let ((kf-e-o-tmp ,e)) (setq ,e ,b ,b kf-e-o-tmp)))) ;;; Based on the 'with-library' in Eric Hanchrow 's .emacs. ;;; [2016-02-09] Wow, it seems I'm not actually using this anywhere ;;; anymore. However, I keep it around because it's a good example of ;;; how to write a macro and give it the correct indentation hints. ;;; Writing macros is something I do rarely enough that I end up ;;; looking up the backquote syntax each time. (defmacro kf-with-library (symbol &rest body) (declare (indent 1)) `(condition-case nil (progn (require ',symbol) ,@body) ('error (message "Library '%s' not available." ',symbol) nil))) (put 'kf-with-library 'lisp-indent-function 1) (defun kf-make-list-cyclic (lst) "Make LST be a cyclic list, by setting its last cdr to point to head." (let ((this lst)) (while (cdr this) (setq this (cdr this))) (setcdr this lst))) ;; Stop the prompting madness. (setq safe-local-variable-values (cons (list 'sgml-parent-document "book.xml" "chapter") safe-local-variable-values)) ;;; More plumbing. (defun kf-read-sexp-from-file (file) "Read an sexp from FILE, returning nil if FILE does not exist." (if (file-exists-p file) (save-excursion (let* ((large-file-warning-threshold nil) (buf (find-file-noselect file))) (set-buffer buf) (goto-char (point-min)) (prog1 (read (current-buffer)) (kill-buffer (current-buffer))))) '())) ;;; http://blogs.fluidinfo.com/terry/2011/11/10/emacs-buffer-mode-histogram/ (defun buffer-mode-histogram () "Display a histogram of emacs buffer modes." (interactive) (let* ((totals ()) (buffers (buffer-list())) (total-buffers (length buffers)) (ht (make-hash-table :test 'equal))) (save-excursion (dolist (buffer buffers) (set-buffer buffer) (let ((mode-name (symbol-name major-mode))) (puthash mode-name (1+ (gethash mode-name ht 0)) ht)))) (maphash (lambda (key value) (setq totals (cons (list key value) totals))) ht) (setq totals (sort totals (lambda (x y) (> (cadr x) (cadr y))))) (with-output-to-temp-buffer "Buffer mode histogram" (princ (format "%d buffers open, in %d distinct modes\n\n" total-buffers (length totals))) (dolist (item totals) (let ((key (car item)) (count (cadr item))) (when (equal (substring key -5) "-mode") (setq key (substring key 0 -5))) (princ (format "%2d %20s %s\n" count key (make-string count ?+)))))))) ;;; Custom keybindings ;; C-c LETTER (upper or lower case) is reserved for user's custom keybindings. (keymap-global-set "C-c c" 'mode-specific-command-prefix) (keymap-global-set "C-c C" 'kf-unbound) (keymap-global-set "C-c h" 'kf-switch-handler-h) (keymap-global-set "C-c v" 'kf-logup) (keymap-global-set "C-c l" 'kf-find-usual-suspect) (keymap-global-set "C-c o" 'kf-ots-map) (keymap-global-set "C-c B" 'bookmark-map) (keymap-global-set "C-c p" 'kf-paragraphize) (keymap-global-set "C-c n" 'kf-narrow-telepathically) (keymap-global-set "C-c r" 'revert-buffer) (keymap-global-set "C-c D" 'kf-delete-blank-or-header-char) (keymap-global-set "C-c d" 'kf-flush-lines) (keymap-global-set "C-c E" 'kf-unbound) (keymap-global-set "C-c F" 'ots-day-from-date) (keymap-global-set "C-c s" 're-search-forward) (keymap-global-set "C-c S" 'kf-just-sent) (keymap-global-set "C-c S" 'search-forward) (keymap-global-set "C-c M" 'manual-entry) (keymap-global-set "C-c m" 'kf-mdash) (keymap-global-set "C-c y" 'kf-switch-handler-y) (keymap-global-set "C-c Y" 'kf-intelligent-yank) (keymap-global-set "C-c i" 'kf-switch-handler-i) (keymap-global-set "C-c L" 'kf-itemized-list) (keymap-global-set "C-c u" 'kf-switch-handler-u) (keymap-global-set "C-c U" 'kf-degoogle-url-around-point) (keymap-global-set "C-c j" 'kf-jump-there) (keymap-global-set "C-c J" 'kf-ots-jitsi-url) (keymap-global-set "C-c g" 'kf-unbound) (keymap-global-set "C-c z" 'kf-saved-spot) (keymap-global-set "C-c G" (lambda () (interactive) (cond ((eq major-mode 'python-mode) (insert "sys.stderr.write(f\"DEBUG: \\n\")") (forward-char -4)) ((eq major-mode 'emacs-lisp-mode) (insert "(message \"\") (sit-for 1)") (forward-char -14)) (t (error "I don't know how to handle %S" major-mode))))) (keymap-global-set "C-c f" 'kf-auto-fill-mode) (keymap-global-set "C-c q" 'kf-unbound) (keymap-global-set "C-c e" 'kf-switch-handler-e) (keymap-global-set "C-c k" 'bury-buffer) (keymap-global-set "C-c t" 'kf-fix-previous-transposition) (keymap-global-set "C-c T" 'kf-remove-text-properties) (keymap-global-set "C-c 1" 'kf-unbound) (keymap-global-set "C-c P" 'kf-pinyin-from-char) (keymap-global-set "C-c x" 'kf-prefixed-yank) (keymap-global-set "C-c w" 'kf-remove-line-break-in-paragraph) (keymap-global-set "C-c W" 'delete-trailing-whitespace) (keymap-global-set "C-c a" 'ots-org-display-headings-to-point) (keymap-global-set "C-c b" 'oref-do-ref) (keymap-global-set "C-c Q" 'kf-finish-log-message) ;; Do some other custom rebindings outside the reserved space. (defun kf-override-key (key expected-binding new-binding) "Replace EXPECTED-BINDING with NEW-BINDING for KEY. If KEY is bound to EXPECTED-BINDING or nil, then globally and locally bind it to NEW-BINDING (and if NEW-BINDING is nil, then globally and locally unbind KEY). Else if KEY is bound to neither EXPECTED-BINDING nor to NEW-BINDING, then issue a warning but change no keybindings." (let ((current-binding (keymap-lookup nil key))) (if (or (eq current-binding expected-binding) ;; Or if there is no binding to shadow anyway, ;; then we can safely own this key. (not current-binding)) (if new-binding (progn (keymap-global-set key new-binding) (keymap-local-set key new-binding)) (when current-binding ;; If the key is bound to something unexpected, then ;; unconditionally unbind, because whatever that current ;; binding is, we wouldn't want to accidentally invoke it. (keymap-global-unset key) (keymap-local-unset key))) (unless (eq current-binding new-binding) (warn "Key %S bound to `%S' instead of `%S' as expected." key current-binding expected-binding))))) (mapcar (lambda (k) (kf-override-key (car k) (car (cdr k)) (car (cdr (cdr k))))) (list (list "C-x f" 'set-fill-column nil) (list "M-n" nil 'kf-next-line) (list "M-p" nil 'kf-previous-line) (list "M-q" 'fill-paragraph 'kf-fill-paragraph) (list "C-l" 'recenter-top-bottom 'recenter) (list "M-(" 'insert-parentheses 'beginning-of-buffer) ;; for Maltron kbd (list "M-)" 'move-past-close-and-reindent 'end-of-buffer) ;; for Maltron kbd (list "C-c ?" nil 'kf-where-am-I) (list "C-c " nil 'kf-push-to-column) (list "C-c -" nil 'kf-section-heading-line) (list "C-c _" nil 'kf-enspacen) (list "C-c 2" nil 'kf-split-window-vertically) (list "C-c 9" nil 'kf-unbound) (list "C-c )" nil 'kf-unbound) (list "C-c (" nil 'kf-unbound) (list "C-c ." nil 'kf-switch-handler-dot) (list "" 'toggle-frame-fullscreen 'kf-switch-to-other-buffer) (list "" nil 'kf-switch-to-other-buffer) ;; (list "C-x C--" 'text-scale-adjust 'kf-text-scale-adjust) ;; (list "C-x C-+" 'text-scale-adjust 'kf-text-scale-adjust) )) ;; Some window managers brilliantly put frames where no one can find them. (when (eq window-system 'x) (kf-override-key "C-x C-z" 'suspend-frame nil) (kf-override-key "C-z" 'suspend-frame nil)) (defun kf-text-scale-adjust (inc) "Do `text-scale-adjust' after first making sure I really mean it." (interactive "p") (let ((ev last-command-event) (echo-keystrokes nil)) (if (= (event-basic-type ev) ?-) (if (y-or-n-p "Really invoke text-scale-adjust? ") (progn ;; Reset the keybinding for this session, so that future ;; invocations (which are somewhat likely to be repeated ;; invocations right now, since we might be adjusting ;; the text size up and down to find the right size) ;; don't ask for confirmation again. (keymap-global-set "C-x C--" 'text-scale-adjust) (text-scale-adjust inc)) (error "I didn't think you meant it.")) (text-scale-adjust inc)))) ;;; Width management ;; According to https://www.emacswiki.org/emacs/HighlightLongLines, ;; this should set up highlighting of too-long lines. But it doesn't ;; seem to have any effect, and I don't care to debug it right now. ;; Some day a moment will arrive when this is absolutely the most ;; important thing I can work on at that moment, and then I'll fix it. ;; ;; (setq whitespace-style '(lines)) ; or '(tabs trailing lines tab-mark) ;; (setq whitespace-line-column 78) ;; (global-whitespace-mode 1) ;;; Frame management (defvar kf-conservative-frame-width 81 "*You'd think this would be 80, but somehow when I set the frame width to 80 the actual number of available character columns is only 79, perhaps because of the scrollbar half-trough on either side.") (defvar kf-worshipping-frame-p nil "Non-nil iff frame is currently being worshipped.") (defun kf-worship-frame () "Toggle widening of the selected frame. Also, raise the selected frame, and get the mouse pointer out of your face." (interactive) (unless (= (user-uid) 0) (if kf-worshipping-frame-p (progn (set-frame-width (selected-frame) kf-conservative-frame-width) (setq kf-worshipping-frame-p nil)) (setq kf-worshipping-frame-p t) (set-frame-width (selected-frame) ;; -3 because scrollbar, sidebar decorations, etc. ;; I determined this constant experimentally; no ;; data scientists were harmed in the process. (- (/ (if (= (display-pixel-width) 3286) ;; Work around GNOME bug. Search for ;; "3286" in bin/set-up-workspaces ;; as of r6260 for details. 1920 (display-pixel-width)) (default-font-width)) 3)))) (set-mouse-pixel-position (selected-frame) (- (frame-pixel-width) 1) 0) (raise-frame)) (or (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version) (progn (keymap-global-set "C-" 'kf-worship-frame) (keymap-global-set "S-" #'(lambda () (interactive) (message "Helpful to humans, harmless to dogs!"))) (keymap-global-set "S-" #'(lambda () (interactive) (message "Helpful to humans, harmless to dogs!"))) )) ;; Emacs 29 introduced `keymap-set', but sometimes I need to run 28. (unless (fboundp 'keymap-set) (fset 'keymap-set (symbol-function 'define-key))) ;; At some point, Emacs decided to do the Right Thing and treat spaces ;; in file names like first-class citizens, which on most systems they ;; are. But in my universe, the wrong thing is the right thing, and ;; anyway I can use C-q in the rare instances when I need to actually ;; type a space in a file name in the minibuffer. (when (boundp 'minibuffer-local-filename-completion-map) (keymap-set minibuffer-local-filename-completion-map "" 'minibuffer-complete) (keymap-set minibuffer-local-filename-completion-map "C-i" 'minibuffer-complete)) (when (boundp 'minibuffer-local-filename-must-match-map) (keymap-set minibuffer-local-filename-must-match-map "" 'minibuffer-complete) (keymap-set minibuffer-local-filename-must-match-map "C-i" 'minibuffer-complete)) ;; I guess British keyboards distinguish between Subtract and Hyphen? ;; Or something? Anyway, there's lossage when I ssh into sanpietro ;; and try to use "-", but only in Emacs! It claims to be "ESC O m". ;; Rather than debug this, I'm kluging around it. Sue me. ;; ;; 2022-10-28: Ah, in the new keybinding syntax, I don't know how to ;; say this. I'll just comment it out until I run into the bug again. ;; ;; (keymap-global-set "\eOm" "-") (when (eq (keymap-lookup nil "C-x C-l") 'downcase-region) (keymap-global-set "C-x C-l" 'what-line)) (when (eq (keymap-lookup nil "C-x l") 'count-lines-page) (keymap-global-set "C-x l" 'goto-line)) (if (or (eq (keymap-lookup nil "C-x c") 'shell) (eq (keymap-lookup nil "C-x c") nil)) (keymap-global-set "C-x c" 'kf-shell)) (if (or (eq (keymap-lookup nil "C-h C-a") nil) (eq (keymap-lookup nil "C-h C-a") 'display-about-screen) (eq (keymap-lookup nil "C-h C-a") 'about-emacs)) (keymap-global-set "C-h C-a" 'apropos)) (when (eq (keymap-lookup nil "M-s") nil) (keymap-global-set "M-s" 'spell-word)) (defconst kf-src-directory (expand-file-name "~/src") "Where public source trees and in-progress work live.") ;; Ignore ref tags generated by `oref-set-ref'. ;; Except, hmm, it's totally not working. What am I doing wrong? (setq ispell-skip-region-alist (cons (list "ref:[[:alnum:]]\\{8\\}") ispell-skip-region-alist)) ;; Tell ispell to automatically save my personal dictionary every time ;; I add a new word to it. The alternative is a choice between ;; wide-area-network spelling amnesia and double-confirmation UI. ;; I'll take neither, please! (setq ispell-silently-savep t) ;;; Stuff related to filling and auto-fill. (setq sentence-end-double-space t) (defun kf-checksum-region (b e) "Print a checksum (currently md5) of the region from B to E." (interactive "r") (message (md5 (buffer-substring b e)))) (defalias 'kf-md5-region 'kf-checksum-region) (defun kf-auto-fill-mode (&optional arg) "Like auto-fill-mode, but with message for users with long mode lines." (interactive "P") (auto-fill-mode 'toggle) (if auto-fill-function (message "auto-fill-mode on") (message "auto-fill-mode off"))) (defun kf-fill-paragraph (&optional justify) "Like `fill-paragraph', but with some improvements. 1) If the region is active, then fill just inside that region using `kf-fill-paragraph-isolated'. (That function, which boils down to eventually calling `fill-paragraph', seems to handle mail quoting better than `fill-region-as-paragraph' and `fill-region' do. This bears looking into, as those latter two really should work for this.) Here's some test text: > >>From: J. Random > >>Sent: Wednesday, June 7, 2023 4:21 PM > >>To: Ray Jandom > >>Subject: Open Tech Strategies, LLC > >> > >>Hi Ray, > >> > >>Please ask Yuncilia for a good standing certificate for Blorpn > >>Shmemf. > >>I've looked in the public records and cannot find the company in > >>Illinois (which I was a bit surprised about). I did find a > >>company > >>incorporated in New York, but none of the annual filings have > >>been > >made > >>in years (last one filed was in 2014). > >> > >>Thanks, > >>J. 2) Don't mark the buffer as modified if no change. Emacs's native fill-paragraph is like the burglar who breaks into your house, rearranges all your furniture exactly as it was, and departs: even if the result of the fill is to leave the buffer in exactly the same state, it still marks the buffer as modified so you know you've been broken into. A further improvement would be to detect the paragraph boundaries even inside N levels of email quoting and still DTRT. Note: Were I going to submit this for inclusion in Emacs, I'd update it to watch the md5sum for just the affected region rather than for the entire buffer. By comparison, see `fill-region' and `fill-region-as-paragraph' in textmodes/fill.el. The elegant solution would be a new macro, '(detect-buffer-unmodified from to)' or something, that just wraps the relevant body of code in those two functions. Then it could be used by other fill functions easily too." (interactive "P") (let ((orig-md5sum (md5 (current-buffer))) (was-modified-before-fill (buffer-modified-p))) (if (region-active-p) (progn ;; It's important to deactivate the mark. Otherwise, when ;; `kf-fill-paragraph-isolated' below semi-recursively calls ;; `kf-fill-paragraph', we'll come right back to this case ;; and simply subdivide the paragraph further and further. ;; With the mark deactivated, `(region-active-p)' above will ;; return nil, so we'll jump to the else case and call plain ;; old `fill-paragraph'. (deactivate-mark) (kf-fill-paragraph-isolated (mark) (point))) (fill-paragraph justify)) (let ((new-md5sum (md5 (current-buffer)))) (when (string-equal orig-md5sum new-md5sum) (set-buffer-modified-p was-modified-before-fill))))) (defun kf-fill-paragraph-isolated (b e) "Fill paragraph on just the region from B to E. B and E can be in either order." (interactive "*r") (let ((extra-line-b nil) (extra-line-e nil)) (when (> b e) (let ((p b)) (setq b e e p))) ; I've always wanted to write that. (save-excursion (goto-char b) (insert "\n") (setq extra-line-b (point)) (goto-char e) (insert "\n") (setq extra-line-e (point-marker)) (goto-char e) (forward-line -1) (kf-fill-paragraph nil) (goto-char extra-line-e) (delete-char -1) (goto-char extra-line-b) (delete-char -1)))) ;; Mainting a package while not using it oneself is dicey, but it ;; seems to be working for 'saveplace.el'. Every now and then, I ;; uncomment these for testing. ;; (setq-default save-place t) ;; (load "/home/kfogel/src/emacs/trunk/lisp/saveplace.el") ;; (require 'saveplace) ;; The Grand Unfried Debugger. (setq gud-chdir-before-run nil) ;; FWIW, http://www.fileformat.info/info/unicode/category/Pd/list.htm says: ;; ;; U+002D HYPHEN-MINUS - ;; U+058A ARMENIAN HYPHEN ֊ ;; U+05BE HEBREW PUNCTUATION MAQAF ־ ;; U+1400 CANADIAN SYLLABICS HYPHEN ᐀ ;; U+1806 MONGOLIAN TODO SOFT HYPHEN ᠆ ;; U+2010 HYPHEN ‐ ;; U+2011 NON-BREAKING HYPHEN ‑ ;; U+2012 FIGURE DASH ‒ ;; U+2013 EN DASH – ;; U+2014 EM DASH — ;; U+2015 HORIZONTAL BAR ― ;; U+2E17 DOUBLE OBLIQUE HYPHEN ⸗ ;; U+2E1A HYPHEN WITH DIAERESIS ⸚ ;; U+2E3A TWO-EM DASH ⸺ ;; U+2E3B THREE-EM DASH ⸻ ;; U+2E40 DOUBLE HYPHEN ⹀ ;; U+301C WAVE DASH 〜 ;; U+3030 WAVY DASH 〰 ;; U+30A0 KATAKANA-HIRAGANA DOUBLE HYPHEN ゠ ;; U+FE31 PRESENTATION FORM FOR VERTICAL EM DASH ︱ ;; U+FE32 PRESENTATION FORM FOR VERTICAL EN DASH ︲ ;; U+FE58 SMALL EM DASH ﹘ ;; U+FE63 SMALL HYPHEN-MINUS ﹣ ;; U+FF0D FULLWIDTH HYPHEN-MINUS － (defun kf-qdash (type &optional omit-hard-spacing-when-xml) "Helper function for `kf-mdash' and `kf-ndash'. Type is `n' or `m'. If OMIT-HARD-SPACING-WHEN-XML, then don't include XML non-breaking space entities on both sides of the dash iff in an XML-flavored markup; otherwise, do include them." (when (stringp type) (setq type (intern type))) ; just convert to symbol (let ((dash-char (cond ((eq type 'm) ?—) ;; 8212 ((eq type 'n) ?–) ;; 8211 (t (error "Unrecognized dash: '%s'" (symbol-name type))))) (flavor (kf-markup-flavor))) (cond ((memq flavor '(sgml html xml)) (unless omit-hard-spacing-when-xml (insert " ")) (insert (format "&%sdash;" (symbol-name type))) (unless omit-hard-spacing-when-xml (insert " "))) (t (insert dash-char))))) (defun kf-mdash (&optional parg) (interactive "*P") (kf-qdash 'm parg)) (defalias 'kf-em-dash 'kf-mdash) (defun kf-ndash (&optional parg) (interactive "*P") (kf-qdash 'n parg)) (defalias 'kf-en-dash 'kf-ndash) ;;;; Partial automation for writing log messages in Emacs. ;;; ;;; 1) Put this code in your .emacs. ;;; ;;; 2) Reload your .emacs (by "M-x load-file", or just by restarting). ;;; ;;; 3) Bind the entry point to a key, for example to "C-c h": ;;; ;;; (keymap-global-set "C-c h" 'kf-log-message) ;;; ;;; Now whenever you're working in source code, Emacs will help you ;;; write the log message for the change you're working on. Just type ;;; C-c h while inside, say, lib/lp/bugs/interfaces/bugtarget.py, in ;;; the class IHasBugs, in the method getBugCounts(). Emacs will ;;; bring up a file in which to accumulate a log message (by default, ;;; this is the file "msg" at the top of your Bazaar working tree). ;;; ;;; If neither the source file path and class/method information are ;;; currently in the log message file, Emacs will insert them, leaving ;;; point at the end so you can write something about the change. If ;;; some of that information is already in the log message (because ;;; you're doing more work in the same class or method), Emacs will ;;; put point at what it thinks is the most appropriate place in the ;;; log message, and the kill ring (that is, the clipboard) should ;;; have anything else you need -- type C-y to paste in the method ;;; name, and if that's not quite right, type M-y immediately to paste ;;; it in surrounded by parentheses and followed by a colon, which is ;;; a traditional format for starting a new subsection for a given ;;; method in a log message. ;;; ;;; The result is log messages that look like this: ;;; ;;; Working with Abel on bug #506018: ;;; ;;; Use the view instead of the model to prepare data for display. ;;; ;;; * lib/lp/bugs/browser/bugtarget.py: Import datetime, timezone, ;;; BugTaskSearchParams, and BugAttachmentType. ;;; (BugsPatchesView.patch_tasks, ;;; BugsPatchesView.context_can_have_different_bugtargets, ;;; BugsPatchesView.youngest_patch, ;;; BugsPatchesView.patch_age): New properties and methods. ;;; ;;; * lib/lp/bugs/templates/bugtarget-patches.pt: Rewrite. ;;; ;;; * lib/lp/bugs/model/bugtarget.py ;;; (HasBugsBase.fish_patches): Remove this now-unused property. ;;; ;;; * lib/lp/bugs/interfaces/bugtarget.py ;;; (IHasBugs.patches): Likewise remove. ;;; ;;; This format more or less adheres to the guidelines given at ;;; http://subversion.apache.org/docs/community-guide/#log-messages, ;;; which I think are pretty good, though of course every project may ;;; have their own guidelines, "your mileage may vary", "void where ;;; prohibited by law", etc. ;; First, block Magit's attempt to take over my filename ("msg"). (when (and (boundp 'git-commit-filename-regexp) ;; Only tweak it if it has the expected value. If Magit ;; ever changes the value, I want to re-decide. (string= git-commit-filename-regexp (concat "/\\(" "\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|MERGEREQ\\|TAG\\)" "_EDIT\\|MERGE_\\|\\)MSG" "\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'"))) ;; The tweak is hard to spot: we remove the empty string option at ;; the end of the first inner parenthetical. In other words, before ;; this tweak, the regexp would have matched (case-insensitively, in ;; Magit's code) "msg"; after this tweak, it won't match "msg" by ;; itself, though it will still match various "prefix_msg" variants. (setq git-commit-filename-regexp (concat "/\\(" "\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|MERGEREQ\\|TAG\\)" "_EDIT\\|MERGE_\\)MSG" "\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'"))) (defun kf-log-path-derive (path &optional root) "If ROOT is a prefix of PATH, return the remainder; else return PATH." (save-match-data (if (and root (string-prefix-p root path)) (substring path (length root)) path))) (defcustom kf-log-message-file-basename "msg" "*The basename of the file in which to accumulate a log message. See `kf-log-message' for more.") (defun kf-log-message-file (path) "Return the name of the log message accumulation file for PATH: the file `kf-log-message-file-basename' in PATH's directory or in some parent upwards from PATH. If no log message file is found, return \"~/gmsg\" (\"gmsg\" for \"global log message\")." (let* ((d (directory-file-name path)) ;; If there's a .bzr directory here, that indicates the top ;; of a working tree, which is a good place for a log message. (b (concat d "/.bzr")) ;; Or if there's already a "msg" file here, then go with that. (m (concat d "/" kf-log-message-file-basename))) (save-match-data (catch 'not-found (while (and d (not (file-exists-p m)) (not (file-exists-p b))) (string-match "\\(.*\\)/[^/]+$" d) (setq d (match-string 1 d) m (concat d "/" kf-log-message-file-basename) b (concat d "/.bzr")) (when (string-equal d "") (setq m (expand-file-name "~/gmsg")) (throw 'not-found nil)))) m))) (defun kf-add-log-current-defun () "Try to determine the current defun using `add-log-current-defun' first, falling back to various custom heuristics if that fails." (let* ((flavor (kf-markup-flavor)) (default-defun (add-log-current-defun))) ;; Work around a bug in add-log-current-defun w.r.t. Subversion's code. (when (string-match "\\.h$" (buffer-file-name)) (setq default-defun nil)) (save-excursion (save-match-data (cond ((and (not default-defun) (eq major-mode 'c-mode)) ;; Handle .h files as well as .c files. (progn (c-beginning-of-statement-1) (or (= (char-after (1- (point))) ?\( ) (search-forward "(" nil t)) (forward-char -1) (forward-sexp -1) (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point))))) ((and (not default-defun) (eq major-mode 'python-mode)) (save-excursion (save-match-data (re-search-backward "^class\\s-+\\([^( \t]+\\)" nil t) (match-string-no-properties 1)))) ((and (not default-defun) (eq major-mode 'js-mode)) (save-excursion (save-match-data (re-search-backward "^function\\s-+\\([^( \t]+\\)" nil t) (match-string-no-properties 1)))) ((eq flavor 'asciidoc) (save-excursion (save-match-data (re-search-backward "^=+ \\(.*\\)$" nil t) (match-string 1)))) ((or (eq flavor 'xml) (eq flavor 'html)) (let* ((section-open-re "\\(") (title-open-re "<\\(title\\|h[0-9]\\)>") (title-close-re "") (nearest-title-spot (or (save-excursion (re-search-backward title-open-re nil t)) (point-min))) (nearest-section-spot (or (save-excursion (re-search-backward section-open-re nil t)) (point-min))) (title-grabber (lambda () (when (re-search-backward title-open-re nil t) (search-forward ">") (buffer-substring-no-properties (point) (progn (re-search-forward title-close-re) (search-backward " nearest-title-spot nearest-section-spot) (funcall title-grabber) ;; Else we have a section or div with no title, so use ;; one of the usual attributes instead. (goto-char nearest-section-spot) (let ((opoint (point)) (bound (progn (re-search-forward section-close-re) (point)))) (goto-char opoint) (if (re-search-forward "\\(id=\"\\|name=\"\\|label=\"\\|title=\"\\)" nil t) (buffer-substring-no-properties (point) (progn (search-forward "\"") (1- (point)))) (funcall title-grabber)))))) ((eq flavor 'ltx) (re-search-backward "^\\\\[a-z]+section{\\([^}]+\\)}" nil t) (match-string 1)) (t (add-log-current-defun))))))) (defun kf-current-defun-to-kill-ring () "Put the name of the current defun into the kill-ring." (interactive "*") (kill-new (kf-add-log-current-defun))) (defun kf-log-message (short-file-names) "Add to an in-progress log message, based on context around point. If prefix arg SHORT-FILE-NAMES is non-nil, then use basenames only in log messages, otherwise use full paths. The current defun name is always used. If the log message already contains material about this defun, then put point there, so adding to that material is easy. Else if the log message already contains material about this file, put point there, and push onto the kill ring the defun name with log message dressing around it, plus the raw defun name, so yank and yank-next are both useful. Else if there is no material about this defun nor file anywhere in the log message, then put point at the end of the message and insert a new entry for file with defun. See also the function `kf-log-message-file'." (interactive "P") (let* ((this-defun (kf-add-log-current-defun)) (log-file (kf-log-message-file buffer-file-name)) (log-file-dir (file-name-directory log-file)) (this-file (if short-file-names (file-name-nondirectory buffer-file-name) (kf-log-path-derive buffer-file-name log-file-dir)))) (find-file log-file) (goto-char (point-min)) ;; Strip text properties from strings (set-text-properties 0 (length this-file) nil this-file) (set-text-properties 0 (length this-defun) nil this-defun) ;; If log message for defun already in progress, add to it (if (and this-defun ;; we have a defun to work with (search-forward this-defun nil t) ;; it's in the log msg already (save-excursion ;; and it's about the same file (save-match-data (if (re-search-backward ; Ick, I want a real filename regexp! "^\\*\\s-+\\([a-zA-Z0-9-_.@=+^$/%!?(){}<>]+\\)" nil t) (string-equal (match-string 1) this-file) t)))) (when (and (re-search-forward ":" nil t) (looking-at " ")) (forward-char 1)) ;; Else no log message for this defun in progress... (goto-char (point-min)) ;; But if log message for file already in progress, add to it. (if (search-forward this-file nil t) (progn (when this-defun (kill-new (format "\"%s\"" this-defun)) (kill-new (format "(%s): " this-defun)) (kill-new this-defun)) (search-forward ")" nil t) (when (looking-at " ") (forward-char 1))) ;; Found neither defun nor its file, so create new entry. (goto-char (point-max)) (when (not (bolp)) (insert "\n")) (insert (format "\n* %s (%s): " this-file (or this-defun ""))) ;; Finally, if no derived defun, put point where the user can ;; type it themselves. (when (not this-defun) (forward-char -3)))))) (defun kf-finish-log-message () "Trim and submit log message. Version control systems often initialize log messages with information about the change, e.g.: --This line, and those below, will be ignored-- A some-added-file M some-modified-file M some-other-modified-file Once I've written the (usually one-line) commit message above the line, I just want to delete all the rest and submit. That's easy, but I do it so often that saving even those few keystrokes is worth it." (interactive) (goto-char (point-min)) (search-forward "--This line, and those below, will be ignored--") (beginning-of-line) (delete-region (point) (buffer-end 1)) (save-buffer) (sit-for 1) (server-edit)) ;;;; End kf-log-message stuff. ;;;; ;;;; Finding certain common files in cwd or a parent thereof. (defun kf-path-chop-last-component (path) "Return PATH minus its last component, chopping all trailing slashes. If PATH is empty or \"/\", return nil." ;; I'd noticed before that Emacs's path manipulation primitives ;; are awful, but this exercise really drives the point home. (setq path (substring (file-name-as-directory path) 0 -1)) (if (string-equal path "") nil (substring path 0 (- -1 (length (file-name-nondirectory (directory-file-name path))))))) (defun kf-rootward-find-file (basename) "Try to find writeable file BASENAME, starting from cwd and walking up. If no such file is found, then `find-file' it in the current directory." (interactive "sFind file rootward: ") ;; The better way to do this might be to make a new function or ;; special form that takes any abstract body of code and runs it in ;; telescopically-contracting directories starting from a given ;; directory (defaulting to `default-directory'). When the body ;; returns non-nil, then that value is returned from the form. ;; If we had that, it could be used to implement the below. (let* ((this-dir (substring default-directory 0 -1)) (found-path (or (catch 'found (while this-dir ;; From the path manipulation primitives Emacs ships with, ;; you'd think no one needed to work with paths until now. (if (and (file-exists-p (concat this-dir "/" basename)) (file-writable-p (concat this-dir "/" basename))) (throw 'found (concat this-dir "/" basename)) (setq this-dir (kf-path-chop-last-component this-dir))))) (concat default-directory basename)))) (find-file found-path))) (defun kf-find-usual-suspect (suspect) "Find file SUSPECT, starting from cwd and walking up. If no SUSPECT found, then just `find-file' it in the current directory. Interactively, prompt for SUSPECT, completing on the usual suspects." (interactive (list (completing-read "Find usual suspect: " '(("logv.out") ("msg")) nil nil "logv.out"))) (kf-rootward-find-file suspect)) ;;;; End of usual suspects stuff. ;;;; ;; VC is great, unless you're trying to do version control. (remove-hook 'find-file-hooks 'vc-find-file-hook) ;; Sort by modtime, with most-recently-modified files on top. ;; (setq dired-listing-switches "-alt") ;; There is absolutely no reason to use a power of two here. (setq kill-ring-max 512) ;;; Setting modes based on filenames: (add-to-list 'auto-mode-alist '("\\.mnu$" . food-menu-mode)) (add-to-list 'auto-mode-alist '("\\.pl$" . perl-mode)) (add-to-list 'auto-mode-alist '("\\.py$" . python-mode)) (add-to-list 'auto-mode-alist '("\\.pm$" . perl-mode)) (add-to-list 'auto-mode-alist '("\\.cgi$" . perl-mode)) (add-to-list 'auto-mode-alist '("\\.sgml$" . text-mode)) (add-to-list 'auto-mode-alist '("\\.ss$" . scheme-mode)) (add-to-list 'auto-mode-alist '("\\.s?html?\\'" . text-mode)) (add-to-list 'auto-mode-alist '("\\.scm$" . scheme-mode)) (add-to-list 'auto-mode-alist '("logv\\.out$" . kf-changelog-mode)) ;; Diff mode gives me the willies. Yes, all of them! (add-to-list 'auto-mode-alist '("\\.patch$" . text-mode)) ;; I don't find HTML mode any more convenient than text mode (add-to-list 'auto-mode-alist '("\\.html$" . text-mode)) ;; Case-insensitive regexp-aware grep is usually what I want. ;; But if upstream changes the default, I want to know about that ;; before I clobber it, so test for expected default first. (when (string-equal grep-command "grep --color -nH -e ") (setq grep-command "grep --color -nH -i -e ")) ;; generic emacs stuff ;; (put 'upcase-region 'disabled nil) (put 'downcase-region 'disabled nil) (put 'eval-expression 'disabled nil) (put 'narrow-to-region 'disabled nil) (put 'narrow-to-page 'disabled nil) (put 'list-threads 'disabled nil) (setq enable-recursive-minibuffers t) (setq enable-local-eval 'ask) (setq-default indent-tabs-mode nil) (setq inhibit-startup-message t) (setq case-fold-search t) (setq-default case-fold-search t) (setq completion-auto-help t) (setq completion-ignored-extensions nil) (setq completion-ignored-extensions nil) (setq-default show-trailing-whitespace nil) ;; The reasons for these next two settings are... interesting, in the ;; the same way that the New York Times Sunday Magazine "Diagnosis" ;; column is "interesting". ;; ;; My private .gnus file contains a gigantic backtick macro defining ;; `nnmail-split-fancy', with a macroexpansion-time inline evaluation ;; right smack in the middle. I never thought this much before, but I ;; guess the way such macros are expanded involves Lisp recursion (?), ;; and thus I was starting to get this error... ;; ;; Eager macro-expansion failure: \ ;; (error "Lisp nesting exceeds ‘max-lisp-eval-depth’") ;; ;; ...at startup time, because my `nnmail-split-fancy' list definition ;; had ~810 elements (on 2022-03-01, r10242 in the private repository, ;; when I first noticed the appearance of that error message). The ;; value of `max-lisp-eval-depth' was a measly 800, which I guess is ;; fine for normal Emacs Lisperizing, but my mail filters long ago ;; left normal Emacs Lisperizing behind in a manner roughly analogous ;; to how the Voyager I space probe left Pocatello, Idaho behind. ;; ;; Now, the doc string of `max-lisp-eval-depth' says that "you can ;; safely make it considerably larger than its default value", so I ;; took it at its word and increased it dramatically, as per below. ;; ;; But even *that* didn't solve the problem! ;; ;; Instead, I now got a new error on starting Gnus: ;; ;; Eager macro-expansion failure: (excessive-variable-binding) ;; ;; That looked to be coming from grow_specpdl_allocation() in eval.c, ;; so I thought perhaps I also need to increase `max-specpdl-size', ;; which was at 1840 at the time. So I did; that fixed the second ;; error, and now Gnus loads without error. ;; ;; We have most definitely left the heliosphere. (setq max-lisp-eval-depth 65536) (setq max-specpdl-size 65536) ;; Let's just solve this once and for all, shall we? (setq mark-ring-max most-positive-fixnum) ;; This is the default anyway, but I want to ensure it because I also ;; set `nnml-use-compressed-files' in the Gnus section, and that ;; depends on this. (setq auto-compression-mode t) ;; XEmacs swings the other way, apparently. (setq next-line-add-newlines t) ;; One day I upgraded my CVS Emacs (to 23.0.60.1) and next-line ;; started going to the next *displayed* line instead of the next ;; actual line. Needless to say, this wreaked havoc with macros. ;; Yuck. I want my editing commands to deal only with hard reality, ;; not the cotton-candy illusions other editors feed to their users. (setq line-move-visual nil) ;; I think I've had enough spurious diffs now, thank you. (setq-default require-final-newline nil) (setq-default mode-require-final-newline nil) ;; Sure, why not? (when (fboundp 'server-start) (server-start)) ;; Add my custom elisp collections to load-path, sometimes on the ;; front, sometimes on the back, but always with love. (add-to-list 'load-path (expand-file-name "~/src/jimb-elisp")) (add-to-list 'load-path (expand-file-name "~/code/jump-def") t) (add-to-list 'load-path (expand-file-name "~/code/chaffwin") t) ;; I want my Emacs back. (setq use-dialog-box nil use-file-dialog nil) ;;; hooks, etc: ;; Sure, I'd like font lock mode, if it weren't like viewing Makefiles ;; by strobe light through ultraviolet-passing sunglasses. (setq font-lock-global-modes (list 'not 'makefile-mode)) (defun kf-isearch-mode-hook () (keymap-set isearch-mode-map "C-o" 'isearch-yank-char) (let ((ctl-l-binding (keymap-lookup isearch-mode-map "C-l"))) (when (or (not ctl-l-binding) (eq ctl-l-binding 'isearch-other-control-char)) (keymap-set isearch-mode-map "C-l" 'isearch-yank-line)))) (add-hook 'isearch-mode-hook 'kf-isearch-mode-hook) (add-hook 'java-mode-hook 'kf-java-mode-hook) (defalias 'kf-java-mode-hook 'kf-c-mode-hook) (setq-default c-electric-flag nil) (defun kf-c-mode-hook () ;; (make-variable-buffer-local 'kf-def-regexp) (setq require-final-newline nil) (if (string-match "cvs" (buffer-file-name)) (progn ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; Follow CVS conventions inherited from Cygnus. Quote ;; ;; liberally, even overeagerly: ;; ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; originally from... ;; Rich's personal .emacs file. feel free to copy. ;; ;; Last Mod Wed Feb 5 16:11:47 PST 1992, by rich@cygnus.com ;; (further modified by kfogel@cyclic.com) ;; ;; This section sets constants used by c-mode for formating ;; ;; If `c-auto-newline' is non-`nil', newlines are inserted ;; both before and after braces that you insert, and after ;; colons and semicolons. Correct C indentation is done on ;; all the lines that are made this way. (setq c-auto-newline nil) ;; *Non-nil means TAB in C mode should always reindent the ;; current line, regardless of where in the line point is ;; when the TAB command is used. It might be desirable to ;; set this to nil for CVS, since unlike GNU CVS often uses ;; comments over to the right separated by TABs. Depends ;; some on whether you're in the habit of using TAB to ;; reindent. ;;(setq c-tab-always-indent nil) ;; It seems to me that ;; `M-x set-c-style BSD RET' ;; or ;; (set-c-style "BSD") ;; takes care of the indentation parameters correctly. ;; C does not have anything analogous to particular function ;; names for which special forms of indentation are ;; desirable. However, it has a different need for ;; customization facilities: many different styles of C ;; indentation are in common use. ;; ;; There are six variables you can set to control the style ;; that Emacs C mode will use. ;; ;; `c-indent-level' ;; Indentation of C statements within surrounding block. ;; The surrounding block's indentation is the ;; indentation of the line on which the open-brace ;; appears. (setq c-indent-level 4) ;; `c-continued-statement-offset' ;; Extra indentation given to a substatement, such as ;; the then-clause of an if or body of a while. (setq c-continued-statement-offset 4) ;; `c-brace-offset' ;; Extra indentation for line if it starts with an open ;; brace. (setq c-brace-offset -4) ;;`c-brace-imaginary-offset' ;; An open brace following other text is treated as if ;; it were this far to the right of the start of its ;; line. (setq c-brace-imaginary-offset 0) ;; `c-argdecl-indent' ;; Indentation level of declarations of C function ;; arguments. (setq c-argdecl-indent 4) ;; `c-label-offset' ;; Extra indentation for line that is a label, or case ;; or default. (setq c-label-offset -4) ) ;; Else default to my personal preferences: (c-set-style "gnu") (c-set-offset 'substatement-open 0 t) (c-set-offset 'inline-open 0 t) (font-lock-mode 1) ;; Some things I've apparently tried in the past: ;; ;; (setq c-indent-level 2) ;; (setq c-continued-statement-offset 2) ; GNU style, it seems ;; (setq c-basic-offset 2) ;; (c-set-offset 'substatement-open 0) ;; (setq c-indent-level 2) ;; (setq c-brace-offset 0) ;; (setq c-continued-statement-offset 2) )) (add-hook 'c-mode-hook 'kf-c-mode-hook) (add-hook 'objc-mode-hook 'kf-c-mode-hook) (defun kf-emacs-lisp-mode-hook () ;; Avoid infectuous Common Lisp lossage (setq lisp-indent-function 'lisp-indent-function)) (add-hook 'emacs-lisp-mode-hook 'kf-emacs-lisp-mode-hook) (defun kf-perl-mode-hook () (kf-perl-mode-style "kff")) (add-hook 'perl-mode-hook 'kf-perl-mode-hook) (defun kf-python-mode-hook () "Fix the utterly execrable and wrong Python Mode word syntax lossage, and other things." (when (and (boundp 'py-mode-syntax-table) py-mode-syntax-table) (modify-syntax-entry ?\_ "_" py-mode-syntax-table)) (when (eq (keymap-lookup nil "C-c ?") 'py-describe-mode) (keymap-local-set "C-c ?" 'kf-where-am-I)) (make-local-variable 'py-indent-offset) (setq py-indent-offset 4) (setq python-indent 4) (make-local-variable 'py-smart-indentation) (setq py-smart-indentation nil)) (add-hook 'python-mode-hook 'kf-python-mode-hook) (defun kf-try-out-jedi () "Playing around with Jedi." (interactive) (require 'package) ;; Standard package.el + MELPA setup ;; (See also: https://github.com/milkypostman/melpa#usage) (add-to-list 'package-archives '("melpa" . "http://melpa.milkbox.net/packages/") t) (package-initialize) (package-refresh-contents) ; `package-list-packages' might work too (package-install 'jedi) (jedi:install-server) (add-hook 'python-mode-hook 'jedi:setup) ;; See https://emacs.stackexchange.com/questions/17963/\ ;; python-jedi-completion-layout-unusable and ;; https://github.com/tkf/emacs-jedi/issues/226 for why ;; the next two lines are necessary. (setq jedia:ac-max-width 0.5) (setq ac-max-width 0.5) ;; Start completing as soon as the user types the dot. (setq jedi:complete-on-dot t) (message "Okay, now open a Python file.")) (setq compilation-scroll-output t) (add-hook 'dired-mode-hook (function (lambda () (keymap-local-set "e" (lambda () (interactive) (edit-pr (file-name-nondirectory (dired-get-filename)))))))) (defun kf-conf-mode-hook () "Keep my preferred keybindings when in `conf-mode'." (when (eq (keymap-lookup nil "C-c ") 'conf-space-keywords) (keymap-local-set "C-c " 'kf-push-to-column))) (add-hook 'conf-mode-hook 'kf-conf-mode-hook) ;;; Common Lisp / SBCL stuff (setq sly-replace-slime t) ;; see PR below (dolist (lib (list ;; If https://github.com/joaotavora/sly/pull/639 gets ;; merged into SLY then we can pre-load SLIME again: ;; ;; "slime" "sly")) (let ((lib-path (expand-file-name (format "~/src/%s/%s.el" lib lib)))) (add-to-list 'load-path (expand-file-name (format "~/src/%s" lib))) (require (intern lib)))) (defun kf-text-mode-hook () (setq require-final-newline nil) (setq case-fold-search t)) (add-hook 'text-mode-hook 'kf-text-mode-hook) (defun kf-find-file-hook () (if (or (string-match "src/subversion/" buffer-file-name) (string-match "src/locking/" buffer-file-name)) (load (concat kf-src-directory "/subversion/tools/dev/svn-dev")))) (add-hook 'find-file-hooks 'kf-find-file-hook) (add-hook 'find-file-hook 'kf-find-file-hook) (defun kf-maybe-set-compile-command () "In known special buffers only, set compile-command. Return non-nil iff did set compile-command." (interactive) (if (string-match ".*go-book.*\\|.*bureaucracy/propaganda.*" (buffer-file-name)) (progn (make-variable-buffer-local 'compile-command) (setq compile-command (concat "make " (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))))) ;; Else we didn't set compile-command, so return nil. nil)) (defun kf-*tex*-mode-set-compile-command (formatter-cmd) "Give compile-command a useful default value in tex, latex, and texinfo modes." (make-local-variable 'compile-command) (let ((fname (file-name-sans-extension (buffer-name)))) (setq compile-command (concat formatter-cmd " " (buffer-name) "; " "dvips -f < " fname ".dvi" " > " fname ".ps; " "gv " fname ".ps &")))) (add-hook 'texinfo-mode-hook (function (lambda () (kf-*tex*-mode-set-compile-command "tex")))) (add-hook 'plain-tex-mode-hook (function (lambda () (kf-*tex*-mode-set-compile-command "tex")))) (defun kf-latex-mode-hook () (or (kf-maybe-set-compile-command) (kf-*tex*-mode-set-compile-command "latex")) (when (eq (keymap-lookup nil "C-") 'tex-feed-input) (keymap-local-set "C-" 'kf-worship-frame))) (add-hook 'latex-mode-hook 'kf-latex-mode-hook) (defun kf-kill-emacs-hook () ;; `save-buffers-kill-emacs' in files.el doesn't run the hooks in ;; `kill-emacs-hook' until after it's already done the process ;; check. Therefore, my code below does no good here. I made a ;; proposal on emacs-devel to fix this at the source: ;; ;; http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00800.html ;; From: Karl Fogel ;; To: Emacs Development ;; Subject: PROPOSAL: Control over process cleanup in `save-buffers-kill-emacs'. ;; Date: Fri, 22 Sep 2017 13:58:41 -0500 ;; Message-ID: <87poai36hq.fsf@red-bean.com> (mapcar (lambda (buf) (when (string-match "^ \\*imap source\\*.*" (buffer-name buf)) (message "shutting down IMAP process '%s'" (get-buffer-process buf)) (sit-for 1) ;; Hunh. Sometimes when I exited, I was getting ;; ;; "error in process filter: process-get: \ ;; Wrong type argument: processp, nil" ;; ;; or something similar to that, in cases where some of ;; my imap process buffers had had things go wrong (for ;; example, trying to use IMAP over a Regus office ;; network connection, sometimes -- but I digress). For ;; now, my solution is to just comment this out, but in ;; the long term the problem the expression below was ;; designed to solve is still there and a better ;; solution will be needed. ;; ;; (set-process-query-on-exit-flag (get-buffer-process buf) nil) ;; ;; Or we could set `confirm-kill-processes' to nil to ;; solve this problem generally -- c.f. [ref:1804d56c]. (kill-buffer buf))) (buffer-list)) (unless noninteractive (when (not (y-or-n-p "Really go away? ")) (error "*** Still here! ***"))) t) (add-hook 'kill-emacs-hook 'kf-kill-emacs-hook) ;; Comint stuff (setq shell-pushd-regexp "pushd\\|pu") ; for dirtracking in cmushell (setq shell-popd-regexp "popd\\|po") ; for dirtracking in cmushell (setq shell-dirstack-query "dirs -l") ; I'm often many different people (setq-default shell-dirstack-query "dirs -l") (add-hook 'shell-mode-hook (function (lambda () (let ((p (get-buffer-process (current-buffer)))) (when (processp p) ;; We could set `confirm-kill-processes' to nil to ;; have this behavior generally, and that might be ;; useful elsewhere too -- see (ref:1804d56c). (set-process-query-on-exit-flag p nil)))))) (add-hook 'comint-output-filter-functions 'shell-strip-ctrl-m) (autoload 'shell-strip-ctrl-m "shell" "Needed for comint stuff.") (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt) (setq history-length 1000) (setq comint-password-prompt-regexp (concat "\\(" "^Enter passphrase.*:" "\\|" "^Repeat passphrase.*:" "\\|" "[Pp]assword for '[a-z0-9_-.]+':" "\\|" "\\[sudo\\] [Pp]assword for [a-z0-9_-.]+:" "\\|" "[a-zA-Z0-9]'s password:" "\\|" "^[Pp]assword:" "\\|" "^[Pp]assword (again):" "\\|" ".*\\([Ww]ork\\|[Pp]ersonal\\).* password:" "\\|" "Password for '([^()]+)' GNOME keyring" "\\|" "Password for 'http.*github.*':" "\\)")) (defun kf-shell (&optional prompt) "Ensure all my standard shell buffers exist, and switch to `*shell*'. With prefix arg PROMPT, ask for a name and make a shell buffer of that name." (interactive "P") (let ((buffers (list "*shell*" "shell" "z" "mprop" "alt-long")) (home-dir-buf nil)) (when prompt (setq buffers (cons (read-string "Create shell buffer: ") buffers))) (dolist (buf buffers) (save-excursion (find-file (expand-file-name "~/")) (setq home-dir-buf (current-buffer)) (set-buffer (get-buffer-create buf)) (unless (eq major-mode 'shell-mode) (shell buf) (bury-buffer buf)))) ;; I'm okay with this side-effect. We could check before the ;; above `dolist' loop whether there was any buffer visiting my ;; home directory, and preserve it if there was. But in practice, ;; the only time I ever have such a buffer is so I can start a ;; shell buffer from the right place anyway. (kill-buffer home-dir-buf) ;; One buffer is for running a particular command, ;; so let's get that command set up ahead of time. (set-buffer "mprop") (let ((opoint (point))) (goto-char (point-max)) ;; Note that this may not work in time the first time this ;; buffer is created (which is usually the first time this ;; function is run), because the shell process won't have had ;; enough time to get up and running, so the prompt won't be in ;; place yet, so the call to `comint-bol-or-process-mark' below ;; won't put point where we want it to put point. While there ;; are probably ways to fix this, in practice there's no need ;; to, because the 2nd time and after that we run this function, ;; the mprop buffer's shell process will be running and so the ;; Right Thing will happen in the buffer -- in other words, by ;; the time we actually visit the buffer, the command we're ;; expecting it to be initialized with will be set up. (comint-bol-or-process-mark) (if (and (not (bolp)) (looking-at "$")) (insert "time ~/bin/mailaprop/run-mailaprop.sh") (goto-char opoint))) ;; Once everything's done, we want to be in "*shell*". (switch-to-buffer (get-buffer (car buffers))))) (defun kf-swap-shell-buffers (&optional other-shell) "Switch the names of the `*shell*' and `shell' buffers (which must exist). This is useful when you start something in the former that ends up being a longer-running command than you expected." (interactive) (save-excursion (set-buffer "*shell*") (let ((obuf (current-buffer))) (rename-buffer (generate-new-buffer-name "kf-swap-shell-buffer-tmp")) (set-buffer "shell") (rename-buffer "*shell*") (set-buffer obuf) (rename-buffer "shell")))) (when (boundp 'display-buffer-alist) (add-to-list 'display-buffer-alist '("^\\*shell\\*$" . (display-buffer-same-window)))) ;;; loads should happen after possible user vars have been set. (load "jka-compr" nil t) (autoload 'bookmark-menu-jump "bookmark" "" t) (autoload 'flash-matching-char "flashparen") ;; radix.el stuff (base conversion): (autoload 'number-to-number "radix" "Convert NUMBER in radix RADIX1 to string in radix RADIX2." t) (autoload 'hex-to-string "radix" "Convert arg HEX ascii to a one-character string." t) (autoload 'string-to-hex "radix" "Convert arg STRING to hexadecimal ascii." t) (autoload 'apply-operator "radix" "Apply OPERATOR, returning in radix RADIX, to NUMBERS." t) (autoload 'balance-mode "balance" "" t) (autoload 'python-mode "python" "" t) (autoload 'run-scheme "cmuscheme" "Run an inferior Scheme" t) (autoload 'yank-match "yank-match" "Yank matches for REGEXP." t) (autoload 'jump-to-def "jump-def" "Jump to a definition." t) (autoload 'food-menu-mode "food-menu-mode" "Live to eat, yay!" t) (autoload 'c++-mode "c++-mode" "Obviously, be in C++ mode." t) (autoload 'pcn-mode "pcn-mode" "Be in PCN mode." t) (autoload 'bibl-mode "bibl-mode" "Browse a bibliography file." t) (autoload 'mandelbrot "mandel" "I can't believe I'm doing this in Emacs." t) (autoload 'fie-insert-insult "fie" "Insert an Elizabethan insult." t) ;; Get the fancy page behaviors no home should be without. (load "page-ext") (defun kf-bol-and-i-mean-it () "Go to beginning of line no matter what They say." (interactive) (forward-line 0)) (defun kf-ensure-point-before-mark () "If point is after mark, exchange point and mark. This is useful in macros. For example, in a LaTeX document, you could mark a region and then run a macro that puts a \"\\begin{foo}\" at the beginning of the region and \"\\end{foo}\" at the end, and not have to worry before running the macro whether you defined the region from top down or from bottom up." (interactive) (unless (<= (point) (mark)) (exchange-point-and-mark))) ;; I do *not* want that damned toolbar, nor Blinky, nor that annoying ;; new comint prompt behavior on C-a. (defun kf-comint-mode-hook () (when (eq (keymap-lookup nil "C-c ") 'comint-accumulate) (keymap-local-set "C-c " 'kf-push-to-column)) (keymap-local-set "C-a" 'kf-bol-and-i-mean-it)) (add-hook 'comint-mode-hook 'kf-comint-mode-hook) ;; Check, so that we don't remake frames that already exist... (when (not (boundp 'kf-display-stuff-already-loaded)) (transient-mark-mode 1) (setq mark-even-if-inactive t) (defvar suspend-hooks nil) ; should't be necessary! (when (fboundp 'scroll-bar-mode) (scroll-bar-mode -1)) (when (fboundp 'horizontal-scroll-bar-mode) (horizontal-scroll-bar-mode -1)) ;; following line should be superfluous, but since I can't ;; pronounce that word, I will play it safe: (add-to-list 'default-frame-alist '(vertical-scroll-bars . nil)) ;;;;;;;;;;;;;;;; This is re ref:8c67af33 in 'emacs.org' ;;;;;;;;;;;;;;;;; ;; ;; (add-to-list 'default-frame-alist '(menu-bar-lines . 3)) ;; (setq default-frame-alist (assq-delete-all 'menu-bar-lines default-frame-alist)) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (when (not (fboundp 'baud-rate)) (fset 'baud-rate (function (lambda () baud-rate)))) (when (and (eq window-system 'x) (>= emacs-major-version 21) (not (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version))) ;; What lovely new features! We'll put them right here on ;; the top shelf, so no one accidentally throws them away. (menu-bar-mode -1) (tool-bar-mode -1) (blink-cursor-mode -1) (auto-image-file-mode 1) ;; Apparently it's important to set the initial frame parameters ;; after turning off menu-bar-mode and tool-bar-mode. Otherwise, ;; the initial frame always ends up being 2 shorter than requested. (let* ((primary-monitor (car (display-monitor-attributes-list))) (geometry (assoc 'geometry primary-monitor)) (width (nth 3 geometry)) (height (nth 4 geometry)) (dimensions (format "%dx%d" width height))) (cond ;; This duplicates the branches in ~/bin/set-up-workspaces. ;; Really, I should just compute the Emacs text-based width ;; and height dynamically here based on screen size, instead ;; of having all these cases. ((or (string-equal "1920x1080" dimensions) (string-equal "3286x1080" dimensions)) (setq initial-frame-alist `((top . 1) (left . 2) (width . ,kf-conservative-frame-width) (height . 50)))) ((string-equal "1680x1050" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) (width . ,kf-conservative-frame-width) (height . 48)))) ((string-equal "1280x1024" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) (width . ,kf-conservative-frame-width) (height . 47)))) ((string-equal "1280x800" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) ;; This is a guess; I haven't tested it yet. (width . ,kf-conservative-frame-width) (height . 41)))) ((string-equal "1366x768" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) ;; This is a guess; I haven't tested it yet. (width . ,kf-conservative-frame-width) (height . 34)))) ((string-equal "2160x1440" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) ;; This is a guess; I haven't tested it yet. (width . ,kf-conservative-frame-width) (height . 41)))) ((string-equal "1024x768" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) (width . ,kf-conservative-frame-width) (height . 34)))) (kf-laptop (setq initial-frame-alist `((top . 1) (left . 2) (width . ,kf-conservative-frame-width) (height . 37)))))) (setq search-highlight t) ;; below good or not? (setq highlight-nonselected-windows nil) (when (facep 'menu) (progn (set-face-background 'menu "black") (set-face-foreground 'menu "grey58"))) (set-frame-font "10x20") (when (string-equal (user-real-login-name) "kfogel") (set-face-background 'default "darkblue") (set-face-foreground 'default "yellow")) (set-face-background 'mode-line "grey85") (set-face-foreground 'mode-line "black") (set-face-background 'highlight "grey30") (set-face-foreground 'highlight "white") (or (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version) (set-face-background 'region "grey30")) (or (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version) (set-face-foreground 'region "white")) ;; https://lists.gnu.org/archive/html/emacs-devel/2022-01/threads.html#01227 ;; ("Can watermarking Unicode text using invisible differences ;; sneak through Emacs, or can Emacs detect it?") explains this ;; next setting, and furthermore proves the proposition, long ;; suspected by semantophysicists, that there is no issue so ;; simple that someone on Emacs Devel cannot find a way to ;; misunderstand it. TL;DR: It helps show whether someone is ;; playing funny information-theoretic games with ZWJ / ZWNJ. ;; ;; See also `glyphless-display-mode' as an alternative. (set-face-background 'glyphless-char "red") (setq kf-display-stuff-already-loaded t) ;; enable wheelmouse support by default (mwheel-install))) ;;; Threats! (defconst emacs-threats '["because you deserve a brk today." "the definitive fritterware." "... it's not just a way of life, it's a text editor!" "the only text editor known to get indigestion." "is that a Lisp interpreter in your editor, or are you just happy to see me?" "no job too big... no job." "the Swiss Army of Editors." "Lovecraft was an optimist." "indefensible, reprehensible, and fully extensible." "where Turing-completeness is only the beginning..." "Resistance is futile; you will be assimilated and byte-compiled." "because extension languages should come with the editor built in." "if it payed rent for disk space, you'd be rich." "a compelling argument for pencil and paper." "it's like swatting a fly with a supernova." "the only text-editing software to require its own heat sink." "featuring the world's first municipal garbage collector!" "the road to Hell is paved with extensibility." "a learning curve you can use as a plumb line." "there's a reason it comes with a built-in psychotherapist." "it's not slow --- it's stately." "is that a text-editor you've got there, or is it Montana?" "more than just a Lisp interpreter, a text editor as well!" "freely redistributable; void where prohibited by law." "(setq software-quality (/ 1 number-of-authors))" "because idle RAM is the Devil's playground." "a Lisp interpreter masquerading as ... a Lisp interpreter!" "anything free is worth what you paid for it." "ballast for RAM." "more boundary conditions than the Middle East." "you'll understand when you're older, dear." "the prosecution rests its case." "don't cry -- it won't help." "because one operating system isn't enough." "well, why *shouldn't* you pay property taxes on your editor?" "a real time environment for simulating molasses-based life forms." "if SIGINT doesn't work, try a tranquilizer." "an inspiring example of form following function... to Hell." "because editing your files should be a traumatic experience." "or perhaps you'd prefer Russian Roulette, after all?" "it's all fun and games, until somebody tries to edit a file." "impress your (remaining) friends and neighbors." "ed :: 20-megaton hydrogen bomb : firecracker" "because Hell was full." "where editing text is like playing Paganini on a glass harmonica." "the answer to the world surplus of CPU cycles." "don't try this at home, kids." "everything *and* the kitchen sink." "why choose between a word processor and a Lisp interpreter when you could have neither instead?"] "Facts about Emacs that you and your loved ones should be aware of.") (defconst x-windows-threats '["a mistake carried out to perfection." "a moment of convenience, a lifetime of regret." "a terminal disease." "all the problems and twice the bugs." "complex nonsolutions to simple nonproblems." "dissatisfaction guaranteed." "don't get frustrated without it." "even your dog won't like it." "flaky and built to stay that way." "flawed beyond belief." "big enough to hurt." "foiled again." "even not doing anything would have been better than nothing." "form follows malfunction." "garbage at your fingertips." "ignorance is our most important resource." "it could be worse, but it'll take time." "it could happen to you." "let it get in *your* way." "live the nightmare." "more than enough rope." "never had it, never will." "no hardware is safe." "power tools for power fools." "power tools for power losers." "putting new limits on productivity." "simplicity made complex." "some voids are better left unfilled." "sometimes you fill a vacuum and it still sucks." "the cutting edge of obsolescence." "the defacto substandard." "the first fully modular software disaster." "the joke that kills." "the problem for your problem." "there's got to be a better way." "warn your friends about it." "you'd better sit down." "you'll envy the dead." "graphics hacking :: Roman numerals : sqrt (pi)"] "What users said as they collapsed.") (defconst microsoft-threats '["I'm not laughing anymore." "where the service packs are larger than the original releases." "programs so large they have weather." "with our software, there's no limit to what you can't do!" "world domination wasn't enough -- we had to write bad software, too!" "where even the version numbers aren't Y2K-compliant" "making the world a better place... for Microsoft." "where `market lock-in' means throwing away the keys." "we've got the solution for the problem we sold you."] "Read this while rebooting.") (defconst gdb-threats '["the only tool for debugging GDB." "oh, I didn't know that \"breakpoint\" meant \"the debugger breaks here\"!" "" ; jimb needs to send me his other two ] ".") (defconst food-place-threats '["Salad Tank" "Fudge Sidewalk" "Bun Vault" "Venison Breezeway" "Burger Ditch" "Cake Tent" "Fondue Lean-To" "Gazpacho Vestibule" "Burrito Stairway" "Corndog Encampment" "Butter Kiln" "Kebab Ramp" "Tapas Runway" "Crumpet Bank" "Noodle Cave" "Borscht Grotto" "Sauerkraut Chimney" "Pasta Pergola" "Waffle Canyon" "Yam Lab" "Soda Jail" "Curry Wall" ] "Pizza Hut was just the first tentacle in the building.") (defun threat-of-the-day (threat-list &optional prefix) "Return a morsel of wisdom from the feast in THREAT-LIST. Prefix it with PREFIX, if non-nil." (or prefix (setq prefix "")) (concat prefix (elt threat-list (random (length threat-list))))) (defmacro threat-of-the-day-generator (category doc-string &optional no-prefix) "Define function `CATEGORY-threat-of-the-day' taking no arguments and returning a random threat from the vector `CATEGORY-threats'. CATEGORY is a string indicating the threat category. DOC-STRING is the doc string for the generated function. Prefix threats with capitalized category unless NO-PREFIX." (declare (indent 1)) `(defun ,(intern (concat category "-threat-of-the-day")) () ,doc-string (interactive) (let ((threat (threat-of-the-day (symbol-value (intern (concat ,category "-threats"))) (unless ,no-prefix (concat (capitalize ,category) ": "))))) (if (called-interactively-p) (message threat) threat)))) (threat-of-the-day-generator "x-windows" "Deny it if you dare.") (threat-of-the-day-generator "emacs" "A Cautionary Tale.") (threat-of-the-day-generator "microsoft" "Straight from public relations.") (threat-of-the-day-generator "gdb" "*It has a built-in debugger for a reason.") (threat-of-the-day-generator "food-place" "*The full market space has yet to be explored." t) (defun kf-wine-review () (interactive) ;; Source: subversion/subversion/libsvn_subr/hash.c (insert "A forthright entrance, yet coquettish on the tongue, its " "deceptively fruity exterior hides the warm mahagony undercurrent " "that is the hallmark of Chateau Fraisant-Pître. Connoisseurs of " "the region will be pleased to note the familiar, subtle hints of " "mulberries and carburator fluid. Its confident finish is marred " "only by a barely detectable suggestion of rancid squid ink.")) ;;; End threats. ;;; (defconst kf-mode-incantations (list '["High" "Noble" "Large" "Capacious" "Grandiose" "Wise"] '["Puissant" "Omnipotent" "Omniscient" "Powerful" "Majestic" "Gracious" "Fragrant" ]) "*Visions of the Gnuddha.") (defun kf-flatter-noun (noun) (let* ((adjectives1 (car kf-mode-incantations)) (adjectives2 (car (cdr kf-mode-incantations))) (adj1 (elt adjectives1 (random (length adjectives1)))) (adj2 (elt adjectives2 (random (length adjectives2))))) (format "Oh Most %s and %s %s" adj1 adj2 noun))) (defun kf-auto-auto-mode-line (mode) "Put a `-*- MODE -*-' line at the top of this buffer. Prompts for MODE completingly, but without forcing a match." (interactive (progn (barf-if-buffer-read-only) (list (completing-read "Mode: " '(("org") ("outline") ("text") ("scheme") ("lisp") ("emacs-lisp") ("c") ("perl") ("python") ("objc")) nil nil "org" )))) (goto-char (point-min)) (insert (kf-flatter-noun "Emacs") ", please be in -*- " mode " -*- mode!\n\n") (goto-char (point-min)) (center-line) (goto-char (point-min)) (insert " ") (funcall (intern (concat mode "-mode")))) (when (not (fboundp 'auto-auto-mode-line)) (defalias 'auto-auto-mode-line 'kf-auto-auto-mode-line)) (defun kf-perl-mode-style (style) "STYLE is one of \"k&r\", \"bsd\", \"blk\", \"gnu\", \"lw\", \"kff\". K&R BSD BLK GNU LW KFF perl-indent-level 5 8 0 2 4 2 perl-continued-statement-offset 5 8 4 2 4 4 perl-continued-brace-offset 0 0 0 0 -4 -4 perl-brace-offset -5 -8 0 0 0 0 perl-brace-imaginary-offset 0 0 4 0 0 0 perl-label-offset -5 -8 -2 -2 -2 -2 " (interactive (list (completing-read "Style: " '(("k&r") ("bsd") ("blk") ("gnu") ("lw") ("kff")) nil t))) (cond ((string-equal style "k&r") (setq perl-indent-level 5) (setq perl-continued-statement-offset 5) (setq perl-continued-brace-offset 0) (setq perl-brace-offset -5) (setq perl-brace-imaginary-offset 0) (setq perl-label-offset -5)) ((string-equal style "bsd") (setq perl-indent-level 8) (setq perl-continued-statement-offset 8) (setq perl-continued-brace-offset 0) (setq perl-brace-offset -8) (setq perl-brace-imaginary-offset 0) (setq perl-label-offset -8)) ((string-equal style "blk") (setq perl-indent-level 0) (setq perl-continued-statement-offset 4) (setq perl-continued-brace-offset 0) (setq perl-brace-offset 0) (setq perl-brace-imaginary-offset 4) (setq perl-label-offset -2)) ((string-equal style "gnu") (setq perl-indent-level 2) (setq perl-continued-statement-offset 2) (setq perl-continued-brace-offset 0) (setq perl-brace-offset 0) (setq perl-brace-imaginary-offset 0) (setq perl-label-offset -2)) ((string-equal style "lw") (setq perl-indent-level 4) (setq perl-continued-statement-offset 4) (setq perl-continued-brace-offset -4) (setq perl-brace-offset 0) (setq perl-brace-imaginary-offset 0) (setq perl-label-offset -2)) ((string-equal style "kff") (setq perl-indent-level 2) (setq perl-continued-statement-offset 4) (setq perl-continued-brace-offset -4) (setq perl-brace-offset 0) (setq perl-brace-imaginary-offset 0) (setq perl-label-offset -2)))) ;;; CSS and Javascript ;;; (setq-default css-indent-offset 2) (defun kf-js-mode-hook () (setq require-final-newline nil)) (add-hook 'js-mode-hook 'kf-js-mode-hook) (defun kf-css-mode-hook () (setq require-final-newline nil)) (add-hook 'css-mode-hook 'kf-css-mode-hook) ;;; SQL mode ;;; (defun kf-sql-mode-hook () (setq require-final-newline nil)) (add-hook 'sql-mode-hook 'kf-sql-mode-hook) ;;; Shell mode ;;; (defun kf-sh-mode-hook () "Can't believe how long it took before I wrote this." (interactive) (setq sh-basic-offset 2 sh-indentation 2)) (add-hook 'sh-mode-hook 'kf-sh-mode-hook) ;;;; Standard defs, mostly bound upstairs. (defun kf-count-characters-region (start end) "Return the number of characters between START and END." (interactive "r") (if (called-interactively-p) (message (concat "Region has " (int-to-string (- end start)) " characters.")) (- end start))) ;; Emacs has C-x h M-= (defun kf-count-characters-buffer () (interactive) (message "%S" (kf-count-characters-region (point-min) (point-max)))) (defun kf-count-words-region (start end) "Return the number of entire words between START and END." (interactive "r") (when (> start end) ; guarantee that start is before end (let ((tmp start)) (setq start end) (setq end tmp))) (save-excursion (goto-char start) (let ((count 0)) (while (< (point) end) (forward-word 1) (when (<= (point) end) (setq count (1+ count)))) ;; Now we're at the end of the region, but a devious off-by-one ;; error may have happened. If the text ended with punctuation, ;; `forward-word' would have moved once over that punctuation. ;; For example, suppose point starts before "house" below, and ;; that the buffer ends right after the period: ;; ;; flower house. ;; ;; You can do `forward-word' twice before reaching the end of ;; the buffer, even though there's only one actual word between ;; point and the end of the buffer. ;; ;; To check for this, upon reaching the end we go back one word ;; and forward one word. If we wind up in the same place then ;; our count was accurate; otherwise, we decrement the count. (let ((end-posn (point))) (forward-word -1) (forward-word 1) (when (/= (point) end-posn) (setq count (1- count)))) (if (called-interactively-p) (message (concat "Region has " (int-to-string count) " words.")) count)))) (defun kf-count-words-buffer () (interactive) (message "%S" (kf-count-words-region (point-min) (point-max)))) (defconst kf-words-per-minute 250 "*I seem to speak about about 250 words per minute.") (defun kf-count-minutes-region (start end) "Return the number of speech minutes between START and END." (interactive "r") (let ((minutes (/ (kf-count-words-region start end) kf-words-per-minute))) (message "%S minutes" minutes) minutes)) (defun kf-count-minutes-buffer (start end) "Return the number of speech minutes in the buffer." (interactive "r") (kf-count-minutes-region (point-min) (point-max))) (defalias 'kf-region-length 'kf-count-characters-region) (defun kf-reverse-region (start end) "Reverse the region between point and mark, by Jim Blandy." (interactive "*r") (goto-char end) (let ((p end)) (while (> p start) (insert (char-after (setq p (1- p)))))) (delete-region start end) (goto-char start)) (defun kf-insert-variable (var) "Insert the value of lisp variable VAR into the current buffer. VAR should be a string or a number; if it is a number, it will be converted into a string and then inserted." (interactive "*vInsert variable: ") (cond ((stringp (symbol-value var)) (insert (symbol-value var))) ((numberp (symbol-value var)) (insert (int-to-string (symbol-value var)))) (t (error (concat (symbol-name var) " not a string or integer!"))))) (defun kf-markup-flavor () "Return a symbol indicating what kind of markup to use, such as `org', `xml', `texi', `html', `ltx', or nil, taking the filename extension into account as well as the buffer's major mode. It's better to use this than to rely solely on the major mode, because for certain formats I don't always use the dedicated Emacs major mode for that format, preferring to edit in text mode." (cond ((eq major-mode 'org-mode) 'org) ((eq major-mode 'html-mode) 'html) ((eq major-mode 'php-mode) 'php) ((eq major-mode 'texinfo-mode) 'texi) ((eq major-mode 'latex-mode) 'ltx) (t (let ((extension (file-name-extension (buffer-name)))) (when extension (save-match-data (when (string-match "\\([^<]+\\)<[^<>]+>$" extension) (setq extension (match-string 1 extension))) (intern extension))))))) (defun kf-switch-handler-e () "This is like the other switch-handler functions, which see." (interactive) (cond ((eq major-mode 'gnus-summary-mode) (dlet ((gnus-expert-user t)) (gnus-summary-expire-articles-now))) (t (call-interactively 'kf-surround-with)))) (defun kf-surround-with (char &optional parg) "Insert two of the same CHAR around a string near point. The string is delimited by whitespace, although the function will do the right thing at beginning or end of line/buffer. Also does the right thing if the char is one of a matching pair. Certain chars stand for more complex markup in certain modes: for example, 's' does HTML tags, and 'e' does emphasis tags for various markup languages. The markup syntax is determined using kf-markup-flavor; note that XML is interpreted to mean the DocBook Lite DTD. The prefix arg has various meanings. Usually it means don't do complex markup, but in a few cases, where non-complex markup would virtually never be useful and there are two useful forms of complex markup, it signals which of the two forms to generate." (interactive "*cSurround with char: \nP") ;; hmm, ought to be able to do this with syntax tables? (let ((begthing char) (endthing char) (handle-ac nil) ; special case for LaTeX \ac{...} (markup-flavor (kf-markup-flavor))) ;; Generally, default to HTML if no known extension. (cond ((and (not parg) (equal char ?a)) (cond ((eq markup-flavor 'ltx) (setq begthing "\\ac{") (setq handle-ac t) (setq endthing "}")))) ((and (not parg) (equal char ?b)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")) ((eq markup-flavor 'ltx) (setq begthing "\\textbf{") (setq endthing "}")) ((or (eq markup-flavor 'html) (eq major-mode 'text-mode)) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?i)) (cond ((eq markup-flavor 'ltx) (setq begthing "\\textit{") (setq endthing "}")) (t (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?c)) (cond ((eq markup-flavor 'ltx) (setq begthing "\\code{") (setq endthing "}")) ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")) (t ; Ah, what the heck, let's default to XML anyway. (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?e)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")) ((eq markup-flavor 'ltx) (setq begthing "\\emph{") (setq endthing "}")) ((or t ; Remove this `t' if we ever choose another default for "e". (eq markup-flavor 'html) (eq major-mode 'text-mode)) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?f)) (cond ((eq markup-flavor 'ltx) (setq begthing "\\fullref{") (setq endthing "}")) ((eq markup-flavor 'texi) (setq begthing "@file{") (setq endthing "}")) ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?r)) (when (eq markup-flavor 'ltx) (setq begthing "\\ref{") (setq endthing "}"))) ((and (not parg) (equal char ?u)) (if (eq markup-flavor 'ltx) (progn (setq begthing "\\otsurl{") (setq endthing "}")) (setq begthing "") (setq endthing ""))) ((and (not parg) (equal char ?t)) (cond ((eq markup-flavor 'ltx) (setq begthing "\\texttt{") (setq endthing "}")) (t (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?s)) (cond ((eq markup-flavor 'html) (setq begthing "") (setq endthing "")) ((eq markup-flavor 'ltx) (setq begthing "\\textbf{ ") (setq endthing "}")) ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?l)) (setq begthing "") (setq endthing "")) ((and (not parg) (equal char ?r)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")) ((eq markup-flavor 'html) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?e)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")) ((eq markup-flavor 'texi) (setq begthing "@emph{") (setq endthing "}")) ((eq markup-flavor 'ltx) (setq begthing "{\\em ") (setq endthing "}")))) ((and (not parg) (equal char ?c)) (cond ((eq markup-flavor 'texi) (setq begthing "@code{") (setq endthing "}")) ((eq markup-flavor 'xml) (setq begthing "(") (setq endthing ")")))) ((and (not parg) (equal char ?n)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?F)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")))) ((equal char ?x) (cond ((eq markup-flavor 'xml) (if parg (progn (setq begthing " in ")) (setq begthing ""))))) ((or (equal char ?{) (equal char ?})) ; get matching char (setq begthing ?{) (setq endthing ?})) ((or (equal char ?\() (equal char ?\))) ; get matching char (setq begthing ?\() (setq endthing ?\))) ((or (equal char ?<) (equal char ?>)) ; get matching char (setq begthing ?<) (setq endthing ?>)) ((and (equal char ?') (eq major-mode 'emacs-lisp-mode)) (setq begthing ?`) (setq endthing ?')) ;; Having backticks on both sides is useful in some wikis. ;; ((equal char ?`) ; do matching quote, but only via backtick ;; (setq begthing ?`) ;; (setq endthing ?')) ((or (equal char ?\[) (equal char ?\])) ; get matching char (setq begthing ?\[) (setq endthing ?\])) ((and (not parg) ; do *TeX quotes (equal char ?\") (eq markup-flavor 'ltx) (not (nth 4 (syntax-ppss)))) ; see commit 2b404e8391b7 of ; 30 Aug 2016 in GNU Emacs. (setq begthing "``") (setq endthing "''"))) ;; Okay, now discover the appropriate boundaries and surround: (re-search-backward "^\\|\\s-" (point-min)) (if (not (bolp)) (re-search-forward "\\s-") (when (looking-at "\\s-") (re-search-forward "\\s-"))) (if (stringp begthing) (insert begthing) (insert-char begthing 1)) (let ((opoint (point))) (if (re-search-forward "\\s-\\|\n" (point-max) t) (forward-char -1) (goto-char (point-max))) (let ((lastchar (char-after (1- (point))))) (when (= lastchar ?,) (forward-char -1))) (if (stringp endthing) (insert endthing) (insert-char endthing 1)) (if (= (point) (1+ opoint)) (forward-char -1) (when handle-ac ;; Since we know we're surrounding an acronym, let's take ;; care of upcasing the surrounded text too -- thus ;; relieving my grateful pinkies of some shift-key time. (upcase-region opoint (point)) ;; Leave point right before the opening "{", in case this ;; "\ac" needs to be "\acp" or one of other other variants. (goto-char (1- opoint)))) ))) (defun kf-hypherscore (parg) "Insert a character (e.g., `-', `_', `/') between this word and the next. The character inserted is the final key (minus any modifiers) in the key sequence by which this function was invoked. For example, if it is bound to C-c C-/, then typing that will insert `/' between this word and the next. If the words are already separated by some other non-whitespace character, then remove that character before inserting its replacement. Prefix argument PARG is the number of times to operate, moving forward by word; treat PARG as 1 if nil." (interactive "*p") (let* ((cmd-keys (this-command-keys-vector)) (char (event-basic-type (aref cmd-keys (1- (length cmd-keys)))))) (when (null parg) (setq parg 1)) (while (> parg 0) (forward-word 1) (delete-horizontal-space) (when (looking-at-p "\\Sw") (delete-char 1)) (insert char) (setq parg (1- parg))))) ;;; find-load-file.el - figure out which file will get loaded ;;; Jim Blandy - February 1993 (fset 'visit-library 'find-library) (defun find-library (filename) "Find the Emacs Lisp library file \(using the same algorithm that searches the load-path when loading files\) and visit it in a buffer." (interactive "sName of library to find: ") ;; give t as second arg to locate-library to avoid editing ;; .elc files (let ((fullname (locate-library filename t))) (if fullname (find-file fullname) (when (called-interactively-p) (message "`%s' not found." filename))))) (defun kf-where-am-I (&optional noninteractive) "Display and return name of current class or defun. If optional arg NONINTERACTIVE is true, then just return it." (interactive) (let ((name nil)) (cond ((or (eq major-mode 'c-mode) (eq major-mode 'lisp-mode) (eq major-mode 'emacs-lisp-mode) (eq major-mode 'perl-mode) (eq major-mode 'java-mode) (eq major-mode 'objc-mode) (eq major-mode 'scheme-mode)) (save-excursion (beginning-of-defun) (if (looking-at "(") ;; A Lispy defun (progn (forward-word 1) (forward-char 1)) ;; Else it's probably a C or Perl function; assume GNU style (forward-line -1)) ;; move past "sub " if Perl: (when (looking-at "^sub ") (forward-word 1) (forward-char 1)) (setq name (buffer-substring (point) (progn (forward-sexp 1) (point)))))) ((eq major-mode 'python-mode) (setq name (add-log-current-defun))) ((or (eq major-mode 'tex-mode) (eq major-mode 'latex-mode)) (save-excursion (re-search-backward "^\\\\[a-z]+section{") (search-forward "{") (setq name (buffer-substring-no-properties (point) (progn (search-forward "}") (forward-char -1) (point)))))) ((eq major-mode 'fundamental-mode) ;; We'll treat Fundamental Mode like a Subversion dumpfile. ;; Hey, at least it's more useful than doing nothing. (save-excursion (re-search-backward "^Revision-number: \\([0-9]+\\)") (setq name (concat "Revision " (match-string 1))))) (t (setq name " ??? "))) (unless noninteractive (message name)) name)) ;; If you're wondering why this is here, this comment won't help. (load "rot13" nil t) (defconst kf-golden-ratio (/ (1+ (sqrt 5.0)) 2.0) "The golden ratio, of course.") (defun kf-golden-ratio (height) "Return the width of a golden rectangle of height HEIGHT. HEIGHT is assumed to be shorter than the width." (* golden-ratio (float height))) (defun kf-really-cant-say (b e &optional rand-limit) "RANDOMLY capitalize CERTAIN WORDS in the region from B to E. Optional third arg RAND-LIMIT means capitalize roughly one out of every RAND-LIMIT words." (interactive "*r") (or rand-limit (setq rand-limit 8)) (save-excursion (goto-char b) (if (bobp) nil (forward-word -1) (forward-word 1)) (while (< (point) e) (if (zerop (random rand-limit)) (upcase-word 1) (forward-word 1))))) (when (not (fboundp 'really-cant-say)) (defalias 'really-cant-say 'kf-really-cant-say)) (defun kf-insert-elizabethan-insult-header () "You know what this does." (interactive "*") (save-excursion (goto-char (point-min)) (re-search-forward "^Subject:") (forward-line 1) (insert "X-Elizabethan-Insult: ") (fie-insert-insult) (insert "\n"))) ;; Define a new symbol so `thing-at-point' can recognize the ;; boundaries of a file path component. For example, while ;; ;; (thing-at-point 'filename) ;; ;; could return "/foo/bar/baz/" when point is in "bar", ;; ;; (thing-at-point 'kf-thingatpt-realistic-filename) ;; ;; ...would return "bar", which is what we really want. (require 'thingatpt) (defvar kf-thingatpt-realistic-filename-chars (let ((tmp (string-replace "/" "" thing-at-point-file-name-chars))) ;; This next part is a bit brittle. It happens that ?: comes at ;; the end of `thing-at-point-file-name-chars', and this fact is ;; not likely to change, so we rely on it to eliminate colon as an ;; allowable character. The reason we don't just remove colon ;; from the string in the normal way (that is, by identifying it ;; as a colon) is that the expression "[:alnum:]" also occurs in ;; `thing-at-point-file-name-chars', and that contains colons. ;; ;; Fortunately, any such character-class expression will by ;; definition never end with a colon, and therefore removing a ;; *final* colon from `thing-at-point-file-name-chars' will always ;; have the semantics we expect. The only thing that could go ;; wrong is that maybe some day someone would move the individual ;; colon from the end to somewhere else in the value, so we detect ;; that and error should it ever happen. (if (equal (aref tmp (1- (length tmp))) ?:) (setq tmp (substring tmp 0 (1- (length tmp)))) (error "`thing-at-point-file-name-chars' no longer ends with a colon")) tmp) "Characters allowable in realistic non-directory filenames.") (define-thing-chars kf-thingatpt-realistic-filename kf-thingatpt-realistic-filename-chars) (defun kf-flush-lines (keep) "Interactive wrapper for `delete-[non-]matching-lines'. With prefix arg KEEP, then call `delete-non-matching-lines'; otherwise, call `delete-matching-lines'. If the region is active, then match the region string (regexp quoted). Otherwise, if not at the beginning of a line then use the path-component-like string point is in as the basis for the regular expression to pass to the deletion function. For example, in these lines... prompt$ find . -name \"*.md\" -print ./some/random/path/to/README.md ./foo/bar/baz/qux/README.md ./foo/bar/baz/qux/etc/README.md ./foo/bar/baz/qux/etc/etc/README.md ./foo/bar/baz/qux/etc/etc/etc/README.md ./foo/bar/baz/qux/etc/etc/etc/etc/README.md ./foo/bar/baz/qux/etc/etc/etc/etc/etc/README.md ./etc/README.md ./etc/etc/ANOTHER_FILE.md ./etc/etc/etc/README.md prompt$ ...if point is in the first occurrence of the word \"qux\", then pass \"/qux/\" as the regexp parameter to `delete-matching-lines' or `delete-non-matching-lines', meaning that all lines that have a path containing a \"/qux/\" component will be deleted, or, as the case may be, preserved. On the other hand, if point is in an occurrence of \"README.md\", then the regexp will be \"/README\\.md$\" -- so that line and all those beneath it that contain \"/README.md\" will be deleted or preserved. This behavior is a time-saver for when one has done a 'find' command in a shell buffer and now has a lot of output from which one wants to filter out whole categories of output lines efficiently so as to quickly narrow down to the real suspects. The full regexp construction algorithm is a bit complicated to describe, but in general it should do what you expect. If anyone really wants it documented here, let me know (also, of course, documentation patches welcome). But my recommendation is that you just trust that it will either make the right guess, if it's confident it can do so, or else prompt you for the string to match." (interactive "*P") (let* ((func (if keep 'delete-non-matching-lines 'delete-matching-lines)) (ii-bounds ; initial-input-bounds (unless (bolp) (bounds-of-thing-at-point 'kf-thingatpt-realistic-filename))) (ii-leading-slash (and ii-bounds (= ?/ (char-before (car ii-bounds))) "/")) (ii-trailing-thing ; could be slash or (if grep output) colon (and ii-bounds (let ((next-char (char-after (cdr ii-bounds)))) (cond ((= ?/ next-char) "/") ((= ?: next-char) ":"))))) (initial-input (if (use-region-p) (regexp-quote (buffer-substring-no-properties (mark) (point))) (when ii-bounds (concat (when (= (char-before (car ii-bounds)) ?\n) "^") (regexp-quote (concat ii-leading-slash (buffer-substring-no-properties (car ii-bounds) (cdr ii-bounds)) ii-trailing-thing)) (when (= (char-after (cdr ii-bounds)) ?\n) "$"))))) (goal-col (when initial-input (current-column)))) (if initial-input (progn (beginning-of-line) (funcall func initial-input) (when goal-col ;; We assume we're in grep output. We want to move to our ;; goal column iff that column exists and is before ;; the colon separating filepath from matched text. (let ((colon-col (save-excursion (beginning-of-line) (when (search-forward ":" (pos-eol) t) (- (current-column) 2))))) ;; colon-col might be nil; hence the odd mini-conditional. (move-to-column (min goal-col (or colon-col goal-col)))))) (call-interactively func)))) ;; Window Configurations. ;; I wanted something simpler than `winner-mode'. Then, after I ;; wrote it and Tweeted about it, Alfred M. Szmidt replied to ask ;; (see https://twitter.com/amszmidt/status/1235248212153438208) ;; "Pardon the ignorance. How is the different from the very old ;; window-configuration-to-register and friends?" Answer: it's not. ;; I just didn't know about that method. Thank you, Alfred! ;; ;; So now I don't know if I'll maintain this here or not. Maybe I ;; will, though, because probably at some point over the next decade ;; I'll forget about the register functions and do `M-x apropos' again ;; and find my own functions first, which due to their names will be ;; slightly easier to spot in Apropos results. (defvar kf-window-configurations () "Alist of the form `(name window-configuration)'. See `kf-save-window-configuration' and `kf-restore-window-configuration'.") (defun kf-save-window-configuration (name) "Save current window configuration under NAME. If there is already a window configuration named NAME, update it. Interactively, prompt completingly for NAME." (interactive (list (completing-read "Save window configuration: " kf-window-configurations))) (let ((cell (assoc name kf-window-configurations))) (if cell (setcdr cell (list (current-window-configuration))) (setq kf-window-configurations (cons (list name (current-window-configuration)) kf-window-configurations))))) (defun kf-restore-window-configuration (window-configuration) "Restore window configuration NAME. Interactively, prompt completingly for NAME, unless only one NAME is available, in which case just use it without prompting." (interactive (list (if (= (length kf-window-configurations) 1) (car (cdr (car kf-window-configurations))) (car (cdr (assoc (completing-read "Restore saved window configuration: " kf-window-configurations nil t) kf-window-configurations)))))) (set-window-configuration window-configuration)) ;; Displaying. (defun kf-display-buffer (buffer) "Display BUFFER in a size-appropriate way." (display-buffer buffer) (shrink-window-if-larger-than-buffer (get-buffer-window buffer))) (defun kf-display-command-output (command) "Display output of COMMAND." (interactive "sCommand: ") (let ((cbuf (get-buffer-create "*Output*"))) (set-buffer cbuf) (erase-buffer) (insert "\n") (goto-char (point-min)) (shell-command command t) (kf-display-buffer cbuf))) ;; Now some commands using above mini-library: (defun kf-who () "Show users. Hit any key to make the window go away. The character typed is treated normally, not lost, by the way." (interactive) (kf-display-command-output "w")) (when (not (fboundp 'who)) (defalias 'who 'kf-who)) (defun kf-ps () "Show processes. Hit any key to make the window go away. The character typed is treated normally, not lost, by the way." (interactive) (kf-display-command-output "ps -aux")) (when (not (fboundp 'ps)) (defalias 'ps 'kf-ps)) (defun kf-cookie () "Show a cookie. Hit any key to make the window go away. The character typed is treated normally, not lost, by the way." (interactive) (kf-display-command-output "cookie")) (when (not (fboundp 'cookie)) (defalias 'cookie 'kf-cookie)) (defun kf-from () "Show mail from. Hit any key to make the window go away. The character typed is treated normally, not lost, by the way." (interactive) (kf-display-command-output "frm")) (when (not (fboundp 'from)) (defalias 'from 'kf-from)) (defun kf-df () "Show output of `df'. Hit any key to make the window go away. The character typed is treated normally, not lost, by the way." (interactive) (kf-display-command-output "df")) (when (not (fboundp 'df)) (defalias 'df 'kf-df)) (defun kf-take-care-of-tags-table () "[Re]Build and visit a tags table for a directory. Prompts for directory, but defaults to directory of current buffer." (interactive) (kf-require 'etags) (let ((dir (file-name-directory (read-file-name "Make tags table in: " default-directory)))) (shell-command (format "(cd %s; etags `${HOME}/bin/find-versioned.sh | grep \"\.[ch]$\"`)" dir)) (let ((tagfile (concat dir "TAGS"))) (if (file-exists-p tagfile) (progn (tags-reset-tags-tables) (visit-tags-table tagfile)) (error "No TAGS table created in %s" dir))))) (defvar kf-current-column nil "Used to preserve column across repeated invocations of some commands.") (defun kf-down-and-recenter (nlines) "Move viewport up, and point down, by NLINES, preserving column. Negative NLINES means what you think it means." (let ((col (if (or (eq last-command 'kf-next-line) (eq last-command 'kf-previous-line)) kf-current-column (setq kf-current-column (current-column))))) (scroll-up nlines) (forward-line nlines) (move-to-column col))) (defun kf-next-line (&optional nlines) "Move down NLINES (default: 1), preserving column, and recenter window." (interactive "p") (or nlines (setq nlines 1)) (kf-down-and-recenter nlines)) (defun kf-previous-line (&optional nlines) "Scroll the buffer to move line position." (interactive "p") (or nlines (setq nlines 1)) (kf-down-and-recenter (- 0 nlines))) ;; Noel Taylor sets this to 1 instead of 0. I go back and forth. (setq scroll-step 0) ;; The documentation for `scroll-step' recommends setting ;; `scroll-conservatively' to a large value instead. I don't see why ;; that's better, though. It's certainly more confusing. ;; (setq scroll-conservatively 99999) (defun kf-make-file-executable () "Make current buffer's file have permissions 755 \(rwxr-xr-x)\. This will save the buffer if it is not currently saved." (interactive) (set-buffer-modified-p t) (save-buffer) (chmod (buffer-file-name) 493)) (defun kf-split-window-vertically () "Split window at the cursor's current line." (interactive) (let ((h (window-height)) (count 1) ; avoid the o-b-o-e opoint lines) ;; Count how many lines cursor is from top of window, ;; then split there by passing that number to ;; `split-window-vertically': (save-excursion (beginning-of-line) (setq opoint (point)) (goto-char (window-start)) (while (< (point) opoint) (forward-line 1) (setq count (1+ count)))) (split-window-vertically count))) (defun kf-switch-handler-i (parg) "Do something depending on context. No, really. See below. I just needed more space in my keymap. So \"i\" is a second-level prefix, but for now it figures out what to do automagically, instead of being bound to a keymap and requiring a next keypress. Here's how it behaves: If at the beginning of a blank line, then insert a sig block. Else try to inspire the URL around point by invoking `kf-inspire-url'. Else if there's nothing to inspire at point, then if in Org Mode, insert a non-live Org Mode time stamp, i.e., with square braces instead of angle brackets (however, an immediate re-invocation will strip those square braces). Otherwise if not in Org Mode, then insert the same date stamp just without the square braces. Either way, prefix argument PARG includes time of day in that time stamp." (interactive "P") (if (and (eq major-mode 'message-mode) (bolp) (or (looking-at "$") (looking-at (concat "^" (regexp-quote kf-generic-mail-signature))))) (if (eq last-command 'kf-switch-handler-i) ;; This variable comes from a non-public init file -- search for ;; "private-dot-emacs" in this .emacs for more about that. (progn (let ((opoint (point))) (search-forward kf-generic-mail-signature) (delete-region opoint (point))) (insert kf-ots-mail-signature)) (insert kf-generic-mail-signature) (forward-line -2)) (unless (kf-inspire-url) (let* ((am-pm (downcase (format-time-string "%p"))) (tz (let ((tz-raw (format-time-string "%Z"))) (if (and (= (length tz-raw) 3) (member (aref tz-raw 1) (list ?S ?D))) (concat (char-to-string (aref tz-raw 0)) (char-to-string (aref tz-raw 2))) tz-raw))) (datestamp (string-replace " " " " (format-time-string (concat "%Y-%m-%d" (if parg (format " %%l:%%M%s %s" am-pm tz) "")))))) (if (and (eq major-mode 'org-mode) (org-at-heading-p)) (if (eq last-command 'kf-switch-handler-i) ;; Assume that the previous invocation inserted an ;; Org-formatted date, so our job is just to remove ;; the Org Mode formatting, namely, the square braces. (progn (search-backward "[") (delete-char 1) (search-forward "]") (delete-char -1)) ;; We don't use `org-time-stamp' (with some customized ;; ambient setting of `org-time-stamp-formats') because in ;; practice the desired date is almost always today, so ;; the extra UI step in which one either confirms today by ;; hitting Enter or chooses a new date is a waste of time. ;; But the code that was formerly here did that; if that's ;; what you're looking for, you know where to find it. (insert "[" datestamp "] ")) ;; If not in Org Mode, then no square braces. And we don't ;; use `kf-insert-date' because it's for fancier use cases. (insert datestamp)))))) (defun kf-switch-handler-u (parg) "Like `kf-switch-handler-i', but for `u' not `i', dear." (interactive "P") (cond ((ots-copy-link)) ;; Thanks to forcer in #emacs on Freenode IRC for this trick. ;; He also suggested "You could write a function that uses ;; `completing-read' with a custom COLLECTION argument.", but I ;; actually think this hack is better, because it lands in the ;; `M-x' interaction natively so we don't have to fake it up. ((looking-at "\\(\\s-+\\|$\\)") (let ((unread-command-events (string-to-list "urlete-do-"))) (call-interactively 'execute-extended-command))) ((psm-show-req parg)))) (defun kf-maybe-yank-as-issue-link (&optional str) "If STR is an issue ticket URL, insert a formatted link to that URL; if STR is a file path to an existing file, insert a formatted link to that file. By \"formatted link\", we mean an Org Mode link; in the post-scarcity future, we'll format the link in some mode-appropriate way, but for now we just submit to the hegemony of Big Org. If STR is nil, use `(current-kill 0 t)' instead. For URL links, shorten certain common elements in the link text (please see the code for details). Return the link text iff a link was inserted; else return nil." (interactive) (or str (setq str (current-kill 0 t))) (cond ((file-exists-p str) (insert "[[file:" str "][" str "]]") str) ((and (kf-is-url str) (string-match "/issues?/" str 0 t)) (save-match-data (let* ((res (if (string-match "/-/issues?/" str nil t) (string-match "^https?://[^/]+/\\(.*\\)/-/issues?/\\([0-9]+\\)" str) (string-match "^https?://[^/]+/\\(.*\\)/issues?/\\([0-9]+\\)" str))) (repos (match-string-no-properties 1 str)) (number (match-string-no-properties 2 str)) (link-text (concat repos " #" number))) ;; Shorten any common stuff in the link text. Only one of ;; these should match, so it would be nice to stop once any ;; replacement happens, but in practice there's no efficiency ;; to be gained by doing so when we're only trying a small ;; number of potential replacements anyway. (dolist (pair '(("^ots/clients/" . "o/c/") ("^PhilanthropyDataCommons/" . "PDC/"))) (setq link-text (replace-regexp-in-string (car pair) (cdr pair) link-text)) (setq link-text (replace-regexp-in-string (car pair) (cdr pair) link-text))) (insert "[[" str "][" link-text "]]") link-text))))) (defun kf-switch-handler-y (ignored) "Run `yank-match' unless there's something even cooler to do. Specifically: if an issue link is available to insert via `kf-maybe-yank-as-issue-link', do so; otherwise just run `yank-match'. Prefix arg IGNORED is currently ignored. In the future, it might fill in the issue title, or do some other fancy and delightful thing." (interactive "P") (or (kf-maybe-yank-as-issue-link) (call-interactively 'yank-match))) (defun kf-switch-to-other-buffer () "Switch to the other buffer, without fuss and with dispatch." (interactive) (switch-to-buffer (other-buffer) nil t)) (defun kf-full-url-to-human-friendly-url (url) "Reduce URL to what a human would want to see in print. That is, Strip any protocol identifier, leading \"www.\", and trailing slash." (let ((case-fold-search t)) (save-match-data (when (string-match "^[a-z]+://" url) (setq url (substring url (match-end 0)))) (when (string-match "^www\." url) (setq url (substring url (match-end 0)))) (when (string-match "/$" url) (setq url (substring url 0 (match-beginning 0)))) url))) (defun kf-degoogle-url (url) "Return the de-Googlified form of URL." ;; Here's an example of the kind of URL you get from Google: ;; ;; https://www.google.com/url?sa=t&rct=j&q=&esrc=s&source=web\ ;; &cd=2&ved=2ahUKEwj68Zm9i5HdAhVGxYMKHaRqC5sQFjABegQICRAC\ ;; &url=https%3A%2F%2Fwww.cms.gov%2FRegulations-and-Guidance%2FGuidance\ ;; %2FTransmittals%2FDownloads%2FR1704OTN.pdf\ ;; &usg=AOvVaw1su6R9ignUgXDGnJiH1wGI ;; ;; Here's what it should be converted to: ;; ;; https://www.cms.gov/Regulations-and-Guidance/Guidance/\ ;; Transmittals/Downloads/R1704OTN.pdf (save-match-data (string-match "url=http" url) (let ((start (match-beginning 0))) (setq url (substring url (+ start 4) nil)) (setq url (url-unhex-string url)) ;; The end always seems to be "&usg=blahblahbla", but I'm not ;; sure Google will stick to adding only that tail, so the ;; expression below allows for an arbitrary number of tails. (setq start (string-match "\\(&[a-z][a-z][a-z]=[a-zA-Z0-9]+\\)+$" url)) (when start (setq url (substring url 0 start))) url))) (defun kf-degoogle-url-around-point () "Convert the URL around point to de-Googlified form." (interactive) (let* ((posns (bounds-of-thing-at-point 'url)) (start (car posns)) (end (cdr posns)) (url (buffer-substring-no-properties start end))) (delete-region start end) (goto-char start) (insert (kf-degoogle-url url)))) (defun kf-is-url (str) "Return t iff STR is a URL." ;; Used to use `thing-at-point-url-regexp' instead of a hardcoded ;; regexp, but apparently that variable went away sometime in 2013, ;; though etc/NEWS is silent on the topic. (string-match "^https?://[a-zA-Z0-9]+\\S-+$" str 0 t)) (defun kf-inspire-url () "Breathe the life-spirit into the URL, email address, or text around point, or into the active region. This is a complex; bear with me. If the region is not active: - If text around point is not a URL or email address, then inspire it as much as possible, push mark at the end of the new tag, add the text to the kill ring, and put point in the life-giving place, so the user can finish the job. - If the text around point is a URL, then make the URL itself (stripped of protocol prefix and any trailing slash) be the link text. If the region is active: - If there is a URL on the front of the kill ring, then make the region text a link with that URL as its destination. - If there is no URL on the front of the kill ring, then make the region text a link, and put point in position to type a URL. I'm not even sure that this is a complete description of the actual behavior, but the actual behavior is working as desired. Maybe I'll check over this doc string again some day and ensure it's complete. Some cases, especially non-Org cases, may still be unfinished. Return nil if no inspiration was possible, and leave the buffer unchanged. Return non-nil (but value otherwise undefined) if inspiration happened." (interactive "P") (let* ((bounds-of-thing-at-point-provider-alist (if (eq major-mode 'org-mode) ;; See this thread for why we override Org Mode's ;; customiations of thingatpt: ;; ;; From: Ihor Radchenko ;; Subject: Re: Possible bug getting bounds of URL at point? ;; To: Karl Fogel ;; Cc: Org Mode Mailing List ;; Date: Tue, 16 Jul 2024 20:21:11 +0000 ;; Message-ID: <875xt5cclk.fsf@localhost> nil bounds-of-thing-at-point-provider-alist)) (posns (or (when (region-active-p) (car (region-bounds))) ; Handle `region-noncontiguous-p'? (bounds-of-thing-at-point 'url) (bounds-of-thing-at-point 'email) (bounds-of-thing-at-point 'symbol) (bounds-of-thing-at-point 'filename) (bounds-of-thing-at-point 'word)))) (when posns (let* ((start (car posns)) (end (copy-marker (cdr posns))) (ambient-link (let ((clip (substring-no-properties (current-kill 0 t)))) (cond ((kf-is-url clip) clip) ((file-exists-p clip) (concat "file:" clip))))) (here-string (buffer-substring-no-properties start end)) (here-link (when (kf-is-url here-string) here-string)) (url (or ambient-link here-link)) (markup-flavor (kf-markup-flavor)) (life-giving-place nil)) (goto-char start) (cond ((eq markup-flavor 'xml) (insert "" (kf-full-url-to-human-friendly-url url) "")) ((eq markup-flavor 'ltx) (insert "\\otsurl{") (goto-char end) (insert "}")) ((eq markup-flavor 'org) (insert "[[") (if here-link (progn (goto-char end) (forward-char -1) (search-backward "/" start t) (when (looking-at "/") (forward-char 1)) (let ((link-text (buffer-substring-no-properties (point) (save-excursion (goto-char end) (when (= (char-after (1- (point))) ?/) (forward-char -1)) (point))))) (goto-char end) (insert "][" link-text "]]"))) (insert (or url "https://TBD") "][") (goto-char end) (insert "]" (if url "]" ""))) (unless url (search-backward "TBD]["))) ((or (eq markup-flavor 'md) (eq markup-flavor 'markdown)) (insert "[" (kf-full-url-to-human-friendly-url url) "](") (goto-char end) (insert ")")) (t (insert "") (setq life-giving-place (point)) (if url (insert url) (if (string-match "@" here-string) (insert "mailto:" here-string))) (insert "") (goto-char life-giving-place))) (when ambient-link (message "%s" ambient-link)) t)))) (defun kf-linkify-from-text () "So useful, so intuitive, and yet so much trouble to document." (interactive) (let ((start (copy-marker (point)))) (re-search-backward "\\(^\\|\\s-+\\)https?://") (forward-word 1) (forward-word -1) (insert "") (goto-char start) (insert ""))) (defun kf-fetch-url (url) "Switch to a buffer containing the raw content at URL, with HTTP headers." (interactive "sURL: ") (unless (string-match "^https?://" url) (setq url (concat "http://" url))) (switch-to-buffer (url-retrieve-synchronously url))) (defun kf-emacs-bug-url (bug-number &optional insert-only) "Put the Emacs bug ticket url for BUG-NUMBER into the kill ring. If optional prefix arg INSERT-ONLY is non-nil, insert the url at point instead of copying it to the kill ring. (See also https://elpa.gnu.org/packages/debbugs.html, which surely turns ticket numbers into urls as well as doing many other things.)" (interactive "nEmacs bug number: \nP") (let ((url (format "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%d" bug-number))) (if insert-only (insert url) (kill-new url)))) (defun kf-itemized-list (&optional parg) "Insert an itemized (or enumerated, with prefix arg) list on current line. LaTeX and XML are supported so far." (interactive "*P") (let* ((type (if parg "enumerate" "itemize")) (text (cond ((eq major-mode 'latex-mode) (concat (format "\\begin{%s}\n\n" type) " \\item \n\n" (format "\\end{%s}\n" type))) (t (concat (format "<%sdlist>\n\n" type) " \n\n" " \n\n" " \n\n" " \n\n" " \n\n" " \n\n" (format "\n" type)))))) (save-excursion (kf-prefixed-yank text)))) (defun kf-footnote () "Insert a footnote template and leave point where the text goes. Supporting only DocBook Lite XML, for now." (interactive) (insert "") (forward-char -18)) (defun kf-variablelist () "Insert a variablelist on the current blank line. XML-only, for now." (interactive) (save-excursion (insert "\n") (insert " \n") (insert " \n") (insert " \n") (insert " \n") (insert "\n") (insert " \n") (insert " \n") (insert " \n") (insert " \n") (insert "\n") (insert " \n") (insert " \n") (insert " \n") (insert " \n") (insert "\n"))) (defun kf-docbook-check-ulinks (&optional strobe) "Scan from point for r3005-noncompliant DocBook Lite XML ulinks. When a non-compliant ulink is found, insert a highly visible mark after the non-compliant link text and stop, to ease a manual fix. Iff optional prefix argument STROBE is non-nil, then make stop on the scan user-visible at STROBE stops per second. See r3005 in https://svn.red-bean.com/repos/producingoss/ (and, e.g., later followup commit r3282) for more on what this is all about." (interactive "p") (if (not (search-forward "") (let ((link-text (buffer-substring-no-properties (point) (progn (search-forward "<") (forward-char -1) (point))))) (when strobe (message "URL: \"%s\", TXT: \"%s\"" url link-text) (sit-for (/ 1.0 (float strobe)))) (if (not (string= url link-text)) (insert " XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX") ;; Look, it's an example of recursion in Elisp! (kf-docbook-check-ulinks strobe))))))) (setq scheme-program-name "scm") (defun kf-factorize () (interactive) (call-interactively 'run-scheme) (insert "(load \"~/scheme/math.ss\")") (comint-send-input) (insert "(factorize )") (forward-char -1)) (defun kf-prime-p () (interactive) (call-interactively 'run-scheme) (let ((sourcepath (expand-file-name "~/scheme/primes.ss"))) (insert "(load \"" sourcepath "\")")) (comint-send-input) (insert "(prime? )") (forward-char -1)) ;;; On-demand help panels for obscure topics. ;;; (defun kf-display-something-maybe-big (contents &optional title) "Display string CONTENTS in a buffer named TITLE." (let ((buf (get-buffer-create (or title "*STUFF*"))) (win nil) (lines nil)) (save-excursion (set-buffer buf) (erase-buffer) (insert contents) (goto-char (point-min)) (setq lines (count-lines (point-min) (point-max))) (setq win (display-buffer buf)) (when (> lines (window-text-height win)) (select-window win))))) (defmacro kf-gen-displayer (txt-sym fn-doc-str buf-name &optional fn-alias) "Generate an interactive function with the same symbol name as TXT-SYM, whose doc string is FN-DOC-STR, and that when invoked displays TXT-SYM in a buffer named BUF-NAME using `display-buffer'." (declare (indent 2)) `(progn (defun ,txt-sym () ,fn-doc-str (interactive) (kf-display-something-maybe-big ,txt-sym ,buf-name)) (when (or (not (boundp ',fn-alias)) (not (eq nil ,fn-alias))) (defalias ',fn-alias ',txt-sym)))) (defconst kf-ascii " Decimal - Character | 0 NUL| 1 SOH| 2 STX| 3 ETX| 4 EOT| 5 ENQ| 6 ACK| 7 BEL| | 8 BS | 9 HT | 10 NL | 11 VT | 12 NP | 13 CR | 14 SO | 15 SI | | 16 DLE| 17 DC1| 18 DC2| 19 DC3| 20 DC4| 21 NAK| 22 SYN| 23 ETB| | 24 CAN| 25 EM | 26 SUB| 27 ESC| 28 FS | 29 GS | 30 RS | 31 US | | 32 SP | 33 ! | 34 \" | 35 # | 36 $ | 37 % | 38 & | 39 ' | | 40 \( | 41 \) | 42 * | 43 + | 44 , | 45 - | 46 . | 47 / | | 48 0 | 49 1 | 50 2 | 51 3 | 52 4 | 53 5 | 54 6 | 55 7 | | 56 8 | 57 9 | 58 : | 59 ; | 60 < | 61 = | 62 > | 63 ? | | 64 @ | 65 A | 66 B | 67 C | 68 D | 69 E | 70 F | 71 G | | 72 H | 73 I | 74 J | 75 K | 76 L | 77 M | 78 N | 79 O | | 80 P | 81 Q | 82 R | 83 S | 84 T | 85 U | 86 V | 87 W | | 88 X | 89 Y | 90 Z | 91 [ | 92 \\ | 93 ] | 94 ^ | 95 _ | | 96 ` | 97 a | 98 b | 99 c |100 d |101 e |102 f |103 g | |104 h |105 i |106 j |107 k |108 l |109 m |110 n |111 o | |112 p |113 q |114 r |115 s |116 t |117 u |118 v |119 w | |120 x |121 y |122 z |123 { |124 | |125 } |126 ~ |127 DEL| Hexadecimal - Character | 00 NUL| 01 SOH| 02 STX| 03 ETX| 04 EOT| 05 ENQ| 06 ACK| 07 BEL| | 08 BS | 09 HT | 0A NL | 0B VT | 0C NP | 0D CR | 0E SO | 0F SI | | 10 DLE| 11 DC1| 12 DC2| 13 DC3| 14 DC4| 15 NAK| 16 SYN| 17 ETB| | 18 CAN| 19 EM | 1A SUB| 1B ESC| 1C FS | 1D GS | 1E RS | 1F US | | 20 SP | 21 ! | 22 \" | 23 # | 24 $ | 25 % | 26 & | 27 ' | | 28 \( | 29 \) | 2A * | 2B + | 2C , | 2D - | 2E . | 2F / | | 30 0 | 31 1 | 32 2 | 33 3 | 34 4 | 35 5 | 36 6 | 37 7 | | 38 8 | 39 9 | 3A : | 3B ; | 3C < | 3D = | 3E > | 3F ? | | 40 @ | 41 A | 42 B | 43 C | 44 D | 45 E | 46 F | 47 G | | 48 H | 49 I | 4A J | 4B K | 4C L | 4D M | 4E N | 4F O | | 50 P | 51 Q | 52 R | 53 S | 54 T | 55 U | 56 V | 57 W | | 58 X | 59 Y | 5A Z | 5B [ | 5C \\ | 5D ] | 5E ^ | 5F _ | | 60 ` | 61 a | 62 b | 63 c | 64 d | 65 e | 66 f | 67 g | | 68 h | 69 i | 6A j | 6B k | 6C l | 6D m | 6E n | 6F o | | 70 p | 71 q | 72 r | 73 s | 74 t | 75 u | 76 v | 77 w | | 78 x | 79 y | 7A z | 7B { | 7C | | 7D } | 7E ~ | 7F DEL| Octal - Character |000 NUL|001 SOH|002 STX|003 ETX|004 EOT|005 ENQ|006 ACK|007 BEL| |010 BS |011 HT |012 NL |013 VT |014 NP |015 CR |016 SO |017 SI | |020 DLE|021 DC1|022 DC2|023 DC3|024 DC4|025 NAK|026 SYN|027 ETB| |030 CAN|031 EM |032 SUB|033 ESC|034 FS |035 GS |036 RS |037 US | |040 SP |041 ! |042 \" |043 # |044 $ |045 % |046 & |047 ' | |050 \( |051 \) |052 * |053 + |054 , |055 - |056 . |057 / | |060 0 |061 1 |062 2 |063 3 |064 4 |065 5 |066 6 |067 7 | |070 8 |071 9 |072 : |073 ; |074 < |075 = |076 > |077 ? | |100 @ |101 A |102 B |103 C |104 D |105 E |106 F |107 G | |110 H |111 I |112 J |113 K |114 L |115 M |116 N |117 O | |120 P |121 Q |122 R |123 S |124 T |125 U |126 V |127 W | |130 X |131 Y |132 Z |133 [ |134 \\ |135 ] |136 ^ |137 _ | |140 ` |141 a |142 b |143 c |144 d |145 e |146 f |147 g | |150 h |151 i |152 j |153 k |154 l |155 m |156 n |157 o | |160 p |161 q |162 r |163 s |164 t |165 u |166 v |167 w | |170 x |171 y |172 z |173 { |174 | |175 } |176 ~ |177 DEL| " "The ASCII character tables.") (defconst kf-datetime-formats "See: * http://pleac.sourceforge.net/pleac_python/datesandtimes.html * http://docs.python.org/library/time.html * http://docs.python.org/library/datetime.html * http://www.python.org/doc/2.5.2/lib/datetime-tzinfo.html * http://uswaretech.com/blog/2009/02/understanding-datetime-tzinfo-timedelta-timezone-conversions-python/ From http://docs.python.org/library/time.html#time.strftime: %a Locale's abbreviated weekday name. %A Locale's full weekday name. %b Locale's abbreviated month name. %B Locale's full month name. %c Locale's appropriate date and time representation. %d Day of the month as a decimal number [01,31]. %H Hour (24-hour clock) as a decimal number [00,23]. %I Hour (12-hour clock) as a decimal number [01,12]. %j Day of the year as a decimal number [001,366]. %m Month as a decimal number [01,12]. %M Minute as a decimal number [00,59]. %p Locale's equivalent of either AM or PM. (1) %S Second as a decimal number [00,61]. (2) %U Week number of the year (Sunday as the first day of the week) as a decimal number [00,53]. All days in a new year preceding the first Sunday are considered to be in week 0. (3) %w Weekday as a decimal number [0(Sunday),6]. %W Week number of the year (Monday as the first day of the week) as a decimal number [00,53]. All days in a new year preceding the first Monday are considered to be in week 0. (3) %x Locale's appropriate date representation. %X Locale's appropriate time representation. %y Year without century as a decimal number [00,99]. %Y Year with century as a decimal number. %Z Time zone name (no characters if no time zone exists). %% A literal '%' character. Notes: 1) When used with the strptime() function, the %p directive only affects the output hour field if the %I directive is used to parse the hour. 2) The range really is 0 to 61; this accounts for leap seconds and the (very rare) double leap seconds. 3) When used with the strptime() function, %U and %W are only used in calculations when the day of the week and the year are specified. Here is an example, a format for dates compatible with that specified in the RFC 2822 Internet email standard. [1] >>> from time import gmtime, strftime >>> strftime('%a, %d %b %Y %H:%M:%S +0000', gmtime()) 'Thu, 28 Jun 2001 14:17:15 +0000' == Date codes, for NS (NextStep) Foundation Classes == == (and possibly the Unix date command as well) == %a abbreviated weekday name %A full weekday name %b abbreviated month name %B full month name %c shorthand for %X %x, the locale format for date and time %d day of the month as a decimal number (01-31) %e same as %d but does not print the leading 0 for days 1 through 9 %F milliseconds as a decimal number (000 - 999) %H hour based on a 24-hour clock as a decimal number (00-23) %I hour based on a 12-hour clock as a decimal number (01-12) %j day of the year as a decimal number (001-366) %m month as a decimal number (01-12) %M minute as a decimal number (00-59) %p AM/PM designation for the locale %S second as a decimal number (00-61) %w weekday as a decimal number (0-6), where Sunday is 0 %x date using the date representation for the locale %X time using the time representation for the locale %y year without century (00-99) %Y year with century (such as 1990) %Z time zone abbreviation (such as PDT) %z time zone offset in hours and minutes from GMT (HHMM) %% a '%' character, of course " "Date and time formats for various programming languages.") (defconst kf-radio-alphabet " A - Alpha N - November B - Bravo O - Oscar C - Charlie P - Papa D - Delta Q - Quebec E - Echo R - Romeo F - Foxtrot S - Sierra G - Golf T - Tango H - Hotel U - Uniform I - India V - Victor J - Juliet W - Whiskey K - Kilo X - X-ray L - Lima Y - Yankee M - Mike Z - Zulu" "Wear aviator goggles when confirming airline reservation numbers.") (defconst kf-stellar-statistics " The Sun: diameter: 1,390,000 km. mass: 1.989e30 kg temperature: 5800 K (surface), 15,600,000 K (core) --------------------------------------------------------------------- Distance Radius Mass Planet (000 km) (km) (kg) Discoverer Date --------- --------- ------ ------- ---------- ----- Mercury 57,910 2439 3.30e23 Venus 108,200 6052 4.87e24 Earth 149,600 6378 5.98e24 Mars 227,940 3397 6.42e23 Jupiter 778,330 71492 1.90e27 Saturn 1,426,940 60268 5.69e26 Uranus 2,870,990 25559 8.69e25 Herschel 1781 Neptune 4,497,070 24764 1.02e26 Galle 1846 Non-Planet (000 km) (km) (kg) Discoverer Date --------- --------- ------ ------- ---------- ----- Pluto 5,913,520 1160 1.31e22 Tombaugh 1930 --------------------------------------------------------------------- So Earth is about 6 septillion kg (5.98 x 10^24 kg). No. Name Distance Radius Mass Discoverer Date ---- --------- -------- ------ ------- ---------- ----- 2062 Aten 144514 0.5 ? Helin 1976 3554 Amun 145710 ? ? Shoemaker 1986 1566 Icarus 161269 0.7 ? Baade 1949 951 Gaspra 205000 8 ? Neujmin 1916 1862 Apollo 220061 0.7 ? Reinmuth 1932 243 Ida 270000 35 ? ? 1880? 2212 Hephaistos 323884 4.4 ? Chernykh 1978 4 Vesta 353400 265 3.0e20 Olbers 1807 3 Juno 399400 123 ? Harding 1804 15 Eunomia 395500 136 ? De Gasparis 1851 1 Ceres 413900 466 8.7e20 Piazzi 1801 2 Pallas 414500 261 3.18e20 Olbers 1802 52 Europa 463300 156 ? Goldschmidt 1858 10 Hygiea 470300 215 ? De Gasparis 1849 511 Davida 475400 168 ? Dugan 1903 911 Agamemnon 778100 88 ? Reinmuth 1919 2060 Chiron 2051900 85 ? Kowal 1977 --------------------------------------------------------------------- " "Stats on the Sun, planets and selected asteroids.") (defconst kf-irc-suckitude " Do this to steal yourself back: ------------------------------- Some combination of these might work, depending on phase of moon: /msg nickserv release kfogel ******** /msg nickserv identify kfogel ******** /msg nickserv regain kfogel You probably don't need these next two, but just in case: /msg nickserv ghost kfogel_ ******** /nick kfogel # To change your password (while logged in) /msg nickserv set password NEWPASSWORD # Before talking to ChanServ, do this so its responses show up in the # right window (XChat bug). /query ChanServ # To get channel operator status: /msg ChanServ op #questioncopyright jrandom # To permanently auto-op someone for a channel: /msg ChanServ flags #openitp jrandom +O " "IRC is the easiest interface ever.") (defconst kf-mariadb-help " MariaDB (MySQL) tips: --------------------- grant select on dbname.* to dbuser@localhost identified by 'RO_PASSWORD'; grant all on dbname.* to dbuser@localhost identified by 'RW_PASSWORD'; DUMP: mysqldump -u dbuser --default-character-set=utf8 dbname > dbname-dump.sql flush privileges SQL SYNTAX I CAN NEVER REMEMBER OFF THE TOP OF MY HEAD: update henryrec set title = 'Nabucco de Verdi: Va, pensiero' \ where title like '%Nabucco de Verdi%'; select COUNT(*) from henryrec where foo = 'bar'; select COUNT(DISTINCT) from henryrec where foo = 'bar'; select COUNT(DISTINCT live_studio) from henryrec; select DISTINCT live_studio from henryrec; LOAD: mysql -u dbuser -p dbname < dbname-dump.sql FANCY: update wp_options set option_value = replace(option_value, 'http://stage.civiccommons.org', 'http://civiccommons.org') where option_name = 'home' or option_name = 'siteurl'; update wp_posts set guid = replace(guid, 'http://stage.civiccommons.org','http://civiccommons.org'); update wp_posts set post_content = replace(post_content, 'http://stage.civiccommons.org', 'http://civiccommons.org'); ADMIN ACCESS AS A REGULAR USER: MaxB says: \"GRANT USAGE ON *.* TO kfogel@localhost IDENTIFIED VIA unix_socket;\" will set you up to then be able to attach whatever database-level permissions you desire (USAGE being the \"no explicit permissions, but the account exists\" placeholder). RESET ROOT PASSWORD: root# systemctl stop mariadb root# mysqld_safe --skip-grant-tables & root# mysql -u root MariaDB [(none)]> use mysql; MariaDB [(mysql)]> update user SET PASSWORD=PASSWORD(\"*********\") WHERE USER='root'; MariaDB [(mysql)]> flush privileges; MariaDB [(mysql)]> exit root# systemctl stop mariadb root# systemctl start mariadb (Note: If the stop or start step at the end hangs, you might have to do 'killall mysqld' and possibly clean out some lock files in /var/run/mysqld/. See also /var/log/mysql/error.log if that doesn't work.) " "Why can't I remember these syntaces? And why do I write \"syntaces\"?") (defconst kf-wireshark-help " Wireshark: --------- Pull down the Capture menu, choose Start. Type \"port 80\" for filter, and turn off promiscuous mode. ...now run your program... Hit Stop in the little box. Now you have a capture. It looks like a huge list of lines. Click on the Protocol column to sort. Then click on the first relevant line to select it. Right click, choose \"follow TCP stream\"." "Wireshark help.") (defconst kf-gimp-help "Turning single-color areas transparent in the Gimp: 1. Select -> Select by Color (Or use \"Magic Wand\" from the toolbox -- stick with a light on the end -- to select only a *contiguous* area of the same color.) 2. Click on the color you want to make transparent. 3. Layer -> Transparency -> Color to Alpha. 4. Edit -> Clear. (When saving as PNG, check 'Save colour values from transparent pixels'.) Paint transparency over parts of the image: 1. Open Layers control window (C-l) 2. Right click on the layer in question ==> \"Add Layer Mask\" 3. Choose \"Layer's Alpha Channel\" 4. Now just paint (in that layer) with whatever tool you want Paint rectangular foreground-color areas (e.g., redacting text): Select them with the selection tool, then use \"B\" to get the Bucket Fill tool and click in the selection. (You may want to set foreground color to black first.) Draw an ellipse: Use the Ellipse Selection tool. Once the ellipsoid selection is in place, set the Foreground Color to whatever color you want the final ellipse to be, choose Edit -> Stroke Selection, set the thickness (3 is usually good) and do the stroke. Changing a background color around anti-aliased text (e.g., black to blue): 1. Right-click on background color, choose Color->Color to Alpha 2. Confirm, thus making the background transparent 3. Set foreground color to desired new background color 4. New Layer (create it with \"foreground\" checked) 5. In the Layers tool, move the new background layer to the bottom Launch the toolbox (if it's not already open): C-b Fading to/from black-and-white across a color image: http://brainsongimp.blogspot.com/2012/08/color-to-black-and-white-fade-tutorial.html To tile an image: Filters -> Map -> Tile (You may want to unchain X units from Y units, as I did for ~/x/abstract-tiled-kluge.png for example.) Random stuff: Circular text: http://registry.gimp.org/node/641 Pie charts: http://www.armino.ro/2010/06/08/gimp-tutorial-how-to-use-paths-and-selections-to-create-a-nice-pie-chart/ ") (defconst kf-gnupg-help "In Emacs, use `C-c RET C-e' to encrypt+sign from Message Mode (or use `C-c RET C-s' to just sign without encrypting). To find/fetch a key: gpg --keyserver hkps://KEYSERVER --recv-keys 0xAEA84EDCF01AD86C4701C85C63113AE866587D0A gpg --keyserver hkps://KEYSERVER --search-keys some@email.address Keyservers to try: - keyring.debian.org - keyserver.ubuntu.com - keys.gnupg.net - pool.sks-keyservers.net - keys.openpgp.org - pgp.mit.edu To send a signed key to a person: gpg --armor --output OTHERKEY.signed-by.C5ED8345.asc --export OTHERKEY To send a signed key to a keyserver: gpg --keyserver KEYSERVER --send-key 16A0DE01 To verify a signature in Gnus: W s (`gnus-summary-force-verify-and-decrypt') To start/stop/restart gpg-agent: gpg-connect-agent /bye # start it, say for SSH to use it gpgconf --kill gpg-agent # stop it (gpg will J-i-T restart it) gpg-connect-agent reloadagent /bye # restart it, in theory, but a) you don't need to, and b) this command didn't have the effect I expected the one time I tried it To see which recipients a file has been encrypted for: gpg --batch --list-packets path/to/file.asc Batch mode: gpg --batch --passphrase-file --output --decrypt Dealing with key errors: You might get an error like this: gpg: 180713EB6C6E4ED775E277D59836566B272CEF7F: skipped: Unusable public key gpg: [stdin]: encryption failed: Unusable public key That can happen with an apparently still-current key if the signature component of the key has expired. Inspect like so: $ gpg --verbose --list-keys jrandom gpg: using pgp trust model gpg: Note: signature key 7CF9CA24B08B8032 expired Tue 30 Aug 2022 07:48:48 PM CDT pub rsa4096/9836566B272CEF7F 2021-08-31 [C] 180713EB6C6E4ED775E277D59836566B272CEF7F uid [ full ] J Random sub rsa4096/7CF9CA24B08B8032 2021-08-31 [S] [expired: 2022-08-31] sub rsa4096/3A140330EBEE2ED6 2021-08-31 [E] [expired: 2022-08-31] sub rsa4096/6616A0179FD153B2 2021-08-31 [A] [expired: 2022-08-31] To fix, do this: $ gpg --recv-keys 0x9836566B272CEF7F You might also get an error like this: gpg: 8E8AF6393F237A2E: There is no assurance this key belongs to the named user gpg: [stdin]: encryption failed: Unusable public key It's due to GPG trust/signature issues that are so intricate that I won't go into them here because I don't want to use up the remaining blank bits in my .emacs :-(. The solution I used (in at least one case, anyway) was to add both a trust level and a signature to the relevant subkey (notice how in the error message above, the \"8E8AF6393F237A2E\" matches the subkey shown below, rather than matching the main public key). One solution is to do something like this: > $ gpg --edit-key 5972830CA206DCBA1EF97758D674C7632F4AC0E7 > pub rsa4096/2674C7632F4AC0E7 > created: 2022-11-21 expires: 2024-11-21 usage: SC > trust: full validity: unknown > sub rsa4096/8E8AF6393F237A2E > created: 2022-11-21 expires: 2024-11-21 usage: E > [ unknown] (1). J. Random > > gpg> key 8E8AF6393F237A2E > > [...] > > gpg> trust > Please decide how far you trust this user to correctly verify other users' keys > (by looking at passports, checking fingerprints from different sources, etc.) > > 1 = I don't know or won't say > 2 = I do NOT trust > 3 = I trust marginally > 4 = I trust fully > 5 = I trust ultimately > m = back to the main menu > > Your decision? 4 > > [...] > > gpg> sign > Your current signature on \"J. Random \" > is a local signature. > Do you want to promote it to a full exportable signature? (y/N) y > > pub rsa4096/2674C7632F4AC0E7 > created: 2022-11-21 expires: 2024-11-21 usage: SC > trust: full validity: full > Primary key fingerprint: 5972 830C A206 DCBA 1EF9 7758 D674 C763 2F4A C0E7 > > J. Random > > This key is due to expire on 2024-11-21. > Are you sure that you want to sign this key with your > key \"Karl Fogel \" (810A75CB5CDE3845) > > Really sign? (y/N) y Note that I had first done 'lsign' instead of 'sign', and that worked fine insofar as it solved my problem, but it generated a local (non-exportable) signature. Since I wanted to send the signed key to others, I did the dance again with 'sign' before exporting. See also this thread from Matthias Apitz on gnupg-users@: https://lists.gnupg.org/pipermail/gnupg-users/2019-October/thread.html#62955 Various advice from http://ben.reser.org/key-transition.txt.asc: The old key was: pub 1024D/641E358B 2001-04-12 Key fingerprint = 42F5 91FD E577 F545 FB40 8F6B 7241 856B 641E 358B And the new key is: pub 4096R/16A0DE01 2011-01-28 Key fingerprint = 19BB CAEF 7B19 B280 A0E2 175E 62D4 8FAD 16A0 DE01 To fetch the full key, you can get it with: curl http://ben.reser.org/benreser.asc | gpg --import - Or, to fetch my new key from a public key server, you can simply do: gpg --keyserver hkp://KEYSERVER --recv-key 16A0DE01 If you already know my old key, you can now verify that the new key is signed by the old one: gpg --check-sigs 16A0DE01 If you don't already know my old key, or you just want to be double extra paranoid, you can check the fingerprint against the one above: gpg --fingerprint 16A0DE01 If you are satisfied that you've got the right key, and the UIDs match what you expect, I'd appreciate it if you would sign my key: gpg --sign-key 16A0DE01 Lastly, if you could upload these signatures, i would appreciate it. You can either send me an e-mail with the new signatures (if you have a functional MTA on your system): gpg --armor --export 16A0DE01 | mail -s 'OpenPGP Signatures' ben@reser.org Or you can just upload the signatures to a public keyserver directly: gpg --keyserver KEYSERVER --send-key 16A0DE01 ") (defconst kf-37-help "Whew, 37 Signals has a lot of products. Basecamp: * Starting discussions or other things via email: https://basecamp.com/help/guides/projects/email-in Basecamp Discussions can sort of be like a mailing list. To start a new thread, you use a personalized destination address such that sending email to it, with a subject line starting with \"Discussion:\", has the same effect as if you'd started a new Discussion in that project) via the web interface. Similar with \"Todo list:\", etc. To find that personalized address, see \"Email content to this project.\" link at the bottom right of the Project home page. * Bringing non-users into a discussion: https://basecamp.com/help/guides/projects/loop-in * General support: https://basecamp.com/support FAQs, etc: http://help.37signals.com/ http://help.37signals.com/highrise/questions/ Customer community: http://answers.37signals.com/") (defconst kf-principl-help " * Principle (n) A doctrine, rule, standard, or law. \"The principle of non-violent resistance.\" * Principal (adj) Main, chief, prevailing. \"Haste is the principal cause of security failures.\" (n) Person or organization holding an important position or role. \"The principals met in Slovenia to discuss the matter.\" (n) One on whose behalf an agent acts. \"The principal, wishing to remain anonymous, sent her agent.\" (n) The base investment or sum of money on which interest is paid. \"In principle, mortgage borrowers pay more in interest than in principal.\" ") (defconst kf-pdf-help "Editing PDFs used to be such a pain. Then everything got better. The names of some PDF tools are below, followed by some recipes. Start with pdfjam and pdfjam-extras, which are amazing. E.g., the 2up command given below comes from 'pdfnup' in pdfjam-extras. * pdfjam https://github.com/rrthomas/pdfjam and in 'texlive-extra-utils' in Debian. * pdfjam-extras https://github.com/rrthomas/pdfjam-extras -- has pdfunite, pdfnup, pdfjoin, etc. See https://github.com/rrthomas/pdfjam\\ #-wrapper-scripts-no-longer-included-here for more information. Also, re Reuben Thomas, their author... whoa: rrt.sc3d.org/ . I GitHub-sponsored him a Grant on 2023-11-17 because I suddenly realized that it's been his universe all along and we've just been living in it. * jPDF Tweak https://jpdftweak.sourceforge.io/ * xournal http://xournal.sourceforge.net/. It's good for adding text and images to an existing PDF. See also Xournal++ at https://github.com/xournalpp/xournalpp -- apparently a successor and probably worth looking into some time? But FWIW as of 2020-01-31 original xournal works just fine. Recipes ======= * Add a signature and date to a PDF document: $ sudo apt-get update && sudo apt-get install xournal $ xournal 1) Choose \"File -> Annotate\" from menu 2) Open the PDF you want to edit or insert an image into 3) Use \"T\" to choose text, or person-in-box icon for image 4) Click in the PDF where you want to insert the text or image 5) When done, \"File -> Export to PDF\". Other possibilities, if xournal isn't available: there's pdfescape.com. Or do what you can with evince, then load the doc into gimp for signing and any other images, Then save as EPS, and use epstopdf (or pdf2ps) to convert *back* to PDF. Or try one of scribus, pdfedit, flpsed, pdftk, inkscape, pdf-shuffler, okular. Or: convert PDF to RTF w/ calibre, open RTF file in LibreOffice, then save as PDF. * Save a range of pages as a new PDF: $ pdftk inputfile.pdf cat 22-36 output outfile_p22-p36.pdf * Join a bunch of PDFs into one PDF: $ pdfunite file-1.pdf file-2.pdf file-N.pdf combined.pdf * Split pages 2 and 5 (or to extract 2-5) into a new PDF: $ pdftk orig.pdf cat 2 5 output new.pdf $ pdftk orig.pdf cat 2-5 output new.pdf * Convert 1 letter-sized portrait PDF to 2 smaller side-by-side landscape: $ pdfjam --suffix nup --nup 2x1 --landscape doc.pdf doc.pdf ==> Yes, give the input file twice. Produces 'doc-nup.pdf'. ") (defconst kf-git-help "Git trivia that I often need and equally often forget. To stash / unstash: $ git stash $ git checkout -b desired-branch-where-the-changes-should-live $ git stash-apply To undo a popped stash that conflicted, so can review it as a diff: ### First, here's how you got into that situation: $ git stash $ git pull ## ...receive changes... ## $ git stash pop Auto-merging FILE.TXT CONFLICT (content): Merge conflict in FILE.TXT $ git status On branch master Your branch is up-to-date with 'origin/master'. Unmerged paths: (use \"git reset HEAD ...\" to unstage) (use \"git add ...\" to mark resolution) both modified: FILE.TXT ### Yikes. Run away! We want to go back to just before \"git stash pop\". ### Fortunately, that is possible: $ git reset HEAD . $ git stash ## Save the un-merged stash pop diff, ## just in case. $ git stash show -p stash@{1} ## Show diff of the older stash, ## which git cleverly saved even ## after the pop, because git knows ## that stash didn't apply cleanly. ## Smart git. Good git. Nice git. To clean up a working tree, i.e., put it in its pristine state: $ git clean # maybe with -x and/or -f option To stage just selected hunks of a file's current diff: $ git add -p|--patch FILE But since you may have already 'git add'ed the file, you might need to unstage selected hunks instead :-). That's done with: $ git reset -p|--patch FILE To unstage: $ git reset FILE To view the changed files in commits with git log: $ git log --name-status $ git log --name-only $ git log --stat (shows the most) To find commit(s) (on a branch) by date: $ git rev-list -n 1 --before=\"2013-07-24 00:00\" master To show commits across all branches: $ git log --name-status --all (The first option isn't strictly necessary, but I almost always want it.) To do the equivalent of 'svn cat': $ git show rev:filepath To find out if there are new changes upstream: $ git pull --dry-run -or- $ git remote -v update To create and apply a git-friendly patch for a specific commit: # Create the patch: $ git format-patch REF^..REF 0001-git-commit-msg-first-line-goes-here.patch # Preview step 1 -- get stats: $ git apply --stat 0001-git-commit-msg-first-line-goes-here.patch # Preview step 2 -- dry run: $ git apply --check 0001-git-commit-msg-first-line-goes-here.patch # Some places (e.g., Emacs) want no sign-off: $ git am < 0001-git-commit-msg-first-line-goes-here.patch # Other places want sign-off: $ git am --signoff < 0001-git-commit-msg-first-line-goes-here.patch To push a new locally-created branch to a remote origin: $ git push origin branch_name:branch_name If you want to push to a different remote and push to it repeatedly, you can create the remote in .git/config. For example, I checked out git://github.com/codeforamerica/srtracker.git read-only (on the remote end, at least). Then I made new branches locally. Then I wanted to submit pull requests from them. So I forked to create https://github.com/OpenTechStrategies/srtracker.git and and pushed my new local branches \"installation-doc-fix\" and \"full-text-search\" up to that new repository, by first adding this to .gitconfig (modeled on the \"origin\" remote): $ git remote add ots git@github.com:OpenTechStrategies/srtracker.git Or you could just add the new remote by hand in the .git/config file: [remote \"ots\"] fetch = +refs/heads/*:refs/remotes/ots/* url = git@github.com:OpenTechStrategies/srtracker.git Then do: $ git push ots full-text-search:full-text-search To push without running pre-push hooks: $ git push --no-verify To fetch a remote branch after cloning (since clone only gets master): $ git checkout -b mybranch origin/mybranch To see if a branch has been merged into master: $ git branch --merged master # branches merged into master $ git branch --merged # branches merged into current HEAD $ git branch --no-merged # branches not yet merged (Use -a to show both local and remote, or -r for remote only.) To archive a branch, locally and remotely: $ git checkout feature-xml $ git tag archive/feature-xml feature-xml $ git checkout master $ git branch -d feature-xml $ git push origin :feature-xml $ git push --tags To remove/rename remote branches: $ git push origin --delete name_of_the_remote_branch # Above is for git >=1.7. Earlier syntax was: $ git push origin :name_of_remote_branch_to_remove (If renaming, just rename the branch locally, perhaps with `git branch -m local_oldname local_newname`, then push it up with `$ git push origin new_name_of_new_local_branch`, and finally remove the old name remotely as per above.) To find out where a repository came from: $ git config --get remote.origin.url ### local information only, no remote repository contact ### $ git remote show origin ### this one actually contacts the remote repository ### To edit the most recent commit message: $ git commit --amend (If you really *really* need to push it up to the remote repository, and you're sure that no one could *possibly* have pushed or pulled in the meantime, then 'git push -f origin master' or something like that will do the trick.) To edit an older commit message, enter interactive rebase land: $ git rebase -i HEAD~3 ## or whatever ref spec # Now change \"pick\" to \"reword\" on the appropriate lines, # and for each commit chosen for editing, do... $ git commit --amend $ git rebase --continue # ...when presented with that commit in the rebase cycle. Remember to use 'git push --force' to send the reworded branch back upstream (and warn your collaborators if necessary). To squash recent commits into one: $ git rebase -i parent-of-first-commit-in-squash-group Replace 'pick' on the second and subsequent commit lines with 'squash' or 'fixup' as described in the 'git-rebase' manual. For example, in a repository where commit 91ee0266c is the parent of the first squashable commit c0607b5 (which is the one whose log message I want to keep), and then a bunch of subsequent commits should also be squashed with their log messages discarded, then: $ git rebase -i 91ee0266c and then produce this in the rebase buffer (time flows downward): pick c0607b5 Add various fixes and Debian tips to INSTALL.md. fixup cde6441 Trying some formatting tricks in INSTALL.md. fixup 2508bf6 Those formatting tricks seem to work. fixup 535482d Getting closer with the formatting tricks. fixup f1a3a11 Yet closer with the formatting tricks. fixup c845f16 Even closer with the formatting tricks. fixup 9c1a1bd More formatting tricks. fixup 27ad1d5 One more formatting trick. fixup b904739 Another formatting trick. fixup 22e1e83 Last bits of formatting. To sync with my force-rebased upstream branch: $ git fetch remotename $ git rebase remotename/branchname [... see replay, messy warning, etc ...] $ git rebase --skip (There's probably a cleaner way to force-pull updates from a remote, but I haven't figured it out yet. You'd think 'git pull --force' would do this, but apparently not.) To list all the remote branches: $ git ls-remote --heads origin To compare branches: $ git show-branch BRANCH_1 BRANCH_2 [BRANCH_3 ...] To see a graph of all branches: $ git log --graph --oneline --all To see the branches most recently committed to: $ git branch --sort=-committerdate $ git for-each-ref --sort=-committerdate refs/heads/ Show latest commits / most recent commits across all branches: $ git log --all $ git log --all -n 2 # e.g., show most recent two commits Show latest commit / commit id only / one-line summary of commit: $ git log -n1 --pretty=oneline --abbrev-commit Show what commit introduced a given line of code (\"pickaxe\"): $ git log -S\"some line\" To grab a file from another branch or revision: $ git show BRANCH_OR_REV:FULL_PATH_TO_FILE > LOCAL_NAME To make a repository bare: Replace repos with just repos/.git Then, inside the now-almost-bare repos, do: $ git config --bool core.bare true You might also want to rename it so it's clear it's bare: $ cd .. $ mv repo repo.git Finding stuff in Git in general -- this is a great article: https://medium.com/@tygertec/how-to-find-stuff-in-git-35d4cb8c1845 Git bisect: $ git bisect start $ git bisect bad SOME_REV $ git bisect good SOME_OTHER_REV $ git bisect run SOME_SCRIPT $ git bisect reset # done; end bisect and check out master All in one: $ git bisect start HEAD run SOME_SCRIPT Pare everything but named files from a repository's history: For example, this preserves just 'csv2wiki': $ git filter-branch --prune-empty --index-filter \\ 'git ls-tree -z -r --name-only --full-tree $GIT_COMMIT \\ | grep -z -v \"^csv2wiki$\" \\ | xargs -0 -r git rm --cached -r' -- --all (See http://stackoverflow.com/questions/5998987/\\ splitting-a-set-of-files-within-a-git-repo-into-\\ their-own-repository-preserving for more.) To cherry-pick commits from one or more divergent repositories: ## First, some context: ## ## Conservatory/wmctrl -> commits have full 1.00->1.07 release history ## geekless/wmctrl -> divergent changes made over a 1.07 top-skim ## dancor/wmctrl -> other divergent changes over a 1.07 top-skim ## ## To \"merge\" changes from the latter two repositories into the former, ## we have to get their master branches into the local repository as ## as appropriately-named local branches and then cherry-pick commits. $ git clone git@github.com:Conservatory/wmctrl.git $ cd wmctrl $ git remote add geekless git@github.com:geekless/wmctrl.git $ git remote add dancor git@github.com:dancor/wmctrl.git $ git fetch geekless From github.com:geekless/wmctrl * [new branch] master -> geekless/master $ git fetch dancor From github.com:dancor/wmctrl * [new branch] master -> dancor/master $ git branch -a * master remotes/dancor/master remotes/geekless/master remotes/origin/master $ git checkout geekless/master Note: checking out 'geekless/master'. You are in 'detached HEAD' state. You can look around, make experimental changes and commit them, and you can discard any commits you make in this state without impacting any branches by performing another checkout. If you want to create a new branch to retain commits you create, you may do so (now or later) by using -b with the checkout command again. Example: git checkout -b HEAD is now at c5c5eb8 Merge pull request #1 from r2rien/master $ git branch geekless-master $ git checkout master Previous HEAD position was c5c5eb8 Merge pull request #1 from r2rien/master Switched to branch 'master' Your branch is up to date with 'origin/master'. $ git log [... see commits representing 1.00 -> 1.07 releases ...] $ git checkout geekless-master Switched to branch 'geekless-master' $ git log [... see commits representing 1.07 import + divergent changes ...] $ git checkout master Switched to branch 'master' Your branch is up to date with 'origin/master'. $ git branch my-merge-branch $ git cherry-pick [...etc...] Check out GitHub pull requests locally (okay, GitHub isn't the same as Git, but this handily allows one to interact with GitHub without the proprietary Javascript): Add a second \"fetch\" line to the project's .git/config file: fetch = +refs/pull/*/head:refs/remotes/origin/pr/* Now when you fetch or pull, it'll get all the pr/* branches. 'git checkout pr/1729' checks out that PR's branch. To remove the ref locally, do 'git update-ref -d refs/remotes/origin/pr/1729' (could probably just remove it by hand under .git/refs/ too). This came from https://gist.github.com/piscisaureus/3342247; we also had https://chat.opentechstrategies.com/#narrow/stream/ 6-Provider-Screening/subject/LEIE/near/50663 in Zulip about it. To convert a Subversion repository to Git: $ git svn clone --no-metadata --authors-file=authors.txt https://svn.red-bean.com/repos/jimb-scripts/trunk/elisp Obviously, authors.txt looks like this: foo = Foo Random bar = Bar Quuuux Add the `--stdlayout' flag if converting from the top of a repository that uses the standard TTB layout. Useful online references: \"On undoing, fixing, or removing commits in git\" http://sethrobertson.github.io/GitFixUm/fixup.html ") (defconst kf-latin-abbreviation-help " http://en.wikipedia.org/wiki/List_of_Latin_abbreviations * A.D. | anno Domini | \"in the year of the Lord\" Used to label or number years in the Julian and Gregorian calendars. The AD or the Christian calendar era is based on the traditionally reckoned year of the conception or birth of Jesus of Nazareth, with AD counting years after the start of this epoch, and BC denoting years before the start of the epoch. Example: The United States Civil War began in AD 1861 * a.m. | Ante Meridiem | \"before midday\" Used on the twelve-hour clock to indicate times during the morning. Example: We will meet the mayor at 10 a.m. (10:00 in 24hour-clock) * c., ca., ca or cca. | circa | \"around\", \"about\", \"approximately\" Used in dates to indicate approximately. Example: The antique clock is from c.1900. * Cap. | capitulus | \"chapter\" Used before a chapter number of laws of the United Kingdom and its (former) colonies. Example: Electronic Transactions Ordinance (Cap. 553).' * cf. | confer | \"bring together\" and hence \"compare\" Confer is the imperative of the Latin verb conferre. Used interchangeably with \"cp.\" in citations indicating the reader should compare a statement with that from the cited source. Example: These results were similar to those obtained using different techniques (cf. Wilson, 1999 and Ansmann, 1992). * cp. | | compare Used interchangeably with \"cf.\" in citations indicating the reader should compare a statement with that from the cited source. Example: These results were similar to those obtained using different techniques (cp. Wilson, 1999 and Ansmann, 1992). * Cp | ceteris paribus | \"all other things equal\" * C.V. or CV | curriculum vitae | \"course of life\" A document containing a summary or listing of relevant job experience and education. The exact usage of the term varies between British English and American English. * cwt. | centum weight | \"Hundredweight\" cwt. uses a mixture of Latin and English abbreviation. * D.V. | Deo volente | \"God willing\" * DG, D.G. or DEI GRA | Dei gratia | \"by the grace of God\". A part of the monarch's title, it is found on all British and Canadian coins. * ead. | eadem | see id. below. * et al. | et alii | \"and others\", \"and co-workers\". It can also stand for et alia, \"and other things\", or et alibi, \"and other places\". Example: These results agree with the ones published by Pelon et al. (2002). * etc. | et cetera | \"and the others\", \"and other things\", \"and the rest\". Other archaic abbreviations include \"&c.\", \"&/c.\", \"&e.\", \"&ct.\", and \"&ca.\" Example: I need to go to the store and buy some pie, milk, cheese, etc. * e.g. | exempli gratia | \"for example\", \"for instance\". Example: The shipping company instituted a surcharge on any items weighing over a ton; e.g., a car or truck. * ff. | folio | \"and following\" This abbreviation is used in citations to indicate an unspecified number of following pages following, Example: see page 258ff. * ibid. | ibidem | \"in the same place (book, etc.)\" The abbreviation is used in citations. It should not be confused with the following abbreviation. It is better pronounced ibídem, with stress on the second -i- (as it was in Latin). * id. | idem | \"the same (man)\". It is used to avoid repeating the name of a male author (in citations, footnotes, bibliographies, etc.) When quoting a female author, use the corresponding feminine form, ead. (eadem), \"the same (woman)\" (eadem is pronounced with stress on the first e-). * i.a. | inter alia | \"among other things\". Example: Ernest Hemingway—author (i.a. 'The Sun Also Rises') and friend. * i.e. | id est | \"that is\", \"in other words\". * J.D. | Juris Doctor | \"teacher of law/rights\". * lb. | libra | \"scales\" Used to indicate the pound (mass). * LL.B. | Legum Baccalaureus | \"bachelor of laws\" The \"LL.\" of the abbreviation for the degree is from the genitive plural legum (of lex, legis f., law), thus \"LL.B.\" stands for Legum Baccalaureus in Latin. In the United States it was sometimes erroneously called \"Bachelor of Legal Letters\" to account for the double \"L\" (and therefore sometimes abbreviated as \"L.L.B.\"). * M.A. | Magister Artium | \"Master of Arts\" A postgraduate academic master degree awarded by universities in many countries. The degree is typically studied for in fine art, humanities, social science or theology and can be either fully taught, research-based, or a combination of the two. * M.O. | modus operandi | \"method of operating\" Sometimes used in criminology to refer to a criminal's method of operation. * N.B. | nota bene | \"note well\" Some people use \"Note\" for the same purpose. Usually written with majuscule (French upper case / 'capital') letters. Example: N.B.: All the measurements have an accuracy of within 5% as they were calibrated according to the procedure described by Jackson (1989). * nem. con. | nemine contradicente | \"with no one speaking against\" The meaning is distinct from \"unanimously\"; \"nem. con.\" simply means that nobody voted against. Thus there may have been abstentions from the vote. * op. cit. | opere citato | \"the work cited\" Means in the same article, book or other reference work as was mentioned before. It is most often used in citations in a similar way to \"ibid\", though \"ibid\" would usually be followed by a page number. * p.a. | per annum | \"through a year\" Is used in the sense of \"yearly\". * per cent. | per centum | \"for each one hundred\" Commonly \"percent\" * Ph.D. | Philosophiæ Doctor | \"Teacher of Philosophy\" * P.M. | Post Meridiem | \"after midday\" Used on the twelve-hour clock to indicate times during the afternoon. Example: We will meet the mayor at 2 P.M. (14:00 in 24hour-clock) * p.m.a. | post mortem auctoris | \"after the author's death\" * p.p. and per pro. | per procurationem | \"through the agency of\" * PRN | pro re nata | \"as needed\" Used in prescriptions * pro tem. | pro tempore | \"for the time being\", \"temporarily\", \"in place of\" * P.S. | post scriptum | \"after what has been written\" it is used to indicate additions to a text after the signature of a letter. * Q.D. | quaque die | \"every day\" Used on prescriptions to indicate the medicine should be taken daily. * Q.E.D. | quod erat demonstrandum | \"which was to be demonstrated\". Cited in many texts at the end of a mathematical proof. Example: At the end of the long proof, the professor exclaimed \"Alas, Q.E.D!\" * q.v. | quod videre | \"which to see\" Used as an imperative. Used after a term or phrase that should be looked up elsewhere in the current document or book. For more than one term or phrase, the plural is quae videre (qq.v.). * Re | in re | \"in the matter of\", \"concerning\" Often used to prefix the subject of traditional letters and memoranda. However, when used in an e-mail subject, there is evidence that it functions as an abbreviation of \"reply\" rather than the word meaning \"in the matter of\". Nominative case singular 'res' is the Latin equivalent of 'thing'; singular 're' is the ablative case required by 'in'. Some people believe it is short for 'regarding'. * REG | regina | \"queen\" A part of the monarch's title, it is found on all British coins minted during the reign of a monarch who is a queen. Rex, \"king\" (not an abbreviation) is used when the reigning monarch is a king. * R.I.P. | requiescat in pace | \"may he/she rest in peace\" Used as a short prayer for a dead person, frequently found on tombstones. \"R.I.P.\" can also mean requiescant in pace, which is the plural form and translates to \"may they rest in peace\" Example: R.I.P good grandmother. * s.o.s. | si opus sit | \"if there is need\", \"if occasion require\", \"if necessary\" * stat. | statim | \"immediately\" Often used in medical contexts. Example: That patient needs attention, stat.! * viz. | videlicet | \"namely\", \"to wit\", \"precisely\", \"that is to say\" In contradistinction to \"i.e.\" and \"e.g.\", \"viz.\" is used to indicate a detailed description of something stated before, and when it precedes a list of group members, it implies (near) completeness. Example: The noble gases, viz. helium, neon, argon, xenon, krypton and radon, show a non-expected behaviour when exposed to this new element. * vs or v. | versus | \"against\" Sometimes is not abbreviated. Example: The next football game will be the Knights vs. the Sea Eagles. ") (defconst kf-ssh-help "How to change a host key: Remove your old host key: $ sudo rm -rf /etc/ssh/ssh_host_* Generate new key: $ sudo ssh-keygen -A # (or 'sudo dpkg-reconfigure openssh-server' would work) Restart the daemon: $ sudo service ssh restart Update client-side ~/.ssh/known_hosts files: $ ssh-keygen -f \"/home/USERNAME/.ssh/known_hosts\" -R SERVER_IP ProxyJump / ProxyCopy: $ ssh -J jump.host internal.host # end result: you are logged into internal.host $ scp -o 'ProxyJump jump.host' foo.txt internal.host:/some/dir # end result: foo.txt is in /some/dir/ on internal.host. How to get all the SSH fingerprints on a server: $ for SSH_KEY_FILE in /etc/ssh/ssh_host_*.pub; do if [ -f ${SSH_KEY_FILE} ]; then ssh-keygen -l -f ${SSH_KEY_FILE}; echo \"\"; fi; done ") (defconst kf-vagrant-help "Basic stuff that Google would say too: Grab a box from, say, http://vagrantbox.es/ or somewhere. They'll have names like this: debsqueeze64.box lxc-precise-amd64-2013-07-12.box squeeze32-vanilla.box Then: $ vagrant init squeeze32-vanilla-1 squeeze32-vanilla.box $ vagrant up W00t. You can ssh in now. 'vagrant ssh' would work, but it just does this: $ ssh -p 2222 vagrant@127.0.0.1 Password: vagrant User 'vagrant' is already in sudoers, so 'sudo su' will just work. Meanwhile, on your \"host\" (real) machine, vagrant dropped a file named \"Vagrantfile\" in the current working directory. That file probably has some stuff worth looking at. ") (defconst kf-gnus-help " Various ways to kill threads: T k `gnus-summary-kill-thread' (or remove all marks, with positive prefix) C-k `gnus-summary-kill-same-subject' k `gnus-summary-kill-same-subject-and-select' See variable `gnus-thread-operation-ignore-subject' for controlling how the above commands deal with messages that are in the same thread but where the Subject header has changed mid-thread. Note that `gnus-summary-kill-thread' apparently does *not* cause new mails received in the thread after that function was run on the thread to start out in an already-killed state, unfortunately. The test was \"[ORDCamp] Solar panels on roofs in Chicago - questions\": message \"[ 504: ...]\" received on 2024-01-12 still showed up in the ORD Camp group, even though I'd done `T k' on the whole thread. C-x C-s `gnus-summary-reselect-current-group' -- basically, make it as as if you exited and re-entered the group. Gives you a fresh view. See also this page re other Summary Buffer marks: https://www.gnu.org/software/emacs/manual/html_node/gnus/Summary-Buffer-Lines.html Incorporate and respool mail from an mbox file: In the Group buffer: \"G f\" then enter the box file name. \"SPACE\" to enter the newly created group. \"M P b\" to process-mark all articles in the group's summary \"B r\" to respool all the process-marked articles (answer 'nnml' at prompt) Extract MIME parts, especially inline MIME parts: `gnus-summary-save-parts' doesn't seem to work the way I'd expect on inline images -- it saves the surrounding HTML but not the image itself. But this worked: Put cursor on the MIME part (e.g., on the image). Then: K H --> view in browser (means HTML in /tmp, with image there) K o --> in theory, save the MIME part, but does not always work https://www.gnu.org/software/emacs/manual/html_node/gnus/MIME-Commands.html has more information. Missing a group: If a group exists on disk but not in the Gnus *Group* buffer, then do `S s' and type the name of the group. Although this runs `gnus-group-unsubscribe-group', which might seem counterintuitive, that's actually what you want: it toggles subscription, and somehow you got unsubscribed from that group. An alternative method seems to be to do `A A' (to invoke `gnus-group-list-active'), which will show all groups and will include the new group you're expecting, and if you then enter and leave that group... and a bunch of funny stuff happens... then when it's all over, you're new group with its new messages will be visible in the Groups buffer. I'm not sure whether this way or the `S s' way is better. Missing mails in some groups: If things ever get out of date, like missing articles where the article file is present in the directory but somehow doesn't show up in the group summary, that's probably because the group's .overview file is out-of-whack. Run `nnml-generate-nov-databases' from the top of the mail hierarchy; it may take a while, but it'll work. See emacs.stackexchange.com/questions/19358/gnus-doesnt-see-mail-even-though-files-are-there www.gnu.org/software/emacs/manual/html_node/gnus/Mail-Spool.html#Mail-Spool for details. Import an mbox file: Create a nndoc group based on the mbox file by doing this in the Group buffer: `G f /path/to/foo.mbox RET'. You now have read-only access to the messages in the mbox. To import them into the regular Gnus groups, enter the new nndoc group with `C-u RET' (the C-u is to ensure that all messages are retrieved), then mark all the messages with `M P b'. Once they're marked, you can either copy them to another group with `B c other.group RET' or respool them (thus running them through `nnmail-split-methods') with `B r'. ") (defconst kf-css-help " ELT1, ELT2 {...} Body applies to those elements. ELT1>ELT2 {...} Only ELT2 immediate children of ELT1 ELT+ADJACENT_SIBLING {...} ... .CLASS1 {...} Elements whose class attr val contains CLASS1. #ID1 {...} Elements whose id attr matches ID1. ELT#ID1 {...} Only ELT whose id attr matches ID1. ELT.CLASS1 {...} Only ELT whose class attr val contains CLASS1. ELT.CLASS1.CLASS2 {...} Only ELT whose class attr val matches both. ELT[ATTR] {...} Only ELTs that have ATTR. #ID1 ELT1, ELT2 {...} ELT1 w/ id ID1, and all ELT2 (, == weak OR) @import url(base.css); Import another CSS file. @media print, FOO {...} Body applies to print and FOO media only. Pseudo classes: :visited, :link, :target, :checked, :hover http://reference.sitepoint.com/css http://code.tutsplus.com/tutorials/the-30-css-selectors-you-must-memorize--net-16048 For float style for an image with text to its right, try this: style=\"float: left; margin-right: 1em; margin-bottom: 1em;\" ") (defconst kf-redmine-help "When updating an existing ticket, put #NUMBER in Subject line: Subject: Re: [AnythingGoesHere #NUMBER] Rest Is Ignored too When creating a ticket by email, put headers at the top: Project: hiring Tracker: Honorarium Priority: Normal Status: New Assignee: Karl Fogel This is the body of the initial description for this test ticket. ") (defconst kf-latex-help "(http://faculty.cbu.ca/srodney/CompSymbInd.pdf has more.) Angle brackets: \\textless \\textgreater OR \\textlangle \\textrangle (sharper) (shallower) Symbols typically used in running text: $ \\$ % \\% _ \\_ } \\} & \\& # \\# { \\{ Keep a block of text all on the same page: \\begin{samepage} ... \\end{samepage} Another, more sophisticated way to do it is: \\noindent \\begin{minipage}{\\textwidth} ... \\vspace{\\parskip} \\end{minipage} Suppressing page numbering: This is a surprisingly complex topic. TL;DR: Before \\begin{document}, do \\pagenumbering{gobble} or maybe \\usepackage{nopageno} or for one page at a time \\thispagestyle{empty} or maybe there are other ways, I don't know. Why is this so hard? Ragged right justification: Put \\raggedright after \\begin{document}. (Except this doesn't seem to actually work, hmmm.) Try the 'ragged2e' package and the \\RaggedRight command. Typeface sizes: \\Huge \\huge \\LARGE \\Large \\large \\normalsize (default) \\small \\footnotesize \\scriptsize \\tiny Tables: \\begin{table}[h] \\begin{tabular}{|l|l|} \\hline \\multicolumn{1}{|c|}{\\textbf{Test (50 users)}} & \\multicolumn{1}{|c|}{\\textbf{Scenario}} \\\\ [0.5ex] \\hline ``Upload Small Text Files (No Poll)'' & \\texttt{login-fileupload-nopoll} \\\\ \\multicolumn{2}{|l|}{} \\\\ \\multicolumn{2}{|l|}{\\begin{footnotesize}\\otsurl{...}\\end{footnotesize}} \\\\ \\hline ``Upload Mixed Content Files'' & \\texttt{login-fileupload-poll} \\\\ \\multicolumn{2}{|l|}{} \\\\ \\multicolumn{2}{|l|}{\\begin{footnotesize}\\otsurl{...}\\end{footnotesize}} \\\\ \\hline ``Share Uploaded Files'' & \\texttt{login-fileupload-share} \\\\ \\multicolumn{2}{|l|}{} \\\\ \\multicolumn{2}{|l|}{\\begin{footnotesize}\\otsurl{...}\\end{footnotesize}} \\\\ \\hline ``Copy Uploaded Files'' & \\texttt{login-fileupload-copy} \\\\ \\multicolumn{2}{|l|}{} \\\\ \\multicolumn{2}{|l|}{\\begin{footnotesize}\\otsurl{...}\\end{footnotesize}} \\\\ \\hline ``Move Uploaded Files'' & \\texttt{login-fileupload-move} \\\\ \\multicolumn{2}{|l|}{} \\\\ \\multicolumn{2}{|l|}{\\begin{footnotesize}\\otsurl{...}\\end{footnotesize}} \\\\ \\hline ``Baseline (All)'' & \\texttt{baseline} \\\\ \\multicolumn{2}{|l|}{} \\\\ \\multicolumn{2}{|l|}{\\begin{footnotesize}\\otsurl{...}\\end{footnotesize}} \\\\ \\hline \\end{tabular} \\caption{Blazemeter Test Runs} \\label{tab:blazemeter-tests} \\end{table} (Also, see https://tex.stackexchange.com/questions/12672/\ which-tabular-packages-do-which-tasks-and-which-packages-conflict for a great overview of all the different table packages.) Dots: cdot: $\\cdot$ bullet point: $\\bullet$ Lists: \\begin{enumerate} \\item ... \\end{enumerate} \\begin{itemize} \\item ... \\end{itemize} (For itemized lists, you can change the markers at each level with \\renewcommand{\\labelitemi}{$\\bullet$}, where \\bullet could be \\cdot, \\diamond, -, \\ast, or \\circ, among other things.) \\begin{description} \\item[Biology] Study of life. \\item[Physics] Science of matter and its motion. \\item[Psychology] Scientific study of mental processes and behaviour. \\end{description} List styles: \\usepackage{enumitem} \\begin{itemize}[label=$\\FOO$] FOO == \"bullet\" | \"-\" | \"cdot\" | \"*\" | \"star\" | \"diamond\" \\begin{enumerate}[label=\\BAR] BAR == \"arabic*\" | \"roman*\" | \"Roman*\" | \"alph*\" | \"Alph*\" To get a closing parenthesis after the list item indicator, just put a closing parenthesis directly in the label specifier. For example... \\begin{enumerate}[label=\\alph*)] \\item foo \\item bar \\item baz \\end{enumerate} ...produces: a) foo b) bar c) baz Arrows: In math mode: $\\leftarrow$ | $\\rightarrow$ | $\\uparrow$ | $\\downarrow$ (Text mode too: \\textrightarrow | \\textleftarrow | \\textuparrow | ... But there are more math mode ones, and they look fine, so just use those.) Commands: What's the difference between star and no-star? https://tex.stackexchange.com/questions/1050/whats-the-difference-between-newcommand-and-newcommand/1058 TL;DR: In TeX, def'ing a command means it takes short args not paragraphs, and you can use \\long\\def to get around that. In LaTeX, \\newcommand by default is \\long, and then later the star form \\newcommand* was added so you could explicitly specify that it's only supposed to take short arguments and *not* paragraphs. Similarly with \\newenvironment. Short answer: use the \"*\" unless you have a known need to support paragraphs as arguments. Pre-defined color names that should be available everywhere: - yellow - white - violet - teal - red - purple - pink - orange - olive - magenta - lime - lightgray - green - gray - darkgray - cyan - brown - blue - black ") (defconst kf-libreoffice-help "LibreOffice has options on its options. * LibreOffice Writer: Three ways to unlock a read-only mode document for editing: Edit -> Edit Mode (try this first) Tools -> Options -> LibreOffice Writer -> Compatibility -> Protect Form Select the sections in a table, then 'Format' -> 'Sections', then deactivate 'Write Protection'. Turn 'Design mode' on: View -> Toolbars -> Form Design To display formulas instead of their results: Tools -> Options -> LibreOffice Calc -> View Then under Display, check (or uncheck) the Formulas box. To change \"Unknown Author\" in comments to self: Tools -> Options -> LibreOffice -> User Data (Might also want to set up OpenPGP encryption keys while there.) * LibreOffice Impress (presentations): Making slide templates / Master slides. View -> Master Slide (this gets you into Master mode) Slide -> New Master (create another master slide; rarely needed) Set background gradient (especially from Master slide view): Slide -> Slide Properties -> Background -> Gradient I like upper left dark blue (RGB 285680, or 295780 for even darker) to lower right light blue (RGB 6FAEE7). Change text color for some specific text: Right Click -> Character -> Font Effects -> Font Color I like F5F5F5 for text if using above gradient background. Change defaut text color (also works on Master slides) Tools -> Options -> LibreOffice -> Application Colors -> Font Color Again, F5F5F5 is good if using above gradient background. Change default toolbars: View -> User Interface -> Toolbars (or something like that) https://www.reddit.com/r/libreoffice/comments/e15nl5/im_sorry_but_to_me_impress_is_just_bad/ also has some good answers. ") (defconst kf-debian-help "I will never remember this stuff. To check what version of a package is installed: $ dpkg -s PACKAGENAME To find out what version of Debian I'm running: $ lsb_release -a # or $ hostnamectl # or $ cat /etc/os-release ") (defconst kf-postgres-help "It's very important that every database have its own command language. Basic stuff: # su - postgres postgres@localhost$ createdb DBNAME -T template_postgis_20 postgres@localhost$ createuser USERNAME postgres@localhost$ psql postgres=# \\password (set password for \"postgres\" superuser) Enter new password: ************ Enter it again: ************ postgres=# \\q (quit; ctrl-d would work as well) postgres@localhost$ psql DBNAME (\"use DBNAME\" w/in psql works too) postgres=# drop database DBNAME; postgres=# drop user USERNAME; postgres=# create database DBNAME; (same as 'createdb' on cmdline) postgres=# create user USERNAME; (same as 'createuser' on cmdline) postgres=# alter user USERNAME with encrypted password 'plaintext'; postgres=# grant all privileges on database DBNAME to USERNAME; postgres=# \\l (list all databases; \\list works too) postgres=# \\c DBNAME (connect to db; \\connect works too) postgres=# \\d (show everything) postgres=# \\d \"TABLENAME\" (show table schema; quotes are needed) postgres=# \\dt \"TABLENAME\" (show table metadata) postgres=# \\pset pager off (could probably set in ~/.psqlrc) To connect to a remote database: $ psql -h -p -u $ psql -h -p -U -W Password: ") (defconst kf-python-help "\ ========================= Virtual Env with setup.py ========================= $ cd jrandom-project # random thing cloned from Mos Eisley $ ls CHANGELOG.md LICENSE README.md requirements.txt setup.py src/ tests/ $ python -m venv venv $ source ./venv/bin/activate (venv) @jrandom-project>pip3 install -e . [...] (venv) @jrandom-project> Sometimes if you see an error like any of these... note: This error originates from a subprocess, and is likely not a problem with pip. error: subprocess-exited-with-error Getting requirements to build wheel did not run successfully. ...you can fix it by doing this inside the venv: (venv) @jrandom-project>pip3 install --upgrade wheel Now you can run 'python' here and it'll be the right Python, etc. Or you can run a command defined by the package and it will exist locally. For example, I cloned https://collaborating.tuhh.de/hos/\ modernes-publizieren/offen/software/middleware/gitlab-exporter.git and did the above, and then ran this: (venv) @gitlab-exporter>gitlab-exporter -h usage: gitlab-exporter [-h] [--version] gitlab_instance private_token ... Export various data sets from GitLab issues, projects and groups [... etc, etc; see https://pypi.org/project/gitlab-exporter/ ...] (venv) @gitlab-exporter> Another example, from late 2023 with linode-cli: $ git clone git@github.com:linode/linode-cli.git $ cd linode-cli/ $ python -m venv .venv $ source .venv/bin/activate $ pip install -e . $ which linode-cli /home/kfogel/src/linode-cli/.venv/bin/linode-cli $ Then again, on https://github.com/linode/linode-api-docs (a related project) I saw this recommended instead: $ virtualenv -p python3 venv $ source venv/bin/activate $ pip install -r requirements.txt I dunno. I should learn more about this. =============================== Strings in Python 2 vs Python 3 =============================== Python 2: --------- Two different string data types: - normal string literal is a \"str\" object, storing bytes - \"u\" prefix means \"unicode\" object, storing code points To convert between them (e.g., to/from UTF-8): unicode_string.encode('utf-8') ==> byte string, containing UTF-8 normal_string.decode('utf-8') ==> unicode, coming from UTF-8 You'll get a UnicodeEncodeError if you try to convert to a representation that can't represent some of the data, assuming you've passed no flags saying to replace or drop such characters. unicode_string.encode('ascii') ==> possible classic fail You can fail in the other direction too. Remember, a stock Python string is just bytes. It doesn't \"know\" that those bytes are arranged in the UTF-8 encoding. This is why when you decode it, you have to tell it what encoding it is in so it can convert to Unicode. But if you tell it an encoding that can't \"contain\" the bytes found in the string, hilarity will ensue: normal_string.decode('ascii') ==> likewise classic fail There is implicit conversion: some_normal_str + some_unicode ==> combined_unicode Or, for example, a dictionary lookup will succeed with either type, as long as the underlying sequence of (ASCII) bytes is the same. Python 3: --------- Two types again, but the naming is more sensible now: - str: natively Unicode: \"I am made of Unicode code points\" - bytes: just raw bytes: b\"I made of raw bytes\" There is no implicit conversion. Combining is always an error now, dictionary lookups cannot be done with the \"same\" data but in the other type, etc. There is no more deferred handling of encoding issues. In Python 3, you have to be clear about what's what at every point in your code. If you're calling something that takes bytes, you have to pass it bytes, and you (not the callee) must do the conversion because the callee does not have all the information it would need to make encoding decisions. For example: >>> import quopri >>> quopri.encodestring(\"Sofía\") Traceback (most recent call last): File \"\", line 1, in File \"/usr/lib/python3.8/quopri.py\", line 108, in encodestring return b2a_qp(s, quotetabs=quotetabs, header=header) TypeError: a bytes-like object is required, not 'str' >>> quopri.encodestring(\"Sofía\".encode('utf-8')) b'Sof=C3=ADa' >>> See also https://docs.python.org/3/library/functions.html#func-bytearray. All this affects reading data from files: In Python 2, using 'b' could only affect line endings, and sometimes (e.g., on Unix) not even those. But in Python 3, opening a file in binary mode produces byte objects, and opening in text mode produces str (i.e., Unicode) objects (therefore, the open() function now takes an encoding parameter). In https://nedbatchelder.com/text/unipain.html, Ned Batchelder recommends that the best thing to do if you're working with strings is convert to Unicode as soon as you get your hands on the data, work exclusively with Unicode internally, and convert to a chosen encoding on the way out. ESR's http://www.catb.org/esr/faqs/practical-python-porting/ is good too, especially about when/why to want the \"b\" (binary) flag on file opens. See also http://lucumr.pocoo.org/2014/5/12/everything-about-unicode/. ") (defconst kf-plantronics-headset-test-help "+1 (866) 210-2157. (Also, random echo-back line at +1 (909) 390-0003.)") (defconst kf-firefox-help "* Magic search-constraint prefixes in address bar: URLs -- $ browsing history -- ^ currently open tabs -- % titles -- # bookmarks -- * pages you've tagged -- + suggestions -- ? (via https://wiki.tilde.institute/w/firefox-address-bar-tips) * List all open tabs: ThreeBarMenu -> Settings -> Home -> New Windows and Tabs -> Homepage and new windows -> [Custom URLs] -> [Use Current Pages] * Tab navigation Switch to tab: Ctrl-Tab: Switch to tab on right (cycles around) Ctrl-Shift-Tab: Switch to tab on left (cycles around) Move a tab: Ctrl-Shift-PageUp: Move tab to left Ctrl-Shift-PageDown: Move tab to right (https://support.mozilla.org/en-US/kb/keyboard-shortcuts-perform-firefox-tasks-quickly has more keyboard shortcuts.) * View source *without* reloading the page: Select all, then right-click and View Selection Source. (viz.: https://bugzilla.mozilla.org/show_bug.cgi?id=307089) * View User Agent header Visit about:support * Change UserAgent header - Browse to \"about:config\" - Right-click anywhere in the preferences, then New->String. - Add a new \"general.useragent.override\" string. A typical Firefox UserAgent header looks something like this: \"Mozilla/5.0 (X11; Linux x86_64; rv:61.0) Gecko/20100101 Firefox/61.0\" ") (defconst kf-grep-help "To avoid long lines and show just context around match, do this: grep -nroP \".{0,20}STRING_TO_MATCH.{0,20}\" FILES_TO_SEARCH_IN Lose the -n if you don't want line numbers. For an even better solution: https://www.topbug.net/blog/2016/08/18/\\ truncate-long-matching-lines-of-grep-a-solution-that-preserves-color/ ") (defconst kf-sqlite-help "See https://www.sqlite.org/cli.html for details. Quick ref: $ ls DATASET.csv $ sqlite3 sqlite> .import DATASET.csv TABLE_NAME sqlite> ### Do whatever you want; writes will go to the CSV. ### sqlite> ### If you want to write it out as a native DB, then: ### sqlite> .save DATASET.db ### (or \"DATASET.sqlite3\" or whatever) sqlite> .mode OUTPUT_MODE ### (see \".help\" below) sqlite> .help ### See a ton of help output here. ### sqlite> .tables sqlite> .tables sqlite> .quit $ ls DATASET.csv DATASET.db $ sqlite3 DATASET.db sqlite> select * from TABLE_NAME; sqlite> .quit $ Or to open a locked (perhaps because currently being written) database in read-only mode, try this: $ sqlite3 'file:DATASET.db?mode=ro&nolock=1' ") (defconst kf-cyrillic-help "See https://en.wikipedia.org/wiki/Cyrillic_alphabets. А а A /a/ Б б Be /b/ В в Ve /v/ Г г Ge /ɡ/ Д д De /d/ Е е Ye /je/, /ʲe/ Ж ж Zhe /ʒ/ З з Ze /z/ И и I /i/, /ʲi/ Й й Short I[a] /j/ К к Ka /k/ Л л El /l/ М м Em /m/ Н н En /n/ О о O /o/ П п Pe /p/ Р р Er /r/ С с Es /s/ Т т Te /t/ У у U /u/ Ф ф Ef /f/ Х х Kha /x/ Ц ц Tse /ts/ (t͡s) Ч ч Che /tʃ/ (t͡ʃ) Ш ш Sha /ʃ/ Щ щ Shcha, Shta /ʃtʃ/, /ɕː/, /ʃt/[b] Ь ь Soft sign / small yer /ʲ/[e] Ю ю Yu /ju/, /ʲu/ Я я Ya /ja/, /ʲa/ ") (defconst kf-google-groups-help "I wish I didn't need to remember all these things. I also wish I were less often in the position of configuring Google Groups. I keep wanting the Free Software solutions to get this right, but we haven't quite done so yet. So for now: First, the two most important things: * Enable people outside your organization to send to the group: (Note that this may only be a \"Google Groups in G-Suite\" thing.) Go to your group's Settings page. The easiest way to get there is via the UI, and once you're there the URL will look something like \"https://admin.google.com/u/1/ac/groups/685a8ft8vt0qz1u/settings\" (where \"685a8ft8vt0qz1u\" is Google's internal unique identifier for your group). Then for \"Publish Posts\", turn on the \"External\" option. Now senders who are not members of your group, and perhaps not even members of your organization, can send email to the group. This is useful when you use a group's address as, e.g., the contact address for some external service. * To enable posting by email (which may be off by default!): (This and everything else below was written for regular Google Groups. Much of it may still apply to Google Groups in G-Suite, of course, but with different navigation paths to the configuration knobs.) Information->General information->Posting options->Allow posting by email (Yes, you'd think it would be under Settings->Email Options, or maybe Permissions->Posting Permissions, or any of a number of other more obviously appropriate places. But no, it's under Information->General Information. Go figure.) Then everything else, by interface location rather than by task: * Settings->Email Options: - Can set a Subject Prefix here - Can set Reply-to behavior - Can set footer text * Settings->Moderation: If you need moderation at all, here is where to handle it. * Permissions->Basic Permissions: Control who can view and who can post here. * Permissions->Posting Permissions: Here you can *also* control who can post. Yes, this is redundant with Permissions->Basic Permissions above. I don't fully grok what the UX designers were aiming for. You can also go directly to the URL for controlling these, e.g.: https://groups.google.com/a/MY_ORGANIZATION.COM/forum/#!groupsettings/GROUP_NAME/postingpermissions * Permissions->Moderation Permissions: Who can add/approve members, who can moderate/delete posts. ") (defconst kf-google-docs-help "To change multiple heading levels at once: To make them deeper: Select one heading of the deepest level you want to change. Then right-click -> Format Options -> Select All Matching Text, then Ctrl+Alt+F, where \"\" is the new heading level (i.e., presumably usually one greater than the heading current's depth. Walk up the stack to the higher levels and do the same. To make them higher, adjust the above recipe accordingly. ") (defconst kf-google-spreadsheets-help "* To merge cells vertically: *First* select all the cells (click for the first one, then shift+click for the ones after that). Then: Format -> Merge Cells -> Merge Vertically (A \"Merge Cells\" icon is sometimes available directly in the toolbar too.) * To copy/paste a view-only spreadsheet: Change the \"/edit#gid=0\" at the end of the URL to \"/preview\". Now you can select all (C-a) in the preview and copy it with C-c. Open up a new blank spreadsheet and paste it all in with C-v. ") (defconst kf-sql-help "https://blog.jooq.org/2016/07/05/say-no-to-venn-diagrams-when-explaining-joins/ These three operate on tuples, that is, on columns of the same type albeit from different tables. E.g.: \"SELECT first_name, last_name FROM customer UNION|INTERSECT|EXCEPT SELECT first_name, last_name FROM staff;\" UNION INTERSECT EXCEPT These create a new virtual table whose column types are assembled from the types involved in the various parts of the query: CROSS JOIN (conceptual base operation) INNER JOIN OUTER JOIN INNER JOIN retains rows based on fulfillment of one or more predicates: -- \"Classic\" ANSI JOIN SELECT * FROM author a JOIN book b ON a.author_id = b.author_id -- \"Nice\" ANSI JOIN SELECT * FROM author a JOIN book b USING (author_id) -- \"Old\" syntax using a \"CROSS JOIN\" SELECT * FROM author a, book b WHERE a.author_id = b.author_id OUTER JOIN does the opposite (and fills with NULLs where necessary) -- it produces any row where either the LEFT side or the RIGHT or both (FULL) sides did not meet the predicate(s): SELECT * FROM author a LEFT JOIN book b USING (author_id) This produces all authors and their books, but if an author doesn't have any book, we still get the author with NULL as their only book value. Equivalently: SELECT * FROM author a JOIN book b USING (author_id) UNION SELECT a.*, NULL, NULL, NULL, ..., NULL FROM ( SELECT a.* FROM author a EXCEPT SELECT a.* FROM author a JOIN book b USING (author_id) ) a LEFT JOIN: like INNER JOIN but retain non-matches from LEFT RIGHT JOIN: like INNER JOIN but retain non-matches from RIGHT FULL JOIN: retain all ") (defconst kf-dia-help "Layers: Do View -> Show Layers. After that, everything makes sense. Making the diagram fit in a page: Export to Encapsulated Postscript (.eps). Then do 'epstopdf foo.eps foo.pdf'. (superuser.com/questions/515302/how-can-i-make-fit-the-diagram-in-the-page) ") (defconst kf-markdown-help "Headers: # H1 ## H2 ### H3 ...etc... Alternates for H1 and H2 are \"=====\" and \"-----\" underlines, respectively. Inline formatting (Inline HTML generally works too.) Italics: *single asterisks* or _single underscores_. Bold/strong: **double asterisks** or __double underscores__. Combined: **Yes, you can _do_ that.** Strikethrough: Use ~~two twiddles~~. Monospace: `backticks` Lists: 1. First ordered list item 2. Another item ⋅⋅* Unordered sub-list. 1. Actual numbers don't matter, just that it's a number ⋅⋅1. Ordered sub-list 4. And another item. ⋅⋅⋅Properly indented paragraphs within list items. Notice blank line above & leading spaces (at least 1). ⋅⋅⋅To have a line break without a paragraph, you will need to use two trailing spaces.⋅⋅ ⋅⋅⋅Note that this line is separate, but within the same paragraph.⋅⋅ ⋅⋅⋅(This is contrary to the typical GFM line break behaviour, where trailing spaces are not required.) * Unordered list can use asterisks - Or minuses + Or pluses Links: [inline style](https://www.example.com) [inline with link text](https://www.example.com \"Example.com's Homepage\") [relative ref to a repository file](../path/to/something) URLs and auto-convert: http://www.example.com or Reference links are special: [reference style][arbitrary case-insensitive ref text] [You can use numbers for reference-style link definitions][1] Or leave it empty and use the [link text itself]. Then at the bottom of your doc you can put the ref resolutions: [arbitrary case-insensitive reference text]: https://www.mozilla.org [1]: http://slashdot.org [link text itself]: http://www.reddit.com Blockquotes: > just like you > would expect Images: Inline style: ![alt text](https://github.com/adam-p/markdown-here/raw/master/src/common/images/icon48.png \"Logo Title Text 1\") Reference style: ![alt text][logo] Then some text, then the image-ref resolution at the bottom of the doc: [logo]: https://github.com/adam-p/markdown-here/raw/master/src/common/images/icon48.png \"Logo Title Text 2\" Inline code blocks ```javascript blah ``` ```python blah ``` ``` No language indicated, so no syntax highlighting. ``` (You can also do it with four spaces of indentation, but it's clearer just to use the backticks always.) Horizontal rule: Use three or more hyphens, asterisks, or underscores. Tables: (Not supported everywhere, but GFM and Markdown Here support them.) Colons can be used to align columns. | Tables | Are | Cool | | ------------- |:-------------:| -----:| | col 3 is | right-aligned | $1600 | | col 2 is | centered | $12 | | zebra stripes | are neat | $1 | At least 3 dashes separate each header cell. Outer pipes (|) are optional. Source doesn't need to line up prettily. Inline formatting is supported: Markdown | Less | Pretty --- | --- | --- *Still* | `renders` | **nicely** 1 | 2 | 3 Sourced liberally from https://github.com/adam-p/markdown-here/wiki/Markdown-Cheatsheet, and see also https://www.markdownguide.org/cheat-sheet/ and of course https://daringfireball.net/projects/markdown/syntax. ") (defconst kf-mediawiki-help "See - https://www.mediawiki.org/wiki/Help:Formatting - https://www.mediawiki.org/wiki/Help:Links - https://www.mediawiki.org/wiki/Help:Images - https://www.mediawiki.org/wiki/Help:Tables - https://www.mediawiki.org/wiki/Help:Lists Now, the quick reference. Formatting: ''Italics'' '''Bold''' '''''bold & italic''''' no [[wiki]] ''markup'' Links: https://www.mediawiki.org/wiki/Help:Links [[Some:Internal Page|link text]] [https://example.com external link text] Lists: Itemized lists use \"*\"s; enumerated lists use \"#\"s. ; item : definition ; item 2 : definition 2 : Single indent :: Double indent ::::: Multiple indent Start a line with a space to get preformatted text; other wiki markup is still valid in preformatted text. Headings and separators: == Heading Level 2 == === Heading Level 3 === (etc; do not do Level 1, as that is page name) Horizontal rule: use \"----\" on a line by itself. Images: [[File:filename.extension|options|caption]] Some options: \"border\", \"frame\", \"thumb\", \"50px\", etc. There can be many options, each separated by pipe. ") (defconst kf-pandoc-help "Everything you need to know: $ pandoc -s -o foo.pdf foo.md ") (defconst kf-diff-help "Diff by word instead of line: $ wdiff -n foo bar | colordiff ") (defconst kf-org-mode-help "Stuff I always have to look up, gathered in one place: * Todo states / workflow states #+TODO: TODO(t) WAIT(w@/!) | DONE(d!) CANCELED(c@) ! ==> timestamp @ ==> note / ==> stuff after the slash happens after leaving the state | ==> divider between non-final states and final states See also: https://orgmode.org/manual/Tracking-TODO-state-changes.html https://orgmode.org/manual/Workflow-states.html * Tags: #+TAGS: FISH(f) WILLOW(w) * Startup stuff #+STARTUP: overview | content | showall | showNlevels | showeverything (N == 2|3|4|5) #+SETUPFILE: ../../blah/blah/blah/foo.org #+CATEGORY: SomeNameHere ") (defconst kf-dns-help "To look up a TXT record, do something like this: $ host -t txt _acme-challenge.bikeshed.com Or use 'dig' and specify a nameserver: $ dig @ns.red-bean.com -t txt _acme-challenge.bikeshed.com To set up a default /etc/resolv.conf in a network-challenged café: namserver 9.9.9.9 nameserver 2620:fe::fe namserver 8.8.8.8 From https://www.quad9.net/service/service-addresses-and-features/: > Recursive DNS Server Addresses and Features - Service based > configuration: > > Recommended: Malware Blocking, DNSSEC Validation (this is the most > typical configuration): > > IPv4: 9.9.9.9, 149.112.112.112 > IPv6: 2620:fe::fe, 2620:fe::9 > HTTPS: https://dns.quad9.net/dns-query > TLS: tls://dns.quad9.net > > Secured w/ECS: Malware blocking, DNSSEC Validation, ECS enabled: > IPv4: 9.9.9.11, 149.112.112.11 > IPv6: 2620:fe::11, 2620:fe::fe:11 > HTTPS: https://dns11.quad9.net/dns-query > TLS: tls://dns11.quad9.net > > Unsecured: No Malware blocking, no DNSSEC validation (for experts > only!) > > IPv4: 9.9.9.10, 149.112.112.10 > IPv6: 2620:fe::10, 2620:fe::fe:10 > HTTPS: https://dns10.quad9.net/dns-query > TLS: tls://dns10.quad9.net > > Hints: If you have devices that need to be configured by IP > address, make sure to put ALL the IP addresses listed for your > selected service into any configuration areas. Putting in just one > of the three will leave you vulnerable to single-path failures if > they should occur. Even if you do not yet have IPv6, please add > those addresses from the list so you don’t have to remember later > – most systems will ignore IPv6 addresses if they cannot be used. ") (defconst kf-adduser-help "Use adduser, not useradd; former is high-level, latter low-level.") (defconst kf-video-editing-help "* Use ffmpeg to extract clips on the command line: $ ffmpeg -f input.mp4 -ss 00:00:00 -to 01:53:52 -c copy output.mp4 This preserves the video and audio codecs of the original. See https://www.baeldung.com/linux/ffmpeg-cutting-videos for more. ffmpeg is shockingly fast. You almost always want to do this, rather than trim in OpenShot and then export. If you want to re-encode, a list of codecs is available from: $ ffmpeg -formats -E Also, apparently 'mencoder' would work too, though I haven't tried it: $ mencoder -ss 00:00:00 -endpos 00:00:05 -oac pcm -ovc copy input.mp4 -o output.mp4 (As per https://askubuntu.com/questions/59383/\ extract-part-of-a-video-with-a-one-line-command.) If you want to re-encode, a list of audio codecs can be had with 'mencoder -oac help' and video codecs with 'mencoder -ovc help'. * Trimming / cutting in OpenShot: * To trim from the beginning or end: Get the play-head to the spot you want. Right click on the track. Choose Slice, and keep whichever side (left or right) you want. * To cut a section from the middle: I dunno, but this web page might help: https://www.openshot.org/\ static/files/user-guide/clips.html#trimming-slicing * To get information about a video file: $ mediainfo foo.mp4 ") (defconst kf-rsync-help "Apparently rsync is the new scp? First, try this way: $ rsync -avz remote.example.com:/PATH/TO/SRC ./DEST $ rsync -avz ./SRC remote.example.com:/PATH/TO/DEST A trailing slash on the source means don't create an additional level of directory at dest. E.g., these two do the same thing, including setting any attributes of DEST/FOO: $ rsync -avz SRC/FOO /DEST $ rsync -avz SRC/FOO/ /DEST/FOO With some OTS boxes, you might sometimes need '--rsync-path': $ rsync -avz --rsync-path=\"sudo rsync\" remote.example.com:/PATH/TO/SRC ./DEST ") (defconst kf-youtube-help "It's this simple: https://www.youtube.com/watch?v=c91yi2XLAMA&t=1m24s Or for a fully time-bound clip with start and end times: https://www.youtube.com/watch?v=c91yi2XLAMA&start=1m24s&end=1m27s (That particular link is \"No, Lieutenant; your men are already dead.\") ") (defconst kf-ss-help "Apparently ss is the new netstat. They're mostly compatible; see https://askubuntu.com/questions/1220280/difference-between-netstat-and-ss-and-how-to-convert-commands TL;DR: h V l a n Z s p e o 4 6 x t u S w options are the same from netstat to ss, while r N i g M W T v C F c A U 2 f require thought. -l, --listening: Display only sockets where someone's listening -a, --all: Display both listening and non-listening -t, --tcp: This means what you think it does. -u, --udp: This means what you think it does. -n, --numeric: Just show numbers; don't convert them to service names. -p, --processes: Show the process that's using the socket. To see what process is listening on port 8000: $ ss -ltnp | grep ':8000' ") (defconst kf-process-help "To see useful process information including start time: $ ps -eo pid,comm,lstart,etime,time,args ") (kf-gen-displayer kf-ascii "Display the ASCII character table in its own buffer." "*ASCII*") (kf-gen-displayer kf-datetime-formats "Display date/time format codes in their own buffer" "*Date / Time Formats*") (kf-gen-displayer kf-radio-alphabet "Display the radio alphabet in its own buffer." "*RADIO ALPHABET*") (kf-gen-displayer kf-stellar-statistics "Display some statistics about the solar system." "*Solar System*") (kf-gen-displayer kf-irc-suckitude "A Twelve Step process for stealing your own identity." "*Never Apologize, Never Explain*" kf-remind-irc-suckitude) (kf-gen-displayer kf-mariadb-help "That stuff you can never remember. Uh, s/you/I/, yeah." "*Never Apologize, Never Explain*") (defalias 'kf-mysql-help 'kf-mariadb-help) (kf-gen-displayer kf-wireshark-help "I don't use wireshark enough to remember how to use it." "*Never Apologize, Never Explain*" kf-ethereal-help) (kf-gen-displayer kf-gimp-help "You never know when the WWW might be down. Or Google." "*Easy as pie. Blueberry neutronium pie.*") (kf-gen-displayer kf-gnupg-help "You never know when the WWW might be down. Or Google." "*Because command-line arcana == more security. Really*" kf-gpg-help) (kf-gen-displayer kf-37-help "37 Signals * 31 Flavors == 1147 Products." "*Are we really supposed to remember all this stuff?*" kf-basecamp-help) (kf-gen-displayer kf-principl-help "Tired of Googling this one all the time." "*English, the failure-friendly language.*") (kf-gen-displayer kf-pdf-help "Never mind jet packs. Where are our editable page formats?" "*Because who wants to edit documents with computers?*") (kf-gen-displayer kf-git-help (concat "Git is like a BMW: " "a terrific engine surrounded by a cloud of bad decisions.") "*Because command-line arcana == productivity.*") (kf-gen-displayer kf-latin-abbreviation-help (concat "No other language is so rich in expressions " "for clarifying what has been previously said.") "*It's what they speak in Latin America.*") (kf-gen-displayer kf-ssh-help "SSH: I'm hunting wabbits." "*Admit it, you've always wanted to say that.*") (kf-gen-displayer kf-vagrant-help "Vagrant: wandering VMs in your machine." "*Is \"virtual machine\" redundant?*") (kf-gen-displayer kf-gnus-help "Gnus: the mailreader that read your mail for you." "*This feature set is larger than my head.*") (kf-gen-displayer kf-css-help "My memory for syntaxes peaked sometime in the late 1990s." "*My memory for docs peaked sometime in the late 1990s.*") (kf-gen-displayer kf-redmine-help "Email manipulation of ticket trackers is such a win." "*Too bad it requires memorizing lots of finicky syntaces.*") (kf-gen-displayer kf-latex-help "If you have 100 years to invest, LaTeX is for you." "*LaTeX: The answer to the NSF funding surplus.*") (kf-gen-displayer kf-libreoffice-help "If we can't bring 1980s wordprocessing back, Libreoffice is the next best thing." "*LibreOffice: As easy to compile as it is to use.*") (kf-gen-displayer kf-debian-help "Because sysadmin is the new user." "*Debian: An OS for the long term... in every sense.*") (kf-gen-displayer kf-postgres-help "Backslash is the new empty string." "*PostgreSQL: With a name like that, it's _got_ to be good.*" kf-psql-help) (kf-gen-displayer kf-python-help "Sanity was all the sweeter for being so long in coming." "*Python: Why'd it have to be snakes?*") (kf-gen-displayer kf-plantronics-headset-test-help "Thank you, thank you, thank you Plantronics." "*And again, thank you.*") (defalias 'kf-cell-phone-headset-test 'kf-plantronics-headset-test-help) (kf-gen-displayer kf-firefox-help "Yes, even with Firefox we sometimes need help." "*It is always darkest just before the event horizon.*") (kf-gen-displayer kf-grep-help "You could figure this out from the man page..." "*If you had a million years.*") (kf-gen-displayer kf-sqlite-help "Isomorphism is to isomorphism as isomorphism is to..." "*The above sentence.*") (kf-gen-displayer kf-cyrillic-help "Я know Я like it." "*Yes, I know Emacs has an input mode for this.*") (kf-gen-displayer kf-google-groups-help "Being this entangled in a proprietary system bugs me." "*Even one line later, it _still_ bugs me.*") (kf-gen-displayer kf-google-docs-help "I keep trying to talk clients into using Etherpad." "*See also `kf-google-spreadsheets-help'.*") (kf-gen-displayer kf-google-spreadsheets-help "I only use it because everyone else does." "*See also `kf-google-docs-help'.*") (defalias 'kf-google-sheets-help 'kf-google-spreadsheets-help) (kf-gen-displayer kf-sql-help "I will always need to look these up." "*And it's better that way.*") (kf-gen-displayer kf-dia-help "Hard-won knowledge." "*Coming soon to a theater near you.*") (kf-gen-displayer kf-markdown-help "Did the dealer give you good trade-in value for your LaTeX?" "*Markdown: so many different ways to be portable!*") (kf-gen-displayer kf-mediawiki-help "The lingua franca of wiki markups." "*MediaWiki: Just like every other syntax, but different.*") (kf-gen-displayer kf-pandoc-help "Pandoc. I have nothing clever to say. It just wins." "*Pandoc: Doing The Right Thing in Haskell since 2006.*") (kf-gen-displayer kf-diff-help "When the world went full autowrap, some of us wept." "*Diff: It's like 'biff', but with a 'd'!*") (kf-gen-displayer kf-org-mode-help "I know there's a manual, but I've only got this week." "*Org Mode: Like Lisp, but with asterisks not parentheses.*") (kf-gen-displayer kf-dns-help "The tools keep changing; I can't keep up." "*DNS: It's kind of like blockchain, but without blocks or chains.*") (defalias 'kf-nameserver-help 'kf-dns-help) (defalias 'kf-resolv.conf-help 'kf-dns-help) (kf-gen-displayer kf-adduser-help "Is it 'adduser' or 'useradd'? C.f. Folger's crystals, `kf-dns-help'." "*adduser: like useradd, only different*") (defalias 'kf-useradd-help 'kf-adduser-help) (kf-gen-displayer kf-video-editing-help "There are actually good FOSS video editing tools." "*But I only use them once every couple of years.*") (defalias 'kf-ffmpeg-help 'kf-video-editing-help) (defalias 'kf-openshot-help 'kf-video-editing-help) (kf-gen-displayer kf-rsync-help "SCP, we hardly knew ye." "*Rolling checksums FTW.*") (kf-gen-displayer kf-youtube-help "Just show me the good part." "*No, Lieutenant; your men are already dead.*") (kf-gen-displayer kf-ss-help "Constantinople is now Istanbul." "*Nobody's business.*") (defalias 'kf-netstat-help 'kf-ss-help) (kf-gen-displayer kf-process-help "There's a lot going on on my box that I don't know about." "*P.S. 'ps' is all you need.*") ;;; genetic code stuff (defconst kf-genetic-code " UUU = F CUU = L AUU = I GUU = V UCU = S CCU = P ACU = T GCU = A UUC = F CUC = L AUC = I GUC = V UCC = S CCC = P ACC = T GCC = A UUA = L CUA = L AUA = I GUA = V UCA = S CCA = P ACA = T GCA = A UUG = L CUG = L AUG = M GUG = V UCG = S CCG = P ACG = T GCG = A UAU = Y CAU = H AAU = N GAU = D UGU = C CGU = R AGU = S GGU = G UAC = Y CAC = H AAC = N GAC = D UGC = C CGC = R AGC = S GGC = G UAA = * CAA = Q AAA = K GAA = E UGA = * CGA = R AGA = R GGA = G UAG = * CAG = Q AAG = K GAG = E UGG = W CGG = R AGG = R GGG = G " "The genetic code: nucleotides -> amino acids.") (kf-gen-displayer kf-genetic-code "Display the genetic code in its own buffer." "*THE GENETIC CODE*") (defconst gene-trans-triplet-table (list ;; On each line/col, the pattern runs UCAG, with U translated to T. (list ; leftmost U ?T (list ?T (cons ?T ?F) (cons ?C ?F) (cons ?A ?L) (cons ?G ?L)) ; mid U (list ?C (cons ?T ?S) (cons ?C ?S) (cons ?A ?S) (cons ?G ?S)) ; mid C (list ?A (cons ?T ?Y) (cons ?C ?Y) (cons ?A ?*) (cons ?G ?*)) ; mid A (list ?G (cons ?T ?C) (cons ?C ?C) (cons ?A ?*) (cons ?G ?W))) ; mid G (list ; leftmost C ?C (list ?T (cons ?T ?L) (cons ?C ?L) (cons ?A ?L) (cons ?G ?L)) ; mid U (list ?C (cons ?T ?P) (cons ?C ?P) (cons ?A ?P) (cons ?G ?P)) ; mid C (list ?A (cons ?T ?H) (cons ?C ?H) (cons ?A ?Q) (cons ?G ?Q)) ; mid A (list ?G (cons ?T ?R) (cons ?C ?R) (cons ?A ?R) (cons ?G ?R))) ; mid G (list ; leftmost A ?A (list ?T (cons ?T ?I) (cons ?C ?I) (cons ?A ?I) (cons ?G ?M)) ; mid U (list ?C (cons ?T ?T) (cons ?C ?T) (cons ?A ?T) (cons ?G ?T)) ; mid C (list ?A (cons ?T ?N) (cons ?C ?N) (cons ?A ?K) (cons ?G ?K)) ; mid A (list ?G (cons ?T ?S) (cons ?C ?S) (cons ?A ?R) (cons ?G ?R))) ; mid G (list ; leftmost G ?G (list ?T (cons ?T ?V) (cons ?C ?V) (cons ?A ?V) (cons ?G ?V)) ; mid U (list ?C (cons ?T ?A) (cons ?C ?A) (cons ?A ?A) (cons ?G ?A)) ; mid C (list ?A (cons ?T ?D) (cons ?C ?D) (cons ?A ?E) (cons ?G ?E)) ; mid A (list ?G (cons ?T ?G) (cons ?C ?G) (cons ?A ?G) (cons ?G ?G)))) ; mid G "Table for translating nucleotide triplets into amino acids.") (defun gene-trans-triplet-to-amino-internal (ch1 ch2 ch3) "Translate the triplet CH1 CH2 CH3 to an amino acid character. Case-sensitive, and only handles T, not U. Returns nil if no such triplet code. You probably don't want to use this function. Take a look at `gene-trans-triplet-to-amino' instead." (cdr (assoc ch3 (cdr (assoc ch2 (cdr (assoc ch1 gene-trans-triplet-table))))))) (defun gene-trans-triplet-to-amino (ch1 ch2 ch3) "Translate the triplet CH1 CH2 CH3 to an amino acid character. Case-insensitive. U or T may be used interchangably. If the triplet does not code for anything, return `X'. The input characters are three separate arguments, not a list." (or (gene-trans-triplet-to-amino-internal (min (upcase ch1) ?T) (min (upcase ch2) ?T) (min (upcase ch3) ?T)) ?X)) ;; Appears to have an off-by-one-error at the very end of the ;; translation, hmm. (defun kf-gene-translate-region (b e) "Interpret region from B to E as nucleotides, insert the corresponding amino acids before B, followed by a newline." (interactive "r") (save-excursion (goto-char b) (setq e (copy-marker (- e (mod (- e b) 3)))) (let ((insert-pt (point)) (trans-pt (progn (re-search-forward "[a-zA-Z]") (forward-char -1) (point)))) (while (<= trans-pt e) (let ((char1 (char-after)) (char2 (progn (forward-char 1) (char-after))) (char3 (progn (forward-char 1) (char-after)))) (setq trans-pt (point)) (goto-char insert-pt) ;; Notice the o-b-o-e. (when (null char1) (error "Char1 is nil, %d" trans-pt)) (when (null char2) (error "Char2 is nil, %d" trans-pt)) (when (null char3) (error "Char3 is nil, %d" trans-pt)) (insert (gene-trans-triplet-to-amino char1 char2 char3)) (setq insert-pt (point)) (goto-char trans-pt))) (goto-char insert-pt) (insert "\n")))) ;;; end genetic code stuff (defun kf-strings-from-alphabet-internal (alphabet depth accum) "Recursive helper for `kf-strings-from-alphabet'. ALPHABET is as in that function. DEPTH must be a positive integer. ACCUM starts as the empty list on the initial (non-recursive) call." (if (= depth 1) (append accum alphabet) (kf-strings-from-alphabet-internal alphabet (1- depth) (let ((new-accum ())) (dolist (letter-str alphabet) (dolist (accum-str (append alphabet accum)) (setq new-accum ;; A better way to do this -- both faster and more ;; GC-efficient -- would be to pre-allocate a vector ;; of the right length and slot the strings into it. ;; The caller would allocate the vector and pass it ;; in, along with an initial index of 0. Instead of ;; `cons' here, we'd just put the constructed string ;; into the current slot and increment the index. ;; The accumulated result would just be the vector up ;; to the index initially received in this call. If ;; some day performance matters, we know what to do. (cons (concat letter-str accum-str) new-accum)))) new-accum)))) (defun kf-strings-from-alphabet (alphabet len) "Return a list of all strings of length 1 to LEN from ALPHABET. ALPHABET is a list of strings whose lengths are all 1. For example, if ALPHABET is `(\"a\" \"b\")' and LEN is 2, then return `(\"a\" \"b\" \"aa\" \"ab\" \"ba\" \"bb\")', though not necessarily in that order: while no particular order is guaranteed, the returned list will have exactly one of each expected string." (kf-strings-from-alphabet-internal alphabet len ())) (defun kf-sample (sample mean std-deviation) "I'm sure there's an Emacs package for this somewhere." (let ((e 2.718281828)) (- 1 (* (/ 1.0 (* std-deviation (sqrt (* 2 pi)))) (expt e (- 0 (/ (expt (- sample mean) 2) (* 2 (expt std-deviation 2))))))))) (defun kf-htmlegalize-region (b e) "Replace \"&\", \"<\", and \">\" with their HTML escape codes, from B to E. Is there anything else that should be done to escape HTML?" (interactive "r") (save-excursion (let ((em (copy-marker e))) (goto-char b) (while (search-forward "&" em t) (replace-match "&" nil t)) (goto-char b) (while (search-forward "<" em t) (replace-match "<" nil t)) (goto-char b) (while (search-forward ">" em t) (replace-match ">" nil t)) ))) (defun kf-anchor-set (name) "Set a standard HTML named anchor at point. This assumes you are inside the attr area of an HTML element opening tag." (interactive "MAnchor name: ") (insert (format " id=\"%s\" title=\"%s\"" name name))) (defun kf-highlight-region (b e) "Highlight the region assuming an HTML+CSS \"highlight\" class." (interactive "r") (save-excursion (setq e (copy-marker e)) (goto-char b) (insert "") (goto-char e) (insert ""))) (defun kf-paragraphize (&optional no-fill) "Put paragraph tags around the paragraph at point. Refill to compensate for the tags, unless prefix arg NO-FILL is non-nil." (interactive "P") (let* ((markup-flavor (kf-markup-flavor)) (open-tag (cond ((eq markup-flavor 'xml) "") (t "

"))) (close-tag (cond ((eq markup-flavor 'xml) "") (t "

")))) (save-excursion (forward-paragraph -1) (forward-line 1) (forward-word 1) (forward-word -1) (insert open-tag) (forward-paragraph 1) (forward-char -1) (insert close-tag) (unless no-fill (kf-fill-paragraph nil))))) (defun kf-quoted-printable-decode (b e) "Soft-decode the quoted-printable-encoded text from B to E. Just convert certain common quoted-printable codes to roughly corresponding ASCII characters suitable for plaintext documents. (This is different from `quoted-printable-decode-region', which would actually interpret the quoted-printable text and insert whatever Unicode characters it specified.) Example text: We won=E2=80=99t be eating the meteorite as proposed.=C2=A0 Instead, we (=3D=3D just us, not you) would like to request: =E2=80=A2 Yams or nightshades;=C2=A0 =E2=80=A2 Anything involving beryllium. Thank =E2=80=98you=E2=80=99 for your =E2=80=9Ctime=E2=80=9D. " (interactive "r") (mapcar (lambda (rplc) (let ((qp-code (car rplc)) (replacement (cdr rplc))) (goto-char b) (replace-string qp-code replacement nil b e))) '( ("=3D" . "=") ("=E2=80=98" . "'") ("=E2=80=99" . "'") ("=E2=80=9C" . "\"") ("=E2=80=9D" . "\"") ("=C2=A0" . " ") ("=E2=80=A2" . "*") ;; more to come )) ;; now handle the =\n\\s-* thing ) (defun fitz-said-fuck-you-clown (start end arg) (interactive "r\nsTagname: ") (goto-char start) (insert "<" arg ">") (goto-char (+ end 2 (length arg))) (insert "")) ;;; Some information about getting ps-print to do color: ;; ;; Thom Goodsell writes: ;; ;;> I've run into a problem trying to print with color from an Emacs ;;> buffer. I can print just fine, but much of the text is unreadable. ;; ;; Someone asked this question before a while back. I copied the code to ;; my .emacs file. Here it is: ;; ;; ; Make printed code have reasonable colors ;; (ps-extend-face '(font-lock-keyword-face "black" nil bold) 'MERGE) ;; (ps-extend-face '(font-lock-function-name-face "black" nil bold) 'MERGE) ;; (ps-extend-face '(font-lock-comment-face "dim gray" nil italic) 'MERGE) ;; (ps-extend-face '(font-lock-type-face "dim gray" nil bold) 'MERGE) ;; ;; Works pretty well for me. (setq ps-print-header nil) ; skip the annoying header when you print pages (defun kf-defang-filename (name) "Substitute underscores for shell-hostile characters in filename NAME." (let ((new-name (copy-sequence name))) (dolist (replaceme (list ?< ?> ?* ? ?! ?/ ?\\ ?\[ ?\] ?\( ?\) ?` ?') new-name) (subst-char-in-string replaceme ?_ new-name t)))) (defun kf-print-region (b e &optional printer file) "Print text from B to E, at 4 pages per page. Optional third arg PRINTER defaults to system printer. Optional fourth arg FILE means output to that file. It is an error to pass both PRINTER and FILE." (interactive "r") (let* ((tmpfile (concat (temporary-file-directory) "/" (kf-defang-filename (buffer-name)))) (cmd (mapconcat (lambda (x) x) (list "a2ps" ;; The story behind this first option ;; is longer than it should be. Every ;; printed sheet had a top right header ;; saying "Printed by Karl Fogel". I ;; thought that was pointless and did ;; not want it, but it is surprisingly ;; hard to suppress; nowhere in the ;; a2ps documentation did I see any ;; obvious way to do so. ;; ;; First I tried passing "--no-header", ;; but alas that also suppresses a lot ;; of other things that I want to keep, ;; like page numbers (which are in the ;; footer, not the header, but already ;; I was getting the sense that there ;; is no point complaining about small ;; things, so I'm not, I'm really not). ;; Anyway, it also suppresses headers ;; in the virtual pages, and I wanted ;; to keep those headers, so overall ;; this option was a non-starter. ;; ;; Fine. I can keep going. It's ;; pretty much my only skill, actually. ;; ;; Next I tried "predefined variables" ;; (see the eponymous section in the ;; a2ps Info pages) which implied that ;; "--define=user.name" would cause the ;; user's name to be unset. While that ;; didn't work (instead, it just made ;; a2ps give the error "/usr/bin/lp: ;; No file in print request."), it turns ;; out that you *can* set the value of ;; user.name to the empty string by ;; doing "--define=user.name=". ;; ;; However, the problem with that is ;; that a2ps will still happily print ;; an empty string -- in other words, ;; each sheet just says "Printed by" on ;; the top right of the sheet, with ;; nothing after the word "by" :-). ;; ;; At this point, I knew I was in over ;; my head, and naturally chose to ;; continue my descent. I cloned the ;; a2ps source (commit ddc999706f) from ;; https://savannah.gnu.org/projects/a2ps/ ;; and found where that header gets ;; emitted in liba2ps/metaseq.c: ;; ;; case 'A': /* `%A' NLS'ed `printed by USERNAME from MACHINE */ ;; cp = macro_meta_sequence_get (job, VAR_USER_NAME); ;; cp2 = macro_meta_sequence_get (job, VAR_USER_HOST); ;; if (cp2) ;; sprintf (buf3, ;; _("Printed by %s from %s"), cp, cp2); ;; else ;; sprintf (buf3, _("Printed by %s"), cp); ;; APPEND_STR (buf3); ;; break; ;; ;; Hmm, okay, sigh. I could continue ;; shaving this yak, or I could just ;; set user.name to something innocuous ;; like, say, the name of the program ;; itself. I went with that. "--define=user.name=a2ps" "--borders=yes" "--columns=2" "--rows=2" "--portrait" "--major=columns" (cond ((and printer file) (error "PRINTER and FILE mutually exclusive")) (printer (concat "--printer=" printer)) (file (concat "--output=" file)) (t "-d")) tmpfile) " "))) (write-region b e tmpfile) (shell-command cmd) (delete-file tmpfile))) (defun kf-print-buffer () "Print current buffer at 4 pages per page." (interactive) (kf-print-region (point-min) (point-max))) ;; A few things, like addresses and phone numbers, I load ;; from a non-public file. (let ((private-dot-emacs (expand-file-name "~/private/.emacs"))) (when (file-exists-p private-dot-emacs) (load private-dot-emacs))) (defvar kf-thesaurus-file "~/thesaurus/roget13a.txt") (defvar kf-thesaurus-file-gz (concat kf-thesaurus-file ".gz")) (defun kf-thesaurus () (interactive) (find-file kf-thesaurus-file) (toggle-read-only 1)) (defalias 'thesaurus 'kf-thesaurus) (defun kf-switch-handler-dot () "Insert \"[...]\" in a manner sensitive to email quoting context. This switch handler function used to do more things, and perhaps one day will again, but for now it's not really a switch handler." (interactive "P") (if (and (eq (current-column) 0) (save-excursion (progn (forward-line -1) (beginning-of-line) (looking-at "^>")))) ;; If extending the quoted section of an email, then ;; put a quote marker before the elision. (insert ">\n> [...]\n\n") (insert "[...]"))) (defun kf-remove-text-properties (b e) "Remove text properties over region from B to E." (interactive "r") (let ((inhibit-read-only t)) ; remove `read-only' text property too (set-text-properties b e nil))) (defvar kf-this-column nil "Internal var for use by kf-push-to-column.") (defun kf-push-to-column (&optional parg-or-column) "If I documented this, that would be cheating, wouldn't it? See also `kf-find-longest-line'." (interactive "p") (when (not parg-or-column) (setq parg-or-column 1)) (let ((col 0)) (if (or (not kf-this-column) (> parg-or-column 1)) (if (called-interactively-p) (progn (setq kf-this-column (current-column) col kf-this-column) (message "Set push column to %d" kf-this-column)) (setq col parg-or-column)) (setq col kf-this-column) (just-one-space) (insert-char ? (- col (current-column)))))) (defun kf-uniqify (start end) "Filter non-unique lines out of the region from START to END. If interactive, display the number of lines deleted. See also `kf-count-fold-lines'." (interactive "r") (kf-ensure-ordering start end) (setq end (copy-marker end)) (goto-char start) (let ((seen-lines (make-hash-table :test 'equal)) (removed-count 0)) (while (< (point) end) (let ((line (buffer-substring-no-properties (point) (progn (end-of-line) (point))))) (gethash line seen-lines) (if (gethash line seen-lines) (progn (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) (setq removed-count (1+ removed-count))) (puthash line t seen-lines) (forward-line 1)))) (if (> removed-count 0) (message "%d lines removed." removed-count) (message "No lines removed.")))) (defun kf-sort-lines (beg end &optional other-order) "Sort lines from BEG to END, maybe numerically. If all of the lines start with a whitespace-delimited number, then sort numerically descending; otherwise, sort lexically ascending. With optional prefix argument OTHER-ORDER, reverse the sort order." (interactive "r\nP") (save-excursion (save-match-data (goto-char beg) (let ((numeric (not (re-search-forward "^\\s-*[^0-9\t ]" end t)))) (goto-char beg) (if numeric (progn (sort-numeric-fields 1 beg end) (unless other-order (kf-reverse-lines-region beg end))) (sort-lines other-order beg end)))))) (defun kf-count-fold-lines (start end &optional no-sort) "Replace lines from START to END with counts of unique lines. Put the lines in descending order by count, unless optional prefix argument NO-SORT is non-nil, in which case order by first occurrence. See also `kf-uniqify'. *NOTE*: The NO-SORT option isn't actually implemented yet; I just thought of it on 2023-03-25 and updated this doc string to describe it. So the doc string is now half aspirational: while the original case in which NO-SORT is nil is implemented, the case where NO-SORT is non-nil doesn't behave differently yet. Here's an example. This region text... foo foo qux bar foo baz bar foo ...would become this with NO-SORT left as nil: 4 foo 2 bar 1 qux 1 baz ...or this with NO-SORT non-nil: 4 foo 1 qux 2 bar 1 baz (in both cases modulo some left-padding differences we don't care about). See https://rants.org/2023/01/count-fold-lines/ for a longer example." (interactive "r\nP") (sort-lines nil start end) (save-mark-and-excursion ;; Hah! You thought I was going to implement this in Elisp, didn't you? ;; Update (2023-03-25): Well, joke's on me after all, because I'll ;; have to write this in Elisp to implement the NO-SORT flag. (shell-command-on-region start end "uniq --count" nil t) (sort-lines t (point) (mark)))) (defun kf-delete-blank-or-header-char (n) "Delete up to the following N blank or Org Mode header characters. Stop at newline or any non-header-non-whitespace character. This can be used in macros where one wants to adjust the indentation of multiple paragraphs that have purely blank lines between them: This paragraph is indented by three or two spaces. So is this one, but the line between them is just a newline. Same here. Again, an entirely blank line preceded this. A macro to pull the paragraphs leftward by one space would founder when run on the second line, if it used `delete-char', because it would just delete the new line, causing this familiar problem: This paragraph is indented by three spaces. So is this one, but the line between them is just a newline. Same here. Again, an entirely blank line preceded this. But if you use this function instead, you get the desired result: This paragraph is indented by three or two spaces. So is this one, but the line between them is just a newline. Same here. Again, an entirely blank line preceded this. " (interactive "p") (unless n (setq n 1)) (catch 'done (while (> n 0) (if (and (not (looking-at "\\*")) (looking-at "\\(\\S-+\\|$\\)")) (throw 'done nil) (delete-char 1 nil)) (setq n (1- n))))) (defmacro defun-with-repeat-key (name arglist &rest body) ;; Idea: write a macro `(defun-with-repeat-key ...)' that wraps its ;; body argument in a defun, slurps the resultant lambda, and ;; returns a new defun that uses that lambda as the `fun' below. ;; Then any interactive function can be written with a repeating key ;; as below, without the mechanics of the repetition needing to be ;; reflected in the body of the function. ;; ;; Other candidates for repeat-ification: ;; - `kf-just-sent' ;; - `kf-delete-blank-or-header-char' ;; - `yank-match' ;; - `kf-fix-previous-transposition' ;; ;; Look at `(defmacro defun ...)' in lisp/emacs-lisp/byte-run.el in ;; the Emacs source tree. ;; ;; 2022-09-10: Wait, hold on, there appears to be a thing called ;; `repeat-mode'. What is that? Does Emacs already have the thing ;; I'm considering implementing? And if so, could I have just used ;; it for `kf-remove-line-break-in-paragraph' in the first place? ;; (...digs further...) Whoa. Yes, see lisp/repeat.el Emacs's ;; source tree. Okay. Sigh. Time to do some more research. `(defun ,name hmm hmm etc TBD )) (defun kf-remove-line-break-in-paragraph () "Replace the line break at the end of this line with a space, iff the paragraph continues after that line break. If the line ends with a period, replace the line break with two spaces. This is to ensure two spaces after a sentence-ending period (though it means that if a string like \"St. Joseph\" is broken across two lines, it will get an extra space -- maybe some day we can add some smarts to handle cases like that). If this function is invoked from a binding in the keybinding space officially reserved for users (C-c LETTER, according to \"Key Binding Conventions\" in the Elisp manual) then typing LETTER immediately after an initial invocation causes the same action to occur again, and again each time LETTER is repeated. Typing any other key exits the loop." (interactive) (let* ((fun (lambda () (interactive) (end-of-line) (cond ((save-excursion (beginning-of-line) (looking-at "^\\s-*$")) (forward-line 1)) ((save-excursion (forward-line 1) (looking-at "\\s-*$")) (forward-line 1)) (t (delete-char 1) (just-one-space) (when (= (char-before (1- (point))) ?.) (insert " ")) (end-of-line))))) (invoked-by (this-command-keys)) (rpt-key (if (and (= (length invoked-by) 2) (= (aref invoked-by 0) 3) ; Ctrl-c ;; Is there a better way to find out if ;; a character is a Roman letter? (or (and (>= (aref invoked-by 1) ?A) (<= (aref invoked-by 1) ?Z)) (and (>= (aref invoked-by 1) ?a) (<= (aref invoked-by 1) ?z)))) (aref invoked-by 1) nil))) (funcall fun) (when rpt-key (let ((map (make-sparse-keymap))) (keymap-set map (string rpt-key) fun) (set-transient-map map t))))) ;;; Stuff for writing a book. ;; This code uses Andy Oram's estimate of 550 words per O'Reilly ;; page, and tries to skip XML metadata. (defun kf-real-words-region (b e &optional unconditionally-msg) "Return the number of entire real words in the region, not including XML tags. If interactive or UNCONDITIONALLY-MSG, then print the number in the minibuffer too." (interactive "r") (let ((find-next-tag '(lambda (&optional limit) "Return a list (start end) delimiting the next XML tag from point, or nil if no XML tag after point. If LIMIT is not nil, it is a point at or beyond which no tags are reported. May error if region does not contain well-formed XML." (save-excursion (let ((start (search-forward "<" nil t))) (when (and start (not (and limit (>= start limit)))) (let ((end (search-forward ">"))) (list (1- start) end)))))))) (save-excursion (goto-char b) (let ((opoint (point)) (count 0)) (while (< opoint e) (let* ((next-tag (funcall find-next-tag e)) (stop-point (if next-tag (car next-tag) e)) (start-point (if next-tag (cadr next-tag) e))) (setq count (+ count (kf-count-words-region opoint stop-point))) (goto-char (setq opoint start-point)) )) (when (or (called-interactively-p) unconditionally-msg) (message "%d real words in region" count)) count)))) (defconst kf-oreilly-words-per-page 430.0 "Calibrated words per O'Reilly book page, not counting XML tags.") (defun kf-oreilly-pages-region (b e &optional unconditionally-msg) "Return the number of O'Reilly book pages in the region. If interactive or UNCONDITIONALLY-MSG, then print the number in the minibuffer too." (interactive "r") (let* ((words (kf-real-words-region b e)) (pages (/ words kf-oreilly-words-per-page))) (when (or (called-interactively-p) unconditionally-msg) (message "%f pages region" pages)) pages)) (defun kf-browse-markdown (&optional not-github-flavored) "Browse the current Markdown buffer as HTML, in the default browser. Treat the input as GitHub-flavored Markdown unless optional argument NOT-GITHUB-FLAVORED is non-nil. Requires 'markdown' and 'pandoc'." (interactive "P") (let ((orig-buf (current-buffer)) (output-buf (get-buffer-create "*HTML from Markdown*"))) (set-buffer output-buf) (delete-region (point-min) (point-max)) (set-buffer orig-buf) (let ((cmd (if not-github-flavored "markdown" "pandoc -f gfm -o -"))) (shell-command-on-region (point-min) (point-max) cmd output-buf)) (browse-url-of-buffer output-buf))) (defconst kf-calendar-day-re (concat "\\([a-zA-Z][a-zA-Z][a-zA-Z]\\)\\s-+" "\\([0-9]+\\)\\s-+" "\\([a-zA-Z][a-zA-Z][a-zA-Z]\\)\\s-+" "\\([0-9][0-9][0-9][0-9]\\)") "Paren groups are: three-letter English day, day of month, three-letter month name, 4-digit year.") (defconst kf-calendar-year-re "$[0-9]*\\.[0-9][0-9]-[a-z][a-z][a-z]_\\([0-9][0-9][0-9][0-9]\\)\\s-" "First paren group gets you the year. That's all you need to know.") (defconst kf-calendar-days-of-week (list "WED" "THU" "FRI" "SAT" "SUN" "MON" "TUE") "What you think it is. This list must be cyclic.") (kf-make-list-cyclic kf-calendar-days-of-week) (defun kf-calendar-next-day-of-week (day) "Return the next day after DAY. Both are three-letter strings; the return value tries to match the case of the argument." (let ((uday (upcase day)) (next nil)) (while (null next) (if (string-equal uday (car kf-calendar-days-of-week)) (setq next (car (cdr kf-calendar-days-of-week))) (setq kf-calendar-days-of-week (cdr kf-calendar-days-of-week)))) ;; Don't just return `next', try to match case too: (cond ((string-equal day uday) next) ((string-equal day (downcase day)) (downcase next)) (t (capitalize next))))) (defun kf-calendar-next-english-month (curr-emon) (let ((tmp timezone-months-assoc) (next nil)) (while tmp (if (string-match (upcase curr-emon) (car (car tmp))) (setq next (or (car (car (cdr tmp))) "JAN"))) (setq tmp (cdr tmp))) (capitalize next))) (defun kf-calendar-insert-day () "Insert a new calendar line. Call with point after a line like Mon 19 Feb 2001 or it won't know when it's counting from." (interactive) (kf-require 'timezone) (save-excursion (re-search-backward kf-calendar-day-re)) (let* ( ;; Current English Day: (curr-eday (match-string 1)) ;; Current Numeric Day (of month): (curr-nday (string-to-number (match-string 2))) ;; Current English Month: (curr-emon (match-string 3)) ;; Current Numeric Month: (curr-nmon (cdr (assoc (upcase curr-emon) timezone-months-assoc))) ;; Current Numeric Year: (curr-year (string-to-number (match-string 4))) ;; Next English Day: (next-eday (kf-calendar-next-day-of-week curr-eday)) ;; Next English Month: (next-emon (if (= curr-nday (timezone-last-day-of-month curr-nmon curr-year)) (kf-calendar-next-english-month curr-emon) curr-emon)) ;; Next Numeric Day (of month): (next-nday (if (not (string-equal curr-emon next-emon)) 1 (1+ curr-nday))) ;; Next Numeric Year: (next-year (if (and (string-equal curr-emon "Dec") (string-equal next-emon "Jan")) (1+ curr-year) curr-year)) ) (insert (format "%s %d %s %d\n" next-eday next-nday next-emon next-year)))) (defconst kf-months ;; I know this is in Emacs somewhere, but the amount of time it ;; would take me to find it is more than the amount of time it ;; took to just write out this array along with this comment. [ "january" "february" "march" "april" "may" "june" "july" "august" "september" "october" "november" "december" ] "The months, in order. That's all.") (defun kf-number-to-month (num) "Convert NUM to the corresponding lower-case month string. NUM can be an integer or a string that converts to an integer." ;; I looked for this in Emacs, I really did. Does it exist? (when (stringp num) (setq num (string-to-number num))) (aref kf-months (1- num))) (defun kf-month-name-to-number (&optional month-name) "Convert MONTH-NAME (a string) to a month number (an integer). If MONTH-NAME is nil, including interactively, use the word around point." ;; There's `icalendar--get-month-number', but it's not advertised as ;; a public function, so I'd feel queasy depending on it. (interactive) (unless month-name (setq month-name (substring-no-properties (thing-at-point 'word)))) (1+ (seq-position kf-months (downcase month-name) (lambda (seq-elt key) (string-prefix-p key seq-elt))))) (defun kf-month-name-to-month-digits (&optional month-name) "Convert MONTH-NAME (a string) to a zero-padded month number string. If MONTH-NAME is nil, including interactively, use the word around point." (interactive) (format "%02d" (kf-month-name-to-number month-name))) (defun kf-op-regexps (re b e &optional parg) "Return result of an arithmetic operation on matches for RE from B to E. If called interactively, also put the result onto the kill ring as a string and display it in the minibuffer. Ignore non-numeric portions of matches. Prefix argument means prompt for the operation; otherwise, use `+'." (interactive "sRegexp (default \"[-+]?[0-9]+\\.?[0-9]*\"): \nr\nP") (when (equal re "") ;; Grab the default regexp presented in the interactive prompt. (let ((interactive-string (cadr (interactive-form this-command)))) (setq re (string-remove-prefix "sRegexp (default \"" (string-remove-suffix "\"): \nr\nP" interactive-string))))) (let ((operator (symbol-function '+))) (when parg (setq operator (symbol-function (intern (completing-read "Operator: " (mapcar (lambda (op) (cons (symbol-name op) (symbol-function op))) '(+ - * / % expt = kf-average)) nil t))))) (let ((accum-any nil) (accum-num nil)) (save-excursion (save-match-data (goto-char b) (while (re-search-forward re e t) (setq accum-any (cons (match-string 0) accum-any))) (mapcar (lambda (str) (string-match re str) (setq accum-num (cons (match-string 0 str) accum-num))) accum-any))) (let ((answer (apply operator (mapcar 'string-to-number accum-num)))) (when (called-interactively-p) (let ((answer-as-string (number-to-string answer))) (kill-new answer-as-string) (message answer-as-string))) answer)))) (defun bwf-cut-here (parg) (interactive "P") (insert (if parg "--------------------8-<-------cut-here---------8-<-----------------------" "---------------------------------------------------------------------------" ))) (when (not (fboundp 'cut-here)) (defalias 'cut-here 'bwf-cut-here)) (defun kf-permute (lst) "Return a list of all permutations of LST." (if (null (cdr lst)) (list lst) (let* ((head (car lst)) (sub (mdb-permute (cdr lst))) (len (length (car sub))) (idx 0) (new nil)) (while sub (while (<= idx len) (let ((this-new (copy-sequence (car sub)))) (cond ((= idx len) (nconc this-new (list head))) ((= idx 0) (setq this-new (cons head this-new))) (t (setcdr (nthcdr (1- idx) this-new) (cons head (nthcdr idx this-new))))) (setq new (cons this-new new))) (setq idx (1+ idx))) (setq sub (cdr sub)) (setq idx 0)) new))) ;;; Edit Chinese in Emacs? You've *got* to be kidding me. That's way ;;; too winning for this life... ;; I want forward-word to think of single characters as words in ;; Chinese. But they don't, yet. Oh well. (defun kf-chinese-language-environment-hook () "Set up Chinese editing the way I like it." (interactive) (if (let ((case-fold-search t)) (and current-language-environment (string-match "chinese" current-language-environment) current-input-method (string-match "chinese" current-input-method))) (progn (message "Setting up chinese environment customizations...") ;; I thought I had something to do here, but apparently not. (message "Setting up chinese environment customizations...done")))) ;; The Chinese charset names are: ;; ;; chinese-gb2312 ;; chinese-cns11643-1 ;; chinese-cns11643-2 ;; chinese-big5-1 ;; chinese-big5-2 ;; chinese-sisheng ;; chinese-cns11643-3 ;; chinese-cns11643-4 ;; chinese-cns11643-5 ;; chinese-cns11643-6 ;; chinese-cns11643-7 ;; ;; (Do `list-character-sets' if this list looks out of date.) (when (and (eq window-system 'x) (string-match "^2" emacs-version) nil) ;; first Chinese fontset (create-fontset-from-fontset-spec (concat "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-chinese1" "," "latin-iso8859-1" ":" "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard" "," "chinese-gb2312" ":" "-guobiao-song-medium-r-normal--0-0-72-72-c-0-gb2312.80&gb8565.88-0" "," "chinese-big5-1" ":" "-eten-fixed-medium-r-normal--0-0-75-75-c-0-big5.eten-0" "," "chinese-cns11643-3" ":" "-cbs-song-medium-r-normal-fantizi-0-0-75-75-c-0-cns11643.1992-1" )) ;; second Chinese fontset (create-fontset-from-fontset-spec (concat "-misc-fixed-medium-r-normal--20-200-75-75-C-100-fontset-chinese2" "," "latin-iso8859-1" ":" "-misc-fixed-medium-r-normal--20-200-75-75-C-100-ISO8859-1" "," "chinese-gb2312" ":" "-isas-song ti-medium-r-normal--24-240-72-72-c-240-gb2312.1980-0" "," "chinese-big5-1" ":" "-eten-fixed-medium-r-normal--24-230-75-75-c-240-big5.eten-0" "," "chinese-cns11643-3" ":" "-cbs-song-medium-r-normal-fantizi-24-240-75-75-c-240-cns11643.1992-1" )) ;; third Chinese fontset (create-fontset-from-fontset-spec (concat "-misc-fixed-medium-r-normal--20-200-75-75-C-100-fontset-chinese3" "," "latin-iso8859-1" ":" "-misc-fixed-medium-r-normal--20-200-75-75-C-100-ISO8859-1" "," "chinese-gb2312" ":" "-cc-song-medium-r-normal-jiantizi-0-0-75-75-c-0-gb2312.1980-0" "," "chinese-big5-1" ":" "-cc-song-medium-r-normal-jiantizi-0-0-75-75-c-0-gb2312.1980-0" "," "chinese-cns11643-3" ":" "-cc-song-medium-r-normal-jiantizi-0-0-75-75-c-0-gb2312.1980-0" )) ;; fourth Chinese fontset (create-fontset-from-fontset-spec (concat "-misc-fixed-medium-r-normal--20-200-75-75-C-100-fontset-chinese4" "," "latin-iso8859-1" ":" "-misc-fixed-medium-r-normal--20-200-75-75-C-100-ISO8859-1" "," "chinese-gb2312" ":" "-guobiao-song-medium-r-normal--16-160-72-72-c-160-gb2312.80&gb8565.88-0" "," "chinese-big5-1" ":" "-guobiao-song-medium-r-normal--16-160-72-72-c-160-gb2312.80&gb8565.88-0" "," "chinese-cns11643-3" ":" "-guobiao-song-medium-r-normal--16-160-72-72-c-160-gb2312.80&gb8565.88-0" )) ) ;; Finally going to test that BiDi code, יאָ. (let ((local-yiddish (expand-file-name "~/src/elisp-assorted/yiddish.el"))) (when (file-exists-p local-yiddish) (load-file local-yiddish))) ;; I'll off my own set, thank you very much. (setq sgml-basic-offset 0) (setq pages-directory-buffer-narrowing-p nil) (when (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version) ;; XEmacs 21 actually wrote this stuff to the bottom of my ;; .emacs when I started it up. The nerve! (custom-set-variables '(load-home-init-file t t) '(gnuserv-program (concat exec-directory "/gnuserv"))) (custom-set-faces)) (defun kf-average (&rest nums) (/ (apply '+ (mapcar 'float nums)) (length nums))) (defun kf-narrow-telepathically () "Narrow to the enclosing class, defun, or whatever you wanted." (interactive) (cond ((eq major-mode 'python-mode) (let ((b (save-excursion (py-beginning-of-def-or-class t) (point))) (e (save-excursion (py-end-of-def-or-class t) (point)))) (narrow-to-region b e))) (t (narrow-to-defun)))) (defun kf-entitize-region (b e) "Convert chars from B to E to HTML entities." (interactive "r") (save-excursion (goto-char b) (let ((e (copy-marker e))) (while (< (point) e) (let ((ch (char-after))) (insert (format "&#%.3d;" ch)) (delete-char 1)))))) (defun kf-arms-race (mailto) "Recode the mail address around point using HTML character entities and various no-op tags, to fool spam harvesters. If MAILTO, then also convert to a mailto URL; but note that mailto means less spam protection, because the no-op tags can't appear in the target portion, so the mail address is less disguised." (interactive "P") (let* ((posns (or (bounds-of-thing-at-point 'url) (bounds-of-thing-at-point 'email))) (start (car posns)) (end (copy-marker (cdr posns)))) (save-excursion (goto-char start) ;; Convert region to HTML character entities. (kf-entitize-region start end) (let ((entitized-string (buffer-substring (point) end))) ;; Surround each logical character with ... tags. (replace-regexp "&#[0-9]+;" "\\&" nil start end) (goto-char start) (when mailto (insert "") (goto-char end) (insert "")))) (goto-char end))) ;; I need easy access to a few different input methods. (defvar kf-input-methods (list "yiddish-yivo" "chinese-py") "*My input methods for multilingual text, in order of preference.") (defun kf-cycle-input-method () "Switch to the next input method defined in `kf-input-methods'." (interactive) (if current-input-method (let ((next-method (cadr (member current-input-method kf-input-methods)))) (set-input-method next-method t)) (set-input-method (car kf-input-methods) t))) (kf-override-key "C-\\" 'toggle-input-method 'kf-cycle-input-method) ;; Why is this necessary? Why in the heck doesn't saving Chinese text ;; as UTF8, you know, just work? Sigh. The doc string for ;; `utf-translate-cjk-mode' says ;; ;; The tables are large (over 40000 entries), so this option is not ;; the default. Also, installing them may be rather slow. ;; ;; but that still doesn't explain why Emacs doesn't just DTRT when ;; you try to save. Right now it errors confusingly instead. (when (fboundp 'utf-translate-cjk-mode) (utf-translate-cjk-mode t)) (defun kf-quail-map-invert (&optional qmap) "Return an inversion of quail map QMAP, which defaults to (quail-map). An inverted quail map is a hash table mapping characters to transliterations. Both the characters and the transliterations are represented as strings." ;; In Quail map character vectors, the elements are strings instead ;; of characters (i.e., numbers). I'm not sure why this is, but ;; there's probably a good reason for it, so the inversion table ;; keys are strings instead of chars here too. As long as we're ;; storing them as strings, we store multiple transliterations as ;; lists of alternatives separated by " / ". (when (not qmap) (setq qmap (quail-map))) (let ((table (make-hash-table :test 'equal)) (downto (function (lambda (str-so-far subitem) (cond ((not subitem) nil) ((and (listp subitem) (integerp (car subitem))) (funcall downto (concat str-so-far (string (car subitem))) (cdr subitem))) ((listp subitem) (funcall downto str-so-far (car subitem)) (funcall downto str-so-far (cdr subitem))) ((vectorp subitem) (mapcar (function (lambda (char) (let* ((cur-val (gethash char table)) (new-val (if cur-val (concat cur-val " / " str-so-far) str-so-far))) (puthash char new-val table)))) subitem)) (t nil)))))) (mapcar (lambda (submap) (funcall downto "" submap)) (cdr qmap)) table)) (defvar kf-quail-inverted-map nil "Inverted quail map. See kf-pinyin-from-char.") (defun kf-pinyin-from-char (char &optional regenerate) "Return pinyin transliteration for chinese character CHAR, which defaults to the character at point; if interactive, display the pinyin in the minibuffer as well. Optional argument REGENERATE means regenerate current input method map." (interactive (list (char-after))) (when (or regenerate (not kf-quail-inverted-map)) ;; Just doing `(require (quote quail))' or `(load "chinese-py")' ;; or `(load "PY")' doesn't work. Maybe if I traced through ;; `toggle-input-method', I'd learn the right way to do this, but ;; for now this hack seems to get all the right tables loaded -- ;; i.e., toggle twice to get just the side effect. (let ((default-input-method "chinese-py")) (toggle-input-method) (toggle-input-method)) (setq kf-quail-inverted-map (kf-quail-map-invert))) (let ((pinyin (or (gethash (string char) kf-quail-inverted-map) (string char)))) (setq pinyin (replace-regexp-in-string " / " "/" pinyin)) (when (called-interactively-p) (message "%s" pinyin)) pinyin)) (defun kf-pinyin-from-region (b e) "Display and return a pinyin string for the Chinese characters from B to E." (interactive "r") (kf-ensure-ordering b e) (let ((str nil)) (save-excursion (goto-char b) (let ((accum ())) (while (< (point) e) (setq accum (cons (kf-pinyin-from-char (char-after)) accum)) (setq accum (cons " " accum)) ; ugh, but whatever, JFGID (forward-char 1)) (setq str (apply (symbol-function 'concat) (nreverse accum))))) (when (called-interactively-p) (message "%s" str)) str)) (defun kf-doit () "Generate an executable shell script template in cwd." (interactive) (find-file "doit.sh") (when (eq (point-min) (point-max)) (insert "#!/bin/sh\n\n")) (save-buffer) (kf-make-file-executable)) ;;; IRC formatting stuff (defun kf-irc-prettify (b e &optional compact keep-channel-meta-events) "Prettify the IRC transcript from B to E. If optional prefix argument COMPACT is non-nil, do not insert a blank line between each two separate IRC events. If optional argument KEEP-CHANNEL-META-EVENTS is non-nil, keep one-line events such as people entering and leaving the channel." (interactive "r\nP") (let ((fill-column 65) (nick-regexp "^<[a-zA-Z0-9][^>]*>") (longest-nick-length 0)) (goto-char b) (save-match-data (while (< (point) e) (when (looking-at nick-regexp) (let* ((len (- (length (match-string 0)) 2))) (when (> len longest-nick-length) (setq longest-nick-length len)))) (forward-line 1))) (goto-char b) (let ((e (copy-marker e))) (setq kff-tmp fill-prefix) (major-mode-suspend) (while (< (point) e) (if (looking-at nick-regexp) (progn (search-forward ">") (insert (make-string (+ (- longest-nick-length (current-column)) 2) ? )) (end-of-line) (let ((fill-prefix (make-string (+ longest-nick-length 3) ? ))) (do-auto-fill))) ;; Not a speech event, so clear it unless told to keep such. (when (looking-at "^\\(<-- \\|--> \\)") (unless keep-channel-meta-events (delete-region (point) (progn (forward-line 1) (forward-char -1) (point)))))) (forward-line 1) (unless compact (insert "\n"))) (major-mode-restore)))) (defun kf-unfeed-beast () (interactive) (insert "http://www.DoNotFeedTheEnergyBeast.com/")) (defun kf-nooooooooooooooo () (interactive) (insert "http://nooooooooooooooo.com/")) (defun kf-this-hunk-line () "Return the starting line number referred to by the diff hunk around point." (save-excursion (save-match-data (beginning-of-line) (let ((search-func (symbol-function 're-search-backward))) (when (looking-at "^\\(Index: \\|=== \\|--- \\|\\+\\+\\+ \\|@@ \\)") (setq search-func (symbol-function 're-search-forward))) (funcall search-func "^@@ -[0-9]") (search-forward "+") (looking-at "[0-9]+") (string-to-number (match-string 0)))))) (defun kf-jump-there (&optional second-time) "Go to the place indicated by the current context. That is: If point is on a line of grep output, go to the appropriate file and line. If point is inside a diff hunk, go to the appropriate file (someday we go to the proper line indicated by the hunk, but right now we don't). Optional argument SECOND-TIME means this is a recursive call, and prevents further recursion when a jump destination cannot be found." (interactive) (let ((fname nil) (is-diff-hunk nil) (line nil) (excerpt nil) (inhibit-field-text-motion nil)) (cl-flet ((looking-at-line ;; A variant of `looking-at' that looks only on the current line. (lambda (regexp) (save-restriction (narrow-to-region (point) (save-excursion (end-of-line) (point))) (looking-at regexp)))) (maybe-debug ;; Built-in debugger to help with debugging/improving this function. ;; Just set `nil' to `t' in the conditional below to get debugging. (lambda (name) (when nil (message "DEBUG: %s" name) (sit-for 1))))) (save-excursion (save-match-data (beginning-of-line) (save-excursion ;; Nested `save-excursion' because `kf-this-hunk-line' needs ;; to start from where point was originally. (cond ((looking-at-line "^\\(Auto-merging\\|CONFLICT (content): Merge conflict in\\)\\s-+\\([^: \t\n]+\\)") (maybe-debug "conflicted 'git merge' output") (setq fname (match-string-no-properties 2))) ((looking-at-line "^[UMGAD]\\s-+\\([^: \t\n]+\\)") (maybe-debug "filename line in a log message entry") (setq fname (match-string-no-properties 1))) ((let ((gen-matcher (lambda (len) ;; In the first group below, the two-spaces ;; case is for the output of the checksum ;; programs, and the tab case is for the the ;; output of, e.g.: ;; 'git ls-tree -r HEAD | | cut -c 13-'. (format "^[[:xdigit:]]\\{%d\\}\\( \\|\t\\)\\([^: \t\n]+\\)" len)))) (or (looking-at-line (funcall gen-matcher 32)) ; md5sum (looking-at-line (funcall gen-matcher 40)) ; sha1sum (looking-at-line (funcall gen-matcher 56)) ; sha224sum (looking-at-line (funcall gen-matcher 64)) ; sha256sum (looking-at-line (funcall gen-matcher 96)) ; sha384sum (looking-at-line (funcall gen-matcher 128)))) ; sha512sum (maybe-debug "a hex hash value followed by a filename") (setq fname (match-string-no-properties 2))) ((looking-at-line "* \\([^: \t\n]+\\)") ;; This used to say "On the filename line in a log message ;; entry.", which duplicates an earlier case. So I have ;; to admit, I really have no idea what this is anymore, ;; but there must have been a reason I included it. (maybe-debug "mystery case") (setq fname (match-string-no-properties 1))) ((re-search-backward "^Index: " nil t) (maybe-debug "native diff header") (search-forward " ") (setq fname (buffer-substring-no-properties (point) (progn (end-of-line) (point)))) (setq is-diff-hunk t)) ((looking-at-line "\\(^[^-+ ][^:]+\\):\\(.*\\)") ;; The reason for disallowing any of "-", "+" or " " on ;; the front is that allowing them can cause us to fall ;; into this case when really one of the diff-output ;; cases should have matched. For example: ;; ;; diff --git onetime onetime ;; index 4b83c40..ad61ccd 100755 ;; --- onetime ;; +++ onetime ;; @@ -90,4 +90,6 @@ import random ;; # ;; # blah blah blah, blah blah blah blah blah ;; # ;; -# This is what the different parts mean: ;; +# The precise number of same characters blah blah blah ;; +# above, except as a rough guide to the blah blah blah ;; +# different sections. This is what the sections mean: ;; ;; If point is on the "-" of "-# This is what...", then ;; lookahead would see the colon and think it's a line ;; of grep output. Except it won't, because see above. (maybe-debug "file path, then colon, then grep output") (setq fname (match-string-no-properties 1) excerpt (match-string-no-properties 2))) ((looking-at-line (concat "^[-rwxst]+\\s-+[0-9]+\\s-+" "[a-zA-Z0-9]+\\s-+[a-zA-Z0-9]+\\s-+" "[0-9.]+[A-Z]*\\s-+[A-Z]+\\s-+" "[0-9]+\\s-+[0-9:]+\\s-+\\(.*\\)")) (maybe-debug "output from 'ls -l' or 'ls -lh'") (setq fname (match-string-no-properties 1))) ((looking-at-line " \\(\\S-+\\) | [0-9]+ [-+]+") (maybe-debug "a line of output from 'git pull'") ;; E.g.: " streetcrm/src/foo.py | 129 +++++++++" (setq fname (match-string-no-properties 1))) ((re-search-backward "^=== modified file '" nil t) (maybe-debug "another style of diff header") (search-forward " '") (setq fname (buffer-substring-no-properties (point) (progn (end-of-line) (1- (point))))) (setq is-diff-hunk t)) ((re-search-backward "^diff --git " nil t) (maybe-debug "output from 'git diff' (with 'noprefix' option)") (re-search-forward "^--- ") (setq fname (buffer-substring-no-properties (point) (progn (end-of-line) (point)))) (setq is-diff-hunk t)) ((looking-at-line "^\\(\\./.+\\)") ;; this one's easy to recognize and handle specially (maybe-debug "output from 'find'") (setq fname (match-string-no-properties 1))) ((looking-at-line "^\\(\\S-+\\)$") ;; Just a filename on a line, so DTRT. The only problem ;; with this one is that it doesn't handle paths with ;; spaces, because we have trouble distinguishing that ;; from some other things. The 'find' case above is ;; partly about avoiding that problem in one common case ;; where we can; if we could generalize this match ;; instead, there would be less reason to have the special ;; case for 'find'. ;; ;; Note that we used to have an earlier case (right ;; before the "^Index: " native diff header case) that ;; also matched a plain file path. It looked like this; ;; ;; ((looking-at-line "^\\s-*\\([^: {}[]\t\n]+$\\)") ;; (setq fname (match-string-no-properties 1))) ;; ;; It's not clear why we had that case, if it ;; essentially duplicates this one (albeit with an ;; inexplicably more complicated regular expression), ;; and it's especially not clear why we had it there. ;; I've removed it for now, but am remarking on it in ;; this comment in case it turns out to be important. (maybe-debug "just a filename on a line") (setq fname (match-string-no-properties 1))) (t ;; Well, let's at least search backwards for an "*" to ;; try being on the filename line of a commit message entry (maybe-debug "fall-through default case") (re-search-backward "^* " nil t) (if second-time (error "No jump destination.") (kf-jump-there t)))))))) (when is-diff-hunk (setq line (kf-this-hunk-line))) (find-file fname) (if line (goto-line line) (when excerpt (beginning-of-buffer) (search-forward excerpt) (beginning-of-line))))) (defvar kf-saved-spot nil "See function `kf-saved-spot'.") (defun kf-saved-spot (set) "Fast register functionality with a default (unnamed) register. With prefix arg SET, set a saved spot in the current buffer. Otherwise, push mark at current point, then jump to the saved spot." (interactive "P") (if set (setq kf-saved-spot (point-marker)) (if kf-saved-spot (progn (push-mark) (goto-char kf-saved-spot)) (error "No spot saved. Use `C-u M-x kf-saved-spot' to set one.")))) (defun kf-insert-with-face (str face) "Insert STR, overlaying FACE." (overlay-put (make-overlay (point) (progn (insert str) (point))) 'face face)) (defun kf-show-change () "Display the current git or svn revision fully in a new buffer. The \"current\" revision means the revision that point is currently in in 'git log' or 'svn log' output. To display that revision fully means to show its commit message, list of affected files, and diff. If point is not in a commit message, raise an error." (interactive) (let ((git-commit-sep-re "^commit \\([[:xdigit:]]\\{40\\}\\)$") (svn-commit-sep-re "^r\\([0-9]+\\) | .*$") (git-rev nil) (svn-rev nil) (repos-root nil)) ; only used for SVN changes (save-excursion (save-match-data (cond ((or (looking-at git-commit-sep-re) (re-search-backward git-commit-sep-re nil t) (re-search-forward git-commit-sep-re nil t)) (beginning-of-line) (forward-char 7) ; skip over "commit " (setq git-rev (buffer-substring-no-properties (point) (progn (end-of-line) (point))))) ((or (looking-at svn-commit-sep-re) (re-search-backward svn-commit-sep-re nil t) (re-search-forward svn-commit-sep-re nil t)) (beginning-of-line) (forward-char 1) ; skip over "r" (setq svn-rev (buffer-substring-no-properties (point) (progn (forward-word 1) (point)))) (setq repos-root (shell-command-to-string (concat "svn info | grep -E \"^Repository Root: \" " "| cut -c 18- | tr -d '\\n'")))) (t (error "Point does not appear to be in a git or svn log message."))))) ;; The `log-cmd-display' and `diff-cmd-display' bindings below ;; allow us to deal with the fact that in the SVN case the ;; commands we issue need to include the repository root but we ;; don't want to clutter up the displayed command with that root. (let (log-cmd diff-cmd out-buf log-cmd-display diff-cmd-display) (cond (git-rev (let ((short (substring git-rev 0 10))) ; keep it readable in git (setq log-cmd (format "git log --name-status %s^..%s" short short) log-cmd-display log-cmd diff-cmd (format "git diff %s^..%s" short short) diff-cmd-display diff-cmd out-buf (get-buffer-create (format "*Git rev %s*" short))))) (svn-rev (setq log-cmd (format "svn log --verbose -r%s %s" svn-rev repos-root) log-cmd-display (format "svn log --verbose -r%s" svn-rev) diff-cmd (format "svn diff -c%s %s" svn-rev repos-root) diff-cmd-display (format "svn diff -c%s" svn-rev) out-buf (get-buffer-create (format "*SVN rev %s*" svn-rev)))) (t (error "Can't happen."))) (save-excursion (set-buffer out-buf) (delete-region (point-min) (point-max)) (kf-insert-with-face (make-string (length log-cmd-display) ?=) 'highlight) (insert "\n") (kf-insert-with-face (format "%s" log-cmd-display) 'highlight) (insert "\n") (kf-insert-with-face (make-string (length log-cmd-display) ?=) 'highlight) (insert "\n\n") (insert (shell-command-to-string log-cmd)) (insert "\n") (kf-insert-with-face (make-string (length diff-cmd-display) ?=) 'highlight) (insert "\n") (kf-insert-with-face (format "%s" diff-cmd-display) 'highlight) (insert "\n") (kf-insert-with-face (make-string (length diff-cmd-display) ?=) 'highlight) (insert "\n\n") (insert (shell-command-to-string diff-cmd)) (goto-char (point-min)) ;; Put point where it's most likely to be useful, on the ;; first character of the first path in the log message. (cond (git-rev (forward-line 7) ;; What's the allowance for a numeric suffix for, you might ask? ;; ;; I renamed and modified a file in one commit, so in the ;; file listing for that commit in 'git log', the indicator ;; was "R087" not just "R". And what does the "087" mean? ;; The answer is not in https://git-scm.com/docs/git-log, ;; but rather in https://git-scm.com/docs/git-diff: ;; ;; > Possible status letters are: ;; > ;; > A: addition of a file ;; > C: copy of a file into a new one ;; > D: deletion of a file ;; > M: modification of the contents or mode of a file ;; > R: renaming of a file ;; > T: change in the type of the file ;; > U: file is unmerged (...) ;; > X: "unknown" change type (...) ;; > ;; > Status letters C and R are always followed by a score ;; > (denoting the percentage of similarity between the ;; > source and target of the move or copy). Status ;; > letter M may be followed by a score (denoting the ;; > percentage of dissimilarity) for file rewrites. ;; ;; Thanks to https://stackoverflow.com/users/5819604/kevchoi ;; who made this mysterious connection in ;; https://stackoverflow.com/questions/35142018/in-git-logs-\ ;; name-status-listing-what-are-the-numbers-suffixed-to-the-status ;; (though, along with the OP, I have no idea how he did so). (re-search-forward "^[ACDMRTUXB][0-9]*\\s-+")) (svn-rev (forward-line 2) (re-search-forward "^ [ACDMRTUXB]\\s-+")) (t (error "Likewise can't happen.")))) (switch-to-buffer out-buf)))) (define-minor-mode kf-changelog-mode "Minor mode for interacting with commit message logs. This is not for GNU-style ChangeLog files; it's for the output of 'git log' and 'svn log' and things like that." :lighter " kf-changelog" ;; There are multiple ways to associate a keymap with a minor mode. ;; Some documentation (see "24.3.2 Keymaps and Minor Modes") claims ;; that the preferable way would be something like this: ;; ;; (defvar kf-changelog-mode-keymap ;; ...see in-place `:keymap' code below...) ;; ;; (add-to-list minor-mode-map-alist ;; '(kf-changelog-mode . kf-changelog-mode-keymap)) ;; ;; But it sure seems a lot simpler to just bind the key here. :keymap (let ((m (make-sparse-keymap))) (keymap-set m "C-c C-c" 'kf-show-change) m) ) (defun kf-logup () "Build the latest SVN or Git log in \"logv.out\" and (re)visit it. If already visiting the file, preserve semantic position in it." (interactive) (shell-command "logup") (let ((buf (find-buffer-visiting "logv.out")) (dir default-directory) (posn-from-end nil)) (when buf (save-excursion (set-buffer buf) (setq dir default-directory) (setq posn-from-end (- (point-max) (point)))) (kill-buffer buf)) (find-file (concat dir "/" "logv.out")) (when posn-from-end (goto-char (- (point-max) posn-from-end))) (kf-changelog-mode))) (defun kf-git-commit-message-mode () "Mode for writing commit messages. The main purpose of this is to make the column number visible, since I like to follow the \"first line is 50 chars\" rule recommended by https://chris.beams.io/posts/git-commit/. If I ever have conventions that apply to log messages more broadly, including Subversion and other VC systems as well as Git, then a more general mode would be necessary." (make-local-variable 'column-number-mode) (column-number-mode 1)) (add-to-list 'auto-mode-alist '(".*COMMIT_EDITMSG.*" . kf-git-commit-message-mode)) (defun kf-quick-commit-svn () "Commit the current buffer's file to SVN with log message \"The usual.\"." (interactive) (save-buffer) (shell-command (format "svn commit -m 'The usual.' %s" (buffer-file-name)))) ;; In some Org Mode buffers, but not all, we'll want to bind C-c C-c ;; to `kf-quick-commit-svn'. If we were to use `keymap-local-set', ;; that would make that binding be in effect across *all* Org Mode ;; buffers. The solution is to create a specialized minor mode and ;; use it in just those buffers. ;; ;; It's surprising that Emacs doesn't have a `keymap-set-buffer' ;; function. From https://www.reddit.com/r/emacs/comments/1582uo\ ;; /bufferlocalsetkey_set_a_key_in_one_buffer_only/ and from ;; https://www.emacswiki.org/emacs/BufferLocalKeys one can see that ;; I'm not the first person to have this thought. But a cleaner ;; solution might be for Emacs to always have a buffer-local map ;; available, with new function `keymap-set-buffer' to set in it. ;; Key lookup would just start with that map (iff non-nil). (defvar kf-quick-commit-map (make-sparse-keymap) "Keymap for `kf-quick-commit-mode'.") (keymap-set kf-quick-commit-map "C-c C-c" 'kf-quick-commit-svn) (define-minor-mode kf-quick-commit-mode "Minor mode in which C-c C-c is bound to a quick-commit function. Right now the only such function is `kf-quick-commit-svn', but perhaps in the future we'll support other version control systems. \\{map-name}." :keymap kf-quick-commit-map ;; :group 'vc ;; not sure about this :lighter " QC" ) (defun kf-svn-put-log-msg () "Save the (presumably edited) current log message to the repository. The \"current\" log message means the one that point is currently in (e.g., in a buffer full of 'svn log' output). The repository is just whatever repository is associated with the SVN working copy of the buffer's current directory. If the buffer's current directory is not part of an SVN working copy, then error." (interactive) (let* ((opoint (point)) (rev (save-match-data ;; This re could be tighter, but doesn't need to be. (let ((re "^r\\([0-9]+\\) | [-a-zA-Z0-9._@]+ | ")) (or (looking-at re) (re-search-backward re))) (match-string 1))) (new-msg-start (progn (search-forward "\n\n") (point))) (new-msg-end (progn (re-search-forward (format "^%s$" (make-string 72 ?-))) (beginning-of-line) (forward-char -1) (point))) (tmp-file (make-temp-file "kf-put-svn-log-msg")) (repos (let ((tmp (shell-command-to-string "svn info ."))) (save-match-data (string-match "^Repository Root: \\(.*\\)$" tmp) (match-string 1 tmp))))) (goto-char opoint) (write-region new-msg-start new-msg-end tmp-file) (shell-command (format "svn propset -F %s --revprop -r%s svn:log %s" tmp-file rev repos)) (delete-file tmp-file) ;; Now verify by retrieving from repository. (let ((here-new-msg (buffer-substring-no-properties new-msg-start new-msg-end)) (fetched-new-msg (shell-command-to-string (format "svn propget --no-newline --revprop -r%s svn:log %s" rev repos)))) (unless (string-equal here-new-msg fetched-new-msg) (error "Messages differ:\n\nHERE:\n\n'%s'\n\n=====\n\nREPOS:\n\n'%s'\n" here-new-msg fetched-new-msg))))) (defun kf-ratio (base-num base-denom new-num) "Return a denominator projecting NEW-NUM to BASE-NUM / BASE-DENOM. For example, if there are 5955 DCSOps incidents as of 21 May (day 142 out of 365), then return how many incidents there will have been by the end of the year. BASE-NUM == 142, BASE-DENOM == 365, NEW-NUM == 5955, so return ~15306.86. In other words, return X: 142 5955 BASE-NUM NEW-NUM --- == ---- i.e: ---------- == --------- 365 X BASE-DENOM X If BASE-NUM or NEW-NUM is a string, then it is a timing of the form \"M:S\" and will be treated as the corresponding total number of seconds. That is: the string is some number of digits (possibly zero of them) representing minutes, followed by a colon, followed by exactly two digits of seconds. (That is the only timing format supported by this function currently. If there is enough popular demand, maybe we'll get fancy and accept \"H:M:S\" too.)" (let ((maybe-convert-timing (lambda (x) (if (numberp x) x (save-match-data (string-match "\\([0-9]*\\):\\([0-9][0-9]\\)" x) (let ((minutes (match-string 1 x)) (seconds (match-string 2 x))) (if (string= minutes "") (setq minutes 0) (setq minutes (string-to-number minutes))) (setq seconds (string-to-number seconds)) (+ (* 60 minutes) seconds))))))) (setq base-num (funcall maybe-convert-timing base-num)) (setq new-num (funcall maybe-convert-timing new-num))) (/ (* (float new-num) (float base-denom)) (float base-num))) (defun kf-percent (&optional numerator denominator) "Return the percentage NUMERATOR is of DENOMINATOR. But if invoked interactively, display the percentage of the (possibly narrowed portion of) the buffer before point." (interactive) (if (called-interactively-p) (message "%.2f%% of the buffer lies before point" (kf-ratio (point-max) 100 (point))) (kf-ratio denominator 100 numerator))) (defalias 'kf-p 'kf-percent) (defun kf-percentage-difference (val1 val2) "Show the percentage difference between VAL1 and VAL2. The percentage difference is the difference between two values, expressed as a percentage of the average of the two values. See http://www.mathsisfun.com/percentage-difference.html." (kf-p (- val2 val1) (/ (+ val1 val2) 2))) (defun kf-percentage-change (before after) "Show the percentage change from BEFORE to AFTER. The percentage change is the difference between an old value and a new value, expressed as a percentage of the old value. See http://www.mathsisfun.com/percentage-change.html." (kf-p (- after before) before)) (defun kf-browse-kill-ring () "Browse the kill ring." (interactive) (switch-to-buffer (get-buffer-create "*Browse Kill Ring*")) (widen) (delete-region (point-min) (point-max)) (mapcar (lambda (str) ;; We could put the full string as a text property on the summary ;; text displayed, but with yank-match available, there's no need. (insert (substring str 0 (min (1- (length str)) 72)) "\n-*- -*- -*- -*- -*-\n")) kill-ring) (goto-char (point-min))) ;;; Insertion helpers for characters not in my usual input methods. ;;; ;;; There's probably some more Emacs-y way to do these, and when I ;;; learn that way, these definitions can be removed. (defun kf-🙂 (&optional parg) "The Internet was basically invented for this." (interactive "P") (insert (if parg ?😊 ?🙂))) (defalias 'kf-smiley 'kf-🙂) (defun kf-set-theory-symbol () "You'd be surprised how often this comes up." (interactive) (let* ((map '((?0 . ?∅) (?e . ?∈) (?u . ?∪) (?i . ?∩) (?a . ?∧) (?o . ?∨) (?p . ?×))) (ch (read-char (format "Choose a set theory symbol: %s" (string-join (mapcar (lambda (cell) (concat (char-to-string (car cell)) "->" (char-to-string (cdr cell)))) map) ", "))))) (insert (cdr (assoc ch map))))) (defun kf-© (parg) "Insert copyright symbol, or phonogram copyright symbol iff prefix arg. This is stupid. Emacs surely offers a better way to do this, right?" (interactive "*P") (if parg (insert "℗") (insert "©"))) (defalias 'kf-copyright 'kf-©) (defun kf-€ () "This is insane. I should really learn The Right Way to do this in Emacs." (interactive) ;; Noah points out that (insert (decode-char 'ucs #x20ac)) ;; would be future-proofer. (insert ?€)) ; 8364 (defalias 'kf-euro 'kf-€) (defun kf-£ () "The insanity is on both sides of the Channel." (interactive) (insert ?£)) ; 163 (defalias 'kf-pound 'kf-£) (defun kf-顿号 () "And you thought `kf-euro' was insane!" (interactive) (insert ?、)) ; 12289 (defalias 'kf-dun-hao 'kf-顿号) (defalias 'kf-listing-comma 'kf-顿号) (defun kf-μ () "μ never know when μ're going to need this." (interactive) (insert "μ")) (defalias 'kf-micro 'kf-μ) (defun kf-句号 () "Or I could just learn the input methods better... nah." (interactive) (insert ?。)) ; 12290 (defalias 'kf-ju-hao 'kf-句号) (defalias 'kf-chinese-period 'kf-句号) (defun kf-¥ () "For some reason, prefix is this instead of 元." (interactive) (insert ?¥)) ; 165 (defalias 'kf-rmb 'kf-¥) (defun kf-│ () "What is this in HTML code anyway? And what's horizontal bar?" (interactive) (insert ?│)) ; 9474 (defalias 'kf-vertical-bar 'kf-│) (defun kf-· () "What is this in Unicode (UTF-8) or HTML code anyway? It's in upper ascii." (interactive) (insert ?·)) ; 183 (defalias 'kf-middle-dot 'kf-·) (defun kf-• () "If I cared enough, I could find out the official name of this character." (interactive) (insert ?•)) ; 8226 (defalias 'kf-middle-round-dot 'kf-•) (defun kf-● () "What I said about `kf-•' is true here too." (interactive) (insert ?●)) ; 9679 (defalias 'kf-large-round-dot 'kf-●) (defun kf-dot (parg) "Insert large round middle dot or, with prefix arg PARG, small middle dot." (interactive "P") (if parg (kf-·) (kf-•))) (defun kf-∗ () "Insert ∗. What the heck is that thing, anyway? It's not *." ;; See r9118 in private repository. (interactive) (insert "∗")) (defalias 'kf-big-asterisk 'kf-∗) (defun kf-🧵 () "Insert a thread (spool of thread) emoji. See also https://twitter.com/jenny8lee/status/1189751069913411589." (interactive) (insert ?🧵)) ; 129525 (defalias 'kf-thread 'kf-🧵) (defun kf-✓ () "Insert a checkmark." (interactive) (insert ?✓)) ; 10003 (defalias 'kf-checkmark 'kf-✓) (defun kf-✗ () "Insert a ballot X (an \"x-mark\")." (interactive) (insert ?✗)) ; 10007 (defalias 'kf-x-mark 'kf-✗) (defalias 'kf-xmark 'kf-✗) (defalias 'kf-ballot-x 'kf-✗) (defun kf-checkbox (parg) "Insert a checkbox. With one prefix arg, insert a checked checkbox. With two prefix args, insert an x'ed checkbox." (interactive "P") (let ((prefix (car parg))) (cond ((not prefix) (insert ?☐)) ; 9744 ((= prefix 4) (insert ?☑)) ; 9745 ((= prefix 16) (insert ?☒)) ; 9746 (t (error "What do you want me to put in that checkbox?"))))) (defun kf-fractions () "I could just learn Emacs' input system better, but... life is short." (interactive) ;; Or we could generate arbitrary fractions by, say, compiling a ;; short LaTeX file to PDF, converting that PDF to an image, and ;; then selecting the appropriate region of the image: ;; ;; \documentclass[18pt]{article} ;; \usepackage{amsmath} ;; \pagenumbering{gobble} ;; \begin{document} ;; $\dfrac{N}{D}$ ;; \end{document} ;; ;; But are we going to do that today? No, we are not, because see ;; the doc string. (insert "½ ⅓ ⅔ ¼ ¾")) (defun kf-double-quotes () (interactive) (insert ?“ ?”) (forward-char -1)) (defun kf-Π () "Just as insane as `kf-euro', yet somehow more defensible." (interactive) (insert (decode-char 'ucs #x03A0))) (defalias 'kf-pi 'kf-Π) (defun kf-° () "I'm sure Emacs has a way to do this, and I'm sure I don't know what it is." (interactive) (insert "°")) (defalias 'kf-degree 'kf-°) (defun kf-ß () "Maybe I should just learn Emacs input systems better?" (interactive) (insert ?ß)) ; 223 (defun kf-ẞ () "Maybe I should just learn Emacs input systems ẞetter?" (interactive) (insert ?ẞ)) ; 7838 (defalias 'kf-scharfes-s-lower 'kf-ß) (defalias 'kf-scharfes-s-upper 'kf-ẞ) (defun kf-ε () "By this point, the εxcuses are wearing thin." (interactive) (insert ?ε)) ; 949 (defalias 'kf-epsilon 'kf-ε) (defun kf-¿ () "I've been looking forward to this one." (interactive) (insert ?¿)) ; 191, and hah (defalias 'kf-inverted-question-mark 'kf-¿) (defalias 'kf-upside-down-question-mark 'kf-¿) (defun kf-¡ () "¡| Ce n'est pas une |!" (interactive) (insert ?¡)) ; 161 (defalias 'kf-inverted-exclamation-point 'kf-¡) (defalias 'kf-upside-down-exclamation-point 'kf-¡) (defun kf-♥ () "The people who made the Unicode standard had their priorities straight." (interactive) (insert ?♥)) ; 9829 (defalias 'kf-heart 'kf-♥) (defun kf-∞ () "It seems appropriate to put this one at the end." (interactive) (insert ?∞)) ; 8734 (defalias 'kf-infinity 'kf-∞) (defun kf-⚛ () "When the glyph is small enough, it looks like a bug." (interactive) (insert ?⚛)) ; 9883 (defalias 'kf-atom 'kf-⚛) (defun kf-shruggy-thing () "You know, that thing everyone uses? For that feeling? Yeah. That one." (interactive) (insert "¯\\_(ツ)_/¯")) (defun kf-
 () "Insert a line separator." (interactive) (insert ?
)) ; 8232 (defalias 'kf-line-separator 'kf-
) (defun kf-👍🏽 () "Insert a thumbs-up emoji (medium skin tone)." (interactive) (insert "👍🏽")) ; 128077 (U+1F44D) 127997 (U+1F3FD) (defalias 'kf-thumbs-up 'kf-👍🏽) (defun kf-🧵 () "Insert a thumbs-up emoji." (interactive) (insert "?🧵")) ; 129525 (defalias 'kf-thread 'kf-🧵) (defun kf-¢ () "Insert a cents sign." (interactive) (insert "¢")) (defalias 'kf-cents 'kf-¢) ;; http://unicodefractions.com/ (defun kf-½ () "Best official Unicode name ever: 'VULGAR FRACTION ONE HALF' (U+00BD)." (interactive) (insert "½")) (defalias 'kf-1/2 'kf-½) (defun kf-⅓ () "See kf-½ and multiply by ⅔." (interactive) (insert "⅓")) (defalias 'kf-1/3 'kf-⅓) (defun kf-⅔ () "George Cantor, please come to the red courtesy phone." (interactive) (insert "⅔")) (defalias 'kf-2/3 'kf-⅔) ;; https://en.wikiversity.org/wiki/Template:Music_symbols (defun kf-♭ () (interactive) (insert "♭")) ; ♭ (defalias 'kf-flat 'kf-♭) (defun kf-♮ () (interactive) (insert "♮")) ; ♮ (defalias 'kf-natural 'kf-♮) (defun kf-♯ () (interactive) (insert "♯")) ; ♯ (defalias 'kf-sharp 'kf-♯) (defun kf-𝄫 () (interactive) (insert "𝄫")) ; 𝄫 (defalias 'kf-double-flat 'kf-𝄫) (defun kf-𝄪 () (interactive) (insert "𝄪")) ; 𝄪 (defalias 'kf-double-sharp 'kf-𝄪) (defun kf-dvořák () (interactive) (insert "Dvořák")) ; it is so hard to do this any other way (defalias 'kf-dvorak 'kf-dvořák) (defun kf-arrow (type) "Insert an arrow of TYPE, where type is a single letter: - \"[u]p\" - \"[d]own\" - \"[l]eft\" - \"[r]ight\" - \"[h]orizontal double arrow\" - \"[v]ertical double arrow\"" (interactive "cArrow type ([u]p, [d]own, [l]eft, [r]ight, [h]oriz, [v]ert): ") (insert (cdr (assoc type '((?u . ?↑) (?d . ?↓) (?l . ?←) (?r . ?→) (?h . ?↔) (?v . ?↕) ))))) (defun kf-zero-width-space (&optional joiner) (interactive "P") "Insert \"​\" or, if prefix argument JOINER is non-nil, \"‌\". That is, Zero-Width Space (ZWSP) a.k.a. Zero-Width Non-Joiner (ZWNJ) in the first case (Unicode 8203) or Zero-Width Joiner (ZWJ) in the second case (Unicode 8204). For more information about these characters, see https://en.wikipedia.org/wiki/Zero-width_non-joiner and https://en.wikipedia.org/wiki/Zero-width_space. See also https://github.com/redcross/arcdata/issues/232)." (interactive) (insert (if joiner ?‌ ?​))) (defun kf-earth-globes () "Insert some Earth globes. Namely: 🌍 - 127757 (#o371415, #x1f30d) 🌏 - 127759 (#o371417, #x1f30f) 🌎 - 127758 (#o371416, #x1f30e) 🌑 - 127761 (#o371421, #x1f311)" (interactive) (insert "🌍🌏🌎🌑")) (defun kf-🦑 () "Insert \"🦑\" (Unicode 129425)." (interactive) (insert ?🦑)) (defalias 'kf-squid 'kf-🦑) (defun kf-mountain-sun () "Insert \"🌄\" (Unicode 127748)." (interactive) (insert ?🌄)) (defun kf-™ (&optional parg) "Insert \"™\" (Unicode U+2122). With prefix arg, insert ® (U+00AE) too. But do not insert \"℠\" (U+2120); nobody wants that." (interactive "P") (insert ?™) (when parg (insert ?®))) (defalias 'kf-trademark 'kf-™) (defun kf-‏ () (interactive) "Insert \"‏\" (RIGHT-TO-LEFT MARK / RLM). This is equivalent to `C-x 8 RIGHT-TO-LEFT MARK'. See also \"Bidirectional Editing\" in the Emacs manual." (insert ?‏)) (defalias 'kf-rlm 'kf-‏) (defun kf-‎ () (interactive) "Insert \"‎\" (LEFT-TO-RIGHT MARK / LRM). This is equivalent to `C-x 8 LEFT-TO-RIGHT MARK'. See also \"Bidirectional Editing\" in the Emacs manual." (insert ?‎)) (defalias 'kf-lrm 'kf-‎) (defun kf-🦠 () (interactive) "Insert 🦠 (Unicode 129440). Obviously." (insert ?🦠)) (defalias 'kf-microbe 'kf-🦠) (defun kf-🛈 (just-i) (interactive "P") "Insert \"🛈\" (U+1F6C8, Circled Information Source). Prefix arg JUST-I, insert \"ⓘ\" ((U+24D8, Circled Latin Small Letter I) ." (if just-i (insert ?ⓘ) (insert ?🛈))) (defalias 'kf-info 'kf-🛈) ;;;; Email section (for Gnus-specific stuff, see the Gnus section). ;;;; (setq mail-yank-prefix ">") (setq mail-yank-hooks nil) (setq compose-mail-user-agent-warnings nil) ;; Okay, this is annoying. I want the inhibition in the minibuffer, ;; and sometimes in Shell Mode, but often want it off under other ;; circumstances, and I do not have a good catalog of those ;; circumstances. My desire is for C-a to DTRT, and for Emacs to Just ;; Know what TRT is without me having to tell it. But I guess that's ;; not in the cards today, so for now, let's just leave this off. ;; ;; (setq inhibit-field-text-motion nil) ;; At some point in fall 2019, it became necessary to set this for ;; GPG-signing an email to behave in the obvious way and use the ;; sender information to decide who's signing the email. I do not ;; know at whom to direct the rest of this rant because none of the ;; etc/NEWS files in the Emacs source tree mention this variable. ;; ;; See related commit 06cb8350c69 in the Emacs tree, which follows ;; up to commit 9c81149ae916 (and probably should have said so). (setq mml-secure-smime-sign-with-sender t) ;; Then at some later point, it became necessary to set this next one, ;; and I don't know if that means the above is no longer necessary or ;; if both must be set for it to work. I'm too worn down by Emacs's / ;; Gnus's / Message Mode's / Whoever Is Responsible Here's constantly ;; changing GnuPG interface to track down exactly what the right ;; settings are. I suspect the etc/NEWS (now etc/NEWS.27) entry of ;; commit 74579d3d2bb (by Teemu Likonen, committed on 2019-07-13 by ;; Lars Ingebrigtsen) would be the place to start investigating this ;; if I were ever going to investigate it, which I hope I never am. ;; ;; Anyway, the main thing is, when this wasn't set, then sending a ;; GPG-signed message (which happens automatically when replying to ;; someone else's GPG-signed message) would error with the familiar ;; "Couldn't find any signer names." message, the same one that, IIRC, ;; prompted me to set `mml-secure-smime-sign-with-sender' earlier. ;; Please, please let this work for at least a few years this time. ;; ;; Aha! It's all https://debbugs.gnu.org/cgi/bugreport.cgi?bug=40118 ;; Thanks to Eli Zaretskii and Robert Pluim for pointing this out. (setq mml-secure-openpgp-sign-with-sender t) (add-hook 'mail-mode-hook 'mail-hist-define-keys) (add-hook 'mail-mode-hook 'kf-mail-mode-hook) (add-hook 'mail-setup-hook 'kf-setup-mail) (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) (add-hook 'mail-send-hook 'kf-mail-send-hook) (add-hook 'mail-sent-hook 'kf-mail-sent-hook) (when (member 'mime-editor/maybe-translate mail-send-hook) (or (fboundp 'mime-editor/maybe-translate) (remove-hook 'mail-send-hook 'mime-editor/maybe-translate))) (add-hook 'message-mode-hook 'mail-hist-define-keys) (add-hook 'message-mode-hook 'kf-message-mode-hook) (add-hook 'message-mode-hook 'kf-mail-mode-hook) (add-hook 'message-header-setup-hook 'kf-setup-mail) (add-hook 'message-send-hook 'mail-hist-put-headers-into-history) (add-hook 'message-send-hook 'kf-mail-send-hook) (add-hook 'message-sent-hook 'kf-mail-sent-hook) (setq message-citation-line-function 'message-insert-formatted-citation-line) (setq message-citation-line-format "On %d %b %Y, %N wrote:") ;; I've posted to emacs-devel@ about making the latter `t' by default. (setq gnus-message-replysign t) (setq gnus-message-replyencrypt t) (autoload 'mail-hist-define-keys "mail-hist") (autoload 'mail-hist-previous-input "mail-hist" "" t) (autoload 'mail-hist-next-input "mail-hist" "" t) (autoload 'mail-hist-put-headers-into-history "mail-hist") ;; post-load programs to run: (setq display-time-mail-file "/dev/null") ; don't notify me of mail ;;; Mailaprop subsection ;; ;; See https://code.librehq.com/kfogel/mailaprop for what this is about. (let ((local-mailaprop (expand-file-name "~/src/mailaprop/mailaprop.el"))) (when (file-exists-p local-mailaprop) (load-file local-mailaprop))) (setq mailaprop-address-file (expand-file-name "~/private/mailaprop/mailaprop-addresses.eld")) (setq mailaprop-show-scores t) (defun kf-mailaprop-drop-address-fn (group-key-addr group-size this-addr &rest ignored) "My value for `mailaprop-drop-address-fn'." (or ;; If this group has exactly one address, and that address contains ;; any of certain special symbols (such as plus sign, equals sign, ;; etc), then it's probably some semi-bot address like ;; "list-allow.12345.afbde=j.random@example.com" and I'll never ;; want to mail it -- so drop it. Similarly with email addresses ;; containing "-accept-", "-discuss-", "-request-", etc as a ;; substring in the address portion; those are mailing list control ;; addresses that in practice I don't ever need completion on. (and (= group-size 1) (string-match-p (concat (apply 'concat "\\([+=]" (mapcar (lambda (word) (concat "\\|-" word "-")) (list "accept" "discuss" "request"))) "\\)") group-key-addr)) ;; If this group has exactly one address, and the address shows ;; signs of being uninteresting for completion, skip it. (Very ;; similar to the above, but the tests for uninterestingness here ;; go beyond what's easy with regexps.) (and (= group-size 1) (string-match-p "^[0-9]" group-key-addr) (> (length group-key-addr) 20)) ;; A lot of spammers will send mail with one's own email address as ;; the email address portion, and some other name as the real name ;; (often a known recipient name, in cases where the spammer has ;; gotten hold of someone else's address book, or else have trawled ;; online forums in a smart way). If an address has "kfogel@" and ;; has a real name portion, and that real name is neither me nor ;; one of the other people whom I often get mail meant for (e.g., ;; Karen Fogel, Ken Fogel, et al), then drop it -- it's a spam ;; address. Experiment suggests this eliminates ~300 addresses. (and (string-match-p " " this-addr) (string-match-p "kfogel@" this-addr) (not (string-match-p "^[kK]" this-addr))))) (setq mailaprop-drop-address-fn 'kf-mailaprop-drop-address-fn) ;; Actually loading up all the Mailaprop addresses happens in ;; `kf-fully-initialize', which see. (defconst kf-mailaprop-already-processed-prefixes (make-hash-table :test 'equal :size 5000) "Helper for `kf-mailaprop-process-string', which see.") (defun kf-mailaprop-process-string (str) "Cache every prefix of STR in mailaprop." (unless (gethash str kf-mailaprop-already-processed-prefixes) (let ((cur-len 1) (max-len (length str))) (while (< cur-len max-len) (let ((prefix (substring str 0 cur-len))) (puthash prefix t kf-mailaprop-already-processed-prefixes) ;; Ignore return value because this is just to heat the cache. (mailaprop-get-candidates prefix)) (setq cur-len (1+ cur-len)))))) ;; TODO: Haven't thought carefully about how much memory this would use. ;; (dolist (maddress mailaprop-addresses) ;; (kf-mailaprop-process-string (car maddress))) ;;; End Mailaprop subsection ;; mail-hist stuff ;; (setq mail-hist-history-size 1826) ;; This is just a default; kf-mail-send-hook changes this dynamically. (defvar kf-default-user-mail-address (concat "kfogel" ;; These anti-spam devices "@" ;; are probably utterly "red-bean.com" ;; pointless :-) ) "What my email identity should be by default.") (setq user-mail-address kf-default-user-mail-address) ;; The relevant resources for understanding format=flowed seem to be: ;; ;; - RFC 2646 ;; - https://github.com/legoscia/messages-are-flowing ;; - https://www.emacswiki.org/emacs/GnusFormatFlowed ;; - reddit.com/r/emacs/comments/7v2b3q/emacs_email_and_format_flowed/ ;; - https://notmuchmail.org/pipermail/notmuch/2017/023871.html ;; --> https://notmuchmail.org/pipermail/notmuch/2017/023874.html ;; --> https://www.gnu.org/software/emacs/manual/html_node/\ ;; emacs-mime/Flowed-text.html#Flowed-text ;; - https://www.emacswiki.org/emacs/FormatFlowed ;; - https://www.gnu.org/software/emacs/manual/html_node/emacs/Hard-and-Soft-Newlines.html ;; - https://www.reddit.com/r/emacs/comments/7cqzm8/messagemode_and_usehardnewlines_formatflowed/ ;; - https://emacs.stackexchange.com/questions/694/can-i-modify-whitespace-mode-to-distinguish-hard-and-soft-newlines ;; - https://stackoverflow.com/questions/29949975/automatically-turn-on-enriched-mode-and-make-newlines-between-paragraphs-hard-in ;; ;; I used to use messages-are-flowing.el, but now that I have ;; `kf-message-flowify' that's no longer necessary. ;; ;; Recently (2023-04-18) I learned about lisp/gnus/deuglify.el and ;; these default keybindings in Gnus Summary Mode: ;; ;; W Y a gnus-article-outlook-repair-attribution ;; W Y c gnus-article-outlook-rearrange-citation ;; W Y f gnus-article-outlook-deuglify-article ;; W Y u gnus-article-outlook-unwrap-lines ;; ;; Note that the "Usage" comment near the top of deuglify.el says ;; "Press `W k' in the Summary Buffer", but that keybinding appears to ;; be obsolete. Maybe it's now `W Y f'? I'm not sure what `W k' used ;; to be bound to, and commit 3ff29babbfa2 by Lars Ingebrigtsen ;; shadows the history, so finding out would take some digging. (defun kf-message-flowify () "Set hard newlines appropriately in a `message-mode' buffer. This is designed to be called from `message-send-hook', although it can be invoked interactively too. Generally you'll want `fill-column' to have a value of 65 or lower in the message buffer when this function is called. That's because major webmail services insert their own line breaks around there when displaying in a browser. If `fill-column' is higher than that, you can get a ragged-looking result like this: On 14 Apr 2023, J. Random wrote: >x xxxxx xx xxxx xx x xxxxx xxx xxx xxxx. x xxx x xxxxxx xxx xxxxx >xxxxxxx xx xxxxxxxxxxxx xxx xxxxxxxx, xxx x xxxxxxx xxx xxxx xxxx >x >xxxxxxx xxxxxx xxxxxx xxxx x xxxxxxxx x xxxxxx x xxxxxxxx xxxxxxx >xxxxxx. x xxxxxxx xxx xx x xxxxx xxxxxxxx, xxx xxxxxxx xxx xxxxx >xx >xxxxxx xxxx xxxx xxxxxxxxxx xxxxxxx xxx xxxxxxxxx xxx xxx >xxxxxxxxxx >x xxxxxx xx xxxx. x xxxxxxxx xx xxx xxxxxx xxxx xxxx xx xxx >xxxxxx >xxxx xxxxxxx xx xxx, xxx xxxxxxx xxx xxxxx xx xxxxxx xxxx xxxxxx >xxxxxx xxx xxxxxxxxx x xxxxxx xx xxxx. :) > >x xxxx xxx xx xxxx xxxxx xx xxxxxxx xxxxx x xxxxxx xx xxxxxxx >xxxxxx, >xxx'x xxxxxx xxxxxxxxx xxxxx xx xxxx xx xxx xxxx xxxxxxxx xxxx >xxxxx >xxxxxxxx xxxxx. x xxx xxxxxxxxxxx, xxxxxxxxx, xx xxx xxxxxxxx >xxxxxxxxxx. xx xxxxx xxxx xxxxx'x xxx xxxxxx xx xxxxxxxxxx xxxx >xxxxxx xxxxxxxxxxx xx xxx xxxx xx xx x xxxxxxxxxxxx, xxx xxxxxxx, >xxxxxxxxx, xxx xxxxxxxx xxx xxx xxx xxxx xxxxx xxxx xxxxxxx xx >xxxxx >xx xxxxxxxx xxxxx xx xxxx xxxxx xxxxxxx xxxxxxxxxxx xxxxx >xxxxxxx. >x'xx xxxxxx xx xxxxxxx xxxxxx xxx xxxx xxx xxxxxxx xxx, xxx xxxx >xxxxxxxxx xxxxxxxx xxx xxxx xxxxxxxxxxx xxxxxxx xxx xxxx xxxxxx >xx >xxxxxxxxx xx xx xxx, xxx (xxxxx xxxx x xxxxx xxxxxxxxx xxxx xxxxx >xxxxxx), xx'x xxx xxxxx xxxxxxxx. xxx'xx xxxx xxxxxxxx xxxx x >xxxxxx >xx xxxx - xxx xxxxx xxxx xxx xxxx xxx... xxx xxxxx. > >xxxxxx! x xxxx xx xxxxxxx - xxx x'x xx xxxxx xxxxxx, xxx x xxxx >xxx'x >xxxx x xxx. xxx xxx xxx xxxx xxx xxxx, xx xx xxx xxxxxx xxxx >xxxxxxxxx xx xxxxxxx? x'x xxxx xx xxx xxxxxx xx x xxx xxxx xxxx >xxxxxxx xxxxx xxx, xx xx xxxxxxxx xx x xxxxxx xxxxxx, xx... x >xxxxx >xxx xx xxx xxxx xxxxxx xxx xxxx? xxx x xxxxx xxxxxxxxxx xxxx xxx >xxxxxxx xxxxxxxx xx xxxxxxxxxxxx xxxx xxx xxxxxxxx. xxx xxxxxx >xxxx >xxxx xx xxxxx xxx xx xxx xx xxx xxxx xxx xxxxxxxxx xxxx x xxx >xxxx >xxxx! xxxxx, xxxxx xxx. x'x xxxx xx xxxx xxx xx xx xxxx, xx xxx'xx xxxx. xx xxx xxxxxx xxx xxx xxxxxxxxxxxxxx xxxxxx -- xx xxxxx xxxxx'x xxxx x xxx, xxx xxx x xxxxx xxxxxxx xxxxxx x'xx xxxxx xxx xx xxx xx xxx xx xxx. x xxx'x xxxxx xx'xx xx x xxxx xxxxxx xx xxxx xxxx xxxxxxx: xxxxxxxxx, xxx xxxxxxx xx-xxxxxx xxxxxxx, xxx xxxx xxxxxxxxxx xxxxx xxxxx xx xxxxx xxxxx xxxxxxxxx xx xxxx xxxxxx xxxxxxxxxxx. x xxx xxxxxxxxx: * xxxxx xxx, xxx'x xxxx xxxxx xxxxxxxxx xx xx xxxx. xxx'xx xxxx x xxxxxx xxxxxxxx xxx xxxx xxxx xxxxxxxx xxx x xxxxxxx xxxxxxxx. x xxx'x xxxx xxxxxxxx xxxxx xxxxx xxxxxxxx xxx xxxx xxxxx xxxxx xxxxxxxx. xxx xxx xxxx xx xxxx x xxxxxx xxxxxx xxx xxx? (x'x xxxx xxx xx xx xxxx xx xxx xxxx xxxx; xxxxxxx, x'x xxx xxxxxxx xxx xx xxx xxxxxxx xx xxxxx xxx xxxxxx xxxx -- x xxxxxx xxx xxxxx'x xxxx xxx xxxxxx xx xxxxxxx xxx. xx xxxxx xxxx xx x xxxx xxxxxxx.) * xx xxx xxxxxx xx xx xxxx xx xxxxxx, xxx xxx, xx xxxx xxxx xx xx xxxx xxx? xxxxx xxxx xx xx xx. x xxx xxxxx; xx xx'x xxxxx xxx xxxx xxxxx xxxxxx -- xxxx'xx xxx xxxxx, xx xxxxxxx xxxxx xxxxxx xxxx xxxxxx -- xxxxxx xxxxx xxx xxxxxxxxxxxxxx xxxx (xxx xxxxxxx). * xxxxxxxx xx xxxxx: xxxx'x xxxx xxxx? xxxx xxxx xx xxx xxxx xxxxxxx! xx, x xxxx xxxxxx xx xxxx xxxx -- xxx xxxx xxxx xxxx xxxxxxxx xxxxxx, xxxxxxxxx x xxxxxxxxx xxxxxxxxxxx xxxxxx, xxxx x'xx xxxx xxxxxxx xx xxxx'x xxxx, xxx xxxxx x xxxxxx xxxx xxxx xx xxxxxxx xx xxx xxxx xxxxx xx xxxxxxxxxx. Best regards, -Karl (Note to self: that's from 875y9uw1t9.fsf@red-bean.com, in case I ever want to test it again.) TODO: Check how this handles forwarded messages too. Look for \"-------------------- Start of forwarded message --------------------\" in a message, then DTRT?." ;; Some test data, in case you're improving this function: ;; ;; From: Karl Fogel ;; To: Julie Hoffmann , ;; Elizabeth Kane , ;; John Mohr , ;; David Goodman , ;; Grace Kendra , ;; Jonathan Mergy , ;; Jim McGowan ;; Subject: Three questions from today's meeting, to ponder for next week. ;; Gcc: nnfolder+archive:sent.2022-03 ;; FCC: ~/mail/outwent ;; Reply-To: Karl Fogel ;; --text follows this line-- ;; Hey, all. We got answers to a lot of questions during today's meeting! ;; There were also three questions that we discussed but didn't arrive at ;; answers for. I'm posting them here as things to ponder over the next ;; week -- hopefully we can answer them by the end of next Friday's ;; meeting. ;; ;; * Does flan taste better with bananas? ;; ;; We've tossed around "yes"; we've also tossed around "no" or even ;; "maybe". ;; ;; I tend to think somewhere in the "maybe" range would be fine. To ;; some extent, the amount of fruit is more of a concern than which ;; fruit (for the purposes of this calculation, assume that a flan with ;; no fruit counts as a flan having one unique fruit, because that's ;; how we'll have to handle from a technical perspective). ;; ;; But maybe I'm not fully taking into account the administrative and ;; political burden of many different fruits in the Pilot? Anyway, ;; let's remember to get this question settled soon. ;; ;; I really liked the idea John raised of trying other desserts, for ;; two reasons: ;; ;; 1. One, "more fruits per flan" is a good direction for the Pilot ;; (within reasonable bounds); ;; ;; 2. Two, it helps us counter somewhat the familiarity-network ;; effect of inviting in dessert makers whom we already know. ;; ;; * Will our team have a role in identifying other desserts? ;; ;; I don't think we really came down on an answer to this today, unless ;; I missed it? ;; ;; There's a lot of flexibility in what we could do here. Also, ;; interested dessert makers who aren't Pilot participants can still ;; help spread the word to dessert suppliers. ;; ;; * Do all dessert makers in the Pilot need to make flan? ;; ;; We discussed this a bit, and I was advocating for the answer "No, we ;; don't need everyone to make flan, in fact, maybe some of them can ;; make Sacher-Torte instead." ;; ;; But I don't think we came to a definite consensus on that, so let's ;; make sure we discuss it on Friday (or before). ;; ;; So that's everything. Now I'm just writing random text in order to ;; have a couple of normal paragraphs at the end of this obviously ;; made-up email. I tried, I really tried, folks, to keep up the fantasy ;; about a meeting concerning flan-accompaniment options from the fruit ;; world, but my real goal here is hard-newline placement in Emacs and I ;; just need to stop trying to hide that. ;; ;; Goodness, what a relief it is to finally admit the truth! Yes. Yes. ;; Yes, this is about hard newlines, not about flans and fruits and some ;; weird-o, imaginary Pilot program involving various combinations of ;; them. Never again will I live a lie; never again will I live in fear. ;; Except of `use-hard-newlines', of course -- *that* we can all fear. ;; ;; Best regards, ;; -Karl (interactive) (save-excursion (save-restriction (message-goto-body) (narrow-to-region (point) (point-max)) (kf-remove-text-properties (point) (point-max)) ;; First, do a pass with `use-hard-newlines' (but see below). (use-hard-newlines 1 'guess) ;; `use-hard-newlines' does decently, but it doesn't get ;; everything perfect. The major problem is that blocks of ;; indented text only get their last newline hardened, whereas I ;; always want every line of such text to have its terminating ;; newline hardened. So now we go back and fix that. (goto-char (point-min)) ;; I am convinced there is a bug in Emac's regular expression ;; matcher, as of Emacs 29.0.50 (Git commit fc62efc5637338). If ;; you put point at the beginning of a buffer with the contents ;; below (assuming that the leftmost letters begin in column 0) ;; and run `(re-search-forward "^\\s-+.*$" nil t)', point will ;; end up after the "ccc". Run it again and it'll end up after ;; the "fff". ;; ;; aaa bbb ccc ;; ;; ddd eee fff ;; ;; ggg hhh iii ;; ;; Wait, I can make this even more blatant. Try using just ;; `(re-search-forward "^\\s-+" nil t)' and get no match! ;; ;; Now, does any of this make sense? I do not see how it can be ;; right. Maybe there's some subtlety of my regexp that I am ;; missing, but that's a pretty simple regexp that clearly ;; matches some whitespace at the beginning of the line. ;; ;; Anyway, I'm just going to use a literal space and a literal ;; tab character in the character class, to get around the fact ;; that \s- is spookily not working as advertised. (while (re-search-forward "^[ ]+" nil t) (end-of-line) (set-hard-newline-properties (point) (1+ (point))) ;; Now, if this is the first continuation line of a ;; bullet-point list, and we're indenting the continuation ;; lines, then harden the newline at the end of the initial ;; line -- the one with the bullet point -- too. (let ((opoint (point))) ; cheaper than `save-excursion' (forward-line -1) ;; Handle the first line of an enumerated or unenumerated ;; list item. It thus could start with "* " or "- ", or be ;; a number with a delimiter like "1. " or "1) ". We might ;; want to support alphabetically enumerated (enalphabeted?) ;; items too, but that starts to raise the possibility of ;; false positives w.r.t. just a regular word at the end of ;; a sentence starting a line, and I haven't decided how to ;; guard against that yet. (when (looking-at "^\\(\\*\\|[0-9]+\\(\\.\\|)\\)\\|-\\|\\+\\)\\s-+\\S-+") (end-of-line) (set-hard-newline-properties (point) (1+ (point)))) (goto-char opoint))) ;; Next: quoted sections should be all hard newlines. (goto-char (point-min)) (while (re-search-forward "^\\([[:blank:]]*>\\|.*\\s-+wrote:$\\)" nil t) (end-of-line) (set-hard-newline-properties (point) (1+ (point)))) ;; And handle signature specially. (goto-char (point-min)) (when (re-search-forward kf-mail-signoffs-re nil t) (forward-line -1) (while (not (looking-at "^\\s-*$")) (end-of-line) (set-hard-newline-properties (point) (1+ (point))) (forward-line 1)))))) (defun kf-switch-handler-h () "Like `kf-switch-handler-i', but for `h' not `i'. Or like `kf-switch-handler-u', but for `h' not `u'." (interactive) (cond ((eq major-mode 'message-mode) (call-interactively 'kf-harden-region)) (t (call-interactively 'kf-log-message)))) ;; You'd think the undocumented function `set-hard-newline-properties' ;; in simple.el would do something like this, but no, that's not what ;; it does. On the other hand, there is a `hard-newline' variable in ;; there that could be a better way to do what I'm trying to do: ;; ;; (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) ;; "Propertized string representing a hard newline character.") ;; ;; Hmmm. (defun kf-harden-region (b e) "Harden every newline in the region from B to E." (interactive "r") (save-excursion (goto-char b) (while (search-forward "\n" e t) (put-text-property (1- (point)) (point) 'hard 't)))) (defun kf-clear-hard-newlines () "For testing/debugging only." (interactive) (save-excursion (goto-char (point-min)) (while (search-forward "\n" nil t) (remove-text-properties (1- (point)) (point) (list 'hard))))) (defun kf-message-indent-citation () (kf-harden-region (point) (mark t)) ;; Whatever Emacs originally had, call it too. (when kf-original-message-indent-citation (funcall kf-original-message-indent-citation))) (defun kf-message-mode-hook () ;; No more annoying ellipses! (when (eq (keymap-lookup nil "C-c C-e") 'message-elide-region) (keymap-local-set "C-c C-e" 'kf-surround-with)) ;; These two settings help with mailaprop.el. (setq message-beginning-of-line nil) (setq company-tooltip-limit (- (frame-height) 4)) ;; See `kf-message-flowify' for why this works: (auto-fill-mode 1) ;; And also see `kf-message-flowify' for why this is necessary: (set-fill-column 65) ;; I'm not sure why `abbrev-mode' was on by default in Message Mode ;; buffers -- AFAIK that's not coming from any of my init files -- ;; but in any case I don't want it on. (abbrev-mode -1) ;; When quoting a mail, we want all the newlines in the quoted part to ;; be hard ones, and this turns out to be the easiest way to get that. (unless (boundp 'kf-original-message-indent-citation) (setq kf-original-message-indent-citation message-indent-citation-function)) (setq message-indent-citation-function 'kf-message-indent-citation) ) (defun kf-mail-mode-hook () ;; TODO: Use `kf-override-key' here to do these more carefully. (keymap-local-set "C-c C-f C-i" 'kf-insert-elizabethan-insult-header) (keymap-local-set "C-c C-a" 'kf-message-beginning-of-this-header-value) ;; Handle Reply-to: (if (or (eq (keymap-lookup nil "C-c C-r") nil) (eq (keymap-lookup nil "C-c C-r") 'mail-yank-region) (eq (keymap-lookup nil "C-c C-r") 'message-caesar-buffer-body)) (keymap-local-set "C-c C-r" 'kf-righteous-reply-to-cycle) (keymap-local-set "M-," 'kf-righteous-reply-to-cycle)) ;; Make sure default directory is writeable so don't get annoying ;; autosave behavior. (let ((mail-dir (expand-file-name "~/mail/"))) (if (file-exists-p mail-dir) (setq default-directory mail-dir) (setq default-directory (expand-file-name "~/"))))) (defun kf-message-beginning-of-this-header-value () "Move point to the start of this header line's value. If not in a mail header, then move point to the beginning of the line." (interactive) ;; In the course of writing this function, I discovered that ;; `message-beginning-of-header' already does exactly what I want ;; when passed a nil HANDLE-FOLDED argument. Thanks, Emacs. (message-beginning-of-header nil)) (defmacro kf-in-mail-headers (&rest body) "Run BODY with point at start of narrowed mail headers and match data saved." `(save-excursion (save-restriction (save-match-data (goto-char (point-min)) (message-narrow-to-headers) ,@body)))) (defun kf-mail-sender-address-portion () "Return the address portion of the address this mail is being sent as. For example, if sending as \"J. Random \", then return \"jrandom@example.com\" (with no angle brackets)." (kf-in-mail-headers (re-search-forward "^[Ff]rom: " nil t) (search-forward "@") (let ((addr (thing-at-point 'email))) (if (= (aref addr 0) ?<) (substring addr 1 (1- (length addr))) addr)))) (defun kf-mail-sender-domain () "Return the sending domain for this mail, or nil if none." (kf-in-mail-headers (when (re-search-forward (concat "^[Ff]rom: .*fogel" (regexp-quote "@")) nil t) (buffer-substring-no-properties (point) (progn (re-search-forward "[^a-zA-Z0-9.-]") (1- (point))))))) (let ((rname "Karl Fogel") (uname "kfogel") (domains (list "red-bean.com" "opentechstrategies.com" "questioncopyright.org" ;; ;; I receive mail at these but never ;; ;; send from them nowadays, so when ;; ;; cycling in `kf-righteous-reply-to' ;; ;; they don't need to be in the ;; ;; rotation: ;; ;; "gnu.org" ;; "opensource.org" ;; "producingoss.com" ;; "archive.org" ;; "newamerica.net" ;; "oreilly.com" ;; "openitp.org" ;; "solutionguidance.com" "gmail.com" ; still needed occasionally ))) (defconst kf-righteous-reply-to-list (mapcar (lambda (domain) (concat rname " <" uname "@" domain ">")) domains) "*Email addresses through which to cycle in Reply-to.") (setq message-dont-reply-to-names (mapcar (lambda (domain) (regexp-quote (concat uname "@" domain))) domains)) (setq mail-dont-reply-to-names message-dont-reply-to-names)) (defun kf-righteous-reply-to () "Return the 'right' reply-to address for the message being edited." (save-excursion (save-match-data (goto-char (point-min)) (re-search-forward "^X-[Dd]raft-[Ff]rom:\\s-+(\"\\([^()\" ]+\\)\" [0-9]+" nil t) (let* ((draftbox (match-string-no-properties 1)) (lst kf-righteous-reply-to-list)) (when (and draftbox (string-match "^\\(ots$\\|ots\\..+\\)" draftbox)) ;; Special case the "ots" -> "opentechstrategies" mapping. (setq draftbox "opentechstrategies")) (if (not draftbox) (car kf-righteous-reply-to-list) (while (and lst (not (string-match draftbox (car lst)))) (setq lst (cdr lst))) (if lst (car lst) (car kf-righteous-reply-to-list))))))) (defun kf-insert-email-addresses (&optional long-form) "Insert a vertical list of email addresses I normally send from. If LONG-FORM is non-nil, include real name and angle brackets. Behaves like `kf-prefixed-yank' in that text from bol to point is used as the prefix text for each line of the yank." (interactive "P") (let ((prefix (buffer-substring (point) (save-excursion (beginning-of-line) (point)))) (maybe-compactify (lambda (s) (if long-form s (save-match-data (substring s (1+ (string-match "<" s)) (string-match ">" s))))))) (let ((first-one t)) (mapcar (lambda (str) (insert (if first-one "" prefix) (funcall maybe-compactify str) "\n") (setq first-one nil)) kf-righteous-reply-to-list)))) (defun kf-righteous-reply-to-cycle () "Cycle through the various email addresses I might use." (interactive "*") (let* ((case-fold-search t) (old (save-excursion (goto-char (point-min)) (if (re-search-forward "^reply-to: " nil t) (buffer-substring (point) (progn (end-of-line) (point))) ""))) (new (let ((lst kf-righteous-reply-to-list)) (if (not (member old kf-righteous-reply-to-list)) (car kf-righteous-reply-to-list) (while (not (equal (car lst) old)) (setq lst (or (cdr lst) kf-righteous-reply-to-list))) (or (cadr lst) (car kf-righteous-reply-to-list)))))) (save-excursion (mapcar (lambda (header-re) (goto-char (point-min)) (when (re-search-forward header-re nil t) (beginning-of-line) (search-forward ": ") (delete-region (point) (progn (end-of-line) (point))) (insert new))) (list "^[Rr]eply-[Tt]o: " "^[Ff]rom: "))))) (defun kf-followable-list () "If this mail message is to a list to which replies should be directed, return the list's name, else return nil. This is meant to be run from a mail header setup hook." (save-excursion (goto-char (point-min)) ;; TODO: This is so weak. It should instead really parse the ;; headers and DTRT. (if (search-forward mail-header-separator nil t) (beginning-of-line) (goto-char (point-max))) (let ((end (point))) (let ((lists '("dev@subversion.tigris.org" "users@subversion.tigris.org" "soc@subversion.tigris.org" "dev@cvs2svn.tigris.org" "users@cvs2svn.tigris.org" ))) (catch 'found (while lists (goto-char (point-min)) (if (search-forward (car lists) end t) (throw 'found (car lists)) (setq lists (cdr lists))))))))) (defun kf-maybe-set-mail-followup-to () "Set the Mail-followup-to header if appropriate." (interactive "*") (let ((list (kf-followable-list))) (when list (save-excursion (goto-char (point-min)) (if (search-forward mail-header-separator nil t) (beginning-of-line) (goto-char (point-max))) (insert "Mail-followup-to: " list "\n"))))) (defun kf-replace-mail-header (hdr str) "Set header HDR to value STR in the current outgoing message. If HDR is already present, remove it and replace with STR." (save-excursion (goto-char (point-min)) (let ((case-fold-search t) (b (point)) (e (progn (search-forward mail-header-separator) (beginning-of-line) (point)))) (goto-char b) (save-restriction (narrow-to-region b e) (unless (re-search-forward (format "^%s: " hdr) nil t) (goto-char (point-max)) (beginning-of-line) (insert hdr ": ")) (insert str) (set-mark (point)) (unless (re-search-forward "^[^ \t]" nil t) (goto-char (point-max))) (beginning-of-line) (kill-region (mark) (point)) (insert "\n") )))) (defun kf-get-mail-header-boundaries (hdr) "Return the start and end positions of header HDR's value, as a list. Return nil if no such HDR. Do not trim whitespace on lines, but omit the space between the 'Header:' label and the value. HDR is case-insensitive." (kf-in-mail-headers (let ((b nil) (case-fold-search t)) (when (re-search-forward (format "^%s: " (regexp-quote hdr)) nil t) (setq b (point)) (unless (re-search-forward "^[^ \t]" nil t) (goto-char (point-max))) (forward-line -1) (end-of-line) (list b (point)))))) (defun kf-in-mail-header-p (hdr str) "Check mail header HDR for the presence of STR. HDR is case-insensitive." (require 'cl-lib) (save-excursion (cl-multiple-value-bind (start end) (kf-get-mail-header-boundaries hdr) (when start (goto-char start) (when (search-forward str end t) t))))) (defun kf-get-mail-header (hdr) "Return a string containing the value associated with the header HDR in the current mail. Return nil if header isn't there, or empty string if header is an empty string. Do not trim whitespace on lines, but omit the space between the 'Header:' label and the value. HDR is case-insensitive." (require 'cl-lib) (cl-multiple-value-bind (start end) (kf-get-mail-header-boundaries hdr) (when start (buffer-substring-no-properties start end)))) (defun kf-get-known-email-headers (&rest headers) "Return a string of all the HEADERS around point, newline-separated." ;; todo: this should use other mail header helper functions ;; already defined in this .emacs. And it would be cleaner to ;; return a list for the caller to assemble, instead of a string. (let ((case-fold-search t) (result "")) (save-excursion (or (looking-at "^from: ") (re-search-backward "^from: ")) (beginning-of-line) (mapcar (lambda (hdr) (save-excursion (save-match-data (search-forward (concat hdr ": ") nil t) (beginning-of-line) (let ((found-hdr (buffer-substring-no-properties (point) (progn (end-of-line) (re-search-forward "\\(^[-_.a-zA-Z0-9]+: \\|^$\\)") (beginning-of-line) (forward-char -1) (point))))) (setq result (concat result found-hdr "\n")))))) headers)) result)) (defun kf-summarize-current-message () "Put important headers of the message around point into the kill ring. This is typically called from within an mbox-format file." (interactive) (kill-new (kf-get-known-email-headers "subject" "message-id"))) (defun kf-insert-mail-header (hdr str) "Insert header HDR with value STR to the current outgoing message. If HDR is already present, prepend STR to it in a headerly way unless STR is also already present. HDR is case-insensitive. Surely there's some utility function for all this, but I can't find it." ;; TODO: this should be rewritten to use `kf-in-mail-headers'. (unless (kf-in-mail-header-p hdr str) (save-excursion (goto-char (point-min)) (let ((case-fold-search t) (b (point)) (e (progn (search-forward mail-header-separator) (beginning-of-line) (point)))) (goto-char b) (save-restriction (narrow-to-region b e) (unless (re-search-forward (format "^%s: " hdr) nil t) (goto-char (point-max)) (beginning-of-line) (insert hdr ": ")) (insert str)) (when (not (looking-at "\\s-*$")) (insert "\n") (when (not (looking-at (regexp-quote mail-header-separator))) (insert (make-string (+ (length hdr) (length ": ")) ? )) (progn (forward-line -1) (end-of-line) (insert ",")))))))) (defun kf-setup-mail () "Prepare some headers and variables for outgoing mail. Specifically, set up \"Reply-to\", and set `user-email-address'. (See also where we set up `message-dont-reply-to-names' and `mail-dont-reply-to-names'.)" (interactive "*") (save-excursion (goto-char (point-min)) (if (search-forward mail-header-separator nil t) (beginning-of-line) (goto-char (point-max))) (when (called-interactively-p) (insert "Vegetable: Emile the Eponymous Eggplant\n")) ;; I decided that including an insult was going a little far... ;; (insert "X-Elizabethan-Insult: ") ;; (fie-insert-insult) ;; (insert "\n") (insert "FCC: ~/mail/outwent\n") (kf-maybe-set-mail-followup-to) (let* ((own-addr-full (kf-righteous-reply-to)) (own-addr-email-only (save-match-data (string-match ".*[^<]+<\\([^>]+\\)>" own-addr-full) (match-string 1 own-addr-full)))) (setq user-email-address own-addr-email-only) (insert (format "Reply-To: %s\n" own-addr-full)) (goto-char (point-min)) (if (re-search-forward "^[Ff]rom:\\s-+\\(.+\\)" nil t) (progn (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point))) (insert "From: " own-addr-full "\n")) (goto-char (point-min)) (search-forward "Reply-to:") (end-of-line) (insert "\nFrom: " own-addr-full))) ;; I'm not so sure I want to insert these anymore. People who ;; actually work on these programs might not get the joke. ;; (cond ;; ((> 70 (mod (random) 100)) ;; (insert (emacs-threat-of-the-day) "\n")) ;; ((> 90 (mod (random) 100)) ;; (insert (x-windows-threat-of-the-day) "\n")) ;; (t ;; (insert (microsoft-threat-of-the-day) "\n"))) )) (defun kf-get-sent-email (&optional resumption-point) "Return the location \(in the sent mail box\) and content of a sent email. Optional argument RESUMPTION-POINT means start from that point in the sent mail box. The return value is a list of the form \(start-point str\), where start-point is the point in the sent mail box where this message begins, and str is the full message including headers. TODO: It would probably make more sense to take a number N, meaning N'th most recent sent message. But implementation-wise, using a resumption point was easier, since my sent mail boxes are text files." (save-excursion (save-restriction (set-buffer (let ((large-file-warning-threshold nil)) (find-file-noselect "~/mail/outwent"))) (widen) (let ((msg-end nil)) (if resumption-point (goto-char resumption-point) (goto-char (point-max))) ;; There's always a blank line separating messages, but we don't ;; need that blank line included in the grabbed message itself. (forward-line -1) (setq msg-end (point)) (let ((case-fold-search nil)) (re-search-backward "^From ")) (let ((ret (list (point) (buffer-substring (point) msg-end)))) ;; If already had file open with unsaved mods, then leave it be. (unless (buffer-modified-p) (kill-buffer)) ret))))) (defun kf-strip-inhuman-headers-internal (msg) "Return a copy of MSG with only very human-useable headers remaining." ;; There's probably some way to do this without a buffer, ;; but using a buffer is more Emacsey. (save-excursion (switch-to-buffer (get-buffer-create "*Cleaning Up An Email Message*")) (delete-region (point-min) (point-max)) (insert msg) ;; Is there some email message library for doing this stuff? (goto-char (point-min)) (search-forward "\n\n") (forward-line -1) (let ((header-boundary (copy-marker (point))) (keep-headers (list ;; C.f. `message-forward-included-headers', ;; which we extend after loading message.el. ;; For now, we don't include Reply-to header ;; here, but that were to change then maybe ;; using `message-forward-included-headers' ;; (with appropriate string transformations) ;; would be the way to go. "from" "to" "subject" "cc" "date" "message-id"))) (goto-char (point-min)) ;; This has to be done carefully, because of multi-line headers ;; We can't just use `delete-non-matching-lines'. (save-match-data (while (< (point) header-boundary) (if (looking-at "^\\([-_a-zA-Z0-9]+\\): ") (if (member (downcase (match-string 1)) keep-headers) (progn (forward-line 1) (while (looking-at "^\\s-+") (forward-line 1))) ;; Else we're looking at a non-keep header. (delete-region (point) (progn (forward-line 1) (point))) (while (and (looking-at "^\\s-+") (< (point) header-boundary)) (delete-region (point) (progn (forward-line 1) (point))))) ;; The only header that doesn't have a colon is the "From " ;; line, so expect it. (if (looking-at "^From ") (delete-region (point) (progn (forward-line 1) (point))) (error "Unexpected header format '%s'" (buffer-substring (point) (progn (end-of-line) (point))))) )))) (let ((ret (buffer-substring (point-min) (point-max)))) (kill-buffer) ret))) ;; TODO: When pasting headers from a Gmail "show original" copy, we ;; start with something like this: ;; ;; MIME-Version: 1.0 ;; Received: by 2002:a4f:76c8:0:0:0:0:0 with HTTP; Fri, 14 Sep 2018 12:44:51 -0700 (PDT) ;; Date: Fri, 14 Sep 2018 14:44:51 -0500 ;; Delivered-To: kfogel@example.com ;; X-Gmail-Original-Message-ID: ;; Message-ID: ;; Subject: Followup regarding HIE. ;; From: Karl Fogel ;; To: J. Doe , D. Joe ;; Cc: Kelley Witmer , James Vasile ;; Content-Type: multipart/alternative; boundary="00000000000095127e0575da0ef9" ;; ;; It'd be great to have a function that magically turns that into: ;; ;; From: Karl Fogel ;; To: J. Doe , ;; D. Joe ;; Cc: Kelley Witmer , ;; James Vasile ;; Subject: Followup regarding HIE. ;; Date: Fri, 14 Sep 2018 14:44:51 -0500 ;; Message-ID: ;; ;; Half the infrastructure for this is built already. (defun kf-strip-inhuman-headers (b e) "Strip inhuman headers from the mail message between B and E. See `kf-strip-inhuman-headers' for more." (interactive "r") (let ((msg (buffer-substring b e))) (delete-region b e) (save-excursion (goto-char b) (insert (kf-strip-inhuman-headers-internal msg))))) (defvar kf-just-sent-resumption-info nil "Used by `kf-just-sent' to step backwards through messages. If non-nil, this is an a list of the form: \(\(sentbox-point N\) \(prev-insertion-start B\) \(prev-insertion-end E\)\) where the value for `sentbox-point' is where to resume from in paging backward for the next message in the sent mail box, and the values for `prev-insertion-start' and `prev-insertion-end' are the start and end points of the most recent insertion, so it can be cleared and replaced with the next one on repeated invocation.") (defun kf-just-sent (&optional full-message) "Insert previously-sent email message's headers, with consistent indentation. The consistent indentation is done the same way as `kf-prefixed-yank'. Interactively, leave point at the start of the insertion but mark at the end. Repeated invocation steps back through previously sent messages. Optional arg FULL-MESSAGE means insert both headers and body." (interactive "P") (let ((enable-local-variables nil) (resumption-point nil)) (when (equal last-command 'kf-just-sent) (setq resumption-point (cadr (assq 'sentbox-point kf-just-sent-resumption-info))) (delete-region (cadr (assq 'prev-insertion-start kf-just-sent-resumption-info)) (cadr (assq 'prev-insertion-end kf-just-sent-resumption-info)))) (let* ((sent-msg-info (kf-get-sent-email resumption-point)) (sent-msg-start (car sent-msg-info)) (sent-msg (kf-strip-inhuman-headers-internal (cadr sent-msg-info)))) (unless full-message (setq sent-msg (substring sent-msg 0 (save-match-data (string-match (regexp-quote "\n\n") sent-msg))))) (when (called-interactively-p) (push-mark (point))) (let ((start (point)) (end nil)) (kf-prefixed-yank sent-msg (buffer-substring (point) (save-excursion (beginning-of-line) (point)))) (setq end (point)) (setq kf-just-sent-resumption-info (list `(sentbox-point ,sent-msg-start) `(prev-insertion-start ,start) `(prev-insertion-end ,end)))) (when (called-interactively-p) (exchange-point-and-mark))))) ;; I cannot believe what I have to do to turn off font locking in mail ;; and message buffers. Running `(font-lock-mode -1)' from every ;; possibly relevant gnus-*, mail-*, and message-* hook still left my ;; reply buffers font-locked. Arrrgh. ;; ;; So the code below fools font-lock-mode into thinking the buffer is ;; already fontified (so it will do nothing -- see ;; font-lock.el:font-lock-mode for details), and then makes sure that ;; the very last thing run when I hit reply to a message is to turn ;; off font-lock-mode in that buffer, from post-command-hook. Then ;; that function removes itself from post-command-hook so it's not run ;; with every command. (defun kf-compensate-for-fucking-unbelievable-emacs-lossage () (font-lock-mode -1) (remove-hook 'post-command-hook 'kf-compensate-for-fucking-unbelievable-emacs-lossage)) (add-hook 'font-lock-mode-hook 'kf-font-lock-mode-hook) (defun kf-font-lock-mode-hook () (when (or (eq major-mode 'message-mode) (eq major-mode 'mail-mode)) (make-local-variable 'font-lock-fontified) (setq font-lock-fontified t) (add-hook 'post-command-hook 'kf-compensate-for-fucking-unbelievable-emacs-lossage) )) (defvar kf-mail-send-prompt-protect t "*Ask for confirmation before sending a mail.") (defvar kf-mail-red-bean-smtp-tls-password nil "*Red Bean SMTP TLS password, set by `kf-mail-get-passwords'.") (defvar kf-mail-gmail-smtp-tls-password nil "*Gmail SMTP TLS password, set by `kf-mail-get-passwords'.") (defvar kf-mail-oreilly-smtp-tls-password nil "*O'Reilly SMTP TLS password, set by `kf-mail-get-passwords'.") (defvar kf-mail-ots-smtp-tls-password nil "*OpenTechStrategies.com SMTP TLS password, set by `kf-mail-get-passwords'.") (defvar kf-mail-sgc-smtp-tls-password nil "*SolutionGuidance.com SMTP TLS password, set by `kf-mail-get-passwords'.") (defvar kf-mail-passwords-gotten nil "Non-nil iff passwords already fetched.") (defun kf-mail-get-passwords () "Get various mail passwords, unless they're already gotten." (interactive) (unless kf-mail-passwords-gotten (let ((obsc-1 (make-string 5 ?3))) (aset obsc-1 3 ?1) (aset obsc-1 2 ?t) (aset obsc-1 0 ?r) (aset obsc-1 1 ?o) (mapcar (lambda (src) (let ((sym (intern (concat "kf-mail-" src "-smtp-tls-password")))) (when (or (not (boundp sym)) (not (symbol-value sym))) (let* ((fun (symbol-function (intern obsc-1))) (src-name (funcall fun src)) (src-file ;; This kind of thing is fun, but the real security ;; comes from the data file simply not existing in ;; any place where you're likely to see this .emacs :-). (funcall fun (concat "~/cevingr/.srgpuznvyep-" src-name))) (keymark (funcall fun "cnffjbeq"))) (save-excursion (when (file-exists-p src-file) (set-buffer (find-file-noselect src-file)) (goto-char (point-min)) (save-match-data (looking-at (format "^.* %s \"\\([^\"]+\\)\"" keymark)) (set sym (match-string-no-properties 1))))))))) (list "red-bean" "gmail" "ots" "sgc" "oreilly"))) (setq kf-mail-passwords-gotten t))) (defun kf-set-up-authinfo (host port login passwd) "Set up ~/.authinfo with HOST, PORT, LOGIN and PASSWD." (let ((authinfo-file (expand-file-name "~/.authinfo")) (authinfo-format "machine %s login %s port %d password %s\n")) ;; Yes, that's right, `set-file-modes', which is Emacs's chmod, ;; takes its mode argument in decimal instead of octal, while ;; the command-line program chmod (which Elisp authors are highly ;; likely to be familiar with already) takes it in octal. (when (file-exists-p authinfo-file) (set-file-modes authinfo-file 384)) ; pre-paranoia (save-excursion (set-buffer (get-buffer-create "*authinfo-tmp*")) (delete-region (point-min) (point-max)) (insert (format authinfo-format host login port passwd)) (write-file authinfo-file) (set-file-modes authinfo-file 384) ; post-paranoia (kill-buffer)))) (defun kf-tear-down-authinfo () "Remove the ~/.authinfo file and forget any cached auth-source data. Meant to be run after sending a message, e.g., from `mail-sent-hook'." (auth-source-forget-all-cached) (delete-file (expand-file-name "~/.authinfo"))) (defun kf-mail-send-hook () ;; I used to accidentally type "C-c C-c" while in mail buffers and ;; accidentally send the email before it was read. I believe that ;; was because I had "C-c c" bound to something useful back then. ;; nowadays I bind that to `mode-specific-command-prefix', so the ;; proximity would no longer be a problem. But in the intervening ;; time, I got used to being prompted, and it feels safer this way. ;; There are plenty of ways to accidentally hit C-c C-c, and most of ;; them don't involve typing "yes" afterwards. (when kf-mail-send-prompt-protect (or (progn (goto-char (point-min)) nil) (yes-or-no-p "Send message? ") (error "Confirmation failed -- message not sent."))) (when (eq major-mode 'message-mode) (kf-message-flowify)) ;; Only allow email to be sent from production boxes. (when kf-prod-box (require 'smtpmail) ;; See also `message-smtpmail-send-it', though we don't need to ;; use it. Some other things I apparently tried at one time: ;; ;; (setq send-mail-function 'sendmail-query-once) ;; (setq message-send-mail-function 'sendmail-query-once) (setq send-mail-function 'smtpmail-send-it) (setq message-send-mail-function 'smtpmail-send-it) ;; Set up authentication information for all my email identities. (kf-mail-get-passwords) ;; Now comes the complex part. My personal mail gets sent through ;; one server, and my work mail through another. There are also ;; a few rarely-used sending addresses -- right now, they use the ;; same server as my work email. ;; ;; That second server is, currently, Gmail. Sometimes Gmail needs ;; to be poked, in an authenticated way, to let you send again. ;; If 'smtp.gmail.com' is suddenly refusing to transmit mails, see ;; http://www.google.com/accounts/DisplayUnlockCaptcha and ;; https://support.google.com/mail/answer/7126229. ;; ;; Otherwise, debug SMTP+TLS troubles by turning on debugging: ;; ;; (setq smtpmail-debug-info t smtpmail-debug-verb t) ;; ;; And to manually test SMTP+TLS authn with the server, do this: ;; ;; $ echo -ne "\0kfogel\0some_password_here" | base64 ;; AGtmb2dlbABzb21lX3Bhc3N3b3JkX2hlcmU= ;; $ openssl s_client -starttls smtp -connect smtp.red-bean.com:587 ;; [...see big block of output from server...] ;; EHLO red-bean.com ;; [...get a list of commands back in response...] ;; AUTH PLAIN AGtmb2dlbABzb21lX3Bhc3N3b3JkX2hlcmU= ;; 235 Authentication successful ;; ;; You might need "AUTH LOGIN" instead of "AUTH PLAIN", in which ;; case instead of combining the username and password (each ;; preceded by a NULL byte) you would supply them separately and ;; without NULL bytes. E.g.: ;; ;; $ echo -ne "kfogel" | base64 ;; a2ZvZ2Vs ;; $ echo -ne "some_password" | base64 ;; c29tZV9wYXNzd29yZA== ;; $ openssl s_client -starttls smtp -connect smtp.red-bean.com:587 ;; [...see big block of output from server...] ;; EHLO red-bean.com ;; [...get a list of commands back in response...] ;; AUTH LOGIN ;; 334 VXNlcm5hbWU6 ;; a2ZvZ2Vs ;; 334 UGFzc3dvcmQ6 ;; c29tZV9wYXNzd29yZA== ;; 235 Authentication successful ;; ;; https://www.stevenrombauts.be/2018/12/test-smtp-with-telnet-or-openssl ;; has further information about testing SMTP, including sending mail. ;; ;; Some other useful web pages: ;; ;; - http://obfuscatedcode.wordpress.com/\ ;; 2007/04/26/configuring-emacs-for-gmails-smtp/ ;; - http://www.google.com/support/a/bin/answer.py?hl=en&answer=60730 ;; - http://mail.google.com/support/bin/answer.py?answer=14257 ;; - http://mail.google.com/support/bin/answer.py?answer=13287 ;; - http://mail.google.com/support/bin/answer.py?answer=78799 (let ((sender-domain (kf-mail-sender-domain))) ;; These two are the same for all SMTP servers I use (only ;; `smtpmail-smtp-server' will vary). (setq smtpmail-stream-type 'starttls) (setq smtpmail-smtp-service 587) (cond ;; Personal address sends via Red Bean SMTP. ((string-equal sender-domain "red-bean.com") ;; At some point in mid-2011, Emacs smtpmail.el started ;; using the auth-source.el system instead of the variable ;; `smtpmail-auth-credentials'. ;; ;; While it is still possible to construct and pass authn ;; data entirely within Emacs (that is, without having to ;; write it to an external file), I haven't yet had time to ;; figure out how to do that. Instead, I write the data to ;; ~/.authinfo temporarily, while a mail message is being ;; sent, and then erase the file; I also have to clear the ;; data from Emacs's internal auth-source cache, otherwise ;; once Emacs has read the ~/.authinfo file once, it will ;; just remember what it read the first time and ignore the ;; file thereafter -- even if the file's contents change. ;; My code to do that setup and teardown is invoked from ;; `mail-send-hook' and `mail-sent-hook'. ;; ;; After some discussion on emacs-devel@ in mid-August 2011 ;; (see threads "Multiple SMTP accounts with smtpmail.el" & ;; "more on starttls, gnutls-cli and using tls for mail"), ;; Lars Magne Ingebrigtsen introduced a new variable to make ;; it easier to control authn information in smtpmail: ;; ;; ------------------------------------------------------------ ;; revno: 105518 ;; committer: Lars Magne Ingebrigtsen ;; branch nick: trunk ;; timestamp: Sun 2011-08-21 06:11:59 +0200 ;; message: ;; Introduce a new variable to allow controlling the \ ;; SMTP user name ;; ;; * mail/smtpmail.el (smtpmail-smtp-user): New variable. ;; (smtpmail-try-auth-methods): Use it. ;; ;; However, then Leo followed up with a bug report about the ;; new variable ("Re: /srv/bzr/emacs/trunk r105518: Introduce ;; a new variable to allow controlling the SMTP user name"). ;; ;; I'm sure this will all get sorted out eventually, and at ;; some point I'll find time to switch to using auth-source ;; methods that are entirely internal to Emacs, and stop ;; depending on the external ~/.authinfo file. But for now, ;; I just need my email to work. ;; ;; In May 2020, I investigated further. Astonishingly, the ;; "Mail Sending" Info page (which I reached, and I am not ;; making this up, via the higher-level page "Sending Mail") ;; indicates that ~/.authinfo is still a reasonable way to ;; communicate an SMTP username and password to Emacs, and is ;; no worse than any other way to get them into Elisp. You'd ;; think there might be some variable(s) you could set (like ;; the old `smtpmail-auth-credentials') so that you wouldn't ;; have to deal with any external systems. But the `smtpmail' ;; library now just uses the `auth-source' library to get ;; creds, and `auth-source' seems determined not to give one ;; an easy way to do that. ;; ;; Unrelated to the above, here's some stuff about *fetching* ;; email via IMAP: ;; ;; That's set up in my private .gnus file (not visible unless ;; you're me, so I guess this comment is only for kfogel), ;; using the `mail-sources' variable (again, it appears that ;; `auth-sources' is the new hotness for all authentication ;; and yet that switching to it will not make things better). ;; We have to setq these, instead of just binding them in a ;; `let', because otherwise there will be a minibuffer prompt ;; for at least `smtpmail-smtp-server' when the mail is ;; actually sent, which happens after this hook has exited. (setq smtpmail-smtp-server "smtp.red-bean.com") (setq user-mail-address (concat "kfogel" (char-to-string 64) sender-domain)) (kf-set-up-authinfo smtpmail-smtp-server smtpmail-smtp-service "kfogel" ;; no domain name for this one kf-mail-red-bean-smtp-tls-password)) ;; Work emails get sent via Gmail. ((member sender-domain (list "opentechstrategies.com" "solutionguidance.com")) (setq smtpmail-smtp-server "smtp.gmail.com") (setq user-mail-address (concat "kfogel" (char-to-string 64) sender-domain)) (kf-set-up-authinfo smtpmail-smtp-server smtpmail-smtp-service user-mail-address kf-mail-ots-smtp-tls-password)) ;; A bunch of other non-work addresses get sent via Gmail too. ((member sender-domain (list "questioncopyright.org" "producingoss.com" "archive.org" "gmail.com" ; still needed occasionally "opensource.org" "oreilly.com" "gnu.org" "subversion.org")) (setq smtpmail-smtp-server "smtp.gmail.com") (setq user-mail-address (concat "kfogel" (char-to-string 64) sender-domain)) (let ((gmail-authn-address ;; these all share the same authn (concat "kfogel" (char-to-string 64) "gmail.com"))) (kf-set-up-authinfo smtpmail-smtp-server smtpmail-smtp-service gmail-authn-address kf-mail-gmail-smtp-tls-password))) (t (error "Unrecognized sender email address.")))) ;; Restore the default ambient identity. (setq user-mail-address kf-default-user-mail-address))) (defun kf-mail-sent-hook () (kf-tear-down-authinfo)) (defconst kf-generic-mail-signature "Best regards,\n-Karl\n" "The generic signature I usually use.") ;;;; End email section, but see also the Gnus section. ;;;; ;;;; Gnus section ;;;; ;;; Much of this started out as material swiped shamelessly from Jim ;;; Blandy's .gnus file. This is because I suspected Jim likes his ;;; mail the same way I do: shaken, not stirred, with one egg over ;;; well on the side. ;; Make Gnus just switch to the Gnus Group buffer if available, ;; because if Gnus is already running then we don't want to fetch ;; mail, we just want to switch to Gnus. Search for "Forrestal" and ;; "(setq gnus-plugged nil)" elsewhere in this .emacs for more ;; information about why, and be prepared to weep. (if kf-prod-box (progn ;; Load normal Gnus first. Otherwise our redefinition of `gnus' ;; below would actually be the first definition, and later on ;; when real Gnus got loaded it would clobber our "re"definition. ;; ;; So, first build the village... (require 'gnus) ;; ...in order to save it... (unless (fboundp 'kf-orig-gnus) (fset 'kf-orig-gnus (symbol-function 'gnus))) ;; ...so we can destroy it: (defun gnus () "Switch to the Gnus *Group* buffer if available, else run Gnus." (interactive) (let ((gbuf (get-buffer "*Group*"))) (if (and gbuf (with-current-buffer gbuf (eq major-mode 'gnus-group-mode))) (switch-to-buffer gbuf) (kf-orig-gnus)))) ;; Byte-compile it to avoid getting a warning from the ;; underlying (real) `gnus' function, which checks to see if the ;; function bound to that symbol is byte-compiled. (byte-compile 'gnus)) ;; If this isn't one of the usual production boxes, then don't run ;; Gnus at all, because it might swallow a mail spool. That ;; disaster happened once on sanpietro, and even though my mail is ;; no longer configured that way, it might be again some day. (defun gnus () (interactive) (message (concat "To run Gnus on sanpietro, which would be insane," " use M-x `kf-orig-gnus'.")))) ;; Fix the awful highlighting problem in Gnus whereby the article ;; buffer for mails from certain HTML-mail senders (e.g., Twitter) ;; would have the foreground and background colors set to similar ;; grays such that the text was barely readable. Thanks to abbe ;; in #gnus on 2014-05-05 for telling me about this variable. ;; ;; See, however, r5896 regarding the dependency on this renderer. (setq mm-text-html-renderer 'gnus-w3m) ;; TBD I'm trying to stop Gnus from viewing certain MIME types inline ;; by default. For example, when I click on or hit Return on a ;; "application/vnd.openxmlformats-officedocument.wordprocessingml.document" ;; attachment in an email, I don't want to view a plaintext rendering ;; of the document in line, rather I want LibreOffice to fire up. I ;; thought that `mm-inline-media-tests' or `mm-inlined-types' might be ;; involved in this, but so far I haven't succeeded in this change. ;; ;; For convenient sample data, see Karen's email "one more chapter!". ;; ;; For next steps in research, see: ;; ;; https://emacs-devel.gnu.narkive.com/8QTgdUmT/displaying-mime-parts-internally-externally-in-gnus ;; https://www.gnu.org/software/emacs/manual/html_node/emacs-mime/Display-Customization.html ;; https://www.emacswiki.org/emacs/MimeTypesWithGnus ;; https://www.gnu.org/software/emacs/manual/html_node/gnus/MIME-Commands.html ;; https://emacs.stackexchange.com/questions/52738/gnus-viewer-for-attachments ;; ;; BEGIN EXPERIMENT: ;; ================= ;; ;; (let ;; ((new-inline-handler ;; (list ;; "application/vnd.openxmlformats-officedocument.wordprocessingml.document" ;; 'ignore 'ignore))) ;; ;; This modification to `mm-inline-media-tests' doesn't seem to ;; ;; affect the behavior -- the attachment still opens inline. ;; (setq mm-inline-media-tests ;; (cons new-inline-handler mm-inline-media-tests))) ;; Make sure that other disaster Never Happens Again either. (defun kf-gnus-exit-hook (phase) "Save .newsrc.eld and .nnmail-cache in case Gnus loses its mind, i.e., loses all its marks. PHASE is the string \"PRE\" or \"POST\", see below about the wrappers for why this is necessary. This hook behaves differently depending on whether it is called from `gnus-exit-gnus-hook' or `gnus-after-exiting-gnus-hook'; note that `gnus-group-exit' runs both hooks. Unfortunately, because Emacs gives a function no way to know the name of the hook running it, that behavior is achieved via two wrapper hooks, `kf-gnus-exit-pre-save-hook' and `kf-gnus-exit-post-save-hook', each of which is added to the appropriate `gnus-' hook mentioned above." (let* ((lifeboat-dir (expand-file-name "~/mail/gnus-lifeboat")) (newsrc (expand-file-name "~/.newsrc.eld")) (nnmc (expand-file-name "~/.nnmail-cache")) (saved-newsrc (concat lifeboat-dir (format "/%s_SAVE_.newsrc.eld" phase))) (saved-nnmc (concat lifeboat-dir (format "/%s_SAVE_.nnmail-cache" phase)))) (unless (file-directory-p lifeboat-dir) (make-directory lifeboat-dir t)) (copy-file newsrc saved-newsrc t t t) (copy-file nnmc saved-nnmc t t t))) (defun kf-gnus-exit-pre-save-hook () (kf-gnus-exit-hook "PRE")) (defun kf-gnus-exit-post-save-hook () (kf-gnus-exit-hook "POST")) (add-hook 'gnus-exit-gnus-hook 'kf-gnus-exit-pre-save-hook) (add-hook 'gnus-after-exiting-gnus-hook 'kf-gnus-exit-post-save-hook) (defun kf-gnus-select-group-hook () "Custom hook called from `gnus-select-group-hook', which see." ;; Make the Message-ID header visible in articles. (let ((mid "Message-ID") (case-fold-search nil)) (unless (string-match (regexp-quote mid) gnus-visible-headers) (setq gnus-visible-headers (concat gnus-visible-headers "\\|^" mid ":"))))) (add-hook 'gnus-select-group-hook 'kf-gnus-select-group-hook) (defun kf-gnus-exit-group-hook () "Custom hook called from `gnus-exit-group-hook', which see." ;; Prior to r4979, this did `(set-frame-width (selected-frame) 80)' ;; to undo the widening done in `kf-gnus-select-group-hook'. I no ;; longer do that widening, but it's likely enough that I'll want to ;; reverse that decision that instead of getting rid of this hook, ;; I'm leaving it in place with this comment, to save time later. ) (add-hook 'gnus-exit-group-hook 'kf-gnus-exit-group-hook) ;; Deal with a common typo. (unless (fboundp 'guns) (defun guns () (interactive) (message "guns don't kill people -- gnus kills people") (sit-for 1) (call-interactively 'gnus))) ;; Make it easy to set up a permanent filter for a sender. (defun kf-gnus-make-filter-for-sender () "Insert a `nnmail-split-fancy' entry for this message's sender at the appropriate location in my private .gnus file where the new entry most likely belongs, put the new entry at the front of the kill ring, and put the group on the front of the isearch ring (so you can check for duplicates conveniently). Call this interactively from *Summary*, *Article* or *Message* buffer." (interactive) (when (eq major-mode 'gnus-summary-mode) (gnus-summary-select-article-buffer)) (let* ((from-hdr (kf-get-mail-header "from")) (marker ";;; People-oriented divisions come next:") (entry " (from\n ") (group nil) ; gets set when lambda below... (make-group (lambda (str) (setq group ; ...is called. (string-replace "\\" "\\\\" (string-replace " " "-" str)))))) (if (string-match "<" from-hdr) (let* ((elts (split-string from-hdr " <")) (name (string-replace " " ".*" (string-replace "\\" "\\\\" (regexp-quote (car elts))))) (email (string-replace "\\" "\\\\" (regexp-quote (substring (car (cdr elts)) 0 -1)))) (group (funcall make-group (downcase (car elts))))) (setq entry (concat entry (format "\".*\\\\(%s\\\\|%s\\\\).*\"\n" name email) (format " \"%s\")\n\n" group)))) ;; Plain email address, with no name on the front. (setq entry (concat entry (format "\"%s\"" (regexp-quote from-hdr)) (format " \"%s\")\n\n" (funcall make-group (downcase from-hdr)))))) (find-file "~/private/.gnus") (goto-char (point-min)) (search-forward marker) (forward-line 2) (insert entry) (isearch-update-ring group)) (redisplay)) (setq mail-source-delete-old-incoming-confirm nil) (defun kf-gnus-mark-region-as-processable (beg end &optional unmark) "Mark lines from BEG to END with a mode-appropriate process mark. This works in either `gnus-group-mode' and `gnus-summary-mode'. If optional third argument UNMARK is non-nil, then remove the process mark." (interactive "r\nP") (kf-ensure-ordering end beg) (let ((mark-fn (cond ((eq major-mode 'gnus-group-mode) 'gnus-group-mark-group) ((eq major-mode 'gnus-summary-mode) 'gnus-summary-mark-as-processable) (t (error "Unrecognized mode: %S" major-mode))))) (save-excursion (goto-char beg) (while (< (point) end) (funcall mark-fn 1 unmark))))) (defun kf-gnus-build-groups-list () "Call this from within the *Group* buffer, with all groups listed." (let ((groups (directory-files (expand-file-name "~/mail")))) (setq groups (delete "." groups)) (setq groups (delete ".." groups)) (setq groups (delete "outwent" groups)) (setq groups (delete "active" groups)) groups)) (defvar kf-gnus-history-list ()) (defun kf-gnus-count-active () "Display and return the approximate number of active messages. Must be invoked from the Gnus Group buffer." (interactive) (unless (eq major-mode 'gnus-group-mode) (error "Must be invoked from Gnus Group buffer.")) (save-excursion (goto-char (point-min)) (let ((total 0)) (save-match-data (while (re-search-forward "^\\*?\\s-+\\([0-9]+\\):" nil t) (setq total (+ total (max 1 (string-to-number (match-string 1))))))) (message "%d" total) total))) ;; The saga behind these next settings is... extensive. ;; ;; Here's what I wanted: to have gnus start up without connecting to ;; any servers. I wanted to decouple the act of looking at my ;; existing (i.e., already fetched) email from the slower act of ;; pulling new mail from my various sources, which is network-bound. ;; ;; So Gnus should start up without fetching, and then I want to use ;; "g" (`gnus-group-get-new-news') to fetch manually while in Gnus. ;; ;; Would you have guessed that this is controlled by a variable named ;; `gnus-plugged'? ;; ;; I wouldn't have. So instead, I went spelunking in the Gnus source ;; code. Promisingly, but deceptively as it turned out, there was ;; parameter name `dont-connect' for the interactive function `gnus'. ;; It wasn't documented, and there was no way to pass it interactively, ;; but those hardly count as obstacles in the world of Gnus, so I ;; wrote an interactive wrapper function to pass that parameter. ;; ;; It had no effect. Mail was still fetched from the servers. ;; ;; Somewhat surprised, I began tracing it down through the code, into ;; `gnus-1', into `gnus-setup-news', into `gnus-get-unread-articles', ;; into the Hall of Skulls, past where Forrestal cashed in... ;; my god, the horrors... what has been seen cannot be unseen... ;; ;; But I digress. ;; ;; The point is, near the end of `gnus-get-unread-articles' there is a ;; call to `gnus-read-active-for-groups'. This is finally where the ;; `dont-connect' parameter is no longer passed along (and by the way, ;; at no point did *any* function that received it document it -- ;; that's probably what did Forrestal in), but, in my setup at least, ;; somewhere under the call to `gnus-read-active-for-groups' is where ;; servers are actually contacted. ;; ;; In `gnus-read-active-for-groups', early on there's a call to ;; `gnus-online', and if the `gnus-plugged' variable is nil, then that ;; call should return nil... Well, okay, that's putting things a ;; little too neatly. The code for that function (which is wholly ;; undocumented, which would surely have done Forrestal in had he not ;; already been done in by the lack of documentation for the buggy ;; `dont-connect' parameter everywhere) looks like this: ;; ;; (defun gnus-online (method) ;; (not ;; (if gnus-plugged ;; (eq (cadr (assoc method gnus-opened-servers)) 'offline) ;; (gnus-agent-method-p method)))) ;; ;; So if `gnus-plugged' is nil, then the function will return the ;; Boolean opposite of whatever `(gnus-agent-method-p method)' ;; returns? Hunh. That's not at all what I would have expected, ;; especially as in the unplugged case, `gnus-read-active-for-groups' ;; seems to be expecting `gnus-online' to return non-nil... Or maybe ;; in the `and' form, `gnus-agent-method-p' (which is defined in ;; gnus.el instead of gnus-agent.el -- Forrestal is looking pretty ;; doomed from all sides here) returns something unexpected too first? ;; ;; Anyway, at this point, having seen that `gnus-plugged' is consulted ;; in `gnus-online', I began to read the Info pages documentation for ;; more about pluggedness. That veered rapidly into a discussion of ;; "Agents" (which were never defined), but I was able to get a ;; general sense that setting `gnus-plugged' to nil might achieve the ;; effect I wanted: no fetching on startup, and manual fetching with ;; "g" (`gnus-group-get-new-news') thereafter from the Group buffer. ;; ;; Oh, except that it doesn't work on its own, because the ;; `gnus-plugged' value continues to suppress fetching even when ;; fetching is manually requested via "g". So, some hooks are needed ;; to make `gnus-plugged' have the right values at the right times. ;; ;; Okay. I can do this. I can get out of here, with ;; the idol, and make it to my plane. As long as I don't encounter ;; any snakes, this will all work out just fine. ;; ;; R.I.P. Forrestal. (setq gnus-plugged nil) (defun kf-gnus-replug-hook () (setq gnus-plugged t)) (defun kf-gnus-unplug-hook () (setq gnus-plugged nil)) (add-hook 'gnus-group-prepare-hook 'kf-gnus-replug-hook) (add-hook 'gnus-after-exiting-gnus-hook 'kf-gnus-unplug-hook) ;; Standards have changed. (setq-default gnus-large-newsgroup nil) ;; Do to Gnus what I used do to Python (but don't do to Python any ;; more Because Standards). (setq gnus-thread-indent-level 2) ;; Why in the heck is this not the default? (setq gnus-gcc-mark-as-read t) ;; I used to have... ;; ;; (setq gnus-use-full-window nil) ;; ;; ...here. This was all I said about why, in r6321: ;; ;; > Improve window behavior when composing new messages in Gnus. ;; > ;; > This is still just a workaround, but at least it's better ;; > than before. ;; ;; Unfortunately, I don't remember what behavior I was trying to ;; improve, but whatever it was, my fix made things worse. After ;; setting that variable to nil, if I was in the Summary buffer, with ;; an Article buffer displaying in the window below it in the usual ;; proportion, then if I switched the Article window to something else ;; (e.g. a shell buffer or whatever) and then went back into the ;; Summary buffer and hit SPC to restore the window configuration in ;; which the Article buffer would displayed, Gnus would try to fit the ;; Summary and the Article buffers in two windows that would occupy ;; the space that formerly just the Summary buffer's window had been ;; in before, while leaving the big other window still displaying ;; whatever non-Gnus-y thing it was displaying. So my Gnus stuff ;; would be all squished up into the top, which is never what I want ;; (if I went back to the Summary buffer and hit SPC, that's because I ;; want to go back to reading mails in the usual way). ;; ;; So I revert that change in r6586. When I reverted it, I removed ;; some comments that might contain useful information if I were ever ;; to try again to solve whatever problem I was trying to solve in the ;; first place by setting `gnus-use-full-window' to nil. So, I should ;; look at the r6586 diff if I'm ever working on this problem again, ;; except that since I have no idea of what the problem was, that'll ;; never happen, unless the problem starts to annoy me again, in which ;; case I should come here and document it! Yeah. ;; ;; Also, some other notes to my future self: ;; ;; Setting `gnus-always-force-window-configuration' to t had no ;; discernable effect. Setting `gnus-use-atomic-windows' to non-nil ;; made everything break in weird ways so *shiver* let's not do that ;; again shall we kthxbye. (defalias 'kf-original-rmail (symbol-function 'rmail)) (defun kf-rmail (parg) "Protective wrapper to ensure I only invoke Rmail with prefix arg. The prefix arg means it will prompt me for an mbox file to read, which is how I always want to use Rmail. I definitely don't want Rmail to inhale my mail spool and accidentally displace Gnus." (interactive "P") (if parg (let ((current-prefix-arg parg)) (call-interactively 'kf-original-rmail)) (error "You use Gnus, so don't invoke `rmail' without a prefix arg."))) (defalias 'rmail 'kf-rmail) ;; I'm mostly using this for reading mail. (setq gnus-select-method '(nnml "private")) ;; Keep it in my mail folder from days of yore, whatever that means: (setq nnml-directory "~/mail") ;; Losing information does not make me smile. (setq gnus-treat-display-smileys nil) ;; Always want to be subscribed to mail groups (warning: paradigm-creep). (setq gnus-options-subscribe ".*") (setq gnus-subscribe-newsgroup-method 'gnus-subscribe-hierarchically) ;; I'd like new mail groups to be subscribed always, and hierarchically. ;; Not that GNUS seems to do real hierarchical browsing, sigh. (setq gnus-subscribe-options-newsgroup-method 'gnus-subscribe-hierarchically) ;; I think with this set I might get 1 mail a day instead of 300. ;; ;; TODO: For the "my own posts to mailing lists don't show up in Gnus" ;; problem, this variable is probably involved, and the solution might ;; be to make it a function that returns nil for my own posts and ;; `delete' for everything else. Here's some more context from #gnus ;; on Libera IRC on 31 July 2021: ;; ;; When I fetch mail into Gnus, for some reason emails from ;; myself (e.g., my own posts to a mailing list that I'm ;; subscribed to) don't seem to appear in Gnus. I know that I ;; am receiving those emails: I can see them in the spool on ;; the remote server where my mail accumulates before I fetch ;; it into Gnus. So this is almost certainly something in my ;; Gnus configuration ;; ;; Behavior I expect: my post to MailingListFoo to be "split" ;; (via `nnmail-split-fancy') into the Gnus newsgroup where ;; all other mail to that list goes. The behavior I actually ;; get: everyone else's posts to that list get put correctly ;; into that Gnus group, but my own mails are nowhere to be ;; seen. ;; ;; The value of `gnus-ignored-from-addresses' is nil (though ;; Emacs says 'Original value was "kfogel {_AT_} ;; red-bean\\.com"' (except with a real @-sign, disguised for ;; spam here in IRC). I can't see anything else in my ;; configuration that would cause this. ;; ;; I doubt this is it, but is it possible that the mails you ;; sent to that list are read, so you aren't seeing them in ;; the group? ;; ;; atw: That's interesting. They would still be *in* the ;; group, then, just marked as read. But I don't see them in ;; the group at all, and also there's no reason why they ;; should be considered read by Gnus. ;; ;; I didn't think that was it but that's the kind of mistake I ;; make with gnus :) ;; ;; atw: I make many mistakes with Gnus. This particular one ;; I've been making for a long time, and it's not been worth ;; fixing. But right now I happen to have a mailing list post ;; from myself sitting in the server spool, waiting, so this ;; is my chance to debug/test a solution. ;; ;; `gnus-gcc-mark-as-read'? ;; ;; n2o4: Hey, wow, that variable is set to `t' but claims its ;; original value was `nil'. I wonder if that's it! Looking ;; into it further now. ;; ;; Hope that clears it up! ;; ;; n2o4: (Although that still wouldn't explain why my mails ;; don't show up in the group at all. If they're just marked ;; as 'read', then they should still be there when I view the ;; full group -- e.g., not just unreads, but everything.) ;; ;; Hmm, true. ;; ;; n2o4: Nope, no effect. I changed it to `nil' and fetched ;; mail (I have a script that lets me do a sneak preview of ;; the mail spool on my remote server before Gnus fetches it, ;; so I knew that there were two posts from me waiting). ;; ;; n2o4: Anyway, the result was: those two messages still ;; don't show up anywhere that I can see. ;; ;; n2o4: I do have headers like "Gcc: ;; nnfolder+archive:sent.2021-07" on every outbound email, ;; though -- your guess was a good one. ;; ;; There's your answer then, though? Check those nnfolder's ;; for your sent messages? ;; ;; `gnus-suppress-duplicates' ? ;; ;; also, `gnus-summary-ignore-duplicates' ;; ;; (kfogel, the ones you fetch would be duplicates of the ones ;; in the nnfolder) ;; ;; True. Sorry, my brain is groggy right now. ;; ;; jao: thank you. Some progress in debugging here (possibly ;; of interest to n204 as well): I just discovered that my ;; ~/.nnmail-cache file *does* contain the message IDs of the ;; mails I sent to that mailing list, but there is no group ;; name next to the message ID. Furthermore, I have these two ;; settings: `(setq nnmail-cache-accepted-message-ids t)' and ;; `(setq nnmail-cache-ignore-groups ".*\\.self")' ;; ;; there is also `nnmail-treat-duplicates' ;; ;; if you're using nnmail ;; ;; jao: heh. `nnmail-treat-duplicates': "Its value is ;; ‘delete’. Original value was ‘warn’" ;; ;; that might be it ;; ;; jao: Yes, I am using nnmail. ;; ;; jao: Whew. Okay, I have some more experimenting to do, but ;; I think thanks to the help here I'm on the right track. ;; ;; excellent ;; ;; jao: (I have to wait until the next time I have a post to ;; some mailing list available to do another test, and I don't ;; feel like setting up a test mailing list just for this, so ;; it'll be a slow process :-) .) ;; ;; fair enough :) ;; ;; In addition to this variable, the ones below (`nnmail-cache-ignore-groups', ;; `nnmail-message-id-cache-length', and `nnmail-cache-accepted-message-ids') ;; may be worth looking at. (setq nnmail-treat-duplicates 'warn) ;; If the above setting of `warn' leads to adverse consequences, then ;; some kind of function value is the next step. I haven't finished ;; thinking about that solution yet, but below is a start. ;; ;; (setq nnmail-treat-duplicates (lambda (msg-id) ;; (save-match-data ;; ;; The Message-ID headers on all my ;; ;; mails look something like this: ;; ;; <87sf5xg3yh.fsf@red-bean.com> ;; ;; That's enough of a heuristic to ;; ;; run with. If we wanted to be ;; ;; even more certain of avoiding a ;; ;; false positive answer to the ;; ;; question "Is this mail from me?" ;; ;; then we could investigate the ;; ;; sender headers directly, since at ;; ;; the point when this function is ;; ;; called we're in a buffer narrowed ;; ;; to the article (i.e., the mail). ;; ;; But I see no need for that: in ;; ;; all my sent mail since 2022-01-01 ;; ;; there are, like, seven messages ;; ;; that don't match this regexp, and ;; ;; the circumstances under which ;; ;; they happen never involve me ;; ;; posting to a mailing list anyway. ;; (if (string-match ;; "[a-z0-9]\\.fsf\\(_-_\\)?@red-bean\\.com" ;; msg-id) ;; 'delete)))) ;; See "Fancy Mail Splitting" in the Gnus Info pages. (setq nnmail-message-id-cache-length 100000) (setq nnmail-cache-accepted-message-ids t) (setq nnmail-cache-ignore-groups ".*\\.self") ;; See documentation in "(gnus) Mail Spool" info page. (setq nnml-use-compressed-files ".gz") ;; It may be primitive, but at least I know how to deal with it: (setq gnus-default-article-saver 'gnus-summary-save-in-file) ;; Other news readers? I don't believe they exist. (setq gnus-save-newsrc-file nil) ;; I hate long goodbyes. (setq gnus-interactive-exit nil) ;; In a just society, position is independent of status. (setq gnus-summary-goto-unread 'never) ;; Pleeeeeze don't do crossposting in my mail groups, pretty please... (setq nnmail-crosspost nil) ;; Standards, people, standards! (setq-default gnus-large-newsgroup nil) ;; I like topic mode. ;; (Well, I don't. -kff) ;; (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) ;; I tried changing my name to "->", but the judge wouldn't let me. (setq gnus-ignored-from-addresses nil) (defun kf-gnus-summary-mark-as-expirable (&optional parg) (interactive "p") (let ((o_pt (point))) (gnus-summary-mark-as-expirable parg) (when (= (point) o_pt) (forward-line 1)))) (defun kf-gnus-summary-next-page (&optional lines circular) "See the documentation for gnus-summary-next-page." (interactive) (let ((gnus-show-mime current-prefix-arg)) (gnus-summary-next-page lines circular t))) (defun kf-gnus-summary-reply-to-list (&optional quoting) "Reply to just the mailing list for a post, maybe QUOTING the original. Depends on the \"list-post: \" header being present." (interactive) (if quoting (gnus-summary-reply-with-original) (gnus-summary-reply)) (message "This is in progress, don't use it yet.")) (defun kf-gnus-summary-reply-to-list-quoting () "See `kf-gnus-summary-reply-to-list'." (interactive) (kf-gnus-summary-reply-to-list t)) ;; Always include the Message-ID and Reply-to headers... (with-eval-after-load 'message ;; C.f. `kf-strip-inhuman-headers-internal', which has some code ;; that might some day use `message-forward-included-headers'. (dolist (header-re (list "^Message-ID:" "^Reply-to:")) (unless (member-ignore-case header-re message-forward-included-headers) (setq message-forward-included-headers (cons header-re message-forward-included-headers))))) ;; ...and sometimes one just wants *every* header: (defun kf-gnus-summary-mail-forward (&optional all-headers) "Forward the current message. If prefix argument ALL-HEADERS is non-nil, forward it with all headers; otherwise forward it with just the headers listed in `message-forward-included-headers'. I wrote this custom replacement for `gnus-summary-mail-forward' because I don't care about any of the prefix arg behaviors that function offers, but I do care about being able to forward a complete message with all headers included from time to time." (interactive "P") (let ((message-forward-included-headers (if all-headers nil message-forward-included-headers)) (message-forward-ignored-headers (if all-headers nil message-forward-ignored-headers))) (gnus-summary-mail-forward))) (defun kf-gnus-summary-mode-hook () ;; Reverse "e" and "E" bindings in summary mode, because I expire far ;; more often than I edit. Stop that -- you know what I mean! (let ((binding (keymap-lookup nil "e"))) (keymap-local-set "e" 'gnus-summary-mark-as-expirable) (keymap-local-set "E" binding)) ;; Make it easier to view MIME messages. (cond ((eq (keymap-lookup nil "") 'gnus-summary-next-page) (keymap-local-set "" 'kf-gnus-summary-next-page)) ((eq (keymap-lookup nil "") 'kf-gnus-summary-next-page) nil) ; do nothing (t (message "Key SPACE has a binding, don'cha know?"))) ;; Make it easier to forward messages the way I like to. (cond ((eq (keymap-lookup nil "C-c C-f") 'gnus-summary-mail-forward) (keymap-local-set "C-c C-f" 'kf-gnus-summary-mail-forward)) ((eq (keymap-lookup nil "C-c C-f") 'kf-gnus-summary-mail-forward) nil) ; do nothing (t (message "Key C-c C-f is being awfully forward today, hmm.")))) (add-hook 'gnus-summary-mode-hook 'kf-gnus-summary-mode-hook) (defun kf-gnus-grab-url-if-any () "Grab URL (if any) around point in a message, else error politely. The motivation for this is complex: Gnus Message Mode renders highlighted text and hyperlinked text in a visually identical way: both are just boldface. Thus if you go into a message and type `u' to grab the URL for the hyperlinked text around point, you *might* get a URL (if there is indeed a URL behind the boldface text) because `gnus-article-copy-string' will be invoked because the hyperlocal active keymap is `gnus-url-button-map', or you might accidentally invoke `gnus-summary-tick-article-forward', which is what `u' is bound to in `gnus-summary-mode-map', which in turn is active in Gnus Message Mode buffers via `gnus-article-read-summary-keys'. Well, accidentally invoking `gnus-summary-tick-article-forward' is a highly unpleasant experience: you leave the current article and move on to the next one, which now gets marked as read. Ugh. I never use `u' in this way even on purpose, so I certainly don't want to do it by accident. This function is thus *really* a replacement for the binding of `gnus-summary-tick-article-forward' in `gnus-summary-mode-map', except that it Does The Right Thing if point happens to be in hyperlinked text too -- even though that shouldn't ever happen in practice, because in that circumstance `gnus-url-button-map' will be overriding `gnus-article-mode-map' and thence `gnus-summary-mode-map', and so `gnus-article-copy-string' would be run directly from `gnus-url-button-map' anyway, not from here. Got that? Good. I knew you would." (interactive) (unless (gnus-article-copy-string) (message "(Nothing copied -- no `gnus-string' property to copy here.)"))) (defun kf-gnus-article-mode-hook () ;; Make it not costly to try to grab a URL from non-hyperlinked text. (cond ((eq (keymap-lookup nil "u") 'gnus-article-read-summary-keys) ;; `gnus-article-read-summary-keys' would normally pass "u" ;; through to `gnus-summary-tick-article-forward', but the former ;; is what shows as the keybinding, not the latter. (keymap-local-set "u" 'kf-gnus-grab-url-if-any)) ((eq (keymap-lookup nil "u") 'kf-gnus-grab-url-if-any) nil) ; do nothing (t (message "Key `u' is no longer `gnus-summary-tick-article-forward'.")))) (add-hook 'gnus-article-mode-hook 'kf-gnus-article-mode-hook) ;; Tricks from https://github.com/jwiegley/dot-emacs/blob/master/dot-gnus.el ;; plus some email instructions from John: Message-IDs are ;; and , ;; "Re: [Emacs-diffs] master b88e7c8: Make transpose-regions interactive (Bug#30343)" ;; ;; Still setting up. ;; ;; (setq gnus-summary-line-format ;; ;; Default was "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" as of [2018-03-20] ;; (concat "%ur" gnus-summary-line-format)) ;; ;; (defun gnus-user-format-function-X (header) ;; (let* ((to (or (cdr (assoc 'To (mail-header-extra header))) "")) ;; (cc (or (cdr (assoc 'Cc (mail-header-extra header))) "")) ;; ) ;; (if (and recipients to-address (not (member to-address recipients))) ;; (propertize "X" 'face 'font-lock-warning-face) ;; " "))) ;; ;; (defun gnus-user-format-function-r (header) ;; "Given a Gnus message header, returns priority mark. ;; Here are the meanings: ;; The first column represent my relationship to the To: field. It can be: ;; I didn't appear (and the letter had one recipient) ;; : I didn't appear (and the letter had more than one recipient) ;; < I was the sole recipient ;; + I was among a few recipients ;; * There were many recipients ;; The second column represents the Cc: field: ;; I wasn't mentioned, nor was anyone else ;; . I wasn't mentioned, but one other was ;; : I wasn't mentioned, but others were ;; ^ I was the only Cc mentioned ;; & I was among a few Cc recipients ;; % I was among many Cc recipients ;; X This is a mailing list, but it wasn't on the recipients list ;; These can combine in some ways to tell you at a glance how visible the message ;; is: ;; <. Someone wrote to me and one other ;; & I was copied along with several other people ;; *: Mail to lots of people in both the To and Cc!" ;; (ignore-errors ;; (let* ((to (or (cdr (assoc 'To (mail-header-extra header))) "")) ;; (cc (or (cdr (assoc 'Cc (mail-header-extra header))) "")) ;; (to-len (length (split-string to "\\s-*,\\s-*"))) ;; (cc-len (length (split-string cc "\\s-*,\\s-*"))) ;; (msg-recipients (concat to (and to cc ", ") cc)) ;; (recipients ;; (mapcar 'mail-strip-quoted-names ;; (message-tokenize-header msg-recipients))) ;; (to-address ;; (alist-get 'to-address ;; (gnus-parameters-get-parameter gnus-newsgroup-name))) ;; (privatized ;; (and recipients to-address (not (member to-address recipients))))) ;; (cond ((string-match gnus-ignored-from-addresses to) ;; (cond ((= to-len 1) ;; (cond (privatized "" "ALT_TEXT") (search-backward "uploads/") (forward-word 1) (forward-char 1)) (defmacro kf-do-on-lines (start end &rest body) "Run BODY at each line start of every line from START to END." (declare (indent 2)) `(save-excursion (save-restriction (save-match-data (goto-char ,start) (while (< (point) ,end) (beginning-of-line) ,@body (forward-line 1)))))) (defun kf-number-lines (&optional start-num) "Number lines starting from line of point. START-NUM defaults to 1. If there is an active region, number the lines just in that region." (interactive (list (read-number "Number lines, starting with: " 1))) (or start-num (setq start-num 1)) (let ((start-posn (point)) (end-posn (point-max))) (when (use-region-p) (setq start-posn (use-region-beginning) end-posn (use-region-end))) (setq end-posn (copy-marker end-posn)) (kf-do-on-lines start-posn end-posn (insert (number-to-string start-num) " ") (setq start-num (1+ start-num))))) (defun kf-find-longest-line () "Go to the start of the (character-wise) first longest line in the buffer. It can be useful to combine this with `kf-push-to-column'." (interactive "") (let ((site nil) (cur-max 0)) (kf-do-on-lines (point) (point-max) (let ((beg-point (point))) (end-of-line) (let ((len (- (point) beg-point))) (when (> len cur-max) (setq cur-max len site beg-point))))) (goto-char site))) (define-skeleton kf-standard-html-page "Insert standard HTML page." "Title: " "\n\n" "\n" "\n" "\n" "\n" "" - str '(kf-htmlegalize-region skeleton-point (point)) "" \n "\n" "\n" "\n" "

" - str '(kf-htmlegalize-region skeleton-point (point)) "

\n" "\n" "
    \n" "

  • " - "

    • \n" "

    • \n" "

    • \n" "
\n" "\n" "\n" "\n") (defun kf-clean-html (start end) "Clean up HTML pasted into a text buffer from a web page. But, this isn't working quite right yet." (interactive "*r") ;; todo: make chars, not strings, and this might work (let ((open-double-quote (make-string 3 0)) (close-double-quote (make-string 3 0)) (funderscore ? ) (apostrophe (make-string 3 0))) (aset open-double-quote 0 ?â) (aset open-double-quote 1 128) (aset open-double-quote 2 156) (aset close-double-quote 0 ?â) (aset close-double-quote 1 128) (aset close-double-quote 2 157) (aset apostrophe 0 ?â) (aset apostrophe 1 128) (aset apostrophe 2 153) (save-excursion (goto-char start) (replace-string apostrophe "'" nil start end)))) ;;; QCO helpers. (let ((qco-el (expand-file-name "~/src/questioncopyright/cm/bin/qco.el"))) (when (file-exists-p qco-el) (load qco-el))) ;;; The PHP Mode mess. Let us celebrate diversity. (let ((php-mode-root (expand-file-name "~/src/php-mode"))) ;; Get it from https://github.com/ejmr/php-mode. (when (file-exists-p php-mode-root) (add-to-list 'load-path php-mode-root) (autoload 'php-mode "php-mode" nil t) (add-to-list 'auto-mode-alist '("\\.php$" . php-mode)))) ;;; Just for now, for writing LISC TTM code. (defun kf-mysqli-safe-wrapper () (interactive) (insert "mysqli_real_escape_string(")) (defun kf-sqlsafe-extension () (interactive) (insert "_sqlsafe") (kill-new "_sqlsafe")) ;;; Ledger Mode helpers. (let ((ledger-mode-el (expand-file-name "~/src/ledger/lisp/ledger-mode.el"))) ;; Hint: git clone git://github.com/jwiegley/ledger.git (when (file-exists-p ledger-mode-el) (add-to-list 'load-path (expand-file-name "~/src/ledger/lisp")) (autoload 'ledger-mode "ledger-mode" nil t) (add-to-list 'auto-mode-alist '(".*\\.ledger" . ledger-mode)))) (defun kf-ledger-narrow-to-entry () "Narrow the region to the current ledger entry." (interactive) (let* ((bounds (ledger-current-entry-bounds)) (boe (car bounds)) (eoe (cdr bounds))) (narrow-to-region boe eoe))) ;;; I'm finally trying Magit (https://magit.vc/), as of 2020-12-21. ;; ;; 2021-12-17 update: Well, after claiming for almost exactly a year ;; that I'm trying Magit, it's time to admit that I'm not actually ;; trying Magit yet. I plan to; it's obviously the right tool for the ;; job. But the problem is... well, there are two problems. One is ;; that all the little helper functions I'd written in the millennia ;; before Magit existed have turned out to be so darned handy, and I'm ;; so darned used to them, that the pressure to switch to Magit is ;; much less than it might otherwise be. And two, there's suddenly ;; some build problem whereby building Magit from source stopped ;; working, at least in the way I had been doing it. Basically, I ;; build its dependencies first, including with-editor, and then add ;; them to LOAD_PATH explicitly in Magit's config.mk file... and that ;; worked fine for a year, but now something's changed, and it's ;; taking more than ten minutes to debug and I don't have time for ;; this nonsense when I've got work to do, and I wasn't really using ;; Magit anyway, so I've just stopped building or loading it for now. ;; When I finally make the move to invest in Magit, I'll solve this. ;; ;; https://magit.vc/manual/magit/Installing-from-the-Git-Repository.html ;; explains the dependencies for building Magit from latest sources. ;; (Confidential to kfogel: ~/private/bin/upall has a build block at ;; the end for this stuff, though as per above it's broken right now.) ;; ;; (when (file-exists-p (expand-file-name "~/src/magit")) ;; (add-to-list 'load-path (expand-file-name "~/src/dash")) ;; (add-to-list 'load-path (expand-file-name "~/src/transient/lisp")) ;; (add-to-list 'load-path (expand-file-name "~/src/with-editor")) ;; (add-to-list 'load-path (expand-file-name "~/src/magit/lisp")) ;; (require 'magit) ;; (with-eval-after-load 'info ;; (info-initialize) ;; (add-to-list 'Info-directory-list ;; (expand-file-name "~/src/magit/Documentation/")))) ;; Tips from https://magit.vc/manual/magit/: ;; Use `magit-toggle-verbose-refresh' to debug, if things are slow. ;; ;; https://magit.vc/manual/magit/Default-Bindings.html says: ;; ;; C-x g magit-status ;; C-x M-g magit-dispatch ;; C-c M-g magit-file-dispatch ;;; Some stuff I used Before Magit [1]: ;; ;; [1] https://twitter.com/arnemart/status/527424320659017728, ;; and see also https://magit.vc/quotes/quotes.js.) ;; ;; I'd heard about Magit for years, but for a long time all I really ;; wanted was completion on branch names and such in my shell buffer. ;; masteringemacs.org/article/pcomplete-context-sensitive-completion-emacs ;; helped me arrange that with pcomplete. That plus `kf-logup' and ;;`kf-show-change' gave me a fair amount of Magit offers, albeit in a ;; klugey and brittle way. But we were happy, aye, we were happy then! (defun kf-git-extract-local-branch (full-branch-name) "Return a local branch name for checkout, based on FULL-BRANCH-NAME. E.g., FULL-BRANCH-NAME might be \"remotes/origin/blah\"; this function returns \"blah\"." (let ((prefixes-to-strip '("remotes/origin/HEAD -> origin/" "remotes/origin/"))) (catch 'ret (mapcar (lambda (prefix) (when (string-prefix-p prefix full-branch-name) (throw 'ret (substring full-branch-name (length prefix))))) prefixes-to-strip) full-branch-name))) (defun kf-uniqify-list (lst) "Return a copy of LST in the same order but with elements unduplicated." (let (out) (while lst (when (not (member (car lst) out)) (setq out (cons (car lst) out))) (setq lst (cdr lst))) (nreverse out))) (defun kf-pcmpl-git-get-branches () "Return a list of `git' branches for the current directory." (with-temp-buffer (insert (shell-command-to-string "git branch -a")) (goto-char (point-min)) (save-match-data (let ((branch-list nil)) (while (not (eobp)) (cond ((looking-at "^[ *] \\([-_.a-zA-Z0-9/+> ]+\\)$") (add-to-list 'branch-list (kf-git-extract-local-branch (match-string 1)))) ((looking-at "^[ *] (HEAD detached at [a-z0-9]+)") ;; Do nothing -- just ignore detached HEADs. ) (t ;; If the regexp doesn't know how to handle this kind of ;; branch name, tell us so we can update the regexp. (error "Unrecognized git branch name: '%s'" (buffer-substring (+ (point) 2) (save-excursion (end-of-line) (point)))))) (forward-line 1)) ;; Completion would actually do fine even if there were ;; duplicates, but for cleanliness we eliminate them. The ;; kinds of duplicates we would have are, e.g., the "master" ;; branch might appear as " master" (or "* master") and as ;; " remotes/origin/HEAD -> origin/master" and as ;; " remotes/origin/master" in 'git branch -a' output, all ;; of which should fold into one "master" entry for checkout. (kf-uniqify-list branch-list))))) (defconst kf-pcmpl-git-commands '("diff" "pull" "status" "branch" "checkout" "show-branch") "The few `git' commands that I want completed.") (defvar kf-pmcpl-completing-branch-names-p t "Non-nil means choose branch names as opposed to directory entries. This can be toggled off by C-g during completion in `pcomplete/git'; it will automatically reset to non-nil between completion exercises.") (defun kf-pcmpl-try-completion-hook () "Offer a toggle between branch name and directory entry completion. This function treats `.' as a special flag when completing: if the user types `.' and continues completing, this hook swallows the `.' and toggles whether `pcomplete/git' (which see) completes branch names or directory entries." (save-excursion (forward-char -1) (when (looking-at "\\.\\s-?") (delete-char 1) (setq kf-pmcpl-completing-branch-names-p (not kf-pmcpl-completing-branch-names-p))))) (add-hook 'pcomplete-try-first-hook 'kf-pcmpl-try-completion-hook) (defun pcomplete/git () "Custom completion for the things I do most often with git. On certain commands, e.g., 'git checkout', branch names and directory entries are both reasonable completion goals. Since it's impossible to know which the user wants, this function uses `.' as a toggle signal. While completing, if you are getting completion on one kind (say, branch names) but you want the other kind (directory entries), just type `.' and then continue completing. The `.' will be eaten and the completion behavior will toggle." (pcomplete-here* kf-pcmpl-git-commands) (cond ((pcomplete-match "checkout" 1) (while (pcomplete-here* (if kf-pmcpl-completing-branch-names-p (kf-pcmpl-git-get-branches) (pcomplete-entries))))) ((pcomplete-match "show-branch" 1) (while (pcomplete-here* (kf-pcmpl-git-get-branches)))) ((pcomplete-match "diff" 1) (pcomplete-here* (list "--cached"))) ((pcomplete-match "pull" 1) (pcomplete-here* (list "--rebase"))) )) ;; Go Mode helpers. (let ((go-mode-el (expand-file-name "~/src/go-mode.el/go-mode-autoloads.el"))) ;; Hint: git clone https://github.com/dominikh/go-mode.el (when (file-exists-p go-mode-el) (add-to-list 'load-path (expand-file-name "~/src/go-mode.el")) (require 'go-mode-autoloads))) (defun kf-go-mode-hook () (add-hook 'before-save-hook #'gofmt-before-save)) (add-hook 'go-mode-hook 'kf-go-mode-hook) ;; What's Corcoran got that I ain't got? (defun kf-how-bad-could-it-be (sale-price) "Determine what happens with if I sell my apartment for SALE-PRICE." (let ((principal 203179.92) ;; remaining mortgage principal (commission (* sale-price .06)) (attorney 1850) (move-out 100) (share-tax (* sale-price .01425)) (fudge-factor 2000) (ucc3-filing 125) (transfer-agent-fee 600)) (- sale-price principal commission attorney move-out share-tax ucc3-filing transfer-agent-fee fudge-factor))) ;; (kf-how-bad-could-it-be 223000.00) ;; Zero point: $224526.00 ;; Copied from http://edward.oconnor.cx/config/.gnus and mildly tweaked. (defun ted-follow-link-at-point (point) "Try to follow an HTML link at point. This works for links created by w3, w3m, and on URLs embedded in text." (interactive "d") (let* ((props (text-properties-at point)) (url (or (plist-get (plist-get props 'w3-hyperlink-info) :href) (plist-get props 'w3m-href-anchor) (thing-at-point 'url) (error "Couldn't determine link at point.")))) ;; (browse-url url) (message url) )) (defun kf-reverse-lines-region (b e) "Reverse the order of lines containing B (inclusive) to E (exclusive)." (interactive "r") ;; There are two ways to do this: the Emacs way, and the easy way. ;; We're going to do it the easy way. (save-excursion (let ((lines ()) (b (progn (goto-char b) (beginning-of-line) (point))) (e (progn (goto-char e) (beginning-of-line) (point)))) (goto-char b) (while (< (point) e) (setq lines (cons (buffer-substring (point) (progn (forward-line 1) (point))) lines))) (delete-region b e) (mapcar 'insert lines)))) (defun kf-reverse-words (b e) "Reverse the order of words in the region from B to E." (interactive "*r") (apply 'insert (reverse (split-string (delete-and-extract-region b e) "\\b")))) ;; From https://www.emacswiki.org/emacs/RandomizeWords (defun randomize-region (beg end) "Randomize the order of words in region." (interactive "*r") (let ((all (mapcar (lambda (w) (if (string-match "\\w" w) ;; Randomize words, (cons (random) w) ;; keep everything else in order. (cons -1 w))) (split-string (delete-and-extract-region beg end) "\\b"))) words sorted) (mapc (lambda (x) ;; Words are numbers >= 0. (unless (> 0 (car x)) (setq words (cons x words)))) all) ;; Random sort! (setq sorted (sort words (lambda (a b) (< (car a) (car b))))) (mapc 'insert ;; Insert using original list, `all', ;; but pull *words* from randomly-sorted list, `sorted'. (mapcar (lambda (x) (if (> 0 (car x)) (cdr x) (prog1 (cdar sorted) (setq sorted (cdr sorted))))) all)))) (defun kf-marketing () "I'm glad to see we're all on the same page in the ballpark here. It's time to finally put a stake in the ground so we can send up a few trial balloons to see just which way the wind is blowing when the rubber meets the road and we pluck the low-hanging fruit." (interactive) (insert (documentation this-command))) (defun kf-til (str) "Learn something about STR today. STR is probably a TLA." (interactive "sTYL: ") (browse-url (format "http://www.urbandictionary.com/define.php?term=%s" (url-encode-url str)))) (defun kf-image-resize (size) "Offer a new size for SIZE (a string like \"282x333\"). After entering both dimensions of the old size, you are prompted for one of the dimensions of the new size. If the horizontal dimension, just enter the number; if vertical, enter \"x\" followed by the number (i.e., the second half of how dimensions are usually represented)." (interactive "sEnter old size (FOOxBAR): ") (save-match-data (string-match "\\([0-9]+\\)x\\([0-9]+\\)" size) (let ((old-x (string-to-number (match-string 1 size))) (old-y (string-to-number (match-string 2 size))) (new-x nil) (new-y nil) (new-dimension (read-string "Enter new dimension (prefix with \"x\" for vertical): "))) (if (= (aref new-dimension 0) ?x) (progn (setq new-y (string-to-number (substring new-dimension 1))) (setq new-x (* old-x (/ (float new-y) (float old-y))))) (setq new-x (string-to-number new-dimension)) (setq new-y (* old-y (/ (float new-x) (float old-x))))) (message "New dimensions: %dx%d" new-x new-y)))) (defun kf-what-rights () (interactive "*") (insert "XXX non-exclusive, perpetual, world-wide, irrevocable, ") (insert "no-charge, royalty-free copyright license to reproduce, ") (insert "prepare derivative works of, publicly display, ") (insert "publicly perform, sublicense, and distribute XXX")) (defun kf-format-phone-number () "Format the number at or near point like a phone number. TODO: I don't think this is ready for prime-time yet, just FYI." (interactive "*") (let* ((posns (or (bounds-of-thing-at-point 'word) (bounds-of-thing-at-point 'sexp))) (start (car posns)) (end (copy-marker (cdr posns))) (d "[0-9]") (local-number (concat d d d d d d d)) (number-with-area-code (concat d d d local-number))) (save-excursion (goto-char start) (cond ((looking-at number-with-area-code) (insert "+1 (") (forward-char 3) (insert ") ") (forward-char 3) (insert "-")) ((looking-at local-number) (forward-char 3) (insert "-")) (t (error "Unrecognized type of phone number."))) (goto-char end)))) ;;; Various kinds of auto-insertion. ;;;; (defvar kf-prefixed-yank-kill-ring-pointer nil "Like `kill-ring-yank-pointer', but for `kf-prefixed-yank'.") (defun kf-prefixed-yank (yank-text &optional prefix-text) "Like `yank', but prefixing each line with `prefix-text'. Interactively, YANK-TEXT is whatever's on the front of the kill-ring, and PREFIX-TEXT is whatever's between bol and point. In other words, the interactive behavior is for yanking a block of text such that each line starts out indented to the current column and prefixed by whatever text precedes the yank point." (interactive (list (progn (if (eq last-command 'kf-prefixed-yank) (progn (delete-region (mark) (point)) (setq kf-prefixed-yank-kill-ring-pointer (cdr kf-prefixed-yank-kill-ring-pointer))) (setq kf-prefixed-yank-kill-ring-pointer kill-ring-yank-pointer)) (car kf-prefixed-yank-kill-ring-pointer)) nil ; later code will set prefix-text )) (when (not prefix-text) (setq prefix-text (buffer-substring (point) (save-excursion (beginning-of-line) (point))))) (when (> (length yank-text) 0) (let ((lines (split-string yank-text "[\n\r]"))) (push-mark (point)) (insert (car lines) "\n") (mapcar (lambda (line) (insert prefix-text line "\n")) (cdr lines)) (let ((last-char (aref yank-text (- (length yank-text) 1)))) (delete-region (point) (progn (when (or (char-equal last-char ?\n) (char-equal last-char ?\r)) (forward-line -1)) (forward-char -1) (point))))))) (defun kf-format-time-string (time-val) "Return a date string formatted from TIME-VAL the way I usually want." (format-time-string "%Y-%m-%d %H:%M:%S %Z" time-val)) (defun kf-insert-date (&optional thorough) "Insert the current date (with day-of-week and time-of-day iff THOROUGH). If there is only whitespace or nothing between point and the first column, then prepend asterisk + space and postpend colon + space." (interactive "P") (let* ((decorate nil) (span (buffer-substring-no-properties (point) (save-excursion (beginning-of-line) (point))))) (save-match-data (when (string-match "^\\s-*$" span) (setq decorate t))) (insert (format-time-string (format "%s%s%%Y-%%m-%%d%s%s" (if decorate "* " "") (if thorough "%A, " "") (if thorough " (%H:%M:%S)" "") (if decorate ": " "")))) (when thorough ;; Position cursor on the start of the time portion, since ;; that's what's most likely to need editing right now. (re-search-backward "([0-9]") (forward-char 1)))) ;; ComicPress / Mimi and Eunice (mimiandeunice.com) (defun kf-m&e-get-embed-link (url &optional add-to-kill-ring) "Return the embed link for Mimi & Eunice comic URL. If optional argument ADD-TO-KILL-RING is non-nil, then also add the embed link to the front of the kill-ring. This function compensates for a bug (or feature-lack) in ComicPress: there is no programmatic API (like a REST request) for converting a comic's main URL into its embed code or embed image URL. For example, http://mimiandeunice.com/2011/08/23/legal-fictions/ is a main page, then .../wp-content/uploads/2011/08/ME_446_LegalExistence-640x199.png is the corresponding embed link." (require 'url) (let ((embed-url nil)) (save-excursion (set-buffer (url-retrieve-synchronously url)) (goto-char (point-min)) (search-forward ">Embed this comic") (search-forward "src=\"") (setq embed-url (buffer-substring-no-properties (point) (progn (search-forward "\"") (1- (point)))))) (when add-to-kill-ring (kill-new embed-url)) embed-url)) (defun kf-m&e-embed-link-for-url-at-point () "Call kf-m&e-get-embed-link on URL at point, with add-to-kill-ring=t." (interactive) (let ((url (thing-at-point 'url))) (if url (kf-m&e-get-embed-link url t) (error "No Mimi & Eunice URL at point.")))) ;;;; Automated typo correction ;;;; ;;; Note: It turns out that `flyspell-mode' offers similar ;;; functionality, albeit with a somewhat different user interface. (defconst kf-words (let ((dict (make-hash-table :test 'equal :size 100000))) (dolist (word-source (list "/usr/share/dict/words" (expand-file-name "~/private/.aspell.en.pws")) dict) (when (file-exists-p word-source) (save-excursion (set-buffer (find-file-noselect word-source)) (goto-char (point-min)) (while (< (point) (point-max)) (let ((this-line-word (buffer-substring-no-properties (point) (progn (end-of-line) (point))))) (puthash this-line-word 0 dict) (let ((capitalized (capitalize this-line-word)) (downcased (downcase this-line-word)) (upcased (upcase this-line-word))) (when (not (string-equal capitalized this-line-word)) (puthash capitalized 0 dict)) (when (not (string-equal downcased this-line-word)) (puthash downcased 0 dict)) (when (not (string-equal upcased this-line-word)) (puthash upcased 0 dict))) (forward-line 1))) (kill-buffer))))) "Hash table whose keys are English words and whose values are ignored.") (defun kf-cleave-compound-word (divider) "Divide the compound word at point into its two words using DIVIDER and leave point at the end. For example, calling this with \"-\" as DIVIDER and point in front of the word \"overinvest\" changes the word to \"over-invest\" and leaves point after the \"t\". If the word at point is not cleaveable, then try to un-cleave instead. Meaning: if that word is separated from the next word by one or more consecutive instances of DIVIDER, then delete the dividers and move point to the end of the newly joined word." (let ((opoint (progn (if (looking-at "\\s-*$") (forward-word -1) (progn (forward-word) (forward-word -1))) (point))) (epoint (copy-marker (progn (forward-word) (point)))) (word-p (lambda (candidate) (gethash candidate kf-words)))) (catch 'done (while (> (point) opoint) (let ((fword (buffer-substring-no-properties opoint (point))) (bword (buffer-substring-no-properties (point) epoint))) (when (and (> (length fword) 1) (> (length bword) 1) (funcall word-p fword) (funcall word-p bword)) (insert divider) (goto-char epoint) (throw 'done nil))) (forward-char -1)) ;; If we made it to here, then the word was not cleaveable, so ;; try un-cleaving instead. (forward-word 1) (let ((uncleaved-p nil)) (while (looking-at divider) (setq uncleaved-p t) (delete-char 1)) (when uncleaved-p (forward-word 1)))))) (defun kf-hyphenate () "Call `kf-cleave-compound-word' (which see) with \"-\"." (interactive) (kf-cleave-compound-word "-")) (defun kf-enspacen () "Call `kf-cleave-compound-word' (which see) with \" \"." (interactive) (kf-cleave-compound-word " ")) (defun kf-section-heading-line (thicker) "Insert a section heading line beneath an existing section header. For example, if point is at the start of the line underneath this... ;; # Some section name ...then add a new line matching the upper line's length: ;; # Some section name ;; ------------------- Optional prefix arg THICKER means use equal signs instead of hyphens to make the line." (interactive "P") (let* ((prefix (save-excursion (forward-line -1) ;; What we really need is an heuristic for finding ;; the true end of (perhaps multiple) comment ;; prefixes and the start of the section name. ;; But for now, this will do. (skip-chars-forward (make-string 1 (char-after))) (skip-chars-forward " \t") (buffer-substring (point) (progn (beginning-of-line) (point))))) (len (save-excursion (let ((col (progn (forward-line -1) (end-of-line) (while (and (not (bolp)) (member (char-before) (list ? ?\t))) (forward-char -1)) (current-column)))) (max 1 (- col (length prefix)))))) (line-char (if thicker ?= ?-))) (insert prefix (make-string len line-char) "\n"))) (defvar kf-fix-typo-current-failed-candidates () "Failed candidates so far in a consecutive series of automated typo fixes, e.g., across successive invocations of `kf-fix-previous-transposition'. The format is simply a list of the failures. The first element in the list is always the original word -- that is, the one the user originally invoked the typo corrector on -- since by definition that word is a failure.") (defun kf-fix-typo-consider-candidate (candidate) "Return non-nil iff current typo-fix CANDIDATE could succeed. This means it is a word, and has not been rejected previously by the user." (and (gethash candidate kf-words) (not (member candidate kf-fix-typo-current-failed-candidates)))) (defun kf-previous-command-was-typo-fix-attempt () "Return non-nil iff the last command was one of the typo-fixing commands." ;; As we have more, we'll add them. (equal last-command 'kf-fix-previous-transposition)) ;; TODO: On 2020-08-18 this failed to fix "enrcypting", even though ;; the dictionary seems to know about "encrypting". And then ;; again on 2021-11-08, it failed to fix "enhancemnets" even ;; though the dictionary knows about "enhancements". On ;; 2021-12-14, it happened again with "permissions". ;; ;; And aha, I think I know what the problem is: stemming. The ;; `kf-words' list is just a hash table of strings, but what ;; ispell and its ilk do is more sophisticated than merely ;; looking up strings; they know stemming rules for English and ;; so can generate words like "encrypting" and "enhancements" ;; from their base words. Thus, the original word list often ;; just has the base words, because ispell will handle the ;; stemming at run time. ;; ;; The obvious solution in `kf-fix-typo-consider-candidate' is ;; if the hash lookup fails then try running ispell next. ;; Unfortunately, ispell doesn't have the nice clean entry ;; points you'd expect. `ispell-word' isn't it (that operates ;; on point in the buffer, not on a string) and the helper ;; function `ispell--run-on-word' doesn't just take a raw string ;; as its argument -- if you try that, you get an error about ;; "Ispell and its process have different character maps". So ;; we have to marinate the word in some kind of sauce in order ;; to prepare it for digestion by ispell. I haven't yet learned ;; what that sauce is, but when I do, I'll fix this problem. (defun kf-fix-previous-transposition () "Fix a single transposition in the previous word. If no transposition fix is possible, then try splitting the word before point as a compound word by using `kf-split-word'. If neither of those fixes works, then leave point in the middle of the previous word so the user can fix things by hand. The return value is currently undefined; do not depend on it. If this function offers a transposition fix, then repeated invocation with no intervening commands will try another transposition fix (if any is available) that has not been previously offered within this invocation sequence. In other words, this runs successively through the various potential fixes of the original word that are reachable via transposition -- often there are several possibilities -- with each successive attempt signaling rejection of all previous candidates. For example, if point is after \"baen\", the first invocation will produce \"bane\", then the next one will produce \"bean\", which might be the user's real target. (My favorite example of this is that one time I accidentally typed \"veince\"; the first invocation of this function turned that into \"venice\", but an immediate re-invocation then turned it into the word I'd intended: \"evince\".) \(See also `flyspell-mode' and `flyspell-auto-correct-previous-word', which offers similar functionality but in a somewhat different way.\) That fallback to `kf-split-word' doesn't really have anything to do with fixing transpositions, of course. A better design would be to have a generic `fix-problem-in-previous-word' function, and have it run through a registry of things to try: - Run the transposition across the previous *two* words? (Often the typo is of the form, e.g., \"fis hfood\" when one meant to type \"fish food\". Expanding the window to two words can fix that kind of typo too. But note there's no point expanding to three words: by the time it's happened with two words the user has noticed it and is ready to run the corrector.) - Else try adding a single space? (Because a frequent typo is to fail to separate two words. This can re-use the check-two-words logic.) - Else try eliminating one letter? (Because a frequent typo is the insertion of a spurious letter.) - Else try adding each letter in each position? (Because a frequent typo is to accidentally drop one letter.) Right now, we implement the first two steps, but in a rather klunky way: when the transposition function gives up, it hands off to the splitting function. While the user-visible behavior is fine, at least for now, this implementation is a poor design because it of the way it entangles responsibilities. If something was done in an invocation, remember what it was so that the next immediately successive invocation can undo it and try the next technique on the list. E.g., if it transposed two chars but that turned out to be the wrong fix, then immediately invoking the function again should undo the transposition and try adding a letter instead; if that still produces the wrong word, then undo it and try adding a single space. One place to look for a more general correction algorithm is http://norvig.com/spell-correct.html." (interactive) (let* ((orig-pos (point)) (word-first (progn (forward-word -1) (point))) (word-last (progn (forward-word 1) (forward-char -1) (point))) (word-past (1+ word-last)) (word-now (buffer-substring-no-properties word-first (1+ word-last))) (orig-word word-now) (current-pos word-last) (fixed-something nil)) (if (kf-previous-command-was-typo-fix-attempt) (progn ;; Restore the original word, since the point is to start ;; the algorithm over from the beginning state (not some ;; random intermediate state) but this time with a longer ;; list of immediately rejectable candidates. (delete-region word-first word-past) (save-excursion (goto-char word-first) (insert (car kf-fix-typo-current-failed-candidates))) (setq kf-fix-typo-current-failed-candidates (append kf-fix-typo-current-failed-candidates (list word-now)))) ;; Else initialize the rejectables list with the current word. (setq kf-fix-typo-current-failed-candidates (list word-now))) (setq fixed-something (catch 'fixed (while (> current-pos word-first) (goto-char current-pos) (transpose-chars 1) (setq word-now (buffer-substring-no-properties word-first word-past)) (if (kf-fix-typo-consider-candidate word-now) (throw 'fixed t) ;; else undo the transpose chars (forward-char -1) (transpose-chars 1) (setq current-pos (1- current-pos)))))) (goto-char orig-pos) (unless fixed-something ;; If didn't manage to fix it, then try splitting the word, and ;; if *that* doesn't work either, then just put point in the ;; middle of the word, closer to where the user might manually ;; fix it. (or (kf-split-word) (goto-char (/ (+ word-first word-last) 2))) ))) (defun kf-split-word () "Insert a space into the possibly-accidental compound word before point. Put a space between the two halves of the previous compound word (if any). If a split happens, then return point to where it was at the end of the second word; otherwise, leave point in the middle of the overall word (the one that turned out not to be a compound word). For example, if point were after \"downstairs\", then calling this function would turn that into \"down stairs\" with point after the second word. But if point were after \"fxsmnlgr\", then no edit would occur and point would be left on the \"m\"." (interactive) (let ((opoint (copy-marker (point))) (split-p nil)) ; don't even think about it (catch 'found (re-search-backward "[a-zA-Z]") (let ((start-of-word nil) (after-word (1+ (point)))) (forward-word -1) ; beginning of compound word (setq start-of-word (point)) (forward-char 1) (while (< (point) after-word) (let ((first-subword (buffer-substring-no-properties start-of-word (point))) (second-subword (buffer-substring-no-properties (point) after-word))) (when (and (gethash first-subword kf-words) (gethash second-subword kf-words)) (insert " ") (setq split-p t) (throw 'found t))) (forward-char 1)))) (when split-p (goto-char opoint)) split-p)) (defun kf-studly-capitalize () "Try to StudlyCapitalize the WordAroundPoint. On repeated invocation, try AnOtherWay to capitalize. NOTE: This is incomplete and doesn't really work yet." ;; This has subtle bugs. For example, "staledonutsarehardandround" ;; ends up as "StaleDoNuTsAreHardandround". Never mind the obvious ;; non-optimal outcomes in the first part, just look at the tail ;; "Hardandround". The reason it stopped capitalizing is because ;; "Ha" is a word. It never even saw "Hard", so every subsequent ;; string began with "rd..." and therefore never matched. (interactive) (when (thing-at-point 'word) (forward-char 1) (forward-word -1)) (let* ((current-start (point)) (word-starts (list current-start)) (end (prog2 (forward-word 1) (point) (goto-char current-start)))) (while (<= (point) end) (let ((current-word (buffer-substring-no-properties current-start (point)))) (if (or (<= (length current-word) 1) (not (gethash current-word kf-words))) (forward-char 1) ;; (message "%s" (buffer-substring-no-properties current-start (point))) (sit-for 1) (let ((current-end (point))) (goto-char current-start) (capitalize-word 1) (goto-char current-end) (setq current-start (point)))))))) (defun kf-find-rhyme (ending) "Display words that end with ENDING (a string of letters)." (interactive "sEnding: ") (let ((words ()) (re (concat (regexp-quote ending) "$"))) (save-match-data (maphash (lambda (word ignored-value) (when (string-match re word) (setq words (cons word words)))) kf-words) (kf-display-something-maybe-big (string-join words "\n"))))) ;;;; LEDES1998B: the pre-Chicxulub standard. (defun kf-human-to-ledes (b e) "Convert the region B to E from human-readable format to LEDES1998B format. A single human-readable entry looks like this: INVOICE_DATE: 20110810 BILLING_START_DATE: 20110502 BILLING_END_DATE: 20110614 LINE_ITEM_DATE: 20110608 BILLER: Your Name Here LINE_ITEM_DESCRIPTION: Following up with Kim Moskowitz et al about the Slovenian debacle. LINE_ITEM_NUMBER_OF_UNITS: .5 LINE_ITEM_UNIT_COST: 400 LINE_ITEM_TOTAL: 200.00 CLIENT_ID: Global Mega Legal Services CLIENT_MATTER_ID: 652-ZQ-051 There must be at least one blank line between human-readable entries. The order of the fields within an entry does not matter. Missing LEDES fields that are not necessary will be created with the empty strings as content where appropriate, or else some standard boilerplate text. Missing fields that are probably necessary, but for which no boilerplate is possible, will generate an error." (interactive "r") (setq e (make-marker e)) (let* ((prompted-responses (make-hash-table :test 'equal)) (prompt-gen (lambda (field-name specifics) (puthash field-name (read-from-minibuffer "\"%s\" (%s): " field-name specifics) prompted-responses))) (err-gen (lambda (field-name specifics) (if specifics (error "\"%s\" requires a value (%s)." field-name specifics) (error "\"%s\" requires a value.")))) (ledes-1998b-init-string "LEDES1998B[]") ;; Even though LEDES1998B says that both CR and LF are ;; ignored, and that "[]" is the record delimiter, smart ;; writers insert CRLF because there are almost certainly ;; non-compliant readers out there that only speak DOS. (linebreak "\r\n") ;; Canonical ordering of the fields -- don't muck with the order. (ledes-pairs '( ("INVOICE_DATE" prompt-gen "date of the overall invoice") ("INVOICE_NUMBER" prompt-gen "number for the overall invoice") ("CLIENT_ID" prompt-gen "client name, e.g., \"Global Megacorp\"") ("LAW_FIRM_MATTER_ID" prompt-gen "your matter ID, else empty") ("INVOICE_TOTAL" nil) ; filled in dynamically ("BILLING_START_DATE" prompt-gen "YYYYMMDD for start of billing") ("BILLING_END_DATE" prompt-gen "YYYYMMDD for end of billing") ("INVOICE_DESCRIPTION" "For services rendered") ("LINE_ITEM_NUMBER" nil) ; filled in dynamically ("EXP/FEE/INV_ADJ_TYPE" "F") ; or "E" for expense ("LINE_ITEM_NUMBER_OF_UNITS" err-gen) ("LINE_ITEM_ADJUSTMENT_AMOUNT" "") ("LINE_ITEM_TOTAL" err-gen) ("LINE_ITEM_DATE" err-gen) ("LINE_ITEM_TASK_CODE" err-gen) ("LINE_ITEM_EXPENSE_CODE" "") ("LINE_ITEM_ACTIVITY_CODE" "") ("TIMEKEEPER_ID" prompt-gen "your SSN will often suffice") ("LINE_ITEM_DESCRIPTION" err-gen) ("LAW_FIRM_ID" prompt-gen "sending firm's EIN, like \"24-6437381\"") ("LINE_ITEM_UNIT_COST" prompt-gen "your hourly rate") ("TIMEKEEPER_NAME" "") ("TIMEKEEPER_CLASSIFICATION" "") ("CLIENT_MATTER_ID" prompt-gen "receiver's UID for this matter") ))) (beginning-of-line) (insert ledes-1998b-init-string linebreak) (mapcar (lambda (pair) (insert (car pair) "|")) ledes-pairs) (backward-delete-char 1) ; get rid of final "|" (insert "[]" linebreak) ;; Now begins the fun. Find the boundaries of the human entry, ;; and transform it into a proper LEDE1998B entry. (while (< (point) e) (while (looking-at "^\\s-*$") (delete-region (point) (progn (end-of-line) (point))) (delete-char 1)) ; hmm, this assumes LF not CRLF (let ((record-start (point)) (record-end nil)) (re-search-forward "^\\s-*$" nil t) (setq record-end (point)) (goto-char record-start) ; todo: working here )))) (defun kf-map-address (addr) "Convert ADDR (a string) to a Google Maps link. If interactive, use region string as ADDR and replace it with map link; whether interactive or not, return the map link. An example of ADDR would be \"59 W Grand Ave, Chicago, IL 60654-4801\". \(This is needed because so many restaurant web sites use either no map, or use Mapquest or Yahoo Maps or some other mapping service that is not as winning as Google Maps.\)" (interactive (list (buffer-substring-no-properties (point) (mark)))) (let ((map-link (format "https://maps.google.com/maps?q=%s&hl=en" (string-replace "\\s-+" "+" addr t)))) (if (not (called-interactively-p)) map-link (delete-region (point) (mark)) (insert map-link) map-link))) (defun kf-eval-and-replace (b e) "Evaluate sexp from B to E and replace it with its value. If called interactively, evaluate and replace sexp preceding point." (interactive (let ((bounds (bounds-of-thing-at-point 'sexp))) (list (car bounds) (cdr bounds)))) ;; `eval-region' doesn't return the result of the evaluation (let ((expr (buffer-substring-no-properties b e))) (goto-char b) (delete-region b e) ;; todo: in-progress, doesn't work, need to eval the string as an ;; expression, not just get a string back (eval-expression expr t))) (defun kf-kickstarter-backer-check () (interactive) (unless (eq major-mode 'gnus-summary-mode) (error "This only works in Gnus Summary Mode.")) (beginning-of-line) ;; Do the save-excursions internally because then the display ;; doesn't shift disconcertingly during the completion. (let ((name (buffer-substring-no-properties (save-excursion (search-forward "New Backer Alert! ") (point)) (save-excursion (search-forward " has pledged") (- (point) 12))))) (kf-mailaprop-interactive-check name))) ;;; URL completion lives in its own independent library now. ;; See https://code.librehq.com/kfogel/urlete/ for more information. (setq urlete-activate-samples t) (let ((local-urlete (expand-file-name "~/src/urlete/urlete.el"))) (when (file-exists-p local-urlete) (load-file local-urlete))) ;;; Yank helpers. ;; yank-match lives in its own independent library now. ;; See https://code.librehq.com/kfogel/yank-match for more information. (let ((local-yank-match (expand-file-name "~/src/yank-match/yank-match.el"))) (when (file-exists-p local-yank-match) (load-file local-yank-match))) ;; TODO: Hey, let's change this so that when invoked in non-whitespace ;; it finds the bounds of the thing at point, kills it, and then ;; recurses in the now-whitespace. (defun kf-intelligent-yank () "Yank something from the kill ring, then maybe do followup formatting." (interactive) (let* ((str (current-kill 0 t)) (is-url (kf-is-url str)) (prefix "") (var "") (suffix "")) (save-match-data (cond (is-url (cond ;; MR review comment on GitLab: ;; https://code.librehq.com/foo/bar/-/merge_requests/NNN#TBD_SOMETHING_HERE? ((string-match "https://.+/-/merge_requests/\\([0-9]+\\)#.+ TBD" str) (setq prefix "TBD comment on MR #") (setq var (match-string-no-properties 1 str))) ;; MR on GitLab: ;; https://code.librehq.com/foo/bar/-/merge_requests/NNN ((string-match "https://.+/-/merge_requests/\\([0-9]+\\)" str) (setq prefix "MR #") (setq var (match-string-no-properties 1 str))) ;; PR review comment on GitHub: ;; https://github.com/foo/bar/pull/NNN#COMMENT_ID ((string-match "https://github\\.com/.+/pull/\\([0-9]+\\)#.+" str) (setq prefix "comment on PR #") (setq var (match-string-no-properties 1 str))) ;; PR on GitHub: ;; https://github.com/foo/bar/pull/NNN ((string-match "https://github\\.com/.+/pull/\\([0-9]+\\)" str) (setq prefix "PR #") (setq var (match-string-no-properties 1 str))) ;; Issue comment on GitLab: ;; https://code.librehq.com/foo/bar/-/issues/NNN#TBD_SOMETHING_HERE? ((string-match "https://.+/-/issues/\\([0-9]+\\)#.+ TBD" str) (setq prefix "TBD comment on issue #") (setq var (match-string-no-properties 1 str))) ;; Issue on GitLab: ;; https://code.librehq.com/foo/bar/-/issues/NNN ((string-match "https://.+/-/issues/\\([0-9]+\\)" str) (setq prefix "issue #") (setq var (match-string-no-properties 1 str))) ;; Issue comment on GitHub: ;; https://github.com/foo/bar/issues/NNN#COMMENT_ID ((string-match "https://github\\.com/.+/issues/\\([0-9]+\\)#.+" str) (setq prefix "comment on issue #") (setq var (match-string-no-properties 1 str))) ;; Issue on GitHub: ;; https://github.com/foo/bar/issues/NNN ((string-match "https://github\\.com/.+/issues/\\([0-9]+\\)" str) (setq prefix "issue #") (setq var (match-string-no-properties 1 str))) ;; Branch on GitLab: ;; https://code.librehq.com/foo/bar/-/tree/BRANCH_NAME ((string-match "https://.+/-/tree/\\(.+\\)" str) (setq prefix "branch '") (setq var (match-string-no-properties 1 str)) (setq suffix "'")) ;; Branch on GitHub: ;; https://github.com/foo/bar/tree/BRANCH_NAME ((string-match "https://github\\.com/.+/tree/\\(.+\\)" str) (setq prefix "branch '") (setq var (match-string-no-properties 1 str)) (setq suffix "'")) ;; Default: just strip the schema from the URL (t (string-match "^https?://\\(.*\\)" str) (setq var (match-string-no-properties 1 str))))) (t ;; Handle non-URLs. )) (cond ((eq major-mode 'org-mode) (when is-url (insert "[[" str "][" prefix var suffix "]]"))) (t ;; Handle other modes. ))))) (defun kf-tweetlen-check (b e) "Check the number of characters in region B to E after folding whitespace. If interactive, print the number, then unconditionally return the number." (interactive "r") (let ((str (buffer-substring-no-properties b e)) (len 0)) (setq str (replace-regexp-in-string "\n" " " str)) ; LF -> space (setq str (replace-regexp-in-string "^\\s-+" "" str)) ; leading wspace (setq str (replace-regexp-in-string "\\s-+" " " str)) ; fold inner wspace (setq str (replace-regexp-in-string "\\s-+$" "" str)) ; trailing wspace (setq len (length str)) (when (called-interactively-p) (message "%d characters" len)) len)) (defun kf-webgrrrlize-region (start end) "Provide a horrrmone supplement to the region from START to END." (interactive "r") (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (replace-string "ir" "r") (goto-char (point-min)) (replace-string "er" "ur") (goto-char (point-min)) (replace-string "r" "rrr")))) (defun kf-tlapd (fore aft) "It's Talk Like A Pirate Day. Planks will be a constant!" (interactive "rrrrrr") (let ((case-fold-search nil)) ;; You might think `case-rrrrreplace' would be the one to use, but ;; the knock-kneed landlubberrrrrs who implemented this ignorrrrre ;; it in favorrrrr of `case-fold-searrrrrch'. Arrrrrgh! (format-replace-strings '(("r" . "rrrrr") ("R" . "rrRRR")) nil fore aft))) (defun kf-swedish-chef (b e) "Esk zee Svedeesh Cheff tu cuuk zee regeeun frum B tu E." ;; (interecteefe-a "r") (interactive "r") ;; (let ((cheff-pgm "/usr/gemes/cheff")) (let ((chef "/usr/games/chef")) ;; (iff (nut (feele-a-ixeests-p cheff)) (if (not (file-exists-p chef)) ;; (irrur "Try 'ept-get instell feelters' tu get zee 'cheff' prugrem.") (error "Try 'apt-get install filters' to get the 'chef' program.") ;; (shell-cummund-oon-regeeun b i cheff-pgm neel t)))) (shell-command-on-region b e chef nil t)))) ;; todo: write a function that replaces “ ” ‘ ’ in plaintext files. ;;; Get ELPA packages straight from the source. ;; Git repository at git+ssh://git.sv.gnu.org/srv/git/emacs/elpa.git ;; or ${USER}@git.sv.gnu.org:/srv/git/emacs/elpa.git -- not that the ELPA ;; home page makes this clear or anything. (let* ((local-elpa (expand-file-name "~/src/elpa/packages/")) (debbugs-path (expand-file-name (concat local-elpa "debbugs" )))) (when (file-exists-p local-elpa) (add-to-list 'load-path debbugs-path))) ;; Based on a nice hack by Chmouel Boudjnah, posted at ;; https://fosstodon.org/@chmouel/111968170968754693. ;; My next step should really be to generalize this to other forges, ;; e.g., code.librehq.com. (defun kf-github-search (&optional search) (interactive (list (read-string "GitHub search: " (thing-at-point 'symbol)))) (let* ((lang (or (cdr (assoc major-mode '((c-mode . "C") (python-mode . "Python") (python-ts-mode . "Python") (shell-script-mode . "Shell") (sh-mode . "Shell") (typescript-mode . "TypeScript") (javascript-mode . "JavaScript") (ruby-mode . "Ruby") (lua-mode . "Lua") (rust-mode . "Rust") (swift-mode . "Swift") (clojurec-mode . "Clojure") (lisp-mode . "Lisp") (scheme-mode . "Scheme") (racket-mode . "Scheme") (go-ts-mode . "Go") (go-mode . "Go") (emacs-lisp-mode . "Emacs Lisp")))) "Text")) (url (format "https://github.com/search/?q=\"%s\"+language:\"%s\"&type=Code" (url-hexify-string search) lang))) (browse-url url))) ;;; Use Emacs to edit text in web browser text input areas. ;; ;; See https://www.emacswiki.org/emacs/Edit_with_Emacs ;; and https://addons.mozilla.org/en-US/firefox/addon/edit-with-emacs1/. ;; git@github.com:stsquad/emacs_chrome.git (let ((ewe (expand-file-name "~/src/emacs_chrome/servers/edit-server.el"))) (when (file-exists-p ewe) (load ewe) (edit-server-stop) (setq edit-server-new-frame nil) ; the default, but let's make sure (edit-server-start))) ;; Mode for tallying a checkbook. While I'd rather use my HP 32-S RPN ;; calculator, the Enter button is getting old and unreliable now. ;; Test data ;; 58437.98 ;; -80987987987 788 (defun kf-checkbook-tally-add () "See documentation for `kf-checkbook-tally'." (interactive) (goto-char (point-min)) (beginning-of-line) (just-one-space) (forward-char -1) (delete-char 1) (let* ((rest-of-line-as-number (lambda () (string-to-number (buffer-substring (point) (progn (end-of-line) (point)))))) (op '-) (cur-total (funcall rest-of-line-as-number)) (next-txn (progn (forward-line 1) (just-one-space) (beginning-of-line) (delete-char 1) (if (looking-at "^-") (delete-char 1) (when (looking-at "^\\(a\\|+\\)") (delete-char 1) (setq op '+))) ;; transform space(s) into a decimal point (save-match-data (when (looking-at "^[0-9]+\\(\\.\\| +\\)[0-9]+") (delete-region (match-beginning 1) (match-end 1)) (save-excursion (goto-char (match-beginning 1)) (insert ".")))) ;; now run the transaction (funcall rest-of-line-as-number)))) (goto-char (point-min)) (beginning-of-line) (delete-region (point) (progn (forward-line 2) (forward-char -1) (point))) (insert (format "%.2f\n" (funcall op cur-total next-txn))))) (defvar kf-checkbook-tally-mode-map (let ((map (make-sparse-keymap))) (keymap-set map "" 'kf-checkbook-tally-add) map) "Keymap for `kf-checkbook-tally-mode'.") (define-derived-mode kf-checkbook-tally-mode nil "ChkBk" "Major mode for tallying a checkbook. Start with a number by itself on the first line of the buffer. Below that, enter a new number (optionally using space instead of dot for the decimal point, for convenience), also on a line by itself. If it has no sign or a minus sign, it is assumed to be a debit; if it has a plus sign, it is assumed to be a credit. Then hit F12." ) ;;; It's Business Time. ;; Thanks to Brian Fitzpatrick for pointing out ;; https://www.atrixnet.com/bs-generator.html. (defconst kf-ibt-adverbs (list "appropriately" "assertively" "authoritatively" "collaboratively" "compellingly" "competently" "completely" "continually" "conveniently" "credibly" "distinctively" "dramatically" "dynamically" "efficiently" "energistically" "enthusiastically" "fungibly" "globally" "holistically" "interactively" "intrinsically" "monotonectally" "objectively" "phosfluorescently" "proactively" "professionally" "progressively" "quickly" "rapidiously" "seamlessly" "synergistically" "uniquely" )) (defconst kf-ibt-verbs (list "actualize" "administrate" "aggregate" "architect" "benchmark" "brand" "build" "cloudify" "communicate" "conceptualize" "coordinate" "create" "cultivate" "customize" "deliver" "deploy" "develop" "dinintermediate" "disseminate" "drive" "embrace" "e-enable" "empower" "enable" "engage" "engineer" "enhance" "envisioneer" "evisculate" "evolve" "expedite" "exploit" "extend" "fabricate" "facilitate" "fashion" "formulate" "foster" "generate" "grow" "harness" "impact" "implement" "incentivize" "incept" "incubate" "initiate" "innovate" "integrate" "iterate" "leverage existing" "leverage others'" "maintain" "matrix" "maximize" "mesh" "monetize" "morph" "myocardinate" "negotiate" "network" "optimize" "onboard" "orchestrate" "parallel task" "plagiarize" "pontificate" "predominate" "procrastinate" "productivate" "productize" "promote" "provide access to" "pursue" "recaptiualize" "reconceptualize" "redefine" "re-engineer" "reintermediate" "reinvent" "repurpose" "restore" "revolutionize" "right-shore" "scale" "seize" "simplify" "strategize" "streamline" "supply" "syndicate" "synergize" "synthesize" "target" "transform" "transition" "underwhelm" "unleash" "utilize" "visualize" "whiteboard" )) (defconst kf-ibt-adjectives (list "24/7" "24/365" "accurate" "adaptive" "agile" "alternative" "an expanded array of" "B2B" "B2C" "backend" "backward-compatible" "best-of-breed" "bleeding-edge" "bricks-and-clicks" "business" "clicks-and-mortar" "client-based" "client-centered" "client-centric" "client-focused" "cloud-based" "cloud-centric" "cloudified" "collaborative" "compelling" "competitive" "cooperative" "corporate" "cost effective" "covalent" "cross functional" "cross-media" "cross-platform" "cross-unit" "customer directed" "customized" "cutting-edge" "distinctive" "distributed" "diverse" "dynamic" "e-business" "economically sound" "effective" "efficient" "elastic" "emerging" "empowered" "enabled" "end-to-end" "enterprise" "enterprise-wide" "equity invested" "error-free" "ethical" "excellent" "exceptional" "extensible" "extensive" "flexible" "focused" "frictionless" "front-end" "fully researched" "fully tested" "functional" "functionalized" "fungible" "future-proof" "global" "go forward" "goal-oriented" "granular" "high standards in" "high-payoff" "hyperscale" "high-quality" "highly efficient" "holistic" "impactful" "inexpensive" "innovative" "installed base" "integrated" "interactive" "interdependent" "intermandated" "interoperable" "intuitive" "just in time" "leading-edge" "leveraged" "long-term high-impact" "low-risk high-yield" "magnetic" "maintainable" "market positioning" "market-driven" "mission-critical" "multidisciplinary" "multifunctional" "multimedia based" "next-generation" "on-demand" "one-to-one" "open-source" "optimal" "orthogonal" "out-of-the-box" "pandemic" "parallel" "performance based" "plug-and-play" "premier" "premium" "principle-centered" "proactive" "process-centric" "professional" "progressive" "prospective" "quality" "real-time" "reliable" "resource-sucking" "resource-maximizing" "resource-leveling" "revolutionary" "robust" "scalable" "seamless" "stand-alone" "standardized" "standards compliant" "state of the art" "sticky" "strategic" "superior" "sustainable" "synergistic" "tactical" "team building" "team driven" "technically sound" "timely" "top-line" "transparent" "turnkey" "ubiquitous" "unique" "user-centric" "user friendly" "value-added" "vertical" "viral" "virtual" "visionary" "web-enabled" "wireless" "world-class" "worldwide" )) (defconst kf-ibt-nouns (list "action items" "adoption" "alignments" "applications" "architectures" "bandwidth" "benefits" "best practices" "catalysts for change" "channels" "clouds" "collaboration and idea-sharing" "communities" "content" "convergence" "core competencies" "customer service" "data" "deliverables" "e-business" "e-commerce" "e-markets" "e-tailers" "e-services" "experiences" "expertise" "functionalities" "fungibility" "growth strategies" "human capital" "ideas" "imperatives" "infomediaries" "information" "infrastructures" "initiatives" "innovation" "intellectual capital" "interfaces" "internal or \"organic\" sources" "leadership" "leadership skills" "manufactured products" "markets" "materials" "meta-services" "methodologies" "methods of empowerment" "metrics" "mindshare" "models" "networks" "niches" "niche markets" "nosql" "opportunities" "\"outside the box\" thinking" "outsourcing" "paradigms" "partnerships" "platforms" "portals" "potentialities" "rocess improvements" "processes" "products" "quality vectors" "relationships" "resources" "results" "ROI" "scenarios" "schemas" "scrums" "services" "solutions" "sources" "sprints" "strategic theme areas" "storage" "supply chains" "synergy" "systems" "technologies" "technology" "testing procedures" "total linkage" "users" "value" "vortals" "web-readiness" "web services" "wins" "virtualization" )) (defun kf-ibt-phrase (&optional insert) "Generate a business time phrase. If interactive, message it unless optional argument INSERT is non-nil, in which case insert it, and in any case return it. If non-interactive, just return it." (interactive "P") (let ((bt (concat (seq-random-elt kf-ibt-adverbs) " " (seq-random-elt kf-ibt-verbs) " " (seq-random-elt kf-ibt-adjectives) " " (seq-random-elt kf-ibt-nouns)))) (if (called-interactively-p) (if insert (insert bt) (message "%s" bt)) bt))) ;;; OTS has its own Elisp libraries. (setq ots-dir (expand-file-name "~/private/work/ots")) (setq ots-elisp-dir (concat ots-dir "/r/ots-tools/emacs-tools")) (let ((oref-el (concat ots-elisp-dir "/oref.el"))) ;; Note that although ots.el is also in this same directory, ;; we only load it in `kf-fully-initialize'. Loading it causes a ;; many OTS Org Mode files to found into buffers, which is slow. (when (file-exists-p oref-el) (load oref-el))) ;; Most (but maybe not all) OTS org files are in this subdirectory. (setq kf-ots-org-directory (concat ots-dir "/org")) ;; There's a local variable setting in hours.org that I don't want to ;; be prompted about. Adding it to `safe-local-variable-values' is ;; the usual answer to that, of course, but that requires knowing the ;; "safe" value in advance. Since virtually any numeric value is fine ;; with me, I don't want to hardcode the value in my .emacs, because ;; that would be brittle and losing for all the obvious reasons. ;; Hence this hack. (let ((ots-hours-file (concat ots-dir "/hours.org"))) (when (file-exists-p ots-hours-file) (let ((expected-rate (save-excursion (with-temp-buffer (insert-file-contents-literally ots-hours-file) (goto-char (point-min)) (prog1 (save-match-data (re-search-forward "^ots-default-rate:\\s-+\\([0-9]+\\)") (string-to-number (match-string 1))) (kill-buffer)))))) (setq safe-local-variable-values (cons (cons 'ots-default-rate expected-rate) safe-local-variable-values))))) (defconst kf-ots-bureaucracy-directory (expand-file-name (concat ots-dir "/bureaucracy")) "This is where the mundane happens.") (defconst kf-ots-home-directory (expand-file-name (concat ots-dir "/home/kfogel")) "Everyone gets their own space. This is mine.") (defconst kf-naf-directory (expand-file-name "~/private/work/naf") "Hysterical raisins; still useful for some things though.") (defconst kf-poss-directory (expand-file-name "~/src/producingoss/") "Is that an org file or a bug tracker?") (defconst kf-poss-private-directory (expand-file-name "~/src/producingoss/private") "Politeness before transparency.") (setq org-mobile-directory "/198.199.68.182:private/org/MobileOrg") (setq org-mobile-inbox-for-pull (concat org-directory "/index.org")) (unless (boundp 'org-agenda-files) (setq org-agenda-files ())) (setq org-deadline-warning-days 14) (setq org-agenda-skip-deadline-prewarning-if-scheduled 'pre-scheduled) (setq org-agenda-skip-scheduled-if-done t) ;; Actually bringing all the Org files into buffers is done in ;; `kf-fully-initialize', which see. ;; Keymap for orgy and OTS actions. ;; That's "Org-ey", as in the adjectival form of "Org Mode". ;; Puh-leeze! What did you *think* I meant? (define-prefix-command 'kf-ots-map) (keymap-set 'kf-ots-map "f" 'org-switchb) (keymap-set 'kf-ots-map "a" 'org-agenda) (keymap-set 'kf-ots-map "c" 'kf-ots-chat-links) (keymap-set 'kf-ots-map "l" 'ots-crm-lookup) (keymap-set 'kf-ots-map "d" 'org-deadline) (keymap-set 'kf-ots-map "s" 'org-schedule) (defun kf-ots-chat-links () "Present all current client chat links in a buffer." (interactive) (let ((links nil) (file (let ((obsc (make-string 6 ?r))) (aset obsc 4 ?/) (aset obsc 0 ?/) (aset obsc 1 ?f) (aset obsc 5 ?f) (aset obsc 3 ?i) (aset obsc 2 ?u) (rot13 obsc)))) (save-excursion (set-buffer (find-file-noselect file)) (save-restriction (goto-char (point-min)) (while (search-forward ":OTS_C:" nil t) (beginning-of-line) (search-forward "http") (forward-char -4) (let ((opoint (point))) (re-search-forward "\\(]\\| \\)") (forward-char -1) (let ((link (buffer-substring-no-properties opoint (point)))) (setq links (cons link links))) (end-of-line))))) (let ((buf (get-buffer-create "*OTS Chat Links*"))) (set-buffer buf) (erase-buffer) (dolist (elt (nreverse links)) (insert elt "\n")) (switch-to-buffer buf) (goto-char (point-min)) (keymap-local-set "C-c C-c" 'kf-browse-buffer)))) (defun kf-browse-region (beg end) "Browse every URL in the current region (formatted as one URL per line). Skip over leading junk (such as \" - \" or \" * \" or something else that looks like a list structural element for a list in which the current line is one entry) to find the URL." (interactive "r") (save-excursion (save-match-data (goto-char beg) (while (< (point) end) (let ((eol (pos-eol))) (when (re-search-forward "[a-zA-Z0-9]" nil eol) (forward-char -1)) (browse-url (buffer-substring-no-properties (point) eol))) (forward-line 1))))) (defun kf-browse-buffer () "Browse every URL in the current buffer (formatted as one URL per line)." (interactive) (kf-browse-region (point-min) (point-max))) (defun kf-browse-textarea () "Browse to my standard empty textarea form. This is useful for hop-pasting material over to, say, an Etherpad or to some other place that blocks non-browser pastes." (interactive) (browse-url (concat "file://" (expand-file-name "~/private/infra/textarea.html")))) ;; (defun kf-org-gnus-article-to-link () ;; "Place in the kill ring an Org-syntax link to the current article." ;; (interactive) ;; (let ((subject nil) ;; (group nil) ;; (article-number nil)) ;; (save-excursion ;; (set-buffer gnus-article-buffer) ;; (let ((headers-hidden nil)) ;; (when (not (gnus-article-goto-header "xref")) ;; (setq headers-hidden t) ;; (gnus-summary-toggle-header) ;; (gnus-article-goto-header "xref")) ;; ;; Point is after first colon in "Xref: kwarm.red-bean.com citycamp:668" ;; (end-of-line) ;; (re-search ...))))) ;; From http://orgmode.org/worg/org-hacks.html ;; ;; Support for saving Gnus messages by Message-ID ;; (defun mde-org-gnus-save-by-mid () ;; (when (memq major-mode '(gnus-summary-mode gnus-article-mode)) ;; (when (eq major-mode 'gnus-article-mode) ;; (gnus-article-show-summary)) ;; (let* ((group gnus-newsgroup-name) ;; (method (gnus-find-method-for-group group))) ;; (when (eq 'nnml (car method)) ;; (let* ((article (gnus-summary-article-number)) ;; (header (gnus-summary-article-header article)) ;; (from (mail-header-from header)) ;; (message-id ;; (save-match-data ;; (let ((mid (mail-header-id header))) ;; (if (string-match "<\\(.*\\)>" mid) ;; (match-string 1 mid) ;; (error "Malformed message ID header %s" mid))))) ;; (date (mail-header-date header)) ;; (subject (gnus-summary-subject-string))) ;; (org-store-link-props :type "mid" :from from :subject subject ;; :message-id message-id :group group ;; :link (org-make-link "mid:" message-id)) ;; (apply 'org-store-link-props ;; :description (org-email-link-description) ;; org-store-link-plist) ;; t))))) ;; ;; (defvar mde-mid-resolve-methods '() ;; "List of methods to try when resolving message ID's. For Gnus, ;; it is a cons of 'gnus and the select (type and name).") ;; (setq mde-mid-resolve-methods ;; '((gnus nnml ""))) ;; ;; (defvar mde-org-gnus-open-level 1 ;; "Level at which Gnus is started when opening a link") ;; (defun mde-org-gnus-open-message-link (msgid) ;; "Open a message link with Gnus" ;; (require 'gnus) ;; (require 'org-table) ;; (catch 'method-found ;; (message "[MID linker] Resolving %s" msgid) ;; (dolist (method mde-mid-resolve-methods) ;; (cond ;; ((and (eq (car method) 'gnus) ;; (eq (cadr method) 'nnml)) ;; (funcall (cdr (assq 'gnus org-link-frame-setup)) ;; mde-org-gnus-open-level) ;; (when gnus-other-frame-object ;; (select-frame gnus-other-frame-object)) ;; (let* ((msg-info (nnml-find-group-number ;; (concat "<" msgid ">") ;; (cdr method))) ;; (group (and msg-info (car msg-info))) ;; (message (and msg-info (cdr msg-info))) ;; (qname (and group ;; (if (gnus-methods-equal-p ;; (cdr method) ;; gnus-select-method) ;; group ;; (gnus-group-full-name group (cdr method)))))) ;; (when msg-info ;; (gnus-summary-read-group qname nil t) ;; (gnus-summary-goto-article message nil t)) ;; (throw 'method-found t))) ;; (t (error "Unknown link type")))))) ;; ;; (eval-after-load 'org-gnus ;; '(progn ;; (add-to-list 'org-store-link-functions 'mde-org-gnus-save-by-mid) ;; (org-add-link-type "mid" 'mde-org-gnus-open-message-link))) ;; OTS uses Beancount. Therefore, I use beancount.el. ;; https://github.com/beancount/beancount/blob/master/editors/emacs/beancount.el (setq beancount-check-program (expand-file-name (concat ots-dir "/r/ots-bookkeeping/ots-bean-check"))) (let ((local-beancount (expand-file-name "~/src/beancount-mode/beancount.el"))) (when (file-exists-p local-beancount) (load-file local-beancount))) (add-to-list 'auto-mode-alist '(".*\\.beancount" . beancount-mode)) ;;; I run this manually because for quick one-off sessions on edge ;;; boxes I don't need this time-consuming initialization done. (defun kf-fully-initialize () "Do some time-consuming things that I don't need for every Emacs session." (interactive) ;; Initialize OTS features and all Org Mode files (OTS and non-OTS). (let ((oref-el (concat ots-elisp-dir "/ots.el"))) (when (file-exists-p oref-el) (load oref-el) (oref-rebuild-refs (expand-file-name "~")))) (message "Ensuring the standard set of Org Mode files...") (let ((all-org-files nil) (exceptions (list "domains.org" ; b/c interferes w/ "doit.sh" in completion ))) (mapcar (lambda (dir) (when (file-directory-p dir) (mapcar (lambda (basename) (let ((path (concat (file-name-as-directory dir) basename))) (when (string-match "\\.org$" basename) (setq all-org-files (cons path all-org-files))))) (directory-files (expand-file-name dir))))) (list org-directory kf-ots-org-directory ots-dir ; some OTS org files may be at top level kf-ots-bureaucracy-directory kf-ots-home-directory kf-naf-directory)) (mapcar (lambda (org-file) (unless (member (file-name-nondirectory org-file) exceptions) (add-to-list 'all-org-files org-file))) ots-org-files) ;; Find them all into Emacs. (mapcar (lambda (f) (bury-buffer (find-file-noselect f))) all-org-files) ;; Tell Org Agenda about them. (mapcar (lambda (agenda-file) (add-to-list 'org-agenda-files agenda-file)) all-org-files) ;; Set up special keybindings in some of them. (save-excursion (mapcar (lambda (f) (set-buffer (find-file-noselect f)) (let ((binding (keymap-lookup nil "C-c C-c"))) (when (memq binding (list 'org-ctrl-c-ctrl-c nil)) ;; This effectively reimplements a tiny subset of vc.el, ;; which is perhaps shortsighted, but... so be it. (kf-quick-commit-mode)))) (append (mapcar (lambda (basename) (concat org-directory "/" basename)) (list "stovetop.org" "main.org" "upstreams.org" "emacs.org" "references.org" "essays.org" "someday-maybe.org")) (list (expand-file-name "~/private/etc/folks")))))) ;; Mailaprop initialization. (when (featurep 'mailaprop) ;; This message will never be seen, because it is quickly replaced ;; by a placeholder message from `mailaprop-load-addresses' itself. (message "Loading Mailaprop addresses...") (mailaprop-load-addresses)) (when (fboundp 'kf-private-initializations) (kf-private-initializations)) (message "Full initialization complete."))