;;; my.el --- my own .emacs

;; Copyright (C) 1999 by Stephen Tse
;;
;; Author: Stephen Tse <stephent@sfu.ca>
;; License: GNU Public License
;; Where: http://www.sfu.ca/~stephent/emacs/my.el
;; Keywords: local,customization

;;; Commentary
;;
;; I publish this .emacs just for sharing. Some stuff here are personal and
;; may not be useful for you. Any feedback or suggestion is welcome.
;;
;; If you want to customize the Windows and Menu keys as alt and hyper on
;; your 104 keywords, visit http://www.jwz.org/xkeycaps/.
;;
;; To install, byte-compile this file and put it in ~/elisp. Then put,
;;   (add-to-list 'load-path "~/elisp")
;;   (require 'my)
;;
;; That's all in my .emacs!
;;

;;; Code:

;; automagically update web copy
;; (write-region (point-min) (point-max) "/stephent@ftp.sfu.ca:~/pub_html/emacs/my.el")

(eval-when-compile
  ;; bug: empty *Group* buffer
  (require 'gnus-group)
  (require 'nnweb)
  (require 'speedbar)
  (require 'view-process-mode)
  (require 'compile)
  (require 'cc-mode)
  (require 'browse-url)
  (require 'dired)
  (require 'scwm)
  (require 'w3)
  (require 'quail))

;; Hundred times of the default. It significantly speeds up startup time
;; and operations for my cool computer without crashes.
(setq gc-cons-threshold 50000000)

;;; routine

(defun pbug ()
  "Check parenthesis bugs or similar horrors.

Even with Emacs advanced programming facilities, checking mismatching
parenthesis or missing quote (so called \"pbug\") is no less annoying than
pointer chasing in C.

This function divides the buffer into regions and tries evaluating them one
by one.  It stops at the first region where it fails to evaluate because of
pbug or any other errors.  It sets point and mark (and highlights if
`transient-mark-mode' is on) on the failing region and center its first
line.  \"^def\" is used to define regions.  You may also `eval-region'
right after pbug is done to let lisp parse pinpoint the bug.

No more \"End of file during parsing\" horrors!"
  (interactive)
  (let ((point (point))
        (region-regex "^(def..")
        defs beg end)
    (goto-char (point-min))
    (setq defs (loop while (search-forward-regexp region-regex nil t)
                     collect (point-at-bol)))
    ;; so it evals last definition
    (nconc defs (list (point-max)))
    (setq beg (point-min))
    (while defs
      (goto-char beg)
      (setq end (pop defs))
      ;; to be cool, uncomment these to see pbug doing step by step
      ;; (message "checking pbug from %s to %s..." beg end)
      ;; (sit-for 1)
      (when (eq (condition-case nil
                    (eval-region beg (1- end))
                  (error 'pbug-error))
                'pbug-error)
        (push-mark end 'nomsg 'activate)
        (goto-char beg)
        (recenter)
        (error "a pbug found from %s to %s" beg end))
      (setq beg end))
    (goto-char point)
    (message "no pbug found")))
(global-set-key [(super c) p] 'pbug)

(defun hack-let ()
  "Hack let-scoping and bind all its variable forms.

Normally it is a good programming practice to `let' variables in a
function, but in debugging it is convenient to bind _all_ variables so that
`eval-last-sexp' comes handy in places even inside a `let' scope.

Call this inside a `let' scope."
  (interactive)
  (save-excursion
    (let (beg end)
      (end-of-line)
      (search-backward "(let")
      (forward-char 5)
      (setq beg (point))                ; beginning of let

      (forward-sexp)
      (setq end (point))                ; end of let

    (loop for form in (read (buffer-substring beg end))
          do (if (listp form)
                 ;; bound variable to evaluated form
          (set (first form) (eval (second form)))
               ;; bound variable to nil
        (set form nil))))))
(global-set-key [(super c) l] 'hack-let)

(defun my-ps ()
  "ps with linux switches."
  (interactive)
  (View-process-status "axu"))
(global-set-key [(alt x) ?1] 'my-ps)

(defun my-ps-kill (&optional kill)
  "Terminate process with SIGTERM on current line.
Non-nil KILL means SIGKILL."
  (interactive)
  (View-process-send-signal-to-process-in-line 
   (if kill "SIGKILL" "SIGTERM")))

(defun delete-trailing-whitespace (begin end)
  "Delete trailing whitespace from all lines in region BEGIN and END."
  (interactive "r")
  (save-excursion
    (save-restriction
      (narrow-to-region begin end)
      (goto-char (point-min))
      (while (re-search-forward "[ \t\r]+$" nil t)
        (replace-match "")))))

(defun just-one-line (begin end)
  "Replace multiple blank lines with one in region BEGIN and END.
Recommend: run `delete-trailing-whitespace' first."
  (interactive "r")
  (save-excursion
    (save-restriction
      (narrow-to-region begin end)
      (goto-char (point-min))
      (while (re-search-forward "\n\\(\n\\)+" nil t)
        (replace-match "\n\n")))))

(defun buffer-to-register (register &optional buffer)
  "Store current buffer to REGISTER.
BUFFER is the buffer to be saved.
Use \\[jump-to-register] to go back to the buffer."
  (interactive "cBuffer to register: ")
  (set-register register (cons 'file (buffer-file-name buffer))))
(global-set-key [(control x) r ?.] 'buffer-to-register)

(defun prev-other-window ()
  (interactive)
  (other-window -1))
(global-set-key [(control iso-left-tab)] 'prev-other-window)

(defun make-buffer-neat ()
  "Make lisp code neat."
  (interactive)
  (delete-trailing-whitespace (point-min) (point-max))
  (just-one-line (point-min) (point-max))
  (untabify (point-min) (point-max)))

(defun kill-all-buffers ()
  "Kill literally all buffers.
This keeps Emacs from bloating."
  (interactive)
  (if (fboundp 'gnus-group-exit) (gnus-group-exit))
  (loop for x being buffers
    do (kill-buffer x)))

(global-set-key [(shift insert)] 'x-insert-selection)

(defun copy (beg end)
  "Copy current region from BEG to END to X cutbuffer."
  (interactive "r")
  (own-selection (buffer-substring beg end)))
(global-set-key [(control insert)] 'copy)

(defun switch-to-next-buffer ()
  "Switch to next most recent buffer."
  (interactive)
  (switch-to-buffer nil))
(global-set-key [(alt space)] 'switch-to-next-buffer)

(defun exchange-point-and-mark-without-zmacs ()
  "Exchange point and mark without activiating zmacs region.
To activate use `activate-region' \\[activate-region] instead."
  (interactive)
  (exchange-point-and-mark 'dont-activate-region))
(global-set-key [(control x) (control x)]
  'exchange-point-and-mark-without-zmacs)

(defun set-symbol-near-point ()
  "Set symbol near point."
  (interactive)
  (set (intern (symbol-near-point)) (read)))
(global-set-key [(super x) s] 'set-symbol-near-point)

(defun debug-on-error ()
  "Toggle variable `debug-on-error'."
  (interactive)
  (setq debug-on-error (not debug-on-error))
  (message "debug-on-error=%s" debug-on-error))
(global-set-key [(super c) d] 'debug-on-error)

(defun enlarge-window-by-a-lot ()
  (interactive)
  (enlarge-window 20))
(global-set-key [(super x) ?^] 'enlarge-window-by-a-lot)

(defun force-revert-buffer ()
  "Revert buffer without confirmation."
  (interactive)
  (revert-buffer nil t))
(global-set-key [(super x) r] 'force-revert-buffer)

(defmacro shellx (id)
  "Switch to a shell named ID."
  `(lambda ()
     (interactive)
     (if (get-buffer ,id)
         (switch-to-buffer ,id)
       (shell)
       (rename-buffer ,id)
       (process-kill-without-query (get-buffer-process ,id)))))
(global-set-key [(super s) ?1] (shellx "*jordon*"))
(global-set-key [(super s) ?2] (shellx "*ally*"))
(global-set-key [(super s) ?3] (shellx "*cartor*"))
(global-set-key 'print (shellx "*jordon*"))
(global-set-key 'scroll-lock (shellx "*ally*"))
(global-set-key 'pause (shellx "*cartor*"))

(defun copy-url-at-point ()
  "Copy url at point."
  (interactive)
  (kill-new (url-get-url-at-point)))
(global-set-key [(alt w) u] 'copy-url-at-point)

(defun copy-file-or-dir-name ()
  "Copy buffer file name, or dir name if in DIRED mode."
  (interactive)
  (kill-new
   (if (eq major-mode 'dired-mode)
       (dired-current-directory)
     buffer-file-name)))
(global-set-key [(alt w) f] 'copy-file-or-dir-name)

(defun copy-symbol-near-point ()
  "Copy symbol near point."
  (interactive)
  (kill-new (symbol-near-point)))
(global-set-key [(alt w) s] 'copy-symbol-near-point)

(defun copy-current-line ()
  "Copy current line."
  (interactive)
  (kill-new (buffer-substring (point-at-bol) (point-at-eol))))
(global-set-key [(alt w) l] 'copy-current-line)

(defun buffer-non-readonly ()
  "Make buffer non-readonly."
  (interactive)
  (setq buffer-read-only nil))
(global-set-key [(alt x) q] 'buffer-non-readonly)

(defadvice switch-to-buffer
  (before exising-buffer activate compile)
  "Avoid creating new buffers.
Switch to exisitng buffers only, unless given a prefix argument."
  (interactive
   (list (read-buffer "Switch to buffer: "
                      (other-buffer) (null current-prefix-arg)))))

(defun toggle-menubar ()
  (interactive)
  (set-specifier
   menubar-visible-p
   (not (specifier-instance menubar-visible-p))))
(global-set-key [(alt c) b] 'toggle-menubar)

(defun toggle-modeline ()
  (interactive)
  (set-specifier
   has-modeline-p
   (not (specifier-instance has-modeline-p))))
(global-set-key [(alt c) m] 'toggle-modeline)

(defun toggle-toolbar ()
  (interactive)
  (set-specifier
   default-toolbar-visible-p
   (not (specifier-instance default-toolbar-visible-p))))
(global-set-key [(alt c) t] 'toggle-toolbar)

(defun highlight-my-keyword ()
  "Highlight code documentation keyword."
  (setq font-lock-keywords
        (append font-lock-keywords
                '(("\\bFIXME\\\|\\bHACK\\\|\\bTODO"
                   (0 'font-lock-warning-face t))))))

(defun exit-emacs-with-gnus ()
  "Save and exit gnus before exiting Emacs."
  (interactive)
  (if (fboundp 'gnus-group-exit) (gnus-group-exit))
  (save-buffers-kill-emacs))
(global-set-key [(control x) (control c)] 'exit-emacs-with-gnus)

(defun fortune ()
  "Famous unix fortune teller."
  (shell-command-to-string "/usr/games/fortune"))

(defun write-file-no-select ()
  "`write-file' without changing to new filename.
Useful for making a copy of working file in development."
  (interactive)
  (let ((old-filename (buffer-file-name)))
    (call-interactively 'write-file)
    (write-file old-filename)))
(global-set-key [(control x) w] 'write-file-no-select)

(defun real-beep ()
  "Make beep sound ignorning `visibile-bell'."
  (let ((visible-bell nil))
    (beep)))

(defun switch-to-scratch ()
  "Switch to scratch buffer.
Create one in `emacs-lisp-mode' if not exists."
  (interactive)
  (let ((previous (get-buffer "*scratch*")))
    (switch-to-buffer "*scratch*")
    ;; don't change current mode
    (unless previous (emacs-lisp-mode))))
(global-set-key [(alt ?4)] 'switch-to-scratch)

;; finger fix! I keep press control-t when I mean control-y.
(global-set-key [(control t)] 'undefined)
(global-set-key [(alt t)] 'transpose-chars)

(defun time-stamp ()
  "Insert a time stamp."
  (interactive "*")
  (insert
   (concat "[" (format-time-string "%b %d, %y" (current-time)) "] ")))
(global-set-key [(alt -)] 'time-stamp)

;; hot file
(defmacro hot-file (filename)
  `(lambda () (interactive) (find-file ,filename)))
(global-set-key [(alt ?1)] (hot-file "~/info/world"))
(global-set-key [(alt ?2)] (hot-file "~/info/memo"))
(global-set-key [(alt ?3)] (hot-file "~/.emacs"))
(global-set-key [(alt ?5)] (hot-file "~/info/data"))
(global-set-key [(alt ?6)] (hot-file "~/elisp/my.el"))
(global-set-key [(alt ?7)] (hot-file "~/.scwm/settings"))
(global-set-key [(alt ?8)] (hot-file "~/elisp/xlib.scm"))

;; hot text
(defun hot-text-sfu ()
  (interactive)
  (insert "/stephent@ftp.sfu.ca:~/"))
(global-set-key [(alt i) s] 'hot-text-sfu)

(defun hot-text-geek ()
  (interactive)
  (insert "linux-geek@sfu.ca"))
(global-set-key [(alt i) l] 'hot-text-geek)

(defun my-compile ()
  (interactive)
  (require 'compile)
  (compile-internal compile-command "No more errors"))
(global-set-key [(control print)] 'my-compile)

(defun next-work-frame ()
  "Skip speedbar and other apps windows."
  (interactive)
  (let ((n (if (and (boundp 'speedbar-frame)
                    (eq (next-frame) speedbar-frame))
               2 1)))
      (other-frame n)))
(global-set-key [(alt tab)] 'next-work-frame)

(defun hungry-backspace ()
  "Similar to hungry delete in cc-mode."
  (interactive)
  (delete-region 
   (point)
   (progn
     (skip-chars-backward " \t\n")
     (point))))
(global-set-key [(alt ?\\)] 'hungry-backspace)

;; FIXME how to automatically apply to every new terminal
;; I am addicted to various modifier keys.
(defun reset-terminal ()
  "Apply everytime to telnet terminal."
  (interactive)
  (global-set-key [(meta ?')] 'undefined)
  (global-set-key [(meta \\)] 'undefined)
  (define-key function-key-map [(meta \])] 'event-apply-hyper-modifier)
  (define-key function-key-map [(meta \\)] 'event-apply-super-modifier)
  (define-key function-key-map [(meta ?')] 'event-apply-alt-modifier))
(global-set-key [(super \\)] 'delete-horizontal-space)
(global-set-key [(control c) t] 'reset-terminal)
(reset-terminal)

(defun touch-buffer ()
  "Touch, to be saved, and force recompile."
  (interactive)
  (set-buffer-modified-p t))
(global-set-key [(control x) t] 'touch-buffer)

(defun zap-to-char-backward (char)
  "`zap-to-char' in backward direction."
  (interactive "cZap back to char: ")
  (zap-to-char -1 char))
(global-set-key [(meta Z)] 'zap-to-char-backward)

(defun delete-word (arg)
  "Delete characters forward until encountering the end of a word.
With argument, do this that many times."
  (interactive "*p")
  (delete-region (point) (save-excursion (forward-word arg) (point))))

(defun backward-delete-word (arg)
  "Delete characters backward until encountering the end of a word.
With argument, do this that many times."
  (interactive "*p")
  (delete-word (- arg)))

;; Meta backspace kills and puts words in kill ring is very unintuitive and
;; screws up kill ring. Use delete instead.
(global-set-key [(meta backspace)] 'backward-delete-word)
(global-set-key [(meta d)] 'delete-word)

(defun copy-recent-message (arg)
  "Copy recent message to kill ring."
  (interactive "p")
  (kill-new (with-output-to-string
              (print-recent-messages (or arg 1)))))
(global-set-key [(alt w) m] 'copy-recent-message)

(defun telnet-fraser ()
  (interactive)
  (telnet "fraser.sfu.ca"))
(global-set-key [(meta pause)] 'telnet-fraser)

;;; c/c++

(push '("\\.h\\'" . c++-mode) auto-mode-alist)

(defun my-cc-mode-hook ()
  (setq c-default-style '((other . "user")))
  (setq c-basic-offset 2)
  (setq fill-column 75)
  ;;(c-toggle-hungry-state 1)
  (turn-on-font-lock)
  (auto-fill-mode 1)
  (turn-on-filladapt-mode))
(add-hook 'c-mode-hook 'my-cc-mode-hook)
(add-hook 'c++-mode-hook 'my-cc-mode-hook)

;;; lisp

(setq checkdoc-spellcheck-documentation-flag t)
(require 'checkdoc)

(defun my-emacs-mode-hook ()
  (turn-on-font-lock)
  (checkdoc-minor-mode 1)
  (turn-on-filladapt-mode)
  (auto-fill-mode 1)
  ;; put variables, functions, type defintions all in top menu
  (setq imenu-generic-expression
        '((nil "^\\s-*(def\\(un\\|subst\\|macro\\|advice\
\\|var\\|const\\|custom\
\\|group\\|type\\|struct\\|class\\|ine-condition\\)\
\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2)))   
  (outline-minor-mode 1)
  (setq fill-column 75)  
  (setq comment-column 40))
(add-hook 'emacs-lisp-mode-hook 'my-emacs-mode-hook)

;; useful with checkdoc
(global-set-key [(control alt x)] 'eval-defun)
(global-set-key [(super e) b] 'eval-current-buffer)
(global-set-key [(super e) r] 'eval-region)
(global-set-key [(super tab)] 'lisp-complete-symbol)
(global-set-key [(super x) x] 'edebug-defun)
(global-set-key [(super e) e] 'eval-last-sexp)

(defun byte-compile-current-file ()
  "Interactive command for byte compiling current file."
  (interactive)
  (byte-compile-file (buffer-file-name)))
(global-set-key [(super e) f] 'byte-compile-current-file)

;;; identity

(setq user-mail-address "stephent@sfu.ca")
(setq user-full-name "Stephen Tse")
;; hack identity
(defun user-uid-hack () 1000)
(fset 'user-uid 'user-uid-hack)
(fset 'user-real-uid 'user-uid-hack)
(defun user-login-name-hack ()
  "Identity hack."
  "stephent")
(fset 'user-login-name 'user-login-name-hack) ; for exim identity
(fset 'user-real-login-name 'user-login-name-hack)

;;; mail

(require 'mime-setup)
(setq mail-user-agent 'message-user-agent)

(setq message-default-headers
      "Bcc: on-fire@home.com\nGcc: nnml:archive\n")
(setq query-user-mail-address nil)
(setq gnus-show-mime t)
(setq gnus-show-mime-method 'gnus-article-preview-mime-message)
(setq gnus-expert-user t)
(setq gnus-secondary-select-methods '((nnml "")))
(setq nnmail-spool-file '("/var/spool/mail/stephent"))

;; Moved to .emacs since it is frequently modified.
;;(setq nnmail-split-methods
;;      '(("xemacs" "^Sender: owner-xemacs-mule@xemacs.org$")
;;      ("xemacs" "^Sender: owner-xemacs-beta@xemacs.org$")
;;      ("inbox" "")))

(defun add-mail-headers ()
  "Add Reply-To, X-OS, and X-Uptime mail headers."
  (let ((maillist '("linux-geek@sfu.ca"))
        to)
    (save-excursion
      (goto-char (point-min))
      (setq to (mail-header 'to (mail-header-extract)))
      (if (member to maillist)
          (message-add-header (concat "Reply-To: " to)))))
  (message-add-header
   (concat "X-Homepage: http://www.sfu.ca/~stephent")
   (concat "X-OS: "
           (substring (shell-command-to-string "uname -a") 0 -1))
   (concat "X-Uptime: "
           (substring (shell-command-to-string "uptime") 0 -1))))
(add-hook 'message-send-hook 'add-mail-headers)

(defun my-message-mode-hook ()
  (auto-fill-mode 1)
  (turn-on-filladapt-mode))
(add-hook 'message-mode-hook 'my-message-mode-hook)

(defun switch-to-gnus ()
  "Switch to Gnus group buffer."
  (interactive)
  (if (buffer-live-p (get-buffer"*Group*"))
      (switch-to-buffer "*Group*")
    (gnus)))
(global-set-key [(alt G)] 'switch-to-gnus)

(setq gnus-asynchronous t)
(setq gnus-use-article-prefetch 5)

;; Deja search engine fix for gnus.
;; http://www.sfu.ca/~stephent/emacs/deja.el
(add-to-list 'after-load-alist
             '("nnweb" (require 'deja)))

;; Convenient function, copied from nnweb.el.
(defun gnus-group-make-dejanews-web-group (&optional solid)
  "Create an ephemeral nnweb group.
If SOLID (the prefix), create a solid group."
  (interactive "P")
  (require 'nnweb)
  (let* ((group
          (if solid (gnus-read-group "Group name: ")
            (message-unique-id)))
         (type "dejanews")
         (search
          (read-string
           "Search string: "
           (cons (or (car gnus-group-web-search-history) "") 0)
           'gnus-group-web-search-history))
         (method
          `(nnweb ,group (nnweb-search ,search)
                  (nnweb-type ,(intern type))
                  (nnweb-ephemeral-p t))))
    (if solid
        (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search))
      (gnus-group-read-ephemeral-group
       group method t
       (cons (current-buffer)
             (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))

(add-hook
 'gnus-group-mode-hook
 (lambda ()
   (define-key gnus-group-mode-map [d]
   'gnus-group-make-dejanews-web-group)))


;;; font lock

(add-hook
 'font-lock-mode-hook
 (lambda ()
   (highlight-my-keyword)
   (turn-on-lazy-shot)))

(add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
(setq lazy-shot-stealth-verbose nil)
(setq lazy-shot-verbose nil)

;;; dictionary

;; http://www.in-berlin.de/User/myrkr/dictionary.html
;; http://www.dict.org

;; very handy and useful
(setq dictionary-server "localhost")
(require 'dictionary)
(global-set-key [(alt s)] 'dictionary-search)
(global-set-key [(alt m)] 'dictionary-match-words)

;;; guile/scheme

;; forget about cmu or guile. use scwm mode instead
;; FIXME load cmu instead xscheme, to use guile
(require 'cmuscheme)
;; then M-x run-scheme

(autoload 'scwm-mode "scwm" "Major mode for editing scwm code. [...]" t)
(add-hook 'scwm-mode-hook 'my-emacs-mode-hook)

(setq scheme-program-name "guile")
(global-set-key [(super s) e] 'scwm-eval-last)

(defun scwm-eval-last-to-echo-area ()
  "`scwm-eval-last' and display result to echo area."
  (interactive)
  (scwm-eval-last 'echo-area))
(global-set-key [(super s) s] 'scwm-eval-last-to-echo-area)

(global-set-key [(super s) r] 'scwm-run)
(autoload 'w3-show-hotlist "w3" "Show w3 hotlist." t)

;;; w3

;; hey, i've got cable
;(setq w3-delay-image-loads t)
(setq url-be-asynchronous t)
(setq w3-do-incremental-display t)
;; work as lynx?
;(setq w3-allowed-image-types nil)

;; It looks prettier this way.
(setq w3-user-colors-take-precedence t)

;; hack for w3
(global-set-key [iso-left-tab] 'widget-backward)

;;; misc

(setq dired-no-confirm '(revert-subdirs))
(setq efs-verbose 0)
(setq initial-major-mode 'emacs-lisp-mode)
(setq package-get-require-signed-base-updates nil)
(setq browse-url-browser-function 'browse-url-netscape)
(setq inhibit-startup-message t)
(setq minibuffer-max-depth nil)
(setq enable-recursive-minibuffers t)
(set-default 'sentence-end-double-space nil)
(setq bookmark-save-flag 1)
(auto-compression-mode 1)
(setq View-process-display-with-2-windows nil)
(paren-set-mode 'paren)
(unless (gnuserv-running-p) (gnuserv-start))
(setq initial-scratch-message (fortune))
(defalias 'debian-changelog-mode 'fundamental-mode)
(setq grep-command "grep -i -n -d skip ")
;; does not work with windowmaker
;; (setq auto-raise-frame t)            ; wm fix

;; store efs-set-passwd and eicq-user-password
(load "~/password.el")

;; use dumb terminfo instead of emacs terminfo
(setq system-uses-terminfo t)

;; efs umask is broken? no backup -> umask ok
(setq efs-make-backup-files nil)
;;(setq efs-umask "000")
;;(efs-send-umask "ftp.sfu.ca" "stephent" "000")

(defun my-dired-mode-hook ()
  (setq case-fold-search t))
(add-hook 'dired-mode-hook 'my-dired-mode-hook)

(global-set-key [(shift f9)]
  (lambda () (interactive) (point-to-register ?1)))
(global-set-key [(control f9)]
  (lambda () (interactive) (jump-to-register ?1)))
(global-set-key [(shift f10)]
  (lambda () (interactive) (point-to-register ?2)))
(global-set-key [(control f10)]
  (lambda () (interactive) (jump-to-register ?2)))
(global-set-key [(shift f11)]
  (lambda () (interactive) (point-to-register ?3)))
(global-set-key [(control f11)]
  (lambda () (interactive) (jump-to-register ?3)))
(global-set-key [(shift f12)]
  (lambda () (interactive) (point-to-register ?4)))
(global-set-key [(control f12)]
  (lambda () (interactive) (jump-to-register ?4)))

;; any better way?
(setq format-alist 
      '((image/jpeg    "JPEG image"
                       "                       image-decode-jpeg nil t image-mode)
        (image/gif     "GIF image"
                       "GIF8[79]"
                       image-decode-gif nil t image-mode)
        (image/png     "Portable Network Graphics"
                       "PNG"
                       image-decode-png nil t image-mode)
        (image/x-xpm   "XPM image"
                       "/\\* XPM \\*/"
                       image-decode-xpm nil t image-mode)
        (image/tiff    "TIFF image"
                       "II\\*                       image-decode-tiff nil t image-mode)
        (image/tiff    "TIFF image"
                       "MM                       image-decode-tiff nil t image-mode)
        (text/enriched "Extended MIME text/enriched format."
                       "Content-[Tt]ype:[     ]*text/enriched"
                       enriched-decode enriched-encode t enriched-mode)
        (text/richtext "Extended MIME obsolete text/richtext format."
                       "Content-[Tt]ype:[     ]*text/richtext"
                       richtext-decode richtext-encode t enriched-mode)
        (plain         "ISO 8859-1 standard format, no text properties."
                       nil nil nil nil nil)))

(defun my-text-mode-hook ()
  (auto-fill-mode 1)
  (turn-on-filladapt-mode))
(add-hook 'text-mode-hook 'my-text-mode-hook)

(require 'backup-dir)
(setq bkup-backup-directory-info
      '((t "~/.backup" full-path)))

(global-set-key [(alt backspace)]
  (lambda ()
    (interactive)
    (delete-region (point) (point-at-bol))))

(define-key help-mode-map [A] 'apropos)
(define-key help-map [\.] 'find-function)
(global-set-key [(super m)] 'gnus-group-mail)
(global-set-key [(alt x) r] 'rename-buffer)
(global-set-key [(alt o)] 'occur)
(global-set-key [(alt x) =] 'what-line)
(global-set-key [(super x) ?4] 'bury-buffer)
(global-set-key [(alt x) b] 'browse-url-at-point)
(global-set-key [(alt b)] 'switch-to-buffer)
(global-set-key [(alt l)] 'add-change-log-entry)
(global-set-key [(control z)] 'undefined)
(global-set-key [(control f4)] 'kill-this-buffer)
(global-set-key [f4] 'bury-buffer)
(global-set-key [(super w) f] 'w3-fetch)
(global-set-key [(super w) h] 'w3-show-hotlist)
(global-set-key [(control A)] 'beginning-of-line-text)
(global-set-key [(shift f1)] 'manual-entry)
(global-set-key [(control W)] 'delete-region)
(global-set-key [(alt c) f] 'font-lock-fontify-buffer)
(global-set-key [(super space)] 'set-mark-command)
(global-set-key [(super x) g] 'grep)
(global-set-key [(super x) v] 'view-file)
(global-set-key [(super x) ?1] 'first-error)
(global-set-key [(super x) ?2] 'previous-error)
(global-set-key [(super x) ?3] 'next-error)

;;; imenu

(defun imenu-jump-to-symbol-definition (symbol)
  "Jump tp functions, variables, and types defintion.
Use hacked `imenu-generic-expression'."
  (interactive (list (symbol-near-point)))
  (imenu symbol))
(global-set-key [(alt g)] 'imenu-jump-to-symbol-definition)

(global-set-key [insert] 'imenu)

;;; zenirc

; (setq zenirc-server-default "irc.debian.org")
(setq zenirc-nick-default "fire")
(setq zenirc-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
(modify-syntax-entry ?<  "<>" zenirc-mode-syntax-table)
(modify-syntax-entry ?> "><" zenirc-mode-syntax-table)
;; color hack
(add-hook
 'zenirc-mode-hook
 (lambda ()
   (font-lock-mode 1)
   (set-syntax-table zenirc-mode-syntax-table)))
(global-set-key [(alt x) ?/] 'zenirc)

;;; chinese

(when (featurep 'mule)
  (setup-chinese-big5-environment)
  (setq default-input-method 'chinese-b5-tsangchi))

(unless (eq (console-type) 'tty)
  (set-face-font
   'default
   "-eten-fixed-medium-r-normal--16-150-75-75-c-160-big5-0"
   ;; "-uw-ming-medium-r-normal-fantizi-16-160-75-75-c-160-big5-0"
   'global
   '(mule-fonts) 'prepend))

(defun chinese-decode-buffer ()
  "Decode chinese in buffer.
It ignores `buffer-read-only'."
  (interactive)
  (setq buffer-read-only nil)
  (decode-coding-region (point-min) (point-max) 'big5))
(global-set-key [(alt c) d] 'chinese-decode-buffer)

(defun chinese-larger-font ()
  (interactive)
  (set-face-font
   'default
   "-eten-fixed-medium-r-normal--24-230-75-75-c-240-big5-0"
   'global
   '(mule-fonts) 'prepend))

;; A quick patch.
(add-hook
 'quail-mode-hook
 (lambda ()
   (define-key quail-mode-map [? ] 'quail-select-current)))

;; A quick hack for bug in quail-show-translations. Bug: turn on quail,
;; press a (for "sun"), press c-x f then c-g (minibuffer then cancel),
;; press a again for overlay in minibuffer.
(defadvice move-overlay
  (around quail-guard-nil-overlay activate)
  "Do nothing if NIL overlay."
  (if overlay ad-do-it))


;; keystroke dictionaries
;; http://www.sfu.ca/~stephent/emacs/clib
(global-set-key [(alt c) ?1] (hot-file "~/code/chinese/associate"))
(global-set-key [(alt c) ?2] (hot-file "~/code/chinese/canton"))
(global-set-key [(alt c) ?3] (hot-file "~/code/chinese/ecdict"))
(global-set-key [(alt c) ?4] (hot-file "~/code/chinese/simple"))

;;; chinese key dictionary
;;
;; http://www.sfu.ca/~stephent/chinese/chinesekeys.tgz
;; This package is a database for dict server <http://www.dict.org>. It is
;; a dictionary of chinese characters that lists input key and association
;; information of each character. I wrote it to aid learning of chinese
;; typing.

;; -unix crlf conversion
(setq network-coding-system-alist '((2628 . big5-unix)))

(defun cinfo-encode (char)
  (let ((big5-char (encode-coding-string char 'big5)))
    (format "%s-%s" 
            (char-to-int (aref big5-char 0))
            (char-to-int (aref big5-char 1)))))

(defun cinfo-char-info (char)
  "Do dictionary search of chinese CHAR."
  (interactive
   (list (if current-prefix-arg
             (read-string "char: ")
           (char-to-string (following-char)))))
  (dictionary-search 
   (cinfo-encode char) 
   "chinesekeys"))
(global-set-key [(alt c) c] 'cinfo-char-info)


;;; eicq

;; http://www.sfu.ca/~stephent/eicq
(setq eicq-world-rc-filename "~/info/world")
(setq eicq-user-alias "fire")
(setq eicq-global-key-prefix [(alt q)])
(global-set-key [(alt q) f] 'world-find)
(setq eicq-coding-system 'big5)
(autoload 'eicq-show-window "eicq" "Show eicq main window." t)
(global-set-key [(alt q) w] 'eicq-show-window)
;;(add-hook 'eicq-load-hook 'eicq-world-update)
(autoload 'world-mode "eicq" "World mode." t)

(global-set-key [(super ?1)] (hot-file "~/icq/eicq.el"))
(global-set-key [(super ?2)] (hot-file "~/icq/README"))
(global-set-key [(super ?3)] (hot-file "~/icq/NEWS"))
(global-set-key [(super ?4)] (hot-file "~/icq/udp2tcp.cc"))
(global-set-key [(super ?5)] (hot-file "~/icq/ChangeLog"))
(global-set-key [(super ?6)] (hot-file "~/icq/README.developer"))

;;; appearance

(setq-default mode-line-buffer-identification '(buffer-file-name ("%f") ("%b")))
(set-face-background 'zmacs-region "blue")
(set-face-foreground 'highlight "blue")
(set-face-foreground 'modeline "lightblue")
(set-face-foreground 'modeline-buffer-id "pink")
(set-face-background 'paren-match "blue")
(set-face-foreground 'isearch "blue")
(set-face-foreground 'list-mode-item-selected "blue")
(set-face-foreground 'primary-selection "red")
(set-face-foreground 'secondary-selection "pink")

(add-hook
 'dired-load-hook
 (lambda ()
   (set-face-foreground
    'dired-face-directory "lightblue")))

(setq visible-bell t)
;; --with-sound=both and dpkg nas (network audio system)
;; (load-default-sounds)
;; (setq sound-default-alist
(set-specifier default-toolbar-visible-p nil)
;(setq use-fancy-toolbar 'next)
;(require 'toolbar-fancy)
(set-specifier menubar-visible-p nil)
(set-specifier modeline-shadow-thickness 1)
(set-specifier vertical-divider-always-visible-p nil)
(set-specifier horizontal-scrollbar-visible-p nil)
(set-specifier scrollbar-width 5)
(set-specifier default-gutter-visible-p nil)
(resize-minibuffer-mode 1)

;;; check mail

(defun new-mail-p ()
  "Non-nil means if there exists new mail."
  ;; Non-zero mail file -> existence of mails.
  (not (zerop (nth 7 (file-attributes "/var/spool/mail/stephent")))))

(defvar new-mail-string nil)

(setq global-mode-string
      (append global-mode-string '("" new-mail-string)))

(defun new-mail-set-state (state)
  "Set new STATE of new-mail-string.
Possible STATE:
 'yes (or t) for new mail,
 'nil, for no new mail,
 'checking for busy checking mail, or
 'done for displaying nothing."
  (setq new-mail-string
        (if (eq state 'done) ""
          (make-glyph
           (cond
            ((eq state 'checking) "~/lib/check-letter.xpm")
            ((or state (eq state 'yes)) 
             (concat (locate-data-directory "time") "letter.xpm"))
            (t 
             (concat (locate-data-directory "time") "no-letter.xpm")))))))

(defun check-mail ()
  "Fetch new mail, display flag on modeline."
  (interactive)
  (new-mail-set-state 'checking)
  (set-process-sentinel 
   (start-process "fetchmail" nil "fetchmail")
   (lambda (process change)
     ;; set flag for 'yes or 'no
     (new-mail-set-state (new-mail-p))
     ;; auto update
     (start-itimer "new mail" 'check-mail-update 180 180))))
(global-set-key [(alt x) ?0] 'check-mail)

(defun check-mail-update ()
  "Remove flag after mail is checked into system."
  (unless (new-mail-p)
    (new-mail-set-state 'done)
    (delete-itimer "new mail")))
(add-hook 'gnus-after-getting-new-news-hook 'check-mail-update)

;;; outline

(global-set-key [(super right)] 'outline-next-visible-heading)
(global-set-key [(super left)] 'outline-previous-visible-heading)
(global-set-key [(super down)] 'outline-forward-same-level)
(global-set-key [(super up)] 'outline-backward-same-level)
(global-set-key [(super prior)] 'outline-up-heading)
(global-set-key [(super insert)] 'show-subtree)
(global-set-key [(super delete)] 'hide-subtree)
(global-set-key [(super end)] 'show-children)
(global-set-key [(alt insert)] 'show-all)
(global-set-key [(alt delete)] 'hide-other)

;;; mp3 player

;; stop: kill `ps axu | grep splay | head -n 1 | cut -c 10-15`
(global-set-key [(control x) kp-insert]
  (lambda () (interactive) (shell-command "stop &")))

(defun mp3-dir ()
  "Dired mp3 feel directory."
  (interactive)
  (dired "~/mp3"))
(global-set-key [(control x) kp-prior] 'mp3-dir)

(setq shell-command-history '("splay -r"))

(defmacro mp3 (filename)
  "Splay mp3 FILENAME."
  `(lambda () (interactive)
     (shell-command (format "splay %s &" 
                            ,(shell-quote-argument
                              (expand-file-name filename))))))

(global-set-key [(control x) kp-end]
  (mp3 "~/mp3/gold/The One.mp3"))
(global-set-key [(control x) kp-down]
  (mp3 "~/mp3/gold/Air Supply - Making Love Out of Nothing At All.mp3"))
(global-set-key [(control x) kp-next]
  (mp3 "~/mp3/gold/Eagles - Hotel California.mp3"))

;;; footer
(provide 'my)

;;; my.el ends here