;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; .emacs file (http://svn.red-bean.com/repos/kfogel/trunk/.emacs) ;;; ;;; ;;; ;;; Summary: Two decades' worth of Emacs customizations. ;;; ;;; ;;; ;;; Copyright (C) 1992-2013 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. ;;; ;;; ;;; ;;; 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, some 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 keybindings in `kf-map', which reveal my ;;; ;;; most-frequently-used entry points, especially: ;;; ;;; ;;; ;;; `kf-jump-there', `kf-surround-with-char', `kf-push-to-column', ;;; ;;; `kf-prefixed-yank', `kf-log-message'. ;;; ;;; ;;; ;;; 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. ;;; ;;; ;;; ;;; As of late 2011, I've been using the `kf-instrument' and `kf-persist' ;;; ;;; mechanisms to track what I use the most, so I can tweak the above to ;;; ;;; more accurately advise readers about the relative utility of things ;;; ;;; in this .emacs. Sometime in 2013 I'll probably use this data, but ;;; ;;; in the meantime, you can see the invocation tally accumulating at ;;; ;;; http://svn.red-bean.com/repos/kfogel/trunk/.emacs.d/kf-persist/\ ;;; ;;; symbols/kf-instrumentation-record. ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 50000000) ;; Doc string says it all. (unless (fboundp 'declare) (defmacro declare (&rest ignored-specs) "Compatibility shim. Older Emaces apparently don't have `declare', and this .emacs needs to be portable to machines running those older Emacs. This definition needs to be a macro because it's important that the arguments (e.g., `(indent 2)') not be evaluated.")) ;; Some code should only be run on my main machine. (defconst floss-p ;; (system-name) suddenly started returning "localhost" instead of ;; "floss". I think it has something to do with networking not ;; coming up in time during the boot process. Anyway (or (string-match "floss" (system-name)) (and (string-match "localhost" (system-name)) (file-exists-p (expand-file-name "~/.fetchmailrc"))))) (defconst kf-laptop (save-match-data (let ((sysname (system-name))) (if (or (string-match "floss" sysname) (string-match "kwarm" sysname) (string-match "ktab" sysname) (string-match "knet" 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.") ;; 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. (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))) ;;; 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)) (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) (kf-instrument) (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 ;; unset keys first: (when (eq window-system 'x) ;; Ubuntu 9.04 brilliantly puts frames where no one can find them. (if (eq (key-binding "\C-x\C-z") 'suspend-frame) (global-unset-key "\C-x\C-z")) (if (eq (key-binding "\C-z") 'suspend-frame) (global-unset-key "\C-z"))) (if (eq (key-binding "\C-xr") 'rmail) ;; unbind RMAIL before it hurts someone. Sheesh... (global-unset-key "\C-xr")) (if (eq (key-binding "\C-xf") 'set-fill-column) ;; unbind set-fill-column. I've had my fill of it! (global-unset-key "\C-xf")) (if (eq (key-binding "\C-xp") 'narrow-to-page) ;; unbind narrow-to-page before it narrows *you*. (global-unset-key "\C-xp")) ;; Now bind some keys, but always check what we're shadowing. (if (eq (key-binding "\M-n") nil) ;; Wow, I can't believe this is not used by Emacs. (global-set-key "\M-n" 'kff-next-line)) (if (eq (key-binding "\M-p") nil) ;; Same here. (global-set-key "\M-p" 'kff-previous-line)) (if (eq (key-binding "\M-q") 'fill-paragraph) (global-set-key "\M-q" 'kf-fill-paragraph)) (if (eq (key-binding "\C-l") 'recenter-top-bottom) (global-set-key "\C-l" 'recenter)) ;; Adjust for Maltron keyboard translations. (if (eq (key-binding "\M-(") 'insert-parentheses) (global-set-key "\M-(" 'beginning-of-buffer)) (if (eq (key-binding "\M-)") 'move-past-close-and-reindent) (global-set-key "\M-)" 'end-of-buffer)) ;; I never iconify my Emacs, because I never leave it. (if (eq (key-binding "\C-z") 'iconify-or-deiconify-frame) (global-set-key "\C-z" (lambda (parg) (interactive "P") (if parg (iconify-or-deiconify-frame) (message "Think smaller, please."))))) ;; "Private Peterson, Prepare the Permanent Personal Prefix!" ;; ;; "Yes, Sir!" ;; (global-unset-key "\C-c") ;should be unset anyway, but can't hurt... (define-prefix-command 'kf-map) (global-set-key "\C-c" kf-map) ;; then bind keys (the function defs mostly come later): (define-key kf-map "c" 'mode-specific-command-prefix) (define-key kf-map "h" 'kf-log-message) (define-key kf-map "v" 'kf-unbound) (define-key kf-map "o" 'org-iswitchb) (define-key kf-map "B" 'bookmark-map) (define-key kf-map "p" 'kf-paragraphize) (define-key kf-map "n" 'kf-narrow-telepathically) (define-key kf-map "r" 'revert-buffer) (define-key kf-map "?" 'kf-where-am-I) (define-key kf-map "D" 'toggle-debug-on-error) (define-key kf-map "d" 'kf-flush-lines) (define-key kf-map "E" 'kf-unbound) (define-key kf-map "F" 'kf-unbound) (define-key kf-map "s" 're-search-forward) (define-key kf-map "S" 'kf-just-sent) (define-key kf-map "S" 'search-forward) (define-key kf-map "M" 'manual-entry) (define-key kf-map "m" 'kf-mdash) (define-key kf-map "y" 'yank-match) (define-key kf-map "i" 'kf-switch-handler-i) (define-key kf-map "a" 'org-agenda) (define-key kf-map "u" 'kf-unbound) (define-key kf-map "j" 'kf-jump-there) (define-key kf-map "g" 'kf-unbound) (define-key kf-map "f" 'kf-auto-fill-mode) (define-key kf-map "q" 'kf-fill-paragraph-isolated) (define-key kf-map "e" 'kf-surround-with-char) (define-key kf-map " " 'kf-push-to-column) (define-key kf-map "k" 'bury-buffer) (define-key kf-map "t" 'kf-fix-previous-transposition) (define-key kf-map "T" 'kf-remove-text-properties) (define-key kf-map "l" 'org-store-link) (define-key kf-map "1" 'kf-unbound) (define-key kf-map "P" 'kf-pinyin-from-char) (define-key kf-map "x" 'kf-prefixed-yank) (define-key kf-map "w" 'kf-ots-header) (define-key kf-map "-" 'kf-hypherscore) (define-key kf-map "_" 'kf-hypherscore) (define-key kf-map "!" 'compile) (define-key kf-map "'" 'next-error) (define-key kf-map "2" 'kf-split-window-vertically) (define-key kf-map "9" 'kf-unbound) (define-key kf-map ")" 'kf-smiley-face) (define-key kf-map "(" 'kf-smiley-face) (define-key kf-map "." 'kf-switch-handler-dot) (define-key kf-map "b" 'kf-unbound) (if (not (string-match "^19" emacs-version)) (define-key kf-map "L" 'set-language-environment)) (if (eq (key-binding [delete]) 'delete-char) (global-set-key [delete] 'backward-delete-char)) (if (eq (key-binding [deletechar]) 'delete-char) (global-set-key [deletechar] 'backward-delete-char)) (defun kf-worship-frame () "Raise the selected frame and get the mouse pointer out of your face." (interactive) (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 (eq (key-binding "\C-xc") nil) (global-set-key "\C-xc" 'shell)) ;; was `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.") (defun kf-auto-fill-mode (&optional arg) "Like auto-fill-mode, but with message for users with long mode lines." (interactive "P") (kf-instrument) (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") (kf-instrument) (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)))) ;; 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) ;; 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) ;; Save some time. (defun kf-mdash (&optional parg) (interactive "*P") (kf-instrument) (let ((flavor (kf-markup-flavor))) (cond ((or parg (memq flavor '(sgml html xml))) (insert " — ")) ((eq flavor 'xml) (insert "—")) (t (insert "--"))))) ;;;; 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." (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 (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"))) 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))))) ((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)))))) (t (add-log-current-defun))))))) (defun kf-current-defun-to-kill-ring () "Put the name of the current defun into the kill-ring." (interactive "*") (kf-instrument) (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") (kf-instrument) (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 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. ;;;; ;; 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: (or (assoc "\\.mnu$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.mnu$" . food-menu-mode) auto-mode-alist))) (or (assoc "\\.pl$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.pl$" . perl-mode) auto-mode-alist))) (or (assoc "\\.py$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.py$" . python-mode) auto-mode-alist))) (or (assoc "\\.pm$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.pm$" . perl-mode) auto-mode-alist))) (or (assoc "\\.cgi$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.cgi$" . perl-mode) auto-mode-alist))) (or (assoc "\\.sgml$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.sgml$" . text-mode) auto-mode-alist))) (or (assoc "\\.ss$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.ss$" . scheme-mode) auto-mode-alist))) (or (assoc "\\.s?html?\\'" auto-mode-alist) (setq auto-mode-alist (cons '("\\.s?html?\\'" . text-mode) auto-mode-alist))) (or (assoc "\\.scm$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.scm$" . scheme-mode) auto-mode-alist))) ;; Diff mode gives me the willies. Yes, all of them! (or (assoc "\\.patch$" auto-mode-alist) (setq auto-mode-alist (cons '("\\.patch$" . text-mode) auto-mode-alist))) ;; I don't find HTML mode any more convenient than text mode (setq auto-mode-alist (cons '("\\.html$" . text-mode) auto-mode-alist)) ;; 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) (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 mark-ring-max (abs (lsh (random) 3))) (setq completion-ignored-extensions nil) (setq-default show-trailing-whitespace nil) (setq compose-mail-user-agent-warnings nil) ;; Sure, why not? (if (fboundp 'server-start) (server-start)) ;; Add my custom elisp collection to load-path: (setq load-path (cons (expand-file-name "~/elithp") load-path)) (setq load-path (cons (expand-file-name "~/elithp/elib") load-path)) (setq load-path (cons (expand-file-name "~/src/jimb-scripts/elisp") load-path)) (setq load-path (append (list (expand-file-name "~/code/jump-def") (expand-file-name "~/code/yank-match") (expand-file-name "~/code/chaffwin")) load-path)) ;; I want my Emacs back. (setq use-dialog-box nil use-file-dialog nil) ;;; Twitter customization. ;; Oh, goodie. There are three Twitter modes, and none of them are ;; really production-ready. Let's try them all. See ;; http://www.emacswiki.org/emacs/Twitter for more. ;; twitter.el (http://www.emacswiki.org/emacs/Twitter) ;; See ~/src/twitter/ for customizations made. (setq twitter-username "karlfogel") (setq load-path (cons (expand-file-name "~/src/twitter") load-path)) (autoload 'twitter-get-friends-timeline "twitter" nil t) (autoload 'twitter-status-edit "twitter" nil t) (if (eq (key-binding "\C-xt") nil) (global-set-key "\C-xt" 'twitter-get-friends-timeline)) (add-hook 'twitter-status-edit-mode-hook 'longlines-mode) (defun kf-twitter-*-mode-hook () (set-face-background 'twitter-header-face "dark slate grey")) (add-hook 'twitter-status-edit-mode-hook 'kf-twitter-*-mode-hook) (add-hook 'twitter-timeline-view-mode-hook 'kf-twitter-*-mode-hook) ;; If your status buffer is empty, C-c C-c will still get an error: ;; "error in process filter: peculiar error: 403" ;; It should just behave like C-c C-k. ;; Oh, and by the way, twitter.el messes up your cursor color if you ;; depart its buffer by hitting 'q'. Sometimes. Not always. (defun kf-cursor-fix () (interactive) (kf-instrument) (set-frame-parameter nil 'cursor-color "yellow")) ;; twittering-mode http://www.emacswiki.org/emacs/TwitteringMode ;; ;; See ~/src/twittering-mode/ for customizations in progress. Its ;; first prompt said "twittering-mode: ", which left a little to be ;; desired in the clarity department. Also, at that point I hit ;; return to quit out and go see about improving the prompt. But ;; hitting return left the password set to "", which of course got an ;; HTTP 404 (Unauthorized) error, and twittering-mode did not detect ;; this and offer to reprompt. Nice. So if you're not an Elisp ;; hacker, you might as well go home at that point. ;; twit.el (http://www.emacswiki.org/emacs/TwIt) ;; ;; This one appears to be in active development, but it was a bit ;; tricky to find a git repository to clone. I finally settled on ;; git://github.com/ieure/twit-el.git, and started reading up on the ;; web page. It's not quite clear what function to run first; when I ;; tried twit-follow-recent-tweets (the first time), it prompted for a ;; username. So I quit out and looked at the code, and then just ;; decided to try again and answer at the prompt. When I did, it ;; first said "Unauthorized!", but then decided to work. Go figure. ;; Unfortunately, it can freeze your whole Emacs while it updates in ;; the background. Not. Cool. Going back to twitter.el for now. ;;; 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) (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 2) (setq python-indent 2) (make-local-variable 'py-smart-indentation) (setq py-smart-indentation nil)) (add-hook 'python-mode-hook 'kf-python-mode-hook) (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-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) (kf-instrument) (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 () (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) (process-kill-without-query p)))))) (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:" "\\|" ".*\\([Ww]ork\\|[Pp]ersonal\\).* password:" "\\|" "Password for '([^()]+)' GNOME keyring" "\\|" "Password for 'http.*github.*':" "\\)")) (defun kf-shell () "My .bashrc screws up shell mode on startup somehow; perhaps this is the timing error mentioned in shell's docstring. Anyway, the solution is to make my .bashrc not exist while the shell is being started, and then have the shell source it manually. See documentation for `shell'." (interactive) (kf-instrument) (if (get-buffer "*shell*") (switch-to-buffer (get-buffer "*shell*")) ;; Else we'll have to start it, with kid-gloves: (let* ((shell-rc-file (expand-file-name "~/.bashrc")) (dark-corner (make-temp-name (expand-file-name "~/")))) (if (file-exists-p shell-rc-file) (progn (rename-file shell-rc-file dark-corner t) (call-interactively 'shell) (comint-send-string (get-process "*shell*") "source ~/.bashrc\n") (rename-file dark-corner shell-rc-file)) ;; else don't try to read rc files (call-interactively 'shell))))) ;;; 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-headers) (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-headers) (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) ;; 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) (kf-instrument) (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)) ;; 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. (if kf-laptop (setq initial-frame-alist (if (= (user-uid) 0) '((top . 1) (left . 2) (width . 80) (height . 55)) '((top . 1) (left . 2) (width . 80) (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-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 ] ".") (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))))) (defun emacs-threat-of-the-day (&optional prefix) "A Cautionary Tale." (interactive) (let ((threat (threat-of-the-day emacs-threats (or prefix "Emacs: ")))) (if (interactive-p) (message threat) threat))) (defun x-threat-of-the-day (&optional prefix) "Deny it if you dare." (interactive) (let ((threat (threat-of-the-day x-threats (or prefix "X-Windows: ")))) (if (interactive-p) (message threat) threat))) (defun microsoft-threat-of-the-day (&optional prefix) "Straight from public relations." (interactive) (let ((threat (threat-of-the-day microsoft-threats (or prefix "Microsoft: ")))) (if (interactive-p) (message threat) threat))) (defvar emacs-threat-of-the-day (emacs-threat-of-the-day) "*Today's Emacs pleasantry.") (defvar x-threat-of-the-day (x-threat-of-the-day) "*Eternal truth, good while supplies last.") (defvar microsoft-threat-of-the-day (microsoft-threat-of-the-day) "*Too big to kill.") ;;; End threats. ;;; (defconst kf-mode-incantations (list '["High" "Noble" "Large" "Grandiose" "Wise"] '["Puissant" "Virile" "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" )))) (kf-instrument) (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))) (kf-instrument) (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)))) ;;;; Standard defs, mostly bound upstairs. (defun kf-count-characters-region (start end) "Return the number of characters between START and END." (interactive "r") (kf-instrument) ;; TODO: Hmmm, possibility for double-counting here. (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) (kf-instrument) (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") (kf-instrument) ;; TODO: Hmmm, possibility for double-counting here. (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) (kf-instrument) (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") (kf-instrument) ;; TODO: Hmmm, possibility for double-counting here. (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-instrument) (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") (kf-instrument) (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: ") (kf-instrument) (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. Use this instead of the major mode when you can't depend on the mode." (let ((extension (file-name-extension (buffer-name)))) (if extension (save-match-data (if (string-match "\\([^<]+\\)<[0-9]>$" extension) (setq extension (match-string 1 extension))) (intern extension))))) (defun kf-surround-with-char (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. Prefix arg means don't do complex markup." (interactive "*cSurround with char: \nP") (kf-instrument) ;; hmm, ought to be able to do this with syntax tables? (let ((begthing char) (endthing char) (markup-flavor (kf-markup-flavor))) ;; Generally, default to HTML if no known extension. (cond ((and (not parg) (equal char ?b)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")) ((or (eq markup-flavor 'html) (eq major-mode 'text-mode)) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?i)) (setq begthing "") (setq endthing "")) ((and (not parg) (equal char ?c)) (setq begthing "") (setq endthing "")) ((and (not parg) (equal char ?e)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")) ((or (eq markup-flavor 'html) (eq major-mode 'text-mode)) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?u)) (setq begthing "") (setq endthing "")) ((and (not parg) (equal char ?t)) (setq begthing "") (setq endthing "")) ((and (not parg) (equal char ?s)) (cond ((eq markup-flavor 'html) (setq begthing "") (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 'texi) (setq begthing "@file{") (setq endthing "}")) ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?F)) (cond ((eq markup-flavor 'xml) (setq begthing "") (setq endthing "")))) ((and (not parg) (equal char ?x)) (cond ((eq markup-flavor 'xml) (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 ?\") (string-match ".*TeX$\\|.*tex$" (format-mode-line mode-name))) (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))))) (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") (kf-instrument) (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: ") (kf-instrument) ;; 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) (kf-instrument) (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))) ((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") (kf-instrument) (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"))) ;;;; Messages and mail. ;;; BEGIN mailaprop stuff (defvar kf-email-address-file (expand-file-name "~/private/mailaprop/email-addresses.eld") "*File created by mailaprop.py et al, containing completable addresses.") (defun kf-email-inhale-addresses () "Read and return the lisp expression in `kf-email-address-file'." (kf-read-sexp-from-file kf-email-address-file)) (defvar kf-email-addresses (kf-email-inhale-addresses) "Completion table for email addresses. Each element is a pair of the form \"foo@example.com | 2007 Dec 5\" . \"Foo Bar \" \"Foo Bar | 2007 Dec 10\" . \"Foo Bar \" The car of the pair is a string showing some form of the address with a date appended (after the separator \" | \") indicating when that form was most recently seen. The cdr is a string with the canonical form of the address: e.g.,, what should be inserted into an email recipient header when a given car is selected.") ;; (defun kf-remove-bad-address (bad-address address-table) ;; "Remove BAD-ADDRESS from ADDRESS-TABLE using setcdr. ;; If the first item in ADDRESS-TABLE matches BAD-ADDRESS, we're out of luck." ;; (let* ((bad-head-1 (assoc bad-address address-table)) ;; (bad-full (car (cdr bad-head-1))) ;; (bad-head-2 (assoc bad-full address-table))) ;; (setcdr address-table ...))) (defun kf-email-load-addresses () "Load (or reload) the email address completion table." (interactive) (setq kf-email-addresses (kf-email-inhale-addresses))) (defalias 'kf-email-reload-addresses 'kf-email-load-addresses) (defun kf-email-complete-address () "Complete an email address on a line by itself before point." (interactive "*") (kf-instrument) (let* ((completion-ignore-case t) (opoint (point)) (bpoint (progn (beginning-of-line) (re-search-forward "\\s-") (re-search-forward "\\S-") (forward-char -1) (point))) (prefix (buffer-substring bpoint opoint)) (attempt (try-completion prefix kf-email-addresses)) (completion (cdr (assoc attempt kf-email-addresses)))) (goto-char opoint) (when (not completion) (setq completion (cdr (assoc (completing-read "" kf-email-addresses nil t prefix) kf-email-addresses)))) (delete-region bpoint opoint) (goto-char bpoint) (insert completion))) (defun kf-email-handle-tab () (interactive "*") (kf-instrument) (require 'mailabbrev) (if (mail-abbrev-in-expansion-header-p) (kf-email-complete-address) (indent-for-tab-command))) (defun kf-mailaprop-interactive-check (&optional str) "Interactively complete STR against known email contacts." (interactive) ;; Don't do this in the interactive form because we want to be able ;; to be invoked with or without an argument. (completing-read "Candidate contact: " kf-email-addresses nil t str "")) ;;; END mailaprop stuff ;; mail-hist stuff ;; (setq mail-hist-history-size 1826) ;; This is just a default; kf-mail-send-hook changes this dynamically. (setq user-mail-address "kfogel@red-bean.com") (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-char)) (local-set-key "\t" 'kf-email-handle-tab)) (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) ;; Eat your heart out, Gmail. (local-set-key "\t" 'kf-email-handle-tab) ;; 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-sending-as (domain) "Return non-nil if sending this mail as kfogel from DOMAIN. If non-nil, the value returned is the domain (usually DOMAIN)." (kf-in-mail-headers (save-match-data (if (re-search-forward (concat "^[Ff]rom: .*fogel" (regexp-quote "@") "\\(" (regexp-quote domain) "\\)") nil t) (match-string-no-properties 1))))) (defconst kf-righteous-reply-to-list (mapcar (lambda (domain) (concat "Karl Fogel ")) (list "red-bean.com" "questioncopyright.org" "opentechstrategies.com" "openitp.org" "newamerica.net" "civiccommons.org" "producingoss.com" "opensource.org" "oreilly.com" "archive.org" "opencommunityservices.com")) "*Email addresses through which to cycle.") (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)) (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-righteous-reply-to-cycle () "Cycle through the various email addresses I might use." (interactive "*") (kf-instrument) (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") (kf-instrument) (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 "*") (kf-instrument) (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) (save-excursion (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) (multiple-value-bind (start end) (kf-get-mail-header-boundaries hdr) (when start (buffer-substring-no-properties start end)))) (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-headers () "Prepare some headers for outgoing mail." (interactive "*") (kf-instrument) (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 (kf-righteous-reply-to))) (insert (format "Reply-To: %s\n" own-addr)) (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 "\n")) (goto-char (point-min)) (search-forward "Reply-to:") (end-of-line) (insert "\nFrom: " own-addr))) ;; 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-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 (find-file-noselect "~/mail/outwent")) (widen) (unless resumption-point (setq resumption-point (point-max))) (goto-char resumption-point)) (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 (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))) (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 () "Insert previously-sent email message, 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." (interactive) (let ((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 (cadr sent-msg-info)))) (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-personal-smtp-tls-password nil "*Personal 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-civcoms-smtp-tls-password nil "*Civic Commons SMTP TLS password, set by `kf-mail-get-passwords'.") (defun kf-mail-get-passwords () "Get various mail passwords, unless they're already gotten." (interactive) (kf-instrument) (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)) (save-match-data (looking-at (format "^.* %s \"\\([^\"]+\\)\"" keymark)) (set sym (match-string 1))))))))) (list "personal" "gmail" "civcoms" "oreilly")))) (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 () ;; Correct for the Problem That Bites Me Every Time (TM): (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."))) ;; How we send mail depends on whether it's work or personal, and ;; what machine we're on. (when kf-laptop (load "smtpmail") ;; Old n' busted? (setq send-mail-function 'smtpmail-send-it) (setq message-send-mail-function 'smtpmail-send-it) ;; ...or maybe `message-smtpmail-send-it' for above. ;; New hotness? ;; (setq send-mail-function 'sendmail-query-once) ;; (setq message-send-mail-function 'sendmail-query-once) ;; See also the `custom-set-variables' call at the end of this file. (kf-mail-get-passwords) ;; Evaluate this if need to debug TLS troubles. ;; (setq smtpmail-debug-info t smtpmail-debug-verb t) ;; If it's smtp.gmail.com 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. (let ((sending-as nil)) ;; We have to setq these, instead of just binding them in the ;; `let', because otherwise there will be a minibuffer prompt ;; for at least `smtpmail-smtp-server' when the mail is actually ;; sent, after this hook is run. (setq smtpmail-smtp-server "smtp.gmail.com") (setq smtpmail-smtp-service 587) (cond ;; Some useful web pages should you ever find yourself in this place: ;; ;; 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 ((or (setq sending-as (kf-mail-sending-as "red-bean.com")) (setq sending-as (kf-mail-sending-as "questioncopyright.org")) (setq sending-as (kf-mail-sending-as "archive.org")) (setq sending-as (kf-mail-sending-as "producingoss.com")) (setq sending-as (kf-mail-sending-as "opensource.org")) (setq sending-as (kf-mail-sending-as "oreilly.com")) (setq sending-as (kf-mail-sending-as "opentechstrategies.com")) (setq sending-as (kf-mail-sending-as "openitp.org")) (setq sending-as (kf-mail-sending-as "opencommunityservices.com")) (setq sending-as (kf-mail-sending-as "subversion.org"))) (setq user-mail-address (concat "kfogel" (char-to-string 64) sending-as)) (setq send-mail-function 'smtpmail-send-it) ;; Vanilla 'starttls' seems to be working okay. ;; (setq starttls-use-gnutls nil) (let ((google-authn-address ;; these all share the same authn (concat "kfogel" (char-to-string 64) "gmail.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 this 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. (kf-set-up-authinfo smtpmail-smtp-server smtpmail-smtp-service google-authn-address kf-mail-gmail-smtp-tls-password) ;; Set this obsolete variable because this .emacs has to ;; work on machines where Emacs hasn't yet been upgraded to ;; a version that uses the new auth-source method. (setq smtpmail-auth-credentials `((,smtpmail-smtp-server ,smtpmail-smtp-service ,google-authn-address ,kf-mail-gmail-smtp-tls-password)))) (setq smtpmail-starttls-credentials `((,smtpmail-smtp-server ,smtpmail-smtp-service nil nil)))) ((setq sending-as (kf-mail-sending-as "civiccommons")) (setq user-mail-address (concat "kfogel" (char-to-string 64) "civiccommons.org")) (setq send-mail-function 'smtpmail-send-it) ;; Vanilla 'starttls' seems to be working okay. ;; (setq starttls-use-gnutls nil) (setq smtpmail-auth-credentials `((,smtpmail-smtp-server ,smtpmail-smtp-service ,user-mail-address ,kf-mail-civcoms-smtp-tls-password))) ;; See long comment in previous `cond' case about this. (kf-set-up-authinfo smtpmail-smtp-server smtpmail-smtp-service user-mail-address kf-mail-civcoms-smtp-tls-password) ;; Likewise, see comment in previous `cond' case about this. (setq smtpmail-starttls-credentials `((,smtpmail-smtp-server ,smtpmail-smtp-service nil nil)))) (t (error "Unrecognized sender email address.")))))) (defun kf-mail-sent-hook () (kf-tear-down-authinfo)) ;; Displaying. (defun kf-display-buffer (buffer &optional kill-after-display) "Display BUFFER. Hit any key to make the window go away. The character typed is treated normally, not lost, by the way." (let ((wc (current-window-configuration))) (display-buffer buffer) (shrink-window-if-larger-than-buffer (get-buffer-window buffer)) (setq unread-command-char (read-char-exclusive)) (set-window-configuration wc) (if kill-after-display (kill-buffer buffer)))) (defun kf-display-command-output (command) "Display output of COMMAND. Hit any key to make the window go away. The character typed is treated normally, not lost, by the way." (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 t))) ;; 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-instrument) (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-instrument) (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-instrument) (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-instrument) (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-instrument) (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-instrument) (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))))) (defun kff-next-line (&optional how-many) "Scroll the buffer to move line position." (interactive "p") (kf-instrument) (or how-many (setq how-many 1)) (progn (scroll-up how-many) (forward-line how-many))) (defun kff-previous-line (&optional how-many) "Scroll the buffer to move line position." (interactive "p") (kf-instrument) (or how-many (setq how-many 1)) (progn (scroll-down how-many) (forward-line (- how-many)))) ;; 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)\." (interactive) (kf-instrument) (set-buffer-modified-p t) (let ((executable-chmod 493)) (save-buffer) (executable-chmod))) (defun kf-date () (interactive) (kf-instrument) (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) (kf-instrument) (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-mail-signature "-Karl desk: +1 (312) 429-7626 cell: +1 (773) 351-1729 main: +1 (312) 857-6361 " "Signature to insert into mail messages.") (defun kf-switch-handler-i () "Insert a sig block, or inspire the URL around point as per `kf-inspire-url', depending on whether or not point is at the beginning of a blank line." (interactive) (if (and (bolp) (looking-at "$")) (insert kf-mail-signature) (kf-inspire-url))) (defun kf-inspire-url () "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." (interactive) (kf-instrument) (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))) (start (car posns)) (end (copy-marker (cdr posns))) (url (buffer-substring start end)) (is-url (string-match thing-at-point-url-regexp 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 "")) (t (insert "") (goto-char end) (insert "") (if life-giving-place (progn (push-mark) (goto-char life-giving-place)) (search-backward "\" >") (forward-char 2)))))) (defun kf-itemized-list () "Insert an itemized list on the current blank line. XML-only, for now." (interactive) (kf-instrument) (save-excursion (insert "\n") (insert " \n") (insert " \n") (insert " \n") (insert " \n") (insert " \n") (insert " \n") (insert "\n"))) (defun kf-variablelist () "Insert a variablelist on the current blank line. XML-only, for now." (interactive) (kf-instrument) (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) (kf-instrument) (call-interactively 'run-scheme) (insert "(load \"~/scheme/math.ss\")") (comint-send-input) (insert "(factorize )") (forward-char -1)) (defun kf-prime-p () (interactive) (kf-instrument) (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-big (contents &optional title) "Display string CONTENTS in a buffer named TITLE." (let ((buf (get-buffer-create (or title "*STUFF*")))) (save-excursion (set-buffer buf) (erase-buffer) (insert contents) (goto-char (point-min))) (display-buffer buf))) (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-instrument) (kf-display-something-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: ------------------------------- /nick other_kfogel /msg NickServ recover kfogel ******** /msg NickServ release kfogel ******** /nick kfogel /msg NickServ identify ******** /part #svn /join #svn ### Before talking to ChanServ, do... /query ChanServ ### ...so its responses show up in the right window (XChat bug). # 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-mysql-help " 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'); This was mysql-passwd-reset.sh on projects.o.o: #!/bin/sh /etc/init.d/mysql stop mysqld --skip-grant-tables & sleep 1 mysql -u root mysql echo \"UPDATE user SET Password=PASSWORD('285wzgv3t8') WHERE User='root'; \ FLUSH PRIVILEGES; exit;\" echo \"/etc/init.d/mysql stop\" echo \"/etc/init.d/mysql start\" " "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 backgrounds transparent in the Gimp: 1. Select -> Select by Color 2. Click on the background color you want to make transparent. 3. Layer -> Transparency -> Add Alpha Channel. 4. Edit -> Clear. (If save 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 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 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 "To encrypt+sign from Message Mode, do C-c RET C-e. To find/fetch a key: gpg --keyserver pool.sks-keyservers.net --search-keys cer@encyclomundi.org To send a signed key: gpg --keyserver hkp://pool.sks-keyservers.net --send-key 16A0DE01 gpg --keyserver hkp://keys.gnupg.net --send-key 16A0DE01 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. 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 is such a pain. pdfescape.com is still the fastest solution. Otherwise: Do what you can with evince. Then load it into gimp for signing and any other images. Then save as EPS, and use epstopdf (or pdf2ps) to convert *back* to PDF. Other tools to try: scribus, pdfedit, flpsed, pdftk, inkscape, pdf-shuffler, okular, xournal Or: convert PDF to RTF w/ calibre, open RTF file in LibreOffice, then save as 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 unstage: $ git reset FILE To push to an unplanned-for remote branch: 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, and I wanted to submit pull requests from them. So I forked the repostory to https://github.com/OpenTechStrategies/srtracker.git. But how to push my new local branches \"installation-doc-fix\" and \"full-text-search\" up to my new repository? First I had to add something like this to .gitconfig (modeled on the \"origin\" remote): [remote \"ots\"] fetch = +refs/heads/*:refs/remotes/origin/* url = https://github.com/OpenTechStrategies/srtracker.git Then I could do: $ git push ots full-text-search:full-text-search 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 ### ") (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. ") (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-mysql-help "That stuff you can never remember. Uh, s/you/I/, yeah." "*Never Apologize, Never Explain*") (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-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.*") ;;; 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") (kf-instrument) (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-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") (kf-instrument) (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-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") (kf-instrument) (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 fitz-said-fuck-you-clown (start end arg) (interactive "r\nsTagname: ") (kf-instrument) (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) (let ((new-name (copy-sequence name))) (subst-char-in-string ?* ?_ new-name t) (subst-char-in-string ? ?_ new-name t) (subst-char-in-string ?! ?_ new-name t) (subst-char-in-string ?/ ?_ new-name t) (subst-char-in-string ?( ?_ new-name t) (subst-char-in-string ?) ?_ new-name t) (subst-char-in-string ?` ?_ new-name t) (subst-char-in-string ?' ?_ new-name t) new-name)) (defconst printer-name (when floss-p "HP-LaserJet-P2055dn")) (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") (kf-instrument) ;; TODO: Hmmm, possibility for double-counting here. (let* ((tmpdir (make-temp-name (kf-defang-filename (expand-file-name (concat "~/" (buffer-name)))))) (tmpfile (kf-defang-filename (concat tmpdir "/" (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) " "))) (make-directory tmpdir) (write-region b e tmpfile) (shell-command cmd) (delete-file tmpfile) (delete-directory tmpdir))) (defun kf-print-buffer () "Print current buffer at 4 pages per page." (interactive) (kf-instrument) (kf-print-region (point-min) (point-max))) (define-skeleton kf-address "Insert my address, at current level of indentation." nil ;; No prompt. "Karl Fogel" \n > "5626 S. Blackstone Ave" \n > "Chicago, IL 60637" \n > "USA" \n \n > "+1 (773) 351-1729" \n > (concat "kfogel" "@" "red-bean.com") \n \n > "Karl Fogel" \n > "c/o OfficePort Chicago" \n > "9 W. Washington" \n > "Chicago, IL 60602 USA" \n > "+1 (312) 429-7626 desk" \n \n > "QuestionCopyright.org" \n > "P.O. Box 20165" \n > "Stanford, CA 94309-0165" \n > "+1 (312) 772-2726" \n \n > "Open Tech Strategies, LLC" \n > "1170 Union Street, #2" \n > "Brooklyn, NY 11225-1512 USA" \n > "+1 (312) 857-6361" \n \n) (defvar kf-thesaurus-file "~/thesaurus/roget13a.txt") (defvar kf-thesaurus-file-gz (concat kf-thesaurus-file ".gz")) (defun kf-thesaurus () (interactive) (kf-instrument) (find-file kf-thesaurus-file) (toggle-read-only 1)) (defalias 'kf-roget 'kf-thesaurus) (defalias 'thesaurus 'kf-thesaurus) (defalias 'roget 'kf-thesaurus) (defun kf-smiley-face () "If you have to ask, you can't afford it." (interactive) (kf-instrument) (cond ((= last-input-char ?\)) (insert ":-) ")) ((= last-input-char ?\() (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") (kf-instrument) (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") (kf-instrument) (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) ;; Instrument here, not right after `interactive', ;; because we should really count only the ;; column-setting first invocation, not all the ;; invocations that immediately follow it using that ;; setting (which could be thousands of lines for what ;; is essentially a single "use" of this function). (kf-instrument)) (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." (interactive "r") (kf-instrument) (kf-ensure-ordering start end) (setq end (copy-marker end)) (goto-char start) (let ((seen-lines (make-hash-table :test 'equal))) (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)))) (puthash line t seen-lines) (forward-line 1)))))) (defun kf-webgrrrlize-region (start end) "Provide a horrrmone supplement to the region from START to END." (interactive "r") (kf-instrument) (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")))) ;;; Stuff for writing a book. (defun kf-conditional-phrase () "Insert a DocBook profilable phrase, conditional on printed output. That is, the attribute will be \"output\", and the value will be \"\\\"printed\\\"\"." (interactive) (kf-instrument) (insert " ") (forward-char -9)) ;; 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") (kf-instrument) (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") (kf-instrument) (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)) (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))) (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") (kf-instrument) (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") (kf-instrument) (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) (kf-instrument) (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" )) ) ) ;; 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 '/ (list (apply '+ (mapcar 'float nums)) (length nums)))) ;; Make sure that disaster Never Happens Again. (let ((orig-gnus (symbol-function 'gnus))) (when (string-match "sanpietro" (system-name)) (fset 'gnus-for-real orig-gnus) (defun gnus () (interactive) (message "To run Gnus on sanpietro, use M-x `gnus-for-real'.")))) ;; 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." ;; Note `kf-gnus-wide-groups' is defined in a private file. (when (assoc gnus-newsgroup-name kf-gnus-wide-groups) (set-frame-width (selected-frame) 125))) (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." (set-frame-width (selected-frame) 80)) (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))) (defun kf-narrow-telepathically () "Narrow to the enclosing class, defun, or whatever you wanted." (interactive) (kf-instrument) (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") (kf-instrument) (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") (kf-instrument) (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") (kf-instrument) (message (md5 (buffer-substring b e)))) (defalias 'kf-md5-region 'kf-checksum-region) (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") (kf-instrument) (let ((orig-md5sum (md5 (current-buffer))) (was-modified-before-fill (buffer-modified-p))) (fill-paragraph justify) (let ((new-md5sum (md5 (current-buffer)))) (if (and (string-equal orig-md5sum new-md5sum) (not was-modified-before-fill) (buffer-modified-p)) (set-buffer-modified-p nil))))) ;; M-x toggle-input-method (C-\) toggles to and from this. (setq default-input-method "chinese-py") ;; 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))) (kf-instrument) (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) (kf-instrument) (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") (kf-instrument) (let ((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) (kf-instrument) (insert "http://www.DoNotFeedTheEnergyBeast.com/")) (defun kf-nooooooooooooooo () (interactive) (kf-instrument) (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 () "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)." (interactive) (kf-instrument) (let ((fname nil) (is-vc-status nil) (is-diff-hunk nil) (line nil) (excerpt nil) (inhibit-field-text-motion nil)) (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 "^[UMGAD]\\s-+\\([^: \t\n]+\\)") ;; On the filename line in a log message entry. (setq fname (match-string-no-properties 1)) (setq is-vc-status t)) ((looking-at "* \\([^: \t\n]+\\)") ;; On the filename line in a log message entry. (setq fname (match-string-no-properties 1))) ((looking-at "^\\s-*\\([^: {}[]\t\n]+$\\)") ;; File path on a line by itself, maybe preceded by whitespace. (setq fname (match-string-no-properties 1))) ((looking-at "\\([^: \t]+\\):\\(.*\\)") ;; File path followed by grep output after a colon. (setq fname (match-string-no-properties 1) excerpt (match-string-no-properties 2))) ((re-search-backward "^Index: " nil t) ;; one style of diff header (search-forward " ") (setq fname (buffer-substring-no-properties (point) (progn (end-of-line) (point)))) (setq is-diff-hunk t)) ((re-search-backward "^=== modified file '" nil t) ;; 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)) ((looking-at "^\\(\\S-+\\)$") ;; Just a filename on a line. DTRT. (setq fname (match-string-no-properties 1))) (t ;; Well, let's search backwards for an "*" to see if we can ;; be on the filename line of a log message entry (re-search-backward "^* " nil t) (kf-jump-there)))))) (when is-diff-hunk (setq line (kf-this-hunk-line))) (find-file fname) (if line (goto-line line) (when excerpt (search-forward excerpt) (beginning-of-line))))) (defun kf-p (numerator denominator) (/ (* (float numerator) 100.0) (float denominator))) (defalias 'kf-percent 'kf-p) (defun kf-browse-kill-ring () "Browse the kill ring." (interactive) (kf-instrument) (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))) (defun kf-euro () "This is insane. I should really learn The Right Way to do this in Emacs." (interactive) (kf-instrument) ;; (insert 342604) would work too, heh ;; ;; Noah points out that (insert (decode-char 'ucs #x20ac)) ;; would be future-proofer. (insert "€")) (defun kf-顿号 () "And you thought `kf-euro' was insane!" (interactive) (kf-instrument) ;; (insert 53410) would work too, heh (insert "、")) (defalias 'kf-listing-comma 'kf-顿号) (defun kf-│ () "What is this in HTML code anyway? And what's horizontal bar?" (interactive) (kf-instrument) (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) (kf-instrument) (insert ?·)) ; 183 (defalias 'kf-middle-dot 'kf-·) (defun kf-fractions () "I could just learn Emacs' input system better, but... life is short." (interactive) (kf-instrument) (insert "½ ⅓ ⅔ ¼ ¾")) (defun kf-double-quotes () (interactive) (kf-instrument) (insert ?“ ?”) (forward-char -1)) (defun kf-pi () "Just as insane as `kf-euro', yet somehow more defensible." (interactive) (kf-instrument) (insert (decode-char 'ucs #x03A0))) (defun kf-ß () "Maybe I should just learn Emacs input systems better?" (interactive) (kf-instrument) (insert ?ß)) ; 223 (defun kf-ẞ () "Maybe I should just learn Emacs input systems ẞetter?" (interactive) (kf-instrument) (insert ?ẞ)) ; 7838 (defalias 'kf-scharfes-s-lower 'kf-ß) (defalias 'kf-scharfes-s-upper 'kf-ẞ) ;;; Gnus helpers (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-instrument) (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 knus (&optional parg) "Prompt to enter a particular Gnus group, without displaying all groups. This is useful for avoiding being distracted by unrelated incoming mail or news when you just want to visit a particular group." (interactive "P") (kf-instrument) (let* ((groups (kf-gnus-build-groups-list)) (group (completing-read "Group: " groups nil t nil 'kf-gnus-history-list))) (gnus) (gnus-group-list-all-groups) (goto-char (point-min)) (re-search-forward (format "\\s-[0-9]+: %s\\s-*$" (regexp-quote group))) (beginning-of-line) (gnus-group-select-group parg) ;; Restore the usual *Group* buffer state. (save-excursion (set-buffer "*Group*") (call-interactively 'gnus-group-list-groups)))) ;; Standards have changed. (setq-default gnus-large-newsgroup nil) ;; Why in the heck is this not the default? (setq gnus-gcc-mark-as-read t) (defun kf-rant-image () "Insert appropriate HTML template code for an image on rants.org. Place point somewhere useful afterward." (interactive) (kf-instrument) (insert "" "ALT_TEXT") (search-backward "uploads/") (forward-word 1) (forward-char 1)) (defun kf-sflc (&optional parg) "People want to know." (interactive "P") (kf-instrument) (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))) (kf-instrument) (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 () "This is stupid. I know Emacs has a better way to do this, right?" (interactive "*") (kf-instrument) (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") (kf-instrument) ;; 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))) ;;; Ledger Mode helpers. (let ((ledger-el (expand-file-name "~/src/ledger/lisp/ledger.el"))) ;; Hint: git clone git://github.com/jwiegley/ledger.git (when (file-exists-p ledger-el) (load ledger-el) (setq auto-mode-alist (cons '(".*\\.ledger" . ledger-mode) auto-mode-alist)))) (defun kf-ledger-narrow-to-entry () "Narrow the region to the current ledger entry." (interactive) (kf-instrument) (let* ((bounds (ledger-current-entry-bounds)) (boe (car bounds)) (eoe (cdr bounds))) (narrow-to-region boe eoe))) ;; 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") (kf-instrument) (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-randomize-region (b e) (interactive "*r") (kf-instrument) (save-excursion (apply 'insert (sort (split-string (delete-and-extract-region b e) "\\b") (function (lambda (a b) (> (random 2) 0))))))) (defun kf-linked-in () "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) (kf-instrument) (insert (documentation this-command))) (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): ") (kf-instrument) (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 "*") (kf-instrument) (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 "*") (kf-instrument) (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 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)) (buffer-substring (point) (save-excursion (beginning-of-line) (point))))) (kf-instrument) (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-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)))) (defconst kf-ots-mail-drops (list (cons "client-log" "client-log")) "Standard dropboxes for OTS traffic.") (defun kf-ots-header (action &optional parg) "Add the appropriate OTS headers to the current mail. For now, that's just a BCC header." (interactive (list (completing-read "OTS addr: " kf-ots-mail-drops nil t nil nil (car (car kf-ots-mail-drops))) current-prefix-arg)) (let ((hdr "Bcc") (dom "opentechstrategies.com")) (kf-insert-mail-header hdr (format "%s@%s" (cdr (assoc action kf-ots-mail-drops)) 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) (kf-instrument) (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)) (upcased (upcase this-line-word))) (when (not (string-equal capitalized this-line-word)) (puthash capitalized 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.") (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)) (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.\) BUGLET TODO: There seems to be a bug right now: I had the word \"Btes\" at the beginning of a line, with point after it. I wanted \"Best\". First invocation of this function resulted in \"Bets\", then second resulted in \"Btes\" again with point placed in the middle of the word. Yet if I *start* from \"Bets\", the first invocation gives \"Best\". TODO: This function could handle much more than in-word transposition: 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 if transposing doesn't work, 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.) 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.) Also, 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) (kf-instrument) (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)))))) (if fixed-something (goto-char orig-pos) ;; If didn't manage to fix it, at least put point in the middle ;; of the word, closer to where the user might manually fix it. (goto-char (/ (+ word-first word-last) 2))))) ;;;; 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-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))) (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-get-anchors (url) "Return a completion table for all identifiably outward anchors at URL. An \"identifiably outward\" anchor is any anchor that looks like it's meant to be used in publicly displayed URLs pointing into the page, e.g., \"http://opensource.org/faq#commercial\", as contrasted with, say, ID attributes that are really only meant to be targeted by Javascript or other DOM-aware code. There is no 100% reliable way to distinguish between these two kinds of anchors. The heuristic used here is that if an element has both \"id\" and \"title\" attributes with the same value, it's an identifiably outward anchor. We don't actually parse the HTML, we just look for the attributes in that order on the same line; patches welcome, though. We also ignore the \"name\" attribute, even though http://www.w3.org/TR/html4/struct/links.html#h-12.2.3 describes how that can be used similarly to \"id\". Again, patches welcome. Returns an alist mapping anchors to full, anchored urls, i.e.: `((\"ANCHOR-NAME\" . \"http://FQDN/ETC/PAGE#ANCHOR-NAME\") ...)' " (require 'url) (let ((anchors ())) (save-excursion (set-buffer (url-retrieve-synchronously url)) (goto-char (point-min)) (save-match-data (while (re-search-forward " id=\"\\([a-zA-Z0-9_.-]+\\)\" title=\"\\([a-zA-Z0-9_.-]+\\)\"" nil t) (let ((id-val (match-string-no-properties 1)) (title-val (match-string-no-properties 2))) (when (string-equal id-val title-val) (setq anchors (cons id-val anchors)))))) (mapcar (lambda (anchor) (cons anchor (concat url "#" anchor))) anchors)))) (defun kf-read-anchored-url-from-url (base-url) "Return an anchored url based on BASE-URL, prompting for the anchor. Interactively completes the anchor name based on the anchors available in the web page at BASE-URL, then returns the full (anchored) url. See `kf-get-anchors' for more about identifying anchors." (let ((anchor-alist (kf-get-anchors base-url))) (cdr (assoc (completing-read (concat base-url "#") anchor-alist) anchor-alist)))) (defmacro kf-make-url-generator (url) "Generate a new interactive function to insert a URL with an anchor name. The function's name will be `kf-url-' followed by the unique portion of the URL. It will fetch anchors from the web page, prompt the user completingly for an anchor name, then insert the full anchored url." (let ((url-unique-portion (save-match-data ;; TODO: Should use `url-generic-parse-url' or whatever here. (string-match "https?://\\([a-zA-Z0-9/.-]+\\)" url) (match-string-no-properties 1 url)))) `(defun ,(intern (concat "kf-url-" url-unique-portion)) () ,(format "%s%s%s%s%s%s" "Insert an anchored url, starting from \"" url "#\"\n" "and completing based on available named anchors in that page.\n" "\n" "(This function was generated by `kf-make-url-generator';\n" "see also `kf-read-anchored-url-from-url'.)") (interactive) (kf-instrument) (insert (kf-read-anchored-url-from-url ,url))))) (kf-make-url-generator "http://opensource.org/faq") ;;; TODO: Could use the `kf-persist' mechanism to implement an offline ;;; cache for the alists -- or even the original web pages -- ;;; generated by the functions returned by `kf-make-url-generator' ;;; (both for response time and for airplane situations). ;;; ;;; Since the time when I'd most likely be writing that is when I find ;;; myself on an airplane or something, I'm saving a copy of one ;;; site's alist from 2011-11-03 here, to have something to work with ;;; when the time comes. ;; ;; (("legal-non-advice" . "http://opensource.org/faq#legal-non-advice") ;; ("legal-advice" . "http://opensource.org/faq#legal-advice") ;; ("logo-nominative-use" . "http://opensource.org/faq#logo-nominative-use") ;; ("logo-use" . "http://opensource.org/faq#logo-use") ;; ("surveys" . "http://opensource.org/faq#surveys") ;; ("join-a-project" . "http://opensource.org/faq#join-a-project") ;; ("unsubscribe" . "http://opensource.org/faq#unsubscribe") ;; ("finding" . "http://opensource.org/faq#finding") ;; ("controversial-licensors" . "http://opensource.org/faq#controversial-licensors") ;; ("osi-site-no-ads" . "http://opensource.org/faq#osi-site-no-ads") ;; ("profit" . "http://opensource.org/faq#profit") ;; ("selling" . "http://opensource.org/faq#selling") ;; ("linking" . "http://opensource.org/faq#linking") ;; ("reuse-osi-materials" . "http://opensource.org/faq#reuse-osi-materials") ;; ("non-distribution" . "http://opensource.org/faq#non-distribution") ;; ("publish-code" . "http://opensource.org/faq#publish-code") ;; ("linking-proprietary-code" . "http://opensource.org/faq#linking-proprietary-code") ;; ("preserve-copyright-notices" . "http://opensource.org/faq#preserve-copyright-notices") ;; ("php-code" . "http://opensource.org/faq#php-code") ;; ("unlisted-licenses" . "http://opensource.org/faq#unlisted-licenses") ;; ("avoid-unapproved-licenses" . "http://opensource.org/faq#avoid-unapproved-licenses") ;; ("approved-licenses-only" . "http://opensource.org/faq#approved-licenses-only") ;; ("permissive" . "http://opensource.org/faq#permissive") ;; ("copyleft" . "http://opensource.org/faq#copyleft") ;; ("evil" . "http://opensource.org/faq#evil") ;; ("restrict" . "http://opensource.org/faq#restrict") ;; ("commercial" . "http://opensource.org/faq#commercial")) ;;; I have joined the Org Mode cult. See http://OrgMode.org/. ;; ".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) ;; Always use the latest org mode code and documentation, if available. (setq load-path (cons "/home/kfogel/src/org-mode/lisp" load-path)) (add-to-list 'Info-default-directory-list (expand-file-name "/home/kfogel/src/org-mode/info")) (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))) (add-hook 'org-mode-hook 'kf-org-mode-hook) ;; (org keybindings were set in `kf-map' earlier) ; (setq org-startup-folded 'overview) ;; 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")) (defconst kf-ots-directory (expand-file-name "~/private/work/ots") "This is where the magic happens.") (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.") (defconst kf-org-files (let ((lst nil)) (mapcar (lambda (dir) (when (file-directory-p dir) (mapcar (lambda (basename) (let ((path (concat dir "/" basename))) (when (string-match "\\.org$" basename) (setq lst (cons path lst))))) (directory-files (expand-file-name dir))))) (list org-directory kf-ots-directory kf-naf-directory kf-poss-directory kf-poss-private-directory)) lst) "List of all of my usual Org Mode files that are available here.") (setq org-agenda-files kf-org-files) (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) ;; (defun kf-org-gnus-article-to-link () ;; "Place in the kill ring an Org-syntax link to the current article." ;; (interactive) ;; (kf-instrument) ;; (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))) ;; I think Emacs likes to modify the part below here. It started ;; doing that sometime before mid-2011. I guess I'll let it. (custom-set-variables ;; custom-set-variables was added by Custom. ;; If you edit it by hand, you could mess it up, so be careful. ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. '(gnus-article-date-headers (quote original)) '(sendmail-query-once-function (quote smtpmail-send-it) t))