;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                ;;;
;;; See http://svn.red-bean.com/repos/kfogel/trunk/.emacs for the  ;;;
;;; master copy of this .emacs file.                               ;;;
;;;                                                                ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

;; 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 "kfogel-work" 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)))


;;; Based on the 'with-library' in Eric Hanchrow <offby1>'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 ((buf (find-file-noselect file)))
          (set-buffer buf)
          (goto-char (point-min))
          (prog1
              (read (current-buffer))
            (kill-buffer (current-buffer)))))
    '()))

(defun kf-write-object-to-file (object file)
  "Write a Lisp OBJECT to FILE, pretty-printing as appropriate."
  (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)))))


;;; 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).
(defconst kf-instrumentation-record nil
  "Instrumentation results, read from and saved to `kf-instrumentation-file'.
  This is an alist: ((function-symbol number-of-invocations) ...)")

(defconst kf-instrumentation-file
  (expand-file-name (format "~/.kf-emacs-instrum/%s.eld"
                            (or kf-laptop (system-name))))
  "*File in which to save results of instrumentation.")

(defun kf-read-instrumentation-record ()
  (setq kf-instrumentation-record
        (kf-read-sexp-from-file kf-instrumentation-file)))

(defun kf-save-instrumentation-record ()
  (kf-write-object-to-file kf-instrumentation-record kf-instrumentation-file))

(defun kf-instrument ()
  (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)))))



;;; 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 "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" '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-inspire-url)
(define-key kf-map "a" 'kf-gtd)
(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" 'toggle-truncate-lines)
(define-key kf-map "T" 'kf-remove-text-properties)
(define-key kf-map "l" 'load-file)
(define-key kf-map "1" 'kf-unbound)
(define-key kf-map "x" 'kf-prefixed-yank)
(define-key kf-map "w" 'kf-gnus-grab-message-id)
(define-key kf-map "-" 'kf-hypherscore)
(define-key kf-map "_" 'kf-hypherscore)
(define-key kf-map "!" 'compile)
(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-elision)
(define-key kf-map "o" '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))

;; Move the mouse pointer away.
(or (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version)
    (progn
      (global-set-key [C-return] 'other-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)
  (call-interactively 'auto-fill-mode)
  (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/emacs-cvs/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 "&nbsp;&mdash;&nbsp;"))
     ((eq flavor 'xml)
      (insert "&mdash;"))
     (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 "\\(<sect[0-9]\\|<div\\)")
                 (section-close-re "</\\(sect[0-9]\\|div\\)>")
                 (title-open-re  "<\\(title\\|h[0-9]\\)>")
                 (title-close-re "</\\(title\\|h[0-9]\\)>")
                 (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 "</")
                              (point)))))))
            (if (> 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))

(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] 'other-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:"
       "\\)"))

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

(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)
    (set-face-background 'modeline "grey85")
    (set-face-foreground 'modeline "black")
    (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 'highlight "rosybrown")
    (set-face-foreground 'highlight "white")
    (or (string-match "XEMACS\\|XEmacs\\|xemacs" emacs-version)
        (set-face-background 'region "rosybrown"))
    (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)
    ;; use extended compound-text coding for X clipboard
    (set-selection-coding-system 'compound-text-with-extensions)))


;;; 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: " 
                                      '(("outline")
                                        ("text")
                                        ("scheme")
                                        ("lisp")
                                        ("org")
                                        ("emacs-lisp")
                                        ("c")
                                        ("perl")
                                        ("python")
                                        ("objc"))
                                      nil nil "outline"
                                      ))))
  (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-count-characters-region 'kf-region-length)


(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 <strong></strong> 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 "<emphasis role=\"bold\">")
        (setq endthing "</emphasis>"))
       ((or (eq markup-flavor 'html) (eq major-mode 'text-mode))
        (setq begthing "<strong>")
        (setq endthing "</strong>"))))
     ((and (not parg) (equal char ?i))
      (setq begthing "<i>")
      (setq endthing "</i>"))
     ((and (not parg) (equal char ?c))
      (setq begthing "<code>")
      (setq endthing "</code>"))
     ((and (not parg) (equal char ?e))
      (cond
       ((eq markup-flavor 'xml)
        (setq begthing "<emphasis>")
        (setq endthing "</emphasis>"))
       ((or (eq markup-flavor 'html) (eq major-mode 'text-mode))
        (setq begthing "<em>")
        (setq endthing "</em>"))))
     ((and (not parg) (equal char ?u))
      (setq begthing "<url>")
      (setq endthing "</url>"))
     ((and (not parg) (equal char ?t))
      (setq begthing "<tt>")
      (setq endthing "</tt>"))
     ((and (not parg) (equal char ?s))
      (cond
       ((eq markup-flavor 'html)
        (setq begthing "<strong>")
        (setq endthing "</strong>"))
       ((eq markup-flavor 'xml)
        (setq begthing "<systemitem>")
        (setq endthing "</systemitem>"))))
     ((and (not parg) (equal char ?l))
      (setq begthing "<literal>")
      (setq endthing "</literal>"))
     ((and (not parg) (equal char ?r))
      (cond
       ((eq markup-flavor 'xml)
        (setq begthing "<remark>")
        (setq endthing "</remark>"))
       ((eq markup-flavor 'html)
        (setq begthing "<font color=\"red\">")
        (setq endthing "</font>"))))
     ((and (not parg) (equal char ?e))
      (cond
       ((eq markup-flavor 'xml)
        (setq begthing "<emphasis>")
        (setq endthing "</emphasis>"))
       ((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 "<comment><para>(")
        (setq endthing ")</para></comment>"))))
     ((and (not parg) (equal char ?n))
      (cond
       ((eq markup-flavor 'xml)
        (setq begthing "<note>")
        (setq endthing "</note>"))))
     ((and (not parg) (equal char ?f))
      (cond
       ((eq markup-flavor 'texi)
        (setq begthing "@file{")
        (setq endthing "}"))
       ((eq markup-flavor 'xml)
        (setq begthing "<firstterm>")
        (setq endthing "</firstterm>"))))
     ((and (not parg) (equal char ?F))
      (cond
       ((eq markup-flavor 'xml)
        (setq begthing "<filename>")
        (setq endthing "</filename>"))))
     ((and (not parg) (equal char ?x))
      (cond
       ((eq markup-flavor 'xml)
        (setq begthing "<xref linkend=\"")
        (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 ?\)))
     ((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) (+ opoint 1))
          (forward-char -1)))))


(defun kf-hypherscore (parg)
  "Insert a hyphen or underscore between this word and the next."
  (interactive "*p")
  (kf-instrument)
  (let* ((cmd-keys (this-command-keys-vector))
         (char (aref cmd-keys (- (length cmd-keys) 1))))
    (if (null parg) (setq parg 1))
    (while (> parg 0)
      (forward-word 1)
      (just-one-space)
      (delete-char -1)
      (insert char)
      (setq parg (1- parg)))))



;;; find-load-file.el - figure out which file will get loaded
;;; Jim Blandy <jimb@occs.cs.oberlin.edu> - 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.")

;; (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)))

;;; 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-oreilly-p ()
  "Return non-nil if this mail buffer is oreillyish."
  (or
   (when (boundp 'gnus-summary-buffer)
     (let ((bname (buffer-name gnus-summary-buffer)))
       (when bname (string-match " oreilly\\." bname))))
   (kf-in-mail-headers
    (re-search-forward
     (concat "^[Ff]rom: .*fogel" (char-to-string 64) "oreilly.com")
     nil t))))


(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 <jrandom@example.com>\", 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 (- (length addr) 1))
       addr))))


(defun kf-mail-sending-as-oreilly-p ()
  "Return non-nil if sending this mail from a oreilly address."
  (kf-in-mail-headers
   (re-search-forward (concat "^[Ff]rom: .*fogel"
                              (char-to-string 64) ;; spam prevention
                              "oreilly.com")
                      nil t)))


(defconst kf-righteous-reply-to-list
  (mapcar (lambda (domain) (concat "Karl Fogel <kfogel@" domain ">"))
          (list "red-bean.com"
                "questioncopyright.org"
                "producingoss.com"
                "subversion.org"
                "oreilly.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)))
          (cond
           (lst (car lst))
           ((kf-mail-oreilly-p)
            (concat "Karl Fogel <kfogel" (char-to-string 64) "oreilly.com>"))
           (t (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-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")))
    ))

;; 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-password nil
  "*Personal mail password, set by `kf-mail-get-passwords'.")

(defvar kf-mail-work-smtp-tls-password nil
  "*Work 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)
  ;; This section isn't currently needed, see the comment in
  ;; `kf-mail-send-hook' about how port-forwarding is enough.
  ;; (or kf-mail-personal-password
  ;;    (setq kf-mail-personal-password
  ;;           (read-passwd "Personal mail SMTP TLS password: ")))
  (or kf-mail-work-smtp-tls-password
      ;; This kind of thing is fun, though in practice the real
      ;; security comes from the data file simply not existing in
      ;; any place where you're likely to see this .emacs :-).
      (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)
        (let* ((fun (symbol-function (intern obsc-1)))
               (obsc-2 (funcall fun "~/cevingr/.srgpuznvyep-jbex"))
               (obsc-3 (funcall fun "cnffjbeq")))
          (save-excursion
            (set-buffer (find-file-noselect obsc-2))
            (save-match-data
              (looking-at (format "^.* %s \"\\([^\"]+\\)\"" obsc-3))
              (setq kf-mail-work-smtp-tls-password (match-string 1))))))))

(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")
    (setq message-send-mail-function 'smtpmail-send-it)
    (setq send-mail-function 'smtpmail-send-it)
    (kf-mail-get-passwords)
    ;; Uncomment this if have any TLS troubles
    ;; (setq smtpmail-debug-info t)
    (cond
     ((kf-mail-sending-as-oreilly-p)
      ;; My guide was: http://obfuscatedcode.wordpress.com/\
      ;; 2007/04/26/configuring-emacs-for-gmails-smtp/
      (setq user-mail-address
            (concat "kfogel" (char-to-string 64) "oreilly.com"))
      (setq smtpmail-smtp-server "meast.oreilly.com")
      (setq send-mail-function 'smtpmail-send-it)
      (setq smtpmail-smtp-service 587)
      ;; Vanilla 'starttls' seems to be working okay.
      ;; (setq starttls-use-gnutls nil)
      (setq smtpmail-auth-credentials
            `(("meast.oreilly.com" 587
               "kfogel" ,kf-mail-work-smtp-tls-password)))
      (setq smtpmail-starttls-credentials
            '(("meast.oreilly.com" 587 nil nil))))
     ;; (For personal mail, start up ~/bin/port-forward.sh first.)
     (t
      ;; smtpmail uses user-mail-address in the "MAIL FROM:" portion
      ;; of the conversation.  So if I'm sending with a regular header
      ;; of "From: Karl Fogel <kfogel@questioncopyright.org>", we want
      ;; user-mail-address to be "kfogel@questioncopyright.org" as
      ;; that mail is being sent via smtpmail.
      (setq user-mail-address (kf-mail-sender-address-portion))
      (setq smtpmail-smtp-server "localhost")
      (setq smtpmail-default-smtp-server "localhost")
      (setq send-mail-function 'smtpmail-send-it)
      (setq smtpmail-smtp-service 1729)
      ;; The port-forwarding authn is enough to make this work, so
      ;; don't even set the creds.
      ;; (setq smtpmail-auth-credentials
      ;;       `(("localhost" 25 "kfogel" ,kf-mail-personal-password)))
      ))))

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



(defun kf-inspire-url ()
  "Breathe the life-spirit into the URL or email address 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, 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 'word)
                    (bounds-of-thing-at-point 'symbol)
                    (bounds-of-thing-at-point 'filename)))
         (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 "<ulink url=\"")
      (goto-char end)
      (insert "\"/>"))
     (t
      (insert "<a href=\"")
      (cond 
       (is-mailto (insert "mailto:" url))
       (is-url (insert url))
       (t (setq life-giving-place (point))))
      (insert "\" >")
      (goto-char end)
      (insert "</a>")
      (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 "<itemizedlist>\n")
    (insert "  <listitem><para></para>\n")
    (insert "  </listitem>\n")
    (insert "  <listitem><para></para>\n")
    (insert "  </listitem>\n")
    (insert "  <listitem><para></para>\n")
    (insert "  </listitem>\n")
    (insert "</itemizedlist>\n")))


(defun kf-variablelist ()
  "Insert a variablelist on the current blank line.  XML-only, for now."
  (interactive)
  (kf-instrument)
  (save-excursion
    (insert "<variablelist>\n")
    (insert "  <varlistentry><term></term>\n")
    (insert "    <listitem><para></para>\n")
    (insert "    </listitem>\n")
    (insert "  </varlistentry>\n")
    (insert "\n")
    (insert "  <varlistentry><term></term>\n")
    (insert "    <listitem><para></para>\n")
    (insert "    </listitem>\n")
    (insert "  </varlistentry>\n")
    (insert "\n")
    (insert "  <varlistentry><term></term>\n")
    (insert "    <listitem><para></para>\n")
    (insert "    </listitem>\n")
    (insert "  </varlistentry>\n")
    (insert "</variablelist>\n")))

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



(defun kf-display-something-big (contents &optional title)
  "Display string CONTENTS in a buffer named TITLE."
  (interactive)
  (kf-instrument)
  (let ((buf (get-buffer-create (or title "*STUFF*"))))
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      (insert contents)
      (goto-char (point-min)))
    (display-buffer buf)))


;;; Display ASCII codes when I need them
(defconst kf-ascii-tables
  "
       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-table
  "
   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
   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.")


(defun kf-ascii ()
  "Display the ASCII character table in its own buffer."
  (interactive)
  (kf-instrument)
  (kf-display-something-big kf-ascii-tables "*ASCII*"))


(defun kf-datetime-formats ()
  "Display date/time format codes in their own buffer"
  (interactive)
  (kf-instrument)
  (kf-display-something-big kf-datetime-formats "*Date / Time Formats*"))
(defalias 'kf-date-formats 'kf-datetimeformats)
(defalias 'kf-time-formats 'kf-datetimeformats)


(defun kf-radio-alphabet ()
  "Display the radio alphabet in its own buffer."
  (interactive)
  (kf-instrument)
  (kf-display-something-big kf-radio-alphabet "*RADIO ALPHABET*"))


(defun kf-stellar-statistics ()
  "Display some statistics about the solar system."
  (interactive)
  (kf-instrument)
  (kf-display-something-big kf-stellar-statistics-table "*Solar System*"))


;;; 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.")


(defun kf-genetic-code ()
  "Display the genetic code in its own buffer."
  (interactive)
  (kf-instrument)
  (let ((buf (get-buffer-create "*THE GENETIC CODE*")))
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      (insert kf-genetic-code)
      (goto-char (point-min)))
    (display-buffer buf)))


(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 "&amp;" nil t))
      (goto-char b)
      (while (search-forward "<" em t)
        (replace-match "&lt;" nil t))
      (goto-char b)
      (while (search-forward ">" em t)
        (replace-match "&gt;" 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) "<para>")
           (t                       "<p>")))
         (close-tag
          (cond
           ((eq markup-flavor 'xml) "</para>")
           (t                       "</p>"))))
    (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 "</" arg ">"))



;;; Some information about getting ps-print to do color:
;;
;; Thom Goodsell <tgg@shalott.cra.com> 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)
  (subst-char-in-string ?* ?_ name)
  (subst-char-in-string ?  ?_ name)
  (subst-char-in-string ?! ?_ name)
  (subst-char-in-string ?/ ?_ name)
  (subst-char-in-string ?( ?_ name)
  (subst-char-in-string ?) ?_ name)
  (subst-char-in-string ?` ?_ name)
  (subst-char-in-string ?' ?_ 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)))



(defun kf-address (parg)
  "Insert my address, at current level of indentation.
If PARG non-nil, do so LaTeXly."
  (interactive "P")
  (kf-instrument)
  (let* ((col (current-column))
         (indentation (make-string col ? ))
         (place-it (lambda (str)
                     (insert indentation str)
                     (if parg (insert " \\\\\n") (insert "\n")))))
    (when parg (insert "\\address{"))
    (let ((indentation "")) ; don't double the first line's indentation
      (funcall place-it "Karl Fogel"))
    (funcall place-it "689 Ft. Washington Ave, #2C")
    (funcall place-it "New York NY  10040")
    (funcall place-it "USA")
    (insert "\n")
    (funcall place-it "Phone: +1 (773) 351-1729")
    (insert indentation "Email: ")
    (if parg (insert "{\\tt "))
    (insert "kfogel@red-bean.com")
    (if parg (insert "}}"))
    (insert "\n\n")
    (funcall place-it "Karl Fogel")
    (funcall place-it "c/o The Change You Want To See Gallery")
    (funcall place-it "84 Havemeyer Street, Storefront")
    (funcall place-it "Brooklyn, NY  11211")
    (funcall place-it "USA")
    (insert "\n\n")
    (funcall place-it "QuestionCopyright.org")
    (funcall place-it "P.O. Box 20165")
    (funcall place-it "Stanford, CA 94309-0165")
    (funcall place-it "+1 (312) 772-2726")
    (insert "\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-elision ()
  (interactive)
  (kf-instrument)
  (if (and (eq (current-column) 0)
           (save-excursion
             (progn (forward-line -1)
                    (beginning-of-line)
                    (looking-at "^>"))))
      (insert ">\n> [...]\n\n")
    (insert "[...]")))


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



(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

### To get channel operator status:
/msg chanserv op #questioncopyright kfogel
"
  "IRC is the easiest interface ever.")

(defun kf-remind-irc-suckitude ()
  "A Twelve Step process for stealing your own identity."
  (interactive)
  (kf-instrument)
  (kf-display-something-big
   kf-irc-suckitude "*Never Apologize, Never Explain*"))

(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';

mysqldump -u root --default-character-set=utf8 dbname > dbname-dump.sql
flush privileges
"
  "Why can't I remember these syntaces?  And why do I write \"syntaces\"?")

(defun kf-mysql-help ()
  "That stuff you can never remember.  Uh, s/you/I/, yeah."
  (interactive)
  (kf-instrument)
  (kf-display-something-big
   kf-mysql-help "*Never Apologize, Never Explain*"))

(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.")

(defun kf-wireshark-help ()
  "I don't use wireshark often enough to remember how to use it."
  (interactive)
  (kf-display-something-big
   kf-wireshark-help "*Never Apologize, Never Explain*"))
(defalias 'kf-ethereal-help 'kf-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'.)")

(defun kf-gimp-help ()
  "You never know when the World Wide Web might be down.  Or Google."
  (interactive)
  (kf-display-something-big
   kf-gimp-help "*Easy as pie.  Blueberry neutronium pie.*"))


(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")
  (kf-instrument)
  (let ((col 0))
    (if (or (not kf-this-column) (> parg-or-column 1))
        (if (interactive-p)
            (progn
              (setq kf-this-column (current-column) col kf-this-column)
              (message "Set push column to %d" kf-this-column))
          (setq col parg-or-column))
      (setq col kf-this-column)
      (just-one-space)
      (insert-char ?  (- col (current-column))))))



(defun kf-uniqify (start end)
  "Filter non-unique lines out of the region from START to END."
  (interactive "r")
  (kf-instrument)
  (if (< end start) (let ((tmp end)) (setq end start start tmp)))
  (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 "<phrase output=\"printed\"> </phrase>")
  (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][0-9]\"): \nr\nP")
  (kf-instrument)
  (if (equal re "") (setq re "$[0-9]+\\.[0-9][0-9]")) ;; default to dollars
  (let ((operator (symbol-function '+)))
    (if parg
        (setq operator (cdr (completing-read
                             "Operator: "
                             (mapcar
                              (lambda (op)
                                (cons (symbol-name op) (symbol-function op)))
                              '(+ - * / % expt =))
                             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 "[0-9]+\\.*[0-9]*" 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 (- idx 1) this-new)
                      (cons head (nthcdr idx this-new)))))
            (setq new (cons this-new new)))
          (setq idx (+ idx 1)))
        (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)

;; 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 <span>...</span> tags.
        (replace-regexp "&#[0-9]+;" "<span>\\&</span>" nil start end)
        (goto-char start)
        (when mailto
          (insert "<a href=\"mailto:" entitized-string "\">")
          (goto-char end)
          (insert "</a>"))))
      (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 touch buffer-modified-p 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 sets buffer-modified-p so you
know you've been broken into.

Note: to get this accepted into Emacs, it should calculate the
md5sum on just the affected region.  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 added to other fill
functions easily."
  (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)
  "Print the pinyin transliteration for chinese character CHAR, which
  defaults to the character at point.  Optional prefix argument
  REGENERATE means regenerate the current input method map."
  (interactive (list (char-after) current-prefix-arg))
  (kf-instrument)
  (when (or regenerate (not kf-quail-inverted-map))
    (message "Regenerating untransliteration table...")
    (setq kf-quail-inverted-map (kf-quail-map-invert))
    (message "Regenerating untransliteration table...done"))
  (message "Pinyin is: \"%s\"" (gethash (string char) kf-quail-inverted-map)))



(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 (buffer-file-name))
  (search-backward "DO STUFF HERE"))


;;; 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-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)
        (line     nil)
        (excerpt  nil)
        (inhibit-field-text-motion nil))
    (save-excursion
      (save-match-data
        (beginning-of-line)
        (cond
         ((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 line (kf-this-hunk-line)))
         ((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 line (kf-this-hunk-line)))
         ((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)))))
    (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 (- (length str) 1) 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 "、"))



;;; 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)
  (if (< end beg)
      ;; Swap if reversed, and assume that overflow could only
      ;; happen if someone has way, way too much mail or news.
      (setq beg (+ beg end) end (- beg end) beg (- beg end)))
  (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)

(defun kf-rant-image ()
  "Insert appropriate HTML template code for an image on rants.org.
Place point somewhere useful afterward."
  (interactive)
  (kf-instrument)
  (insert "<a href=\"LINK_DEST\">"
          "<img src=\"http://www.rants.org/wp-content/uploads/"
          "2009/02/IMAGE_FILE.jpg\" alt='ALT_TEXT'/></a>")
  (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: "
  "<html>\n\n"
  "<head>\n"
  "<style type=\"text/css\">\n"
  "  body { background: white;}\n"
  "  h1 { text-align: center;}\n"
  "  :target {\n"
  "    border: 2px solid red;\n"
  "  }\n"
  "  a, img { border: none; }\n"
  "  .label { font-style: monospace; font-size: 60%; "
  "margin: 0 0 0.6% 0; }\n"
  "</style>\n"
  "</head>\n"
  "\n"
  "<title>" - str '(kf-htmlegalize-region skeleton-point (point)) "</title>" \n
  "\n"
  "<body>\n"
  "\n"
  "<h1>" - str '(kf-htmlegalize-region skeleton-point (point)) "</h1>\n"
  "\n"
  "<p>" - "</p>\n"
  "\n"
  "</body>\n"
  "</html>\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")))
  (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)))

(defun kf-ledger-next-entry ()
  ;; todo: working here
  )

(defun kf-ledger-align-amounts (&optional currency-sign)
  "Align the amounts in this entry columnarly."
  (or currency-sign (setq currency-sign "$"))
  (kf-ledger-narrow-to-entry)
  ;; todo: working here
  )


;; 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           208825.55)
        (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 240000.00)
;; Zero point: $230624.42


;; 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-randomize-region (b e)
  (interactive "r")
  (kf-instrument)
  (when (< e b) (setq b (+ b e) e (- b e) b (- b e)))
  (let ((words ()))
    (save-excursion
      (goto-char b)
      (while (< (point) e)
        (let ((opoint (point)))
          (forward-word 1)
          (setq words (cons (buffer-substring-no-properties
                             opoint (point)) words)))))
    words))


(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-phone-number ()
  "Format the number at or near point like a phone number."
  (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))))



;;; GTDfG: handling GTD files, yanking with auto-indentation, etc. ;;;;

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

(defvar kf-gtd-directory (expand-file-name "~/private/")
  "*The directory where your standard GTD files live.")

(defconst kf-gtd-files
  (list "actions" "waiting-for" "someday-maybe" "projects" "log")
  "Standard GTD files.  The first one is the default file for `kf-gtd'.")

(defvar kf-gtd-hooks nil
  "*Hooks run when a gtd file is found.")

(defun kf-gtd-hook ()
  "Set up some further GTDfG keybindings, etc."
  (if (member (buffer-name) kf-gtd-files)
      (local-set-key "\C-cc"
                     (lambda () (interactive)
                       (insert (format-time-string "* %Y-%m-%d: "))))))

(add-hook 'kf-gtd-hooks 'kf-gtd-hook)

(defun kf-gtd (gtd-file)
  "Go to the specified GTD destination."
  (interactive (list (completing-read "GTD: " kf-gtd-files
                                      nil t nil nil (car kf-gtd-files))))
  (kf-instrument)
  (find-file (expand-file-name (concat kf-gtd-directory gtd-file)))
  (run-hooks 'kf-gtd-hooks))