;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; .emacs file (http://svn.red-bean.com/repos/kfogel/trunk/.emacs) ;;; ;;; ;;; ;;; Summary: Some decades' worth of Emacs customizations. ;;; ;;; ;;; ;;; Copyright (C) 1992-2020 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 still-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. I use the `kf-' prefix not out of egotism, but to ;;; ;;; avoid namespace collisions. In fact, a few of the functions with a ;;; ;;; `kf-' prefix were actually contributed by others -- for details, do ;;; ;;; 'svn blame https://svn.red-bean.com/repos/kfogel/trunk/.emacs'. ;;; ;;; ;;; ;;; Start by looking at the section "Custom keybindings", which shows ;;; ;;; my most-frequently-used entry points, especially: ;;; ;;; ;;; ;;; - `kf-jump-there' ;;; ;;; - `kf-surround-with' ;;; ;;; - `kf-push-to-column' ;;; ;;; - `kf-prefixed-yank' ;;; ;;; - `kf-log-message' ;;; ;;; - `kf-show-change' ;;; ;;; - `kf-find-usual-suspect' ;;; ;;; - `kf-delete-blank-or-header-char' ;;; ;;; - `kf-fix-previous-transposition' ;;; ;;; ;;; ;;; For sheer weirdness, see `kf-gene-translate-region'. If you edit ;;; ;;; Chinese but are not a native reader/writer, `kf-pinyin-from-char' ;;; ;;; might be useful. ;;; ;;; ;;; ;;; From 19 Nov 2011 to 9 Jan 2015, I used the `kf-instrument' and ;;; ;;; `kf-persist' mechanisms to track which of my custom functions I ;;; ;;; use the most, so I can tweak the above to more accurately advise ;;; ;;; readers about the relative utility of things in this .emacs. ;;; ;;; Some day maybe I'll finally analyze that data; in the meantime, ;;; ;;; http://svn.red-bean.com/repos/kfogel/trunk/.emacs.d/kf-persist/\ ;;; ;;; symbols/kf-instrumentation-record has the raw invocation tally. ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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) ;; 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)) (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 "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 "khpd" (system-name)) (string-match "mcfan" (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. (let* ((local-org (expand-file-name "~/src/org-mode")) (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 (file-exists-p local-org) (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-mode-hook () "Custom hooks run on entering Org Mode." (when (eq (key-binding [C-return]) 'org-insert-heading-respect-content) (local-set-key [C-return] 'kf-worship-frame)) (when (eq (key-binding "\C-c ") 'org-table-blank-field) (local-set-key "\C-c " 'kf-push-to-column))) (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) ;; 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) ;; 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) ;; 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")) ;; See where OTS elisp is handled, for some more Org Mode stuff. ;;; 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))))) '())) ;;; A generic cross-session data persistence mechanism. ;;; ;;; The entry point is the function `kf-persist'. That's all one should ;;; need to learn, though note that one may also need to define a ;;; "LOAD-MERGE-FUNC" and/or a "STORE-MERGE-FUNC" as documented there. ;;; ;;; I originally developed this system to save and merge ;;; `kf-instrumentation-record' data across my various machines, but ;;; it's generic enough to be used for any kind of data. (defconst kf-persist-root-root (expand-file-name "~/.emacs.d") "There should be a variable for this, but `apropos-value' spins...") ;; Why doesn't Elisp have Python's os.path.join() and friends? (defconst kf-persist-root (concat kf-persist-root-root "/kf-persist") "*Where to store cross-session persistent data.") ;; We have a "symbols" directory in case there are other kinds of ;; things we want to offer persistence for later. One extra level ;; of subdirectory can prevent a lot of chaos down the road. (defconst kf-persist-symbols-root (concat kf-persist-root "/symbols") "*Where to store cross-session persistent values by symbol.") (defmacro kf-persist-make-prop-accessors (property doc) "Generate `kf-persist' accessor functions for PROPERTY, a string. Defines accessors `kf-persist-get-PROPERTY' and `kf-persist-set-PROPERTY'. They can be used with any object in the kf-persist storage system \(currently only symbols are implemented\), and should be the only way PROPERTY is accessed within that system. \(The property actually used will be named `kf-persist-PROPERTY', but this is an implementation detail that callers of the accessors should, in theory, not need to take advantage of.\) DOC is the middle part of both accessors' documentation strings. The first paragraph of each doc string is a single line, auto-generated to something reasonable indicating this is a getter or setter for `kf-persist-PROPERTY', and the last paragraph is a single line explaining how the function was autogenerated; in between is DOC." (let ((proper-property (intern (concat "kf-persist-" property))) (getter (intern (concat "kf-persist-get-" property))) (setter (intern (concat "kf-persist-set-" property)))) `(progn (defun ,getter (obj) ,(format "Getter function for `%s'.\n\n%s\n\n%s." proper-property doc "(This function was created by `kf-persist-make-prop-accessors'.)") (if (symbolp obj) (get (quote ,proper-property) ,property) (error "Unable to get `%s' for %S" (symbol-name (quote ,proper-property)) obj))) (defun ,setter (obj val) ,(format "Setter function for `%s'.\n\n%s\n\n%s." proper-property doc "(This function was created by `kf-persist-make-prop-accessors'.)") (if (symbolp obj) (put obj (quote ,proper-property) val) (error "Unable to set `%s' for %S" (symbol-name (quote ,proper-property)) obj))) ))) (put 'kf-persist-make-prop-accessors 'lisp-indent-function 'defun) (kf-persist-make-prop-accessors "storage-timestamp" "The timestamp of the object's persistent storage when the object was read from storage (often, but not always, at Emacs init time). If the value is a list, it is like that returned by `current-time'; if it is not a list, its meaning is currently undefined.") (kf-persist-make-prop-accessors "load-timestamp" "The time when the object was loaded from storage (e.g., the first call to `kf-persist'). If the value is a list, it is like that returned by `current-time'; if it is not a list, its meaning is currently undefined.") (defvar kf-persist-symbol-dict (make-hash-table :test 'eq) "Obsolete hash table mapping symbols to their persistent store information. TODO: This will now be done using symbol plists, but this dict is still currently being used in a predicate, so we need to rewrite that code before removing it.") (defun kf-persist-symbol-storage (sym) "Return the path to the persistent storage file for SYM." (when (string-match "[^a-zA-Z0-9-]" (symbol-name sym)) ;; Ideally, we'd escape filesystem-unsafe characters. But that ;; would be premature generalization, which, as we know well, is ;; the root of all evil whenever premature optimization isn't. (error "`%s' contains non-alphanumeric characters other than `-'" (symbol-name sym))) (concat kf-persist-symbols-root "/" (symbol-name sym))) (defun kf-persist-has-stored-value (sym) "Return non-nil iff there is a stored value for SYM." (let ((store-file (kf-persist-symbol-storage sym))) (file-exists-p store-file))) (defun kf-persist-write-object-to-file (object file) "Write a Lisp OBJECT to FILE, pretty-printing for readability." (save-excursion (let ((buf (find-file-noselect file))) (set-buffer buf) (delete-region (point-min) (point-max)) (pp object buf) (save-buffer) (kill-buffer (current-buffer))))) (defun kf-persist-stored-value (sym) "Return the current stored value for SYM in the persistent store. Note that the value may be nil; if there is no value, raise an error. Use `kf-persist-has-stored-value' to check whether SYM has a value in the store first." (let ((store-file (kf-persist-symbol-storage sym))) (if (file-exists-p store-file) (save-excursion (let* ((large-file-warning-threshold nil) (buf (find-file-noselect store-file))) (set-buffer buf) (goto-char (point-min)) (prog1 (read (current-buffer)) (kill-buffer (current-buffer)) ;; TODO: Query datestamp slippage to check race condition? ;; TODO: All uses of kf-persist-symbol-dict are currently ;; wrong; need alist or second-level hash. (puthash sym (kf-persist-symbol-storage-timestamp sym) kf-persist-symbol-dict) (kf-persist-set-storage-timestamp sym (kf-persist-symbol-storage-timestamp sym)) ))) (error "No persistent storage found for `%s'" (symbol-name sym))))) (defun kf-persist-store (sym &optional store-merge-func) "Record the value of SYM into the persistent store. If optional second argument STORE-MERGE-FUNC is non-nil, then invoke it if necessary to determine the stored value, as documented in `kf-persist'." (let ((has-stored-value (kf-persist-has-stored-value sym)) (store-file (kf-persist-symbol-storage sym))) (if has-stored-value (if (boundp sym) (set sym (funcall store-merge-func sym (kf-persist-stored-value sym) (symbol-value sym) t)) (set sym (kf-persist-stored-value sym)))) (when (boundp sym) (make-directory (file-name-directory store-file) t) ; just ensuring (kf-persist-write-object-to-file (symbol-value sym) store-file)))) (defun kf-persist-symbol-storage-timestamp (sym) "Return the time of last modification for SYM's persistent storage. The value is a list of two integers: the first integer has the high-order 16 bits of time, the second has the low 16 bits, as with the value of `current-time'." (elt (file-attributes (kf-persist-symbol-storage sym)) 5)) (defun kf-persist (sym &optional load-merge-func store-merge-func) "Cause the value of symbol SYM to persist between sessions. That is, load SYM's value from the persistent store, and set a hook such that the (possibly changed) value is saved back in the persistent store when Emacs exits. Only the first call has any effect; subsequent calls are ignored. Optional arguments LOAD-MERGE-FUNC and STORE-MERGE-FUNC are used when loading or storing, respectively, to merge the ambient value (if any) with the stored value (if any). Each function is only invoked if both an ambient and a stored value are present at the appropriate time, and each function takes these arguments: SYMBOL, STORED-VALUE, AMBIENT-VALUE. They should return the new value; for LOAD-MERGE-FUNC the new value will become the ambient value, and for STORE-MERGE-FUNC it will become the stored value. \(And the reason we pass in AMBIENT-VALUE, rather than just expecting merge-funcs to get it from the environment, is that we are looking forward to a bright, if ever-receding, lexically scoped future.\) If a merge-func is nil, then just take a best guess about which value to prefer at the time that merge-func would have been called." (let ((sym-data (gethash sym kf-persist-symbol-dict))) (when (not sym-data) (let ((has-stored-value (kf-persist-has-stored-value sym)) (has-ambient-value (boundp sym))) (if has-stored-value (let ((stored-value (kf-persist-stored-value sym))) (if has-ambient-value ;; This is an odd condition, since we're most likely ;; being invoked from startup. Nevertheless, if there ;; is an ambient value already and a load-merge-func ;; is available, we should use it. If not, then ;; *if* there is a store-merge-func, let the ambient ;; value stand, under the assumption that the ;; store-merge-func will DTRT later on; else go with ;; the stored value, on the assumption that it holds ;; more accumulated information than the ambient value. (if load-merge-func (set sym (funcall load-merge-func sym stored-value (symbol-value sym) nil)) (when (not store-merge-func) (set sym stored-value))) ;; Else initialize it according to stored value. (set sym stored-value)))) ;; TODO: All uses of kf-persist-symbol-dict are currently ;; wrong; the alist or second-level hash isn't actually ;; implemented yet. For now, it doesn't matter, since we're ;; just using SYM's presence in the hash as a predicate test. ;; But later, when we add timestamp parameters to the ;; merge-funcs, the hash will need to actually work. (puthash sym (kf-persist-symbol-storage-timestamp sym) kf-persist-symbol-dict) (kf-persist-set-storage-timestamp sym (kf-persist-symbol-storage-timestamp sym)) (puthash sym (cons 'load-timestamp (current-time)) kf-persist-symbol-dict) (kf-persist-set-load-timestamp sym (current-time)) (add-hook 'kill-emacs-hook `(lambda () (kf-persist-store (quote ,sym) (quote ,store-merge-func)))))))) ;;; Instrument my custom interactive functions, so I can know what I ;;; use the most and therefore what to recommend to others. ;;; ;;; See also http://www.emacswiki.org/cgi-bin/wiki?CommandLogMode, ;;; which does something similar (pointed out by Aaron Hawley). (defvar kf-instrumentation-record nil "Instrumentation results, read from and saved to `kf-instrumentation-file'. This is an alist: ((function-symbol number-of-invocations) ...)") (defun kf-instrumentation-persist-store-merge (sym stored ambient to-store) "Return a new value (for SYM), based on STORED, AMBIENT, and TO-STORE. This is a merge-func set and used by `kf-persist', which see. STORED and AMBIENT are of the same form, though not necessarily with the same contents: '((kf-fill-paragraph 2) (kf-auto-fill-mode 1) (COMMAND NUM-INVOCATIONS) ...) We assume SYM is `kf-instrumentation-record' without checking. If TO-STORE is nil, then return nil, because every Emacs session should accumulate its own fresh value of `kf-instrumentation-record'. If TO-STORE is non-nil, then merge, i.e. add, the ambient values into the stored and return the result, which is now ready to be stored. The reason to do things this way, instead of always having a for-all-time current value of `kf-instrumentation-record' in each Emacs session, is that there might be multiple simultaneous sessions. There's no way to merge their values using the stored file as coordinating force, because no individual session knows which portions of its numbers are from its own session and which are from other sessions. But if each session always knows that its ambient value is for its own session only, then it's clear how to merge: add the ambient values to whatever is in the store, and store the result." (if to-store (let ((new-records ())) (mapcar (lambda (ambient-cell) (let* ((key (car ambient-cell)) (val (cadr ambient-cell)) (stored-cell (assq key stored))) (if stored-cell (setcar (cdr stored-cell) (+ val (cadr stored-cell))) (setq new-records (cons ambient-cell new-records))))) ambient) (append stored new-records)) ambient)) ;; This expression, if uncommented, would cause the value of ;; 'kf-instrumentation-record to persist between Emacs sessions: ;; ;; (kf-persist 'kf-instrumentation-record ;; nil 'kf-instrumentation-persist-store-merge) (defun kf-instrument () (when (string-match "^kf-" (symbol-name this-command)) (let ((elt (assq this-command kf-instrumentation-record))) (if elt (setcdr elt (list (1+ (cadr elt)))) (setq kf-instrumentation-record (cons (list this-command 1) kf-instrumentation-record)))))) ;;; 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))) (if (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. (global-set-key "\C-cc" 'mode-specific-command-prefix) (global-set-key "\C-cC" 'ots-conference-call-info) (global-set-key "\C-ch" 'kf-log-message) (global-set-key "\C-cv" 'kf-logup) (global-set-key "\C-cl" 'kf-find-usual-suspect) (global-set-key "\C-co" 'kf-ots-map) (global-set-key "\C-cB" 'bookmark-map) (global-set-key "\C-cp" 'kf-paragraphize) (global-set-key "\C-cn" 'kf-narrow-telepathically) (global-set-key "\C-cr" 'revert-buffer) (global-set-key "\C-cD" 'kf-delete-blank-or-header-char) (global-set-key "\C-cd" 'kf-flush-lines) (global-set-key "\C-cE" 'kf-unbound) (global-set-key "\C-cF" 'kf-unbound) (global-set-key "\C-cs" 're-search-forward) (global-set-key "\C-cS" 'kf-just-sent) (global-set-key "\C-cS" 'search-forward) (global-set-key "\C-cM" 'manual-entry) (global-set-key "\C-cm" 'kf-mdash) (global-set-key "\C-cy" 'yank-match) (global-set-key "\C-ci" 'kf-switch-handler-i) (global-set-key "\C-cL" 'kf-itemized-list) (global-set-key "\C-cu" 'kf-switch-handler-u) (global-set-key "\C-cU" 'kf-degoogle-url-around-point) (global-set-key "\C-cj" 'kf-jump-there) (global-set-key "\C-cg" 'kf-show-change) (global-set-key "\C-cG" (lambda () (interactive) (insert "sys.stderr.write(\"DEBUG: \\n\")") (forward-char -4))) (global-set-key "\C-cf" 'kf-auto-fill-mode) (global-set-key "\C-cq" 'kf-fill-paragraph-isolated) (global-set-key "\C-ce" 'kf-surround-with) (global-set-key "\C-ck" 'bury-buffer) (global-set-key "\C-ct" 'kf-fix-previous-transposition) (global-set-key "\C-cT" 'kf-remove-text-properties) (global-set-key "\C-c1" 'kf-unbound) (global-set-key "\C-cP" 'kf-pinyin-from-char) (global-set-key "\C-cx" 'kf-prefixed-yank) (global-set-key "\C-cw" 'kf-ots-header) (global-set-key "\C-ca" 'ots-org-display-headings-to-point) (global-set-key "\C-cb" 'oref-do-ref) ;; Do some other custom rebindings outside the reserved space. (defun kf-override-key (key expected-binding new-binding) "If KEY is bound to EXPECTED-KEYBINDING, then globally bind it to NEW-KEYBINDING (if NEW-KEYBINDING is nil, then globally unbind KEY). If KEY is not bound to EXPECTED-KEYBINDING, print a message but don't change any keybindings." (if (eq (key-binding key) expected-binding) (if new-binding (global-set-key key new-binding) (global-unset-key key)) (message "Key %S not bound to %S as expected." key expected-binding))) (mapcar (lambda (k) (kf-override-key (car k) (car (cdr k)) (car (cdr (cdr k))))) (list (list "\C-xf" '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-hyphenate) (list "\C-c_" nil 'kf-enspacen) (list "\C-c2" nil 'kf-split-window-vertically) (list "\C-c9" nil 'kf-unbound) (list "\C-c)" nil 'kf-smiley-face) (list "\C-c(" nil 'kf-smiley-face) (list "\C-c." nil 'kf-switch-handler-dot))) ;; 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)) ;;; 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. (- (/ (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 (global-set-key [C-return] 'kf-worship-frame) (global-set-key [S-backspace] '(lambda () (interactive) (message "Helpful to humans, harmless to dogs!"))) (global-set-key [S-delete] '(lambda () (interactive) (message "Helpful to humans, harmless to dogs!"))) )) ;; 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) (define-key minibuffer-local-filename-completion-map " " 'minibuffer-complete) (define-key minibuffer-local-filename-completion-map "\C-i" 'minibuffer-complete)) (when (boundp 'minibuffer-local-filename-must-match-map) (define-key minibuffer-local-filename-must-match-map " " 'minibuffer-complete) (define-key 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. (global-set-key "\eOm" "-") (if (eq (key-binding "\C-x\C-l") 'downcase-region) (global-set-key "\C-x\C-l" 'what-line)) (if (eq (key-binding "\C-xl") 'count-lines-page) (global-set-key "\C-xl" 'goto-line)) (if (or (eq (key-binding "\C-xc") 'shell) (eq (key-binding "\C-xc") nil)) (global-set-key "\C-xc" 'kf-shell)) (if (or (eq (key-binding "\C-h\C-a") nil) (eq (key-binding "\C-h\C-a") 'display-about-screen) (eq (key-binding "\C-h\C-a") 'about-emacs)) (global-set-key "\C-h\C-a" 'apropos)) (if (eq (key-binding "\M-s") nil) (global-set-key "\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 `ots-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)) (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-isolated (b e) "Fill paragraph on a temporarily isolated region." (interactive "*r") (let ((extra-line-b nil) (extra-line-e nil)) (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 hard-spacing-when-xml) "Helper function for `kf-mdash' and `kf-ndash'. Type is `n' or `m'. If HARD-SPACING-WHEN-XML, include XML non-breaking space entities on both sides of the dash iff in an XML-flavored markup." (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)) (when hard-spacing-when-xml (insert " ")) (insert (format "&%sdash;" (symbol-name type))) (when 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": ;;; ;;; (global-set-key "\C-ch" '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. (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. (if (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)))) (if (re-search-forward ":" nil t) (if (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 (if this-defun (progn (kill-new (format "\"%s\"" this-defun)) (kill-new (format "(%s): " this-defun)) (kill-new this-defun))) (search-forward ")" nil t) (if (looking-at " ") (forward-char 1))) ;; Found neither defun nor its file, so create new entry. (goto-char (point-max)) (if (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. (if (not this-defun) (forward-char -3)))))) ;;;; 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) ;; Sometimes I have to tweak dired. ;; ;; (setq dired-listing-switches "-laF") ;; 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)) ;; 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 mail-yank-prefix ">") (setq mail-yank-hooks nil) (setq completion-auto-help t) (setq completion-ignored-extensions nil) (setq completion-ignored-extensions nil) (setq-default show-trailing-whitespace nil) (setq compose-mail-user-agent-warnings 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) ;; 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 .gnus, 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? (if (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/yank-match") 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 () (define-key isearch-mode-map "\C-o" 'isearch-yank-char) (let ((ctl-l-binding (lookup-key isearch-mode-map "\C-l"))) (if (or (not ctl-l-binding) (eq ctl-l-binding 'isearch-other-control-char)) (define-key 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." (if (and (boundp 'py-mode-syntax-table) py-mode-syntax-table) (modify-syntax-entry ?\_ "_" py-mode-syntax-table)) (if (eq (key-binding "\C-c?") 'py-describe-mode) (local-set-key "\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 () (local-set-key "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 (key-binding "\C-c ") 'conf-space-keywords) (local-set-key "\C-c " 'kf-push-to-column))) (add-hook 'conf-mode-hook 'kf-conf-mode-hook) (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")) (if (eq (key-binding [C-return]) 'tex-feed-input) (local-set-key [C-return] '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 (if (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)))) (if (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 () "Switch to `*shell*' buffer if any, else create two shell buffers. If creating, create both `*shell*' and `shell' and switch to the former." (interactive) (if (get-buffer "*shell*") (switch-to-buffer (get-buffer "*shell*")) (call-interactively 'shell) ;; Some time around early April 2017, this next line became ;; necessary, because the "(call-interactively 'shell)" stopped ;; switching to the "*shell*" buffer it had just created. I don't ;; see any change in the logs that obviously explains it. (switch-to-buffer (get-buffer "*shell*")) (unless (get-buffer "shell") (rename-buffer "shell") (call-interactively 'kf-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) (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) (if (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 '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 '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") (autoload 'insert-arbitrary-subject "arbysubj" nil 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") ;; post-load programs to run: (setq display-time-mail-file "/dev/null") ; don't notify me of mail (defun kf-bol-and-i-mean-it () "Go to beginning of line no matter what They say." (interactive) (forward-line 0)) ;; I do *not* want that damned toolbar, nor Blinky, nor that annoying ;; new comint prompt behavior on C-a. (defun kf-comint-mode-hook () (if (eq (key-binding "\C-c ") 'comint-accumulate) (local-set-key "\C-c " 'kf-push-to-column)) (local-set-key "\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)) (if (fboundp 'transient-mark-mode) (transient-mark-mode 1)) (setq mark-even-if-inactive t) (defvar suspend-hooks nil) ; should't be necessary! (if (fboundp 'scroll-bar-mode) (scroll-bar-mode -1)) (if (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)) (if (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. ((string-equal "1920x1080" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) (width . ,kf-conservative-frame-width) (height . 50)))) ((string-equal "1280x1024" dimensions) (setq initial-frame-alist `((top . 1) (left . 2) (width . ,kf-conservative-frame-width) (height . 47)))) ((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) (if (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")) (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 (interactive-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" "Grandiose" "Wise"] '["Puissant" "Omnipotent" "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")))) (if (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 (interactive-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") (save-excursion (goto-char start) (let ((count 0)) (while (< (point) end) (forward-word 1) (if (<= (point) end) (setq count (1+ count)))) (if (interactive-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 'xml', 'texi', 'html', 'ltx', or nil, based on the filename extension; fall back to looking at the major mode if no extension is available. Use this instead of just looking at the major mode, since you can't always depend on the mode." (cond ((eq major-mode 'html-mode) 'html) ((eq major-mode 'php-mode) 'php) (t (let ((extension (file-name-extension (buffer-name)))) (if extension (save-match-data (if (string-match "\\([^<]+\\)<[^<>]+>$" extension) (setq extension (match-string 1 extension))) (intern extension))))))) (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 "{\\bf ") (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-") (if (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))))) (if (= 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)))))) (if (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) (if (interactive-p) (message "`%s' not found." filename) nil)))) (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: (if (looking-at "^sub ") (progn (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))) (define-skeleton kf-latex-letter "Insert a LaTeX letter template." "" "\ \\documentclass{letter} \\date{" (format-time-string "%d %b %Y") "} \\address{Karl Fogel \\\\ 689 Ft. Washington Ave, \\#2C \\\\ New York, NY 10040 \\\\ USA \\\\ \\\\ Phone: (773) 351-1729 \\\\ Email: {\\tt kfogel@red-bean.com}} \\signature{Karl~Fogel} \\begin{document} \\begin{letter}{" _ "J. Random Recipient \\\\ blah blah blah \\\\ blah blah blah \\\\ blah blah blah \\\\ blah blah blah \\\\ blah} \\opening{To Whom it May Concern,} \\parindent 0in XXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXX body XXXXXXXXX XXXXXXXX of XXXXXXXXX XXXXXXXX letter XXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXX \\closing{Best,} \\end{letter} \\end{document}\n") (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))))) (if (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"))) ;;;; Mailaprop ;;; ;;; See https://github.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")) (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)) ;; Why would I want to mail myself? Or that other guy named me? (string-match-p (concat (apply 'concat "\\([+=]" (mapcar (lambda (word) (concat "\\|" word)) (list "KARL FOGEL" "Karl Fogel" "karl fogel" "KFogel" "Kfogel" "Cron Daemon"))) "\\)") 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 " " addr) (string-match-p "kfogel@" addr) (not (string-match-p "^[kK]" addr))))) (setq mailaprop-drop-address-fn 'kf-mailaprop-drop-address-fn) (when (featurep 'mailaprop) (mailaprop-load-addresses)) (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))) ;;;; Messages and mail. ;; 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) (defun kf-message-mode-hook () ;; No more annoying ellipses! (if (eq (key-binding "\C-c\C-e") 'message-elide-region) (local-set-key "\C-c\C-e" 'kf-surround-with)) (setq message-beginning-of-line nil) (auto-fill-mode -1) (visual-line-mode) (setq company-tooltip-limit (- (frame-height) 4))) (defun kf-mail-mode-hook () ;; Bind C-c C-f C-i to insert an elizabethan insult header. (local-set-key "\C-c\C-f\C-i" 'kf-insert-elizabethan-insult-header) ;; Bind C-c C-a to insert one of Vic Zandy's truly arbitrary subjects: (local-set-key "\C-c\C-a" 'insert-arbitrary-subject) ;; Handle Reply-to: (if (or (eq (key-binding "\C-c\C-r") nil) (eq (key-binding "\C-c\C-r") 'mail-yank-region) (eq (key-binding "\C-c\C-r") 'message-caesar-buffer-body)) (local-set-key "\C-c\C-r" 'kf-righteous-reply-to-cycle) (local-set-key "\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 "~/"))))) (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" "questioncopyright.org" "opentechstrategies.com" "solutionguidance.com" "openitp.org" "opensource.org" "archive.org" "producingoss.com" "newamerica.net" "gnu.org" "oreilly.com"))) (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-flush-lines (keep) "Interactive switch function for `delete-[non-]matching-lines'." (interactive "*P") (unless (interactive-p) (error "This function is for calling interactively.")) (if keep (call-interactively 'delete-non-matching-lines) (call-interactively 'delete-matching-lines))) (defun kf-maybe-set-mail-followup-to () "Set the Mail-followup-to header if appropriate." (interactive "*") (let ((list (kf-followable-list))) (if 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)) (if (not (looking-at "\\s-*$")) (progn (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))) (if (interactive-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) (unless resumption-point (setq resumption-point (point-max))) (goto-char resumption-point)) (let ((case-fold-search nil)) (re-search-backward "^From ")) (let ((ret (list (point) (buffer-substring (point) resumption-point)))) ;; 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 "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 (interactive-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 (interactive-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 () (if (or (eq major-mode 'message-mode) (eq major-mode 'mail-mode)) (progn (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 ?r))) (aset obsc-1 1 ?o) (aset obsc-1 4 ?3) (aset obsc-1 2 ?t) (aset obsc-1 3 ?1) (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. (if kf-mail-send-prompt-protect (or (progn (goto-char (point-min)) nil) (yes-or-no-p "Send message? ") (error "Confirmation failed -- message not sent."))) ;; 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 ;; http://mail.google.com/support/bin/answer.py?hl=en&answer=14257. ;; ;; 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" "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)) ;; 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")) (if (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")) (if (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")) (if (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")) (if (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")) (if (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-date () (interactive) (message (current-time-string))) (if (not (fboundp 'date)) (defalias 'date 'kf-date)) (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))) (defconst kf-generic-mail-signature "Best regards,\n-Karl\n" "The generic signature I usually use.") (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 insert a non-live Org Mode time stamp (i.e., square braces instead of angle brackets); If prefix argument PARG, include time of day in that time stamp." (interactive "P") (if (or (eq last-command 'kf-switch-handler-i) (and (bolp) (looking-at "$"))) (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 parg) (let ((org-time-stamp-formats '("<%Y-%m-%d>" . "<%Y-%m-%d %a %H:%M>"))) (org-time-stamp parg t))))) (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-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-inspire-url (&optional custom-link-text) "Breathe the life-spirit into the URL, email address, or text around point. If the 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 if CUSTOM-LINK-TEXT is nil let the URL itself be the link text. If it is non-nil, then just put point where link text goes, with the link text itself either empty or perhaps some default value dependent on the mode. (The above behavior is kind of a crock and needs to be improved. Rather than having the link text depend on the mode, it should depend on the nature of the URL. For example, if the URL looks it's pointing to a particular numbered ticket in a ticket tracker, then the link text should clearly just be that number. But for now I've made a quick-and-dirty hack that DTRT in the particular circumstances I cared about at the time -- see the `org' case below for details.) 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 ((posns (or (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))) (url (buffer-substring start end)) ;; Used to use `thing-at-point-url-regexp' below, instead of ;; a hardcoded regexp, but apparently that variable went away ;; sometime in 2013, though etc/NEWS is silent on the topic. (is-url (string-match "^https?://[a-zA-Z]+" url)) (is-mailto (and (not is-url) (string-match "@" url))) (markup-flavor (kf-markup-flavor)) (life-giving-place nil)) (goto-char start) (cond ((eq markup-flavor 'xml) (insert "" (if custom-link-text "" (kf-full-url-to-human-friendly-url url)) "")) ((eq markup-flavor 'ltx) (insert "\\otsurl{") (goto-char end) (insert "}")) ((eq markup-flavor 'org) (insert "[[") (goto-char end) (save-match-data (search-backward "/" start t) (when (looking-at "/") (forward-char 1)) (let ((link-text (buffer-substring-no-properties (point) end))) (goto-char end) (when custom-link-text (setq link-text (concat "#" link-text))) (insert "][" link-text "]]")))) ((or (eq markup-flavor 'md) (eq markup-flavor 'markdown)) (insert "[" (if custom-link-text "" (kf-full-url-to-human-friendly-url url)) "](") (goto-char end) (insert ")")) (t (insert "") (setq life-giving-place (point)) (unless custom-link-text (cond (is-mailto (insert "mailto:" url)) (is-url (insert url)) (t (kill-new url)))) (insert "") (goto-char life-giving-place))) 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" " \\item \n\n" " \\item \n\n" " \\item \n\n" " \\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"))) (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'); 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 -> Add Alpha Channel. 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 pool.sks-keyservers.net --search-keys cer@encyclomundi.org http://keys.gnupg.net/pks/lookup?op=get&search=0xFE392561103F70BD 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 hkp://pool.sks-keyservers.net --send-key 16A0DE01 gpg --keyserver hkp://keys.gnupg.net --send-key 16A0DE01 To verify a signature in Gnus: W s (`gnus-summary-force-verify-and-decrypt') 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 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://keys.gnupg.net --recv-key 16A0DE01 -or- gpg --keyserver hkp://pool.sks-keyservers.net --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 hkp://keys.gnupg.net --send-key 16A0DE01 -or- gpg --keyserver hkp://pool.sks-keyservers.net --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 I discovered xournal. (See http://xournal.sourceforge.net/. There's also Xournal++ at https://github.com/xournalpp/xournalpp, which is apparently a successor and is probably worth looking into some time. But as of 2020-01-31 I've found the original xournal works just fine.) Here are the steps $ 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. To save a range of pages as a new PDF: $ pdftk inputfile.pdf cat 22-36 output outfile_p22-p36.pdf To join a bunch of PDFs into one PDF: $ pdfunite file-1.pdf file-2.pdf file-N.pdf combined.pdf To split pages 2 and 5 into a new PDF: $ pdftk orig.pdf cat 2 5 output new.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 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 --all 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 git-friendly patches: $ git format-patch ... > foo.patch # create the patch $ git apply --stat foo.patch # preview step 1: get stats $ git apply --check foo.patch # preview step 2: dry run $ git am --signoff < foo.patch # apply with sign-off $ git am < foo.patch # Emacs wants no sign-off 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 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/ 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 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\" 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. 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. ") (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 " 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) 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. ") (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 ") (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: $ \\$ % \\% _ \\_ } \\} & \\& # \\# { \\{ 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} 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*\" Arrows: Use math mode: $\\leftarrow$ | $\\righttarrow$ | $\\uparrow$ | $\\downarrow$ 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. ") (defconst kf-libreoffice-help "LibreOffice has options on its options. To unlock a read-only mode document for editing: Three ways to try: 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. ") (defconst kf-debian-help "I will never remember this stuff. To check what version of a package is installed: $ dpkg -s PACKAGENAME ") (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-string-help "\ 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 "List all open tabs: ThreeBarMenu -> Preferences -> General -> Home Page -> Use Current Pages 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. ") (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> .quit $ ls DATASET.csv DATASET.db $ sqlite3 DATASET.db sqlite> select * from TABLE_NAME; sqlite> .quit $ ") (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-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: showeverything #+SETUPFILE: ../../blah/blah/blah/foo.org #+CATEGORY: SomeNameHere ") (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 (concat "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-string-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-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.*") ;;; 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. (if (null char1) (error "Char1 is nil, %d" trans-pt)) (if (null char2) (error "Char2 is nil, %d" trans-pt)) (if (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-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" "--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-smiley-face () "If you have to ask, you can't afford it." (interactive) (cond ((= last-input-event ?\)) (insert ":-) ")) ((= last-input-event ?\() (insert ":-( ")) (t (insert ":)")))) (defun kf-switch-handler-dot (parg) "Insert the current date, or with prefix arg insert \"[...]\" (in a manner sensitive to email quoting context)." (interactive "P") (if parg (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 "[...]")) ;; We don't use `kf-insert-date' because it's for fancier use cases. (insert (format-time-string (format "%%Y-%%m-%%d"))))) (defun kf-remove-text-properties (b e) "Remove text properties over region from B to E." (interactive "r") (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?" (interactive "p") (let ((col 0)) (if (or (not kf-this-column) (> parg-or-column 1)) (if (interactive-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." (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-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))))) ;;; 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))) (if start (if (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)) )) (if (or (interactive-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))) (if (or (interactive-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)))) ;; Another calendar helper while we're at it. (defun kf-day-of-week (date) "Return the day of week for DATE, as a word. Interactively, prompts for DATE and displays result." (interactive (let ((saved-mcomplete (symbol-function 'minibuffer-complete))) (defalias 'saved-mcomplete saved-mcomplete) (condition-case nil (progn (defalias 'minibuffer-complete (lambda () (interactive) (let (completion-so-far (saved-mcomplete)) (if completion-so-far t (insert " ") nil)))) (let ((month-name-completion-list (mapcar (lambda (mname) (list (downcase mname))) calendar-month-name-array))) (list (completing-read "Date: " month-name-completion-list)))) ;; Unconditionally restore original minibuffer-complete (t (progn (defalias 'minibuffer-complete saved-mcomplete) (defalias 'saved-mcomplete nil)))))) (message "%S" date) (kf-require 'calendar) (calendar-day-of-week '(01 31 01))) (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) "Do an arithmetic operation on REGEXPs in the region from B to E. The matches will have non-number portions removed automatically. Prefix argument means prompt for the operation; otherwise, `+' is used." (interactive "sRegexp (default \"[-+]?[0-9]+\\.?[0-9]*\"): \nr\nP") (if (equal re "") (setq re "[-+]?[0-9]+\\.?[0-9]*")) ;; default to dollars (let ((operator (symbol-function '+))) (if 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)))) (if (interactive-p) (insert (number-to-string answer))) answer)))) (defun bwf-cut-here (parg) (interactive "P") (insert (if parg "--------------------8-<-------cut-here---------8-<-----------------------" "---------------------------------------------------------------------------" ))) (if (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.) (if (and (eq window-system 'x) (string-match "^2" emacs-version) nil) (progn ;; 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) (if (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version) (progn ;; 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))) ;; 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) ;; 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 the .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. (replace-in-string "\\" "\\\\" (replace-in-string " " "-" str)))))) (if (string-match "<" from-hdr) (let* ((elts (split-string from-hdr " <")) (name (replace-in-string " " ".*" (replace-in-string "\\" "\\\\" (regexp-quote (car elts))))) (email (replace-in-string "\\" "\\\\" (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) )) (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))) (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) (setq sentence-end-double-space t) (defun kf-fill-paragraph (&optional justify) "Like fill-paragraph, but 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. Note: to get this accepted into Emacs, it should watch the md5sum for just the affected region rather than the entire buffer. 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))) (fill-paragraph justify) (let ((new-md5sum (md5 (current-buffer)))) (when (string-equal orig-md5sum new-md5sum) (set-buffer-modified-p was-modified-before-fill))))) ;; 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. (if (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 " / ". (if (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 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 68) (nick-regexp "^<[a-zA-Z0-9][^>]*>") (longest-nick-length 0)) (goto-char b) (save-match-data (while (< (point) e) (if (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) (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. (if (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")))))) (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))) (if (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))))) (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)))) (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))))) (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-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) (message "DONE. VERIFYING BY RETRIEVING FROM REPOSITORY:\n\n%s" (shell-command-to-string (format "svn propget --revprop -r%s svn:log %s" rev repos))))) (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" (/ (* (float new-num) (float base-denom)) (float base-num))) (defun kf-percent (numerator denominator) (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-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-€ () "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-句号 () "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-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) (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-thumbs-up () "Insert a thumbs-up emoji (medium skin tone)." (interactive) (insert "👍🏽")) ; 128077 (U+1F44D) 127997 (U+1F3FD) ;; 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-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 () "Insert \"​\" (a.k.a., Zero-Width Space, Unicode 8203, https://en.wikipedia.org/wiki/Zero-width_space. See also https://github.com/redcross/arcdata/issues/232)." (interactive) (insert ?​)) (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-mountain-sun () "Insert \"​🌄\" (Unicode 127748)." (interactive) (insert ?🌄)) ;;; Gnus helpers. See also .gnus in this same directory. (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 that hardly counts as an obstacle 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) (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) (defun kf-rant-image () "Insert appropriate HTML template code for an image on rants.org. Place point somewhere useful afterward." (interactive) (insert "" "ALT_TEXT") (search-backward "uploads/") (forward-word 1) (forward-char 1)) (defun kf-sflc (&optional parg) "People want to know." (interactive "P") (when parg (insert "Software Freedom Law Center (softwarefreedom.org):\n")) (insert "1995 Broadway (at 68th street), 17th floor. " "The 59th / Columbus Circle [A,B,C,D,1] stop is close, " "as is the 66th street [1] and the 72nd street [1,2,3].\n")) (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." (interactive (list (read-number "Number lines, starting with: " 1))) (or start-num (setq start-num 1)) (kf-do-on-lines (point) (point-max) (insert (number-to-string start-num) " ") (setq start-num (1+ start-num)))) (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") (defun kf-insert-copyright-symbol (parg) "Insert copyright symbol, or phonogram copyright symbol iff prefix arg. This is stupid. I know Emacs has a better way to do this, right?" (interactive "*P") (if parg (insert "℗") (insert "©"))) (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 tried Magit, but all I really wanted was completion on branch ;; names and such in my Shell buffer, and pcomplete can do that. ;; masteringemacs.org/article/pcomplete-context-sensitive-completion-emacs ;; really helped here. (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 it starts out indented to the current column." (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)) ;; (message "yank-text: %S" yank-text) (sit-for 2) (let ((last-char (aref yank-text (- (length yank-text) 1)))) (when (or (char-equal last-char ?\n) (char-equal last-char ?\r)) (delete-region (point) (progn (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 (if (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)))) ;;; Personal OTS helpers (defun kf-ots-header (&optional inclusive) "Add the appropriate OTS headers (for now, just BCC) to the current mail. Iff optional argument INCLUSIVE is non-nil, include more people in BCC." (interactive "P") (let ((hdr "Bcc") (dom "opentechstrategies.com") (cecilia-present (kf-in-mail-headers (search-forward "James Vasile" nil t)))) (unless (or cecilia-present (not inclusive)) (kf-insert-mail-header hdr (format "James Vasile <%s@%s>" "james" dom))) (kf-insert-mail-header hdr (format "%s@%s" "crm" dom)))) ;; 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)) (word-source "/usr/share/dict/words")) (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))) dict) "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 " ")) (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". This needs to ;; be investigated further. (defun kf-fix-previous-transposition () "Fix a single transposition in the previous word. Or if unable to find a single transposition to fix, then leave point in the middle of the previous word so the user can fix it by hand. The return value is currently undefined; do not depend on it. Repeated invocation with no intervening commands runs successively through the various potential fixes of the original word that are reachable via transposition; each successive attempt signals 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. \(See also `flyspell-mode' and `flyspell-auto-correct-previous-word', which offers similar functionality but in a somewhat different way.\) If no transposition fix is possible, then try splitting the word before point as a compound word by using `kf-split-word'. TODO: That last part doesn't really have anything to do with fixing transpositions, of course. The right design is 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 lThe 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-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: What has been seen cannot be unseen. (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 replace-in-string (from to str &optional re-match) ;; Kind of stunning that Emacs doesn't have this built in, really. ;; Update: JimB says subr.el has `replace-regexp-in-string'. Sigh. "Return a copy of STR with FROM replaced by TO everywhere. If optional argument RE-MATCH is non-nil, then treat FROM as a regular expression to be matched." (with-temp-buffer (insert str) (goto-char (point-min)) (let ((search-func (if re-match 're-search-forward 'search-forward))) (save-match-data (while (funcall search-func from nil t) (replace-match to nil t)))) (buffer-substring (point-min) (point-max)))) (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" (replace-in-string "\\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))) (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)))) ;;; 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))) ;;; 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))) (define-key map (quote [f12]) 'kf-checkbook-tally-add) ;; TODO: For some reason the above isn't working and I ;; have to do this in the cbeckbook buffer instead: ;; ;; (local-set-key (quote [f12]) 'kf-checkbook-tally-add) ;; ;; But note that the define-key way did work when the key was ;; Enter (Return, a.k.a. "[?\r]") instead of F12. Go figure. 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" "holisticly" "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 (file-name-as-directory (expand-file-name "~/private/work/ots"))) (mapcar (lambda (el-file) (when (file-exists-p el-file) (load el-file))) (list (concat ots-dir "r/ots-tools/emacs-tools/ots.el") (concat ots-dir "r/ots-tools/emacs-tools/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")) (defconst kf-org-files (let ((lst nil)) (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 lst (cons path lst))))) (directory-files (expand-file-name dir))))) (list org-directory kf-ots-org-directory ots-dir ; some OTS org files may still be at top level kf-ots-bureaucracy-directory kf-ots-home-directory kf-naf-directory (expand-file-name "~/private/move"))) (when (boundp 'ots-org-files) (mapcar (lambda (org-file) (setq lst (cons org-file lst))) ots-org-files)) lst) "List of all of my usual Org Mode files that are available here.") (unless (boundp 'org-agenda-files) (setq org-agenda-files ())) (mapcar (lambda (agenda-file) (add-to-list 'org-agenda-files agenda-file)) kf-org-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) (defun kf-org-find-files () "Of my usual Org Mode files, find all the available ones into Emacs." (interactive) (mapcar (lambda (f) (bury-buffer (find-file-noselect f))) kf-org-files)) (kf-org-find-files) ;; 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) (define-key 'kf-ots-map "f" 'org-switchb) (define-key 'kf-ots-map "a" 'org-agenda) (define-key 'kf-ots-map "c" 'ots-visit-client) (define-key 'kf-ots-map "l" 'ots-crm-lookup) (define-key 'kf-ots-map "d" 'org-deadline) (define-key 'kf-ots-map "s" 'org-schedule) ;; (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/editors/emacs/beancount.el"))) (when (file-exists-p local-beancount) (load-file local-beancount))) (add-to-list 'auto-mode-alist '(".*\\.beancount" . beancount-mode))