;;; hooks.el
;;;
;;; Copyright (C) 1996, 1997, 1998, 2000, 2002,
;;;   2003, 2004, 2005, 2006, 2007, 2008 Thien-Thi Nguyen
;;; This file is part of ttn's personal elisp library, released under GNU
;;; GPL with ABSOLUTELY NO WARRANTY.  See the file COPYING for details.

;;; Description: Hooks: Load time, normal and advice.


;;;---------------------------------------------------------------------------
;;; Load time hooks.
;;; Some files are pre-loaded in the dumped Emacs;
;;; their associated forms are evaluated immediately.

(let (file) (while (setq file (read))
              (eval-next-after-load file)))

"subr"
(define-keys minibuffer-local-completion-map
  ;; 2005-08-29 09:21:39.  "hang on... just a little bit longer now..."
  ;; beautiful drop from tonic to the fifth, sweeping down one whole for a bit
  ;; to end up back on the fifth for the hold and recycle prep.  i miss it.
  "\M-o" (lambda () (interactive)
           (when (equal ?/ (char-before))
             (delete-char -1))
           (when (re-search-backward "/[^/]+" (point-min) t)
             (forward-char 1)
             (delete-region (point) (match-end 0))))
  ;; 2000/02/02 12:00:34.  a beautiful day, warm breeze blowing in, hiding the
  ;; sound of traffic.  i think of friends on the east coast and my parents,
  ;; who are hip-deep in snow.
  "~" (lambda ()
        (interactive)
        (insert (if (let ((c (char-before (point))))
                      (or (not c) (/= ?/ c)))
                    "~"
                  ;; this doesn't work w/ emacs 21 because the prompt is
                  ;; considered part of the buffer and has `read-only' text
                  ;; property.
                  ;;- (erase-buffer)
                  ;; so instead, we zonk manually...
                  (while (ignore-errors (delete-char -1) t))
                  "~/"))))

;; 2001/11/06 17:18:40.  silence.

"view"
(lambda ()
  (define-keys view-mode-map
    "{" 'backward-page-ignore-narrow
    "}" 'forward-page-ignore-narrow))

;; 2004/07/08 14:21:00.  piova leggermente.  ucelli mati come al solito.

"subr"
(define-keys minibuffer-local-map "\M-m" 'exit-minibuffer)

"emacs-lisp/lisp-mode"
(progn
  (define-keys lisp-interaction-mode-map
    "\C-j" 'ppq
    "\C-\M-z" (defun zonk-definition ()
                "Do `makunbound' or `fmakunbound' on current top-level form.
Additionally, delete the form and any extra blank lines."
                (interactive)
                (beginning-of-defun)
                (let ((p (point))
                      (form (read (current-buffer))))
                  (funcall (case (car form)
                             ((setq) 'makunbound)
                             ((defun defmacro) 'fmakunbound)
                             (t 'identity))
                           (cadr form))
                  (delete-region p (point)))
                (delete-blank-lines)))
  (define-keys emacs-lisp-mode-map
    "\C-\M-z" 'zonk-definition))

"help"
(define-keys help-map
  "a" 'apropos
  "\C-o" (lambda (ref) (interactive "sDisplay Commentary: ")
           (let ((buf (format "*Commentary* %s" ref)))
             (shell-command (format "guile-tools display-commentary %S"
                                    ref)
                            buf)
             (set-buffer buf)
             (view-mode 1)
             (set (make-local-variable 'view-scroll-auto-exit) nil)
             (setq view-exit-action 'kill-buffer))))

"vc-hooks"
(define-keys vc-prefix-map
  "p" 'display-previous-revision)

"isearch"
(define-keys isearch-mode-map
  "\C-y" (lambda () (interactive)
           ;; 1999/08/08 03:40:00.  this used to use X properties
           ;; (ugh).  however, this may fail for older emacs
           ;; versions.  cannot determine when `isearch-yank-string'
           ;; was introduced.
           (isearch-yank-string (thing-at-point 'symbol))))

"bookmark"
(define-keys bookmark-map
  "?" (lambda () (interactive)
        (message "Make Jump Save Load Edit Rename Delete Insert")))

"dired"
(define-keys dired-mode-map
  "\C-m" 'dired-view-file
  "q"    (lambda () (interactive) (kill-buffer nil))
  "z"    'gzip-or-gunzip-from-dired
  "W"    'dired-wipe
  "/"    'dired-mark-directories
  "@"    'dired-mark-symlinks
  "U"    'browse-url-of-dired-file
  ;; 1998.1010.00:37:10-0700.  KCSM 91FM commercial-free jazz.  a standard,
  ;; "feelings"... original tune recorded in 1978.  strange, this is more
  ;; "easy-listening" than usual, but i guess the hour is late and bebop
  ;; might keep one awake.  because they are commercial-free, KCSM must
  ;; periodically undergo a pledge-drive, where they interrupt the usually
  ;; continuous music with annoying begging.  we are currently in the midst
  ;; of one of these month-long drives, but luckily it will be ending soon
  ;; (sunday).
  "I" (lambda () (interactive)
        (info (dired-get-filename)))
  ;; 1998.1015.00:11:28-0700.  92.3 KSJO mainstream rock station.  guns and
  ;; roses -- "knocking on heaven's door".  tomorrow (actually right now)
  ;; is lucy's birthday, the ides of october, i wonder if she's planning to
  ;; do anything special.  will give her a call...
  ;;
  ;; finally got hideshow.el xemacs-compatible.  seems silly to me that
  ;; emacs and xemacs should diverge, the why-can't-we-all-work-together
  ;; part of me is saddened.  although, i suppose personal experience
  ;; should teach me that sometimes viewpoints are so tenaciously held that
  ;; wresting compromise from the hardness of the righteous heart is too
  ;; much to ask.
  "\C-c\C-r" (lambda () (interactive)
               (save-window-excursion
                 (release (dired-get-filename)))
               (dired-do-redisplay)
               (dired-next-line 1))
  ;; 1999/06/05 13:39:13.  more dired fun.
  "_" (lambda () (interactive) (hexl-find-file (dired-get-filename)))
  ;; 2007-08-25 17:52:59.  meno male, ritrovato <http://www.kfjc.org>.
  "\C-c\C-d" (lambda ()
               "Do `edb-interact' or `db-find-file' on current file."
               (interactive)
               (let ((filename (dired-get-filename)))
                 (if (string-match "[.]edb$" filename)
                     (edb-interact filename nil)
                   (db-find-file filename)))))

"info"
(dolist (x (list
            "/usr/info"
            "/usr/share/info"
            "/usr/local/info"
            (expand-file-name "~/local/info")))
  (when (file-exists-p x)
    (add-to-list 'Info-directory-list x)))

"ebuff-menu"
(define-keys electric-buffer-menu-mode-map
  "\C-b" (lambda () (interactive)
           (let (buffer-read-only)
             (keep-lines "\\(Inferior Scheme\\)\\|\\(Comint\\)")))
  "\C-o" (lambda () (interactive)
           (let (buffer-read-only)
             (call-interactively 'keep-lines))))

"compile"
(progn
  (eval `(defadvice ,(if (fboundp 'compilation-start)
                         'compilation-start
                       'compile-internal)
           (before rewrite-compilation-command-w/cd activate)
           "Replace COMMAND using `rewrite-shell-command-w/cd'."
           (ad-set-arg 0 (rewrite-shell-command-w/cd (ad-get-arg 0)))))
  (defun ttn-hey-compilation-finished! (buf status-string)
    (unless (eq (car (buffer-list)) buf)
      (with-current-buffer (car (buffer-list))
        (yo! (substring status-string 0 -1) 'funky-flash))))
  (if (boundp 'compilation-finish-functions)
      (add-to-list 'compilation-finish-functions 'ttn-hey-compilation-finished!)
    (set 'compilation-finish-function 'ttn-hey-compilation-finished!))
  (define-keys compilation-mode-map
    "\C-c\C-q" 'kill-compilation
    ":" (lambda (line) (interactive "sLine: ")
          (let ((proc (get-buffer-process (current-buffer)))
                (buffer-read-only nil))
            (goto-char (process-mark proc))
            (insert (propertize line 'font-lock-face 'bold) "\n")
            (set-marker (process-mark proc) (point)))
          (process-send-string (buffer-name) (concat line "\n")))
    "\C-c\C-v" (lambda () (interactive)
                 (find-file (thing-at-point 'filename))
                 (vc-print-log))))

"isearch"
(define-key isearch-mode-map
  "\C-?" (lambda () (interactive)       ; from gnu.emacs.help probably
           (setq isearch-string
                 (substring isearch-string 0 -1)
                 isearch-message
                 (mapconcat 'isearch-text-char-description
                            isearch-string ""))
           (isearch-update)))

"make-mode"
(add-to-list
 'makefile-font-lock-keywords
 (list
  (concat "[$][({]"
          (regexp-opt
           (cons "call" (mapcar 'car makefile-gnumake-functions-alist))
           'words))
  1 font-lock-keyword-face)
 'append)

"vc-rcs"
(setup-anticipatory-vc-rcs-annotation)

"vc-cvs"
(progn
  (fset 'vc-cvs-show-log 'pretty-up-vc-print-log-output)
  (if (fboundp 'vc-rollback)
      (unless (fboundp 'vc-rcs-rollback)
        (defalias 'vc-cvs-rollback 'ttn-cvs-rollback))
    (unless (fboundp 'vc-cvs-cancel-version)
      (defalias 'vc-cvs-cancel-version 'ttn-cvs-cancel-version))))

"man"
(define-keys Man-mode-map
  "\M-n" 'down-holdcursor
  "\M-p" 'up-holdcursor
  "f"    'Man-follow-manual-reference
  "\C-m" 'Man-follow-manual-reference)

"comint"
(progn
  (add-hook 'comint-output-filter-functions 'comint-strip-ctrl-m t)
  (define-keys comint-mode-map
    "\C-a" 'comint-bol
    ;; 1998.0129.23:58:54-0800.  silence.  getting hungry.
    ;; this is support for the "go" programming convention.
    "\M-\C-g" 'go
    ;; 2004-12-04 14:28:23.  che bello poco movimento.
    "\M-m" (lambda () (interactive)
             (case last-command
               ((comint-previous-input comint-next-input move-end-of-line)
                (comint-send-input))
               (t (call-interactively (lookup-key global-map "\M-m")))))
    ;; 2006-08-31 13:13:38.  whir nowhir whir nowhir whir.
    ;;   Gotta make rent, gotta track sent,
    ;;     don't forget received, and all that was spent.
    ;;   Zero is not failure if mind can twist to tailor
    ;;     that which only ghosts can find to be more paler.
    ;;   New line to nowhere, decide now to go there,
    ;;     loss is a circle whose endpoint is stowed, shared.
    "\M-j" 'erase-buffer))

"sendmail"
(define-keys mail-mode-map
  "\M-&" (lambda (tag) (interactive "sTag: ")
           (rename-buffer (concat "*mail-" tag "*"))))

"help-mode"
(define-keys help-mode-map
  "\M-r" (lambda () (interactive)       ; remember
           (rename-buffer
            (concat "*Help* "
                    (buffer-substring-no-properties
                     (point) (save-excursion (end-of-line) (point)))))))

"scheme"
(progn
  (font-lock-add-keywords
   'scheme-mode
   '(("\\<\\(defmacro\\)\\>\\s-+\\(\\S-+\\)"
      (1 font-lock-keyword-face)
      (2 font-lock-function-name-face))
     ("\\<\\(define-module\\)\\>\\s-+(\\(\\S)+\\))"
      (1 font-lock-keyword-face)
      (2 font-lock-function-name-face))
     ("\\<\\(define-.*\\)\\>\\s-+\\(\\S-+\\)" ; hmm, is this right?
      (1 font-lock-keyword-face)
      (2 font-lock-function-name-face))))
  ;; 2005-08-23 12:23:26.  trapano e martello degli vicini lavorando.
  (ignore-errors (load-file "~/.emacs.d/ttn/scheme-indent-function-1.el"))
  ;; 2005-08-15 21:52:42.  random boombox.  some emacsen define this to
  ;; have string delim syntax, which is allowed, i suppose, but ugly...
  (modify-syntax-entry ?| "_ 23b" scheme-mode-syntax-table)
  ;; 1997.1122.02:57:53-0800.  middle of the night, why didn't i think of
  ;; this sooner?!
  (define-keys scheme-mode-map
    "\M-\C-m" 'scheme-send-definition-and-go))

;; 1998.1013.00:27:42-0700.  89.7 KFJC college station.  strange
;; noise-type sounds, but works for hacking since mostly instrumental.
;; i remember when living at 421 century getting seriously twisted and
;; hacking THUD to this radio station...

"outline"
(define-keys outline-mode-map
  "\C-c\C-d" (global-key-binding "\C-c\C-d")
  "\C-c\C-h" 'hide-subtree)

;; 1999/04/19 00:33:52.  silence.

"gud"
(define-keys gud-mode-map
  [f9]  'gud-cont
  [f10] 'gud-finish
  [f11] 'gud-step
  [f12] 'gud-next)

;; 1999/10/04 08:24:13.

"sgml-mode"
(define-keys sgml-mode-map
  [f11] (lambda () (interactive) (execute-kbd-macro 'spew)))

"vc"
(define-keys vc-annotate-mode-map
  "a" 'vc-annotate-display-autoscale)

"diff-mode"
(progn
  (when (facep 'diff-header)
    (set-face-background 'diff-header "gray20"))
  (when (facep 'diff-refine-change)
    (set-face-background 'diff-refine-change 'unspecified)
    (set-face-foreground 'diff-refine-change "green"))
  (define-keys diff-mode-map
    "\M-r" 'diff-auto-refine-mode
    "\M-z" (lambda () (interactive)
             (let ((p (point)) (inhibit-read-only t))
               (diff-apply-hunk) (delete-region p (point))))))

"grep"
(setq grep-find-command
      (concat "find . "
              (mapconcat (lambda (subdir)
                           (format "-name %s -prune" subdir))
                         '(RCS CVS)
                         " -o ")
              " -o"
              " -type f -print0"
              " | xargs -0 -e grep -nH -e "))

"texinfo"
(define-keys texinfo-mode-map
  [(control x) (n) (N)]
  (lambda ()
    (interactive)
    (let ((page-delimiter "^@node\\s-+"))
      (narrow-to-page))))

;; Add load-time hooks here.
nil


;;;---------------------------------------------------------------------------
;;; Normal hooks.

;; To paraphrase some moby CS dude: You KNOW when you are a programmer.

(let (hook) (while (setq hook (read))
              (add-hook hook 'my-prog-env)))
c-mode-common-hook
sh-mode-hook
emacs-lisp-mode-hook
lisp-mode-hook
asm-mode-hook
verilog-mode-hook
perl-mode-hook
sgml-mode-hook
scheme-mode-hook
;; 1998.0730.15:55:35-0700.  useful for wrapping, etc.
makefile-mode-hook
;; 1998.1020.02:39:00-0700.  KCSM 91FM.  some nice Count Basie, perky.  i
;; suppose that's fitting for this entry, my first bow to the inevitable.
java-mode-hook
;; Add programming major modes here.
nil

;; However, when you don't know, you can at least learn...

(let (hook) (while (setq hook (read))
              (add-hook hook (read) t)))

;; You might think that some text mode functionality should be bubbled up.
;; But, I ask: to where?  Since only bogus *scratch* buffer generation
;; seems to be uninterested, having text mode as default basically allows
;; it a large amount of the required functionality.  Btw, this hook fixes
;; that.

text-mode-hook
(lambda ()
  (setq truncate-lines t)
  (setq fill-column 78)
  ;; (abbrev-mode 1) ;; need abbrevs table
  (auto-fill-mode 1))

;; Keep things visually consistent in Dired.  Try for "instant response".

dired-mode-hook
(lambda ()
  (scroll-LR-by-20-minor-mode 1)
  (setq truncate-lines t))

;; C and C++ modes are similar.

c-mode-common-hook
(lambda ()
  (local-set-keys
   "\C-c\C-d" (global-key-binding "\C-c\C-d")
   "\C-?"     'backward-delete-char))

asm-mode-hook
(lambda ()
  (setq comment-column 32))

compilation-mode-hook
(lambda ()
  (scroll-LR-by-20-minor-mode 1)
  (setq truncate-lines t))

Man-mode-hook
(lambda ()
  (scroll-LR-by-20-minor-mode 1))

electric-buffer-menu-mode-hook
(lambda ()
  (scroll-LR-by-20-minor-mode 1)
  ;; Replace parentdirs w/ environment variables, plus others.
  (buffer-substitute-file-env-vars)
  ;; zonk the header line and adjust the window
  (setq header-line-format nil)
  (unless (one-window-p)
    (enlarge-window -1)))

verilog-mode-hook
(lambda ()
  (hs-minor-mode -1)
  (auto-save-mode -1)
  (abbrev-mode -1)
  (set (make-local-variable 'compile-command) "make ")
  (set (make-local-variable 'compilation-error-regexp-alist)
       '(("^Error!.*\n\\([^\n]+\n\\)*\\s-+\"\\(.*\\)\", \\([0-9]+\\):" 2 3)
         ("^Warning!.*\n\\([^\n]+\n\\)*\\s-+\"\\(.*\\)\", \\([0-9]+\\):"
          2 3))))

comint-mode-hook
(lambda ()
  (setq comint-scroll-show-maximum-output t))

mail-mode-hook
(lambda ()
  ;; easier to quote
  (set-fill-column 72)
  ;; 2004/05/27 15:24:26.  uccelli mati.
  (setq truncate-lines t))

view-mode-hook
(lambda ()
  (setq truncate-lines t)
  (scroll-LR-by-20-minor-mode 1))

help-mode-hook
(lambda ()
  ;; recent emacs does this automatically
  (when (eq this-command 'describe-bindings)
    (let (buffer-read-only)
      (goto-char (point-min))
      (flush-lines "\t\tundefined$"))))

;; 1997-10-14 04:11. make "man -k" pretty and useful.  it surprises me
;; that this wasn't thought of before.  the best way to rephrase the
;; following is:
;;
;;   i like references to be useful.  the original code does not
;;   recognize the reference nature of the output.  thus, the output needs
;;   to be massaged.
;;
;; some hints to ong-da: (a) what do we look for?  (b) is there a better
;; way?

Man-mode-hook
(lambda ()
  (when (string-match "[Mm]an -k" (buffer-name))
    (let (buffer-read-only ents ent txt sec pivot)
      (goto-char (point-min))
      (insert Man-see-also-regexp "\n\n")
      (while (re-search-forward
              "^\\(.*\\)\\(([^ ]+)\\)\\(\\s-+-\\s-+.*\\)$"
              (point-max) t)
        (setq ents (match-string 1)
              pivot (list (match-beginning 2) (match-string 2))
              txt (list (match-end 3) (match-string 3)))
        (goto-char (match-beginning 1))
        (do ((i (count ?, ents) (1- i)))
            ((= i 0) nil)
          (re-search-forward "\\(,\\|\n\\)" (point-max) t)
          (delete-char -1)
          (delete-horizontal-space)
          (insert (cadr pivot) "\t" (cadr txt) "\n"))
        (re-search-forward "\\(\\s-+\\)(")
        (delete-region (match-beginning 1) (match-end 1))
        (end-of-line)
        (insert "\n"))
      (Man-build-references-alist))))

;; 2007-02-20 16:10:21.  piccoli movimenti da tmv.  si č addormentata
;; tornando dal'ipercoop e adesso esploriamo il nuovo sistema di gnuvola.
;;
;; ;; 1998.0825.12:53:42-0700.  the whirring of the espresso machine gently
;; ;; drowns out the baroque guitar (there is also some piano).  baroque
;; ;; harmonies rule!  typical comment, i know, but all those geeks can't be
;; ;; wrong!
;;
;; mail-send-hook
;; (lambda ()
;;   (and (boundp 'ttn-jammed-from)
;;        (save-excursion
;;          (goto-char (point-min))
;;          (let ((reply-to (concat "Reply-to: " ttn-jammed-from)))
;;            (unless (search-forward reply-to nil t)
;;              (goto-char (point-min))
;;              (insert reply-to "\n"))))))

;; 1999/03/05 07:42:52.  silence.

view-mode-hook
(lambda ()
  (when (eq major-mode 'outline-mode)
    (define-keys view-mode-map
      "{" 'outline-previous-visible-heading
      "}" 'outline-next-visible-heading
      "+" (lambda ()
            (interactive)
            (let ((nlp (save-excursion (next-line 1) (point))))
              (hide-subtree)
              (when (= nlp (save-excursion (next-line 1) (point)))
                (show-subtree)))))))

vc-before-checkin-hook
(lambda ()
  (save-excursion
    (goto-char (point-min))
    (hs-show-block))
  ;; 1999/05/15 15:51:10.  well this should have been done a long time ago.
  ;; 2007-09-16 12:38:38.  never too late to improve things a bit, however...
  (when (and buffer-file-name (vc-registered buffer-file-name))
    (unless (eq 'change-log-mode major-mode)
      (let ((diff-switches
             (cons
              (case major-mode
                ((emacs-lisp-mode scheme-mode lisp-mode) "-F^(")
                ((texinfo-mode) "-F^@node")
                (t "-p"))
              (if (stringp diff-switches)
                  (list diff-switches)
                diff-switches))))
        (vc-diff nil)))))

ediff-prepare-buffer-hook
(lambda () (hs-minor-mode -1))

;; 2004-11-09 12:36:36.  camion e vicini.
;; magari questa cosa non ci serve pių.

perl-mode-hook
(lambda ()
  (setq perl-indent-level                2 ; stile GNU
        perl-continued-statement-offset  2
        perl-continued-brace-offset      0
        perl-brace-offset                0
        perl-brace-imaginary-offset      0
        perl-label-offset               -2))

;; 2003/09/04 15:40:45.  camion e vicini.
write-file-hooks
time-stamp

change-log-mode-hook
(lambda ()
  (local-set-keys
   "\M-i" 'indent-according-to-mode
   "\C-i" 'indent-according-to-mode)
  (set (make-local-variable 'backup-inhibited) t))

display-time-hook
(lambda ()
  (put-text-property 0 5 'help-echo '(italy-time t) display-time-string))

log-edit-mode-hook
abbrev-mode

next-error-hook
where-am-i

find-file-hook
(lambda ()
  (when vc-mode
    (update-rmanglement)
    (add-hook 'after-revert-hook 'update-rmanglement nil t)))

change-log-mode-hook
more-vc-make-sure-writeable

log-view-mode-hook
more-vc-pretty-up-log

;; Add normal hooks here.
nil


;;;---------------------------------------------------------------------------
;;; Advice hooks.
;;;
;;; TODO: Define some consistent naming convention.

;; Do the right thing after a `C-c C-l' when using gud.
;;
(defadvice gud-refresh (after gud-refresh-with-ttn-env)
  "Take into account recenter may be weird!"
  (call-interactively (key-binding "\M->")))

(defadvice dired-diff (around diff-last-release)
  (if (not (and (string= (file-name-nondirectory (ad-get-arg 0))
                         "")
                (string= (file-name-nondirectory (dired-get-filename))
                         ".last-release")))
      ad-do-it
    (find-file ".last-release")
    (goto-char (point-min))
    (let ((here default-directory)
          (lr (prog1 (read (current-buffer))
                (kill-buffer nil))))
      (switch-to-buffer (get-buffer-create (format "*%s*" lr)))
      (erase-buffer)
      (shell-command "diff-last-release" 1)
      (diff-mode)
      (setq buffer-read-only t)
      (set (make-local-variable 'list-buffers-directory) here))))

(defadvice shrink-window-if-larger-than-buffer (after post-eob-lines-too)
  "Unconditionally eliminate post-eob lines, as well."
  (when (pos-visible-in-window-p (point-max))
    (let ((window-min-height 1))
      (shrink-window
       (- (window-height)
          1                          ; todo: minibuffer/header-line accounting
          (if (= ?\C-j (char-before (point-max))) 1 0)
          (count-lines (window-start)
                       (window-end)))))))

;; Add advice here.

;;;---------------------------------------------------------------------------
;;; hooks.el ends here