;;; Nhat Minh's .emacs

;; This code is public domain.

;; This is just my plain old .emacs with settings accumulated over the
;; years. It's not really clean, to say the least, and I do use
;; outdated pieces of software, but well, I'm used to it.

;; -- Nhat Minh Lê <nhat.minh.le@huoc.org>

(setq my-dot-emacs-dir "~/.emacs.el.d"
      my-log-dir "~/log"
      my-ssl-cert-dir "~/.certs"
      my-auth-el (concat my-dot-emacs-dir "/auth.el"))

;; My IMAP traffic is handled through a tunnel.
;(setq my-imap-port 1143)
(setq my-imap-port 143)

;; If `version<=' is not defined, we don't know this emacs so assume
;; it's old.
(unless (fboundp 'version<=)
  (defun version<= (x y)
    "Compatibility. Always returns t."
    t))



;;;; Environment

;; User-local lisp paths.
(add-to-list 'load-path "~/lisp")
(add-to-list 'load-path "~/lisp/themes")

;; Keep ~/.emacs.el clean from customize stuff.
(setq custom-file (concat my-dot-emacs-dir "/custom.el"))
(load custom-file)

;; Sensible information.
(when (file-exists-p my-auth-el)
  (load my-auth-el))

;; Experimental packages.

;; CEDET.
(when (file-exists-p "~/lisp/cedet/common")
  (add-to-list 'load-path "~/lisp/cedet/common"))

;; w3m
(when (file-exists-p "~/lisp/emacs-w3m")
  (add-to-list 'load-path "~/lisp/emacs-w3m"))

;; Wanderlust.
(when (file-exists-p "~/lisp/wanderlust")
  (add-to-list 'load-path "~/lisp/wanderlust/utils")
  (add-to-list 'load-path "~/lisp/wanderlust/elmo")
  (add-to-list 'load-path "~/lisp/wanderlust/wl"))



;;;; Global settings

;; Theoretically unneeded if locales are correctly set.
(set-language-environment "UTF-8")

;; Emacs-wide limits.
(setq gc-cons-threshold 2000000
      message-log-max 200)

;; No backup.
(setq make-backup-files nil
      vc-cvs-stay-local nil)

;; Prefer distributed and local VCS.
(setq vc-handled-backends '(Git RCS SVN CVS))

;; Read and write compressed files transparently.
(auto-compression-mode 1)

;; Save/restore sessions on exit/startup.
(desktop-save-mode 1)



;;;; Global interface

;; Suppress startup verbosity.
(setq inhibit-startup-message t
      initial-scratch-message nil)

;; I'm used to splitting my Emacs horizontally to code and I still
;; want line wrapping in the rare occurrences where there would be
;; a long line.
(setq truncate-partial-width-windows nil)

;; Use a block cursor.
(blink-cursor-mode -1)

;; Display current column in addition to line number in mode line.
(setq line-number-display-limit 2000000)
(column-number-mode 1)

;; Display battery state. TODO: Add support for NetBSD.
(require 'battery-netbsd)
(display-battery-mode 1)

;; Display time.
(setq display-time-mail-file 0
      display-time-string-forms '((if mail "Mail-") 24-hours ":" minutes))
(display-time-mode 1)

;; Partial completion and more when switching buffers.
(setq iswitchb-use-frame-buffer-list t
      iswitchb-max-to-show 20
      iswitchb-default-method 'samewindow)
(iswitchb-mode 1)

;; Use (my) static work spaces.
(require 'mws)

;; Suppress the annoying bell.
(setq ring-bell-function 'ignore)

;; No GUI widgets.
(scroll-bar-mode -1)
(tooltip-mode -1)
(if (version<= emacs-version "22")
    (progn
      (menu-bar-mode -1)
      (tool-bar-mode -1))
  (add-to-list 'default-frame-alist '(tool-bar-lines . 0))
  (add-to-list 'default-frame-alist '(menu-bar-lines . 0)))

;; Disable transient (visible) mark. We can still use `C-SPC C-SPC' to
;; enable it temporarily and I like it this way.
(transient-mark-mode -1)

;; Uniquify file buffer names with path components.
(require 'uniquify)
(setq uniquify-buffer-name-style 'forward)

;; Load my color theme.
(load-theme 'minh)
(load-theme 'minh-misc)
(load-theme 'minh-custom)
(load-theme 'minh-erc)
(load-theme 'minh-wl)
(load-theme 'minh-latex)
;;(load-theme 'minh-newsticker)
(load-theme 'minh-cscope)
(load-theme 'minh-twit)
;;(load-theme 'wine)
(load-theme 'bluey)



;;;; Editing settings

;; Enable all commands in minibuffer.
(setq enable-recursive-minibuffers t)

;; So that French text doesn't get refilled in a ugly fashion.
(setq fill-nobreak-predicate '(fill-french-nobreak-p))

;; Allow jumping around the buffer using C-u C-SPC C-SPC ...
(setq set-mark-command-repeat-pop t)

;; `narrow-to-region' is just a bit disturbing for the newcomer but
;; it's nothing to be afraid of. `erase-buffer' can be reverted and is
;; not bound to any key by default anyway.
(put 'erase-buffer 'disabled nil)
(put 'narrow-to-region 'disabled nil)

;; `misc.el' provides `zap-up-to-char' among other things.
(require 'misc)

;; Show matching parentheses.
(show-paren-mode t)

;; Some compatibility stuff for software that does not handle tabs
;; properly or don't know about basic manners like wrapping text.
(defun my-text-mode-init ()
  (setq indent-tabs-mode nil)
  (setq word-wrap t))
(add-hook 'text-mode-hook 'my-text-mode-init)

;; Same binding as in info mode.
(defun my-help-mode-init ()
  (define-key help-mode-map (kbd "l") 'help-go-back))
(add-hook 'help-mode-hook 'my-help-mode-init)

;; Some utility editing functions.

(defun my-just-no-space ()
  "Delete every whitespaces around point, leaving no blanks at all."
  (interactive)
  (save-excursion
    (if (re-search-backward "[^ \t\r\n\f]" nil t)
        (goto-char (1+ (point))))
    (re-search-forward "[ \t\r\n\f]*")
    (delete-region (match-beginning 0) (match-end 0))))

(defun my-kill-surrounding-parens ()
  "Delete the pair of matching characters around the sexp after point."
  (interactive)
  (down-list)
  (backward-char)
  (let ((pt (point))
        npt)
    (forward-sexp)
    (backward-delete-char 1)
    (goto-char pt)
    (delete-char 1)))

(defun my-tab-to-right ()
  "Insert spaces or tabs so that the end of the line lines up on
`fill-column'."
  (interactive)
  (let* ((pt (point))
         (len (save-excursion
                (end-of-line)
                (- (point) pt))))
    (indent-to (- fill-column len))))

(defun my-hungry-delete-forward (n)
  "Delete all whitespace up to the next non-whitespace character."
  (interactive "P")
  (save-excursion
    (if (or n
            (not (memq (char-after) '(?\  ?\t ?\r ?\n ?\f))))
        (delete-char (if n n 1))
      (while (memq (char-after) '(?\  ?\t ?\r ?\n ?\f))
        (delete-char 1)))))

(defun my-hungry-delete-backward (n)
  "Delete all whitespace back to the previous non-whitespace
character."
  (interactive "P")
  (save-excursion
    (if (or n
            (not (memq (char-before) '(?\  ?\t ?\r ?\n ?\f))))
        (backward-delete-char (if n n 1))
      (while (memq (char-before) '(?\  ?\t ?\r ?\n ?\f))
        (backward-delete-char 1)))))



;;;; Programming settings

;; Mode <-> file name associations.
(setq auto-mode-alist (cons '("Makefile\\." . makefile-bsdmake-mode)
                            auto-mode-alist))
(setq auto-mode-alist (cons '("\\.l\\'" . c-mode) auto-mode-alist))
(setq auto-mode-alist (cons '("\\.sc[ei]\\'" . scilab-mode) auto-mode-alist))

;; Because PHP modes suck.
(setq auto-mode-alist
      (cons '("\\.php\\'" . javascript-generic-mode) auto-mode-alist))
(setq auto-mode-alist (cons '("\\.phtml\\'" . html-mode) auto-mode-alist))

;; This adds BSD lint error patterns to compilation-mode.
(require 'compile)
(setq compilation-error-regexp-alist
      (cons '("^\\([^ \n]+\\)(\\([0-9]+\\)): \\(warning:\\)?" 1 2 nil (3))
	    compilation-error-regexp-alist))
(setq compilation-window-height 10)

;; No mode that I use respect `standard-indent' but well...
(setq standard-indent 8)


;;;;;; CEDET

;; The default idle display is annoying at times, so we use our own
;; manually-triggered summary display.
(defun my-semantic-show-summary (point)
  "Display a summary for the symbol under POINT."
  (interactive "P")
  ;; shamelessly borrowed from semantic-ia.el
  (let* ((ctxt (semantic-analyze-current-context point))
         (pf (when ctxt
               ;; The CTXT is an EIEIO object.  The below
               ;; method will attempt to pick the most interesting
               ;; tag associated with the current context.
               (semantic-analyze-interesting-tag ctxt))))
    (when pf
      (message "%s" (funcall semantic-idle-summary-function pf nil t)))))

;; Load basic features only, since I perceive others as intrusive.
;; (when (require 'cedet nil t)
;;   (require 'semantic-gcc)
;;   (require 'semantic-ia)
;;   (semantic-load-enable-minimum-features)
;;   (global-ede-mode 1)
;;   (load (concat my-dot-emacs-dir "/projects.el")))


;;;;;; Cscope

(defun my-cscope-list-entry-mode-init ()
  (hl-line-mode 1)
  (define-key cscope-list-entry-keymap
    (kbd "RET") 'cscope-select-entry-other-window))
(add-hook 'cscope-list-entry-hook 'my-cscope-list-entry-mode-init)


;;;;;; C modes

;; NetBSD KNF style, adapted from the mailing list.
(c-add-style
 "knf"
 '((indent-tabs-mode . t)
   (c-recognize-knr-p . t)
   (c-basic-offset . 8)
   (c-backslash-column . 76)
   (c-backslash-max-column . 76)
   (c-comment-only-line-offset . 0)
   (c-cleanup-list . (brace-else-brace
                      brace-elseif-brace
                      defun-close-semi))
   (c-hanging-braces-alist . ((defun-open . (before after))
                              (defun-close . (before after))
                              (block-open . (after))
                              (block-close . c-snug-do-while)
                              (substatement-open . after)
                              (statement-case-open . nil)
                              (brace-list-open . after)
                              (brace-list-close . nil)))
   (c-hanging-colons-alist . ((label after)
                              (case-label after)))
   (c-offsets-alist . ((arglist-cont-nonempty . *)
                       (block-open          . 0)
                       (brace-list-open     . +)
                       (brace-list-intro    . +)
                       (brace-list-entry    . 0)
                       (brace-list-close    . 0)
                       (case-label          . 0)
		       (statement-case-open . +)
                       (cpp-define-intro    . 0)
                       (knr-argdecl         . 0)
                       (knr-argdecl-intro   . +)
                       (label               . 0)
                       (member-init-intro   . ++)
                       (statement-cont      . *)
                       (substatement-open   . 0)))))

;; Similar to the Linux style, except I had worked this out before
;; Emacs actually included a Linux style and I don't want to bother
;; checking if they are the same.
(c-add-style
 "mine"
 '((c-basic-offset . 8)
   (c-block-comment-prefix . "")
   (c-recognize-knr-p . t)
   (c-comment-only-line-offset . 0)
   (c-cleanup-list . (brace-else-brace
                      empty-defun-braces
                      defun-close-semi
                      list-close-comma
                      scope-operator))
   (c-hanging-braces-alist . ((defun-open . (before after))
                              (defun-close . (before))
                              (class-open . (after))
                              (class-close . nil)
                              (inline-open . nil)
                              (inline-close . nil)
                              (block-open . (after))
                              (block-close . (before))
                              (substatement-open . nil)
                              (statement-case-open . nil)
                              (brace-list-open . nil)
                              (brace-list-close . nil)
                              (brace-list-intro . nil)
                              (brace-list-entry . nil)))
   (c-offsets-alist . ((statement-cont . *)
                       (cpp-define-intro . 0)
                       (func-decl-cont . *)
                       (knr-argdecl-intro . *)
                       (statement-case-open . +)
                       (substatement-label . 0)
                       (label . 0)
                       (arglist-intro . *)
                       (arglist-close . *)
                       (knr-argdecl . 0)))))

;; Use KNF by default.
(setq-default c-default-style "knf")

;; Turn on `indent-tabs-mode' since it is disabled by our `text-mode'
;; hook. Also add CEDET bindings.
(defun my-c-mode-common-init ()
  (setq indent-tabs-mode t)
  (c-toggle-hungry-state 1)
  (define-key c-mode-base-map (kbd "C-M-i") 'semantic-ia-complete-symbol)
  (define-key c-mode-base-map (kbd "C-c i") 'my-semantic-show-summary))
(defun my-java-mode-init ()
  (setq comment-start "/* "
	comment-end " */"))
(add-hook 'c-mode-common-hook 'my-c-mode-common-init)
(add-hook 'java-mode-hook 'my-java-mode-init)

;; Use cscope if available.
(when (require 'xcscope nil t)
  (setq cscope-truncate-lines t))

;;;;;; Ada and VHDL modes

;; Auto casing is just plain annoying since it doesn't understand the
;; difference between various uses of keywords.
(setq ada-auto-case nil
      ada-indent-after-return nil
      ada-fill-comment-prefix "-- ")

;; Substitutes for the default very unpleasant indent-everywhere
;; behavior.
(defun my-ada-indent-newline ()
  "Insert a newline. The original line is indented first if
`ada-indent-after-return' is non-nil."
  (interactive "*")
  (when (and ada-indent-after-return (not (bolp)))
    (ada-indent-current))
  (newline))
(defun my-ada-indent-newline-indent ()
  "Insert a newline then indent. The original line is indented
first if `ada-indent-after-return' is non-nil."
  (interactive "*")
  (my-ada-indent-newline)
  (ada-indent-current))
(setq ada-ret-binding 'my-ada-indent-newline
      ada-lfd-binding 'my-ada-indent-newline-indent)

;; We don't use tabs to indent because my school's standard is like
;; that (XXX: or something like that, I forgot exactly why).
(defun my-ada-mode-init ()
  (setq indent-tabs-mode nil)
  (define-key ada-mode-map (kbd "RET") 'my-ada-indent-newline)
  (define-key ada-mode-map (kbd "C-j") 'my-ada-indent-newline-indent)
  ;; `ada-mode' overrides our global binding.
  (define-key ada-mode-map [(control tab)] 'other-window))
(add-hook 'ada-mode-hook 'my-ada-mode-init)

;; Basic VHDL indentation to match `ada-mode' defaults. Disable
;; annoying electric behavior (XXX: I don't remember exactly why).
(setq vhdl-basic-offset 3
      vhdl-electric-mode nil
      vhdl-indent-tabs-mode nil)

;; Do not use tabs, as in Ada. Undo silly binding on C-i (sorry guys,
;; TAB = C-i, there's no way around that).
(defun my-vhdl-mode-init ()
  (setq indent-tabs-mode nil)
  (define-key vhdl-mode-map "\C-i" 'indent-for-tab-command))
(add-hook 'vhdl-mode-hook 'my-vhdl-mode-init)


;;;;;; Misc. modes

;; Assembly language.
(setq asm-comment-char ?\#)

;; Shell scripts.
(setq sh-basic-offset standard-indent)
(setq sh-indent-for-case-label 0)
(setq sh-indent-for-case-alt '+)
(setq sh-indent-for-continuation '*)

;; JavaScript.
(setq javascript-indent-level standard-indent)

;; PHP.
;;(require 'php-mode)



;;;; Misc. editing modes

;; Org files.
(setq org-agenda-files '("~"))

;; Org work flow states.
(setq org-todo-keywords
      '((sequence "TODO" "PARTIAL" "|" "DONE" "DELEGATED" "CANCELED")))

;; Org-mode keybindings.
(defun my-org-mode-init ()
  (define-key org-mode-map (kbd "<C-tab>") 'other-window))
(add-hook 'org-mode-hook 'my-org-mode-init)

;; Associate web template files with html-mode.
(setq auto-mode-alist (cons '("\\.tpl\\'" . html-mode) auto-mode-alist))

;; A simple Scilab mode; it's no good but there is no other good mode
;; either (by "good" I mean that does editing and does it right).
(require 'scilab-mode)

;; Zoom by default in document viewer.
(setq doc-view-resolution 90)

;; Use plain (single frame) ediff interface.
(setq ediff-window-setup-function 'ediff-setup-windows-plain)

;; Make LaTeX modes recognize verbatim environments properly.
(setq LaTeX-verbatim-regexp "[vV]erbatim\\*?")
(setq font-latex-verbatim-environments '("verbatim" "verbatim*" "Verbatim"))

;; I don't use `@' very often in LaTeX...
(defun my-LaTeX-math-mode-init ()
  (define-key LaTeX-math-mode-map "@" LaTeX-math-keymap)
  (define-key LaTeX-math-keymap "@" 'self-insert-command))
(add-hook 'LaTeX-math-mode-hook 'my-LaTeX-math-mode-init)

;; Fix auto-indent stuff.
(defun my-metapost-mode-init ()
  (define-key meta-mode-map [?\C-m] 'newline))
(add-hook 'metapost-mode-hook 'my-metapost-mode-init)

;; Let us write inline `<code>' tags (else, they are always formatted
;; as blocks when inserted). XXX: This is really for HTML.
(defun my-sgml-mode-init ()
  (add-to-list 'sgml-tag-alist '("code")))
(add-hook 'sgml-mode-hook 'my-sgml-mode-init)



;;;; Misc. modes

;; Calendar
(setq calendar-offset -1)
(defun my-calendar-mode-init ()
  (setq truncate-lines t))
(add-hook 'calendar-mode-hook 'my-calendar-mode-init)

;; Comint modes (e.g. shell)
(add-hook 'comint-mode-hook 'ansi-color-for-comint-mode-on)

;; Diary.
(add-hook 'diary-display-hook 'fancy-diary-display)
(add-hook 'list-diary-entries-hook 'include-other-diary-files)
(add-hook 'list-diary-entries-hook 'sort-diary-entries)
(add-hook 'mark-diary-entries-hook 'mark-included-diary-files)

;; File browser.
(setq dired-ls-F-marks-symlinks t)
(defun my-dired-mode-init ()
  (hl-line-mode 1)
  (setq truncate-lines t))
(add-hook 'dired-mode-hook 'my-dired-mode-init)

;; Image viewer.
(when (require 'image-mode nil)
  (defun my-image-next-by-number ()
    (interactive)
    (let ((file-name (buffer-file-name))
	  base num suffix
	  num-width fmt)
      (unless (string-match
	       "^\\(.*[^0-9-]\\)?\\(?:[0-9]+-\\)?\\([0-9]+\\)\\(\\.[^.]+\\)?$"
	       file-name)
	(error "Improper file name"))
      (setq base (match-string 1 file-name))
      (setq num (match-string 2 file-name))
      (setq suffix (match-string 3 file-name))
      (setq num-width (length num))
      (setq fmt (format "%%s%%0%dd%%s" num-width))
      (setq num (1+ (string-to-number num)))
      (setq file-name (format fmt base num suffix))
      (unless (file-exists-p file-name)
	(setq fmt (format "%%s%%0%dd-*%%s" num-width))
	(setq file-name (format fmt base num suffix))
	(setq file-name (file-expand-wildcards file-name))
	(if file-name
	    (setq file-name (car file-name))
	  (error "No more files")))
      (find-alternate-file file-name)))
  (defun my-image-scroll-up-or-next-by-number ()
    (interactive)
    (let* ((image (image-get-display-property))
	   (edges (window-inside-edges))
	   (win-height (- (nth 3 edges) (nth 1 edges)))
	   (img-height (ceiling (cdr (image-size image)))))
      (if (< (+ win-height (window-vscroll nil t))
	     img-height)
	  (image-scroll-up)
	(my-image-next-by-number))))
  (define-key image-mode-map (kbd "SPC")
    'my-image-scroll-up-or-next-by-number))

;; Process browser (does not support NetBSD).
(defun my-proced-mode-init ()
  (hl-line-mode 1))
(add-hook 'proced-mode-hook 'my-proced-mode-init)


;;;;;; Mail

;; The mail address I use to send mails: here, my local user name
;; since I use a local mail server.
(setq user-mail-address (user-login-name))

;; Wanderlust configuration.
(when (require 'wl nil t)
  ;; Main WL configuration file.
  (load (concat my-dot-emacs-dir "/wlrc"))

  ;; Use WL as the default MUA.
  (if (boundp 'mail-user-agent)
      (setq mail-user-agent 'wl-user-agent))
  (if (fboundp 'define-mail-user-agent)
      (define-mail-user-agent
        'wl-user-agent
        'wl-user-agent-compose
        'wl-draft-send
        'wl-draft-kill
        'mail-send-hook)))

;; Shortcut to WL.
(defun my-wl-ws ()
  "Switch to WL in its own work space."
  (interactive)
  (mws-switch-to-layout 1)
  (delete-other-windows)
  (wl))

;; Shortcut to Gnus.
;; (defun my-gnus-ws ()
;;   "Switch to Gnus in its own work space."
;;   (interactive)
;;   (mws-switch-to-layout 1)
;;   (delete-other-windows)
;;   (gnus))


;;;;;; IRC

;; Main ERC configuration file.
(require 'erc)
(load (concat my-dot-emacs-dir "/ercrc"))

;; Shortcut to ERC.
(defvar my-erc-servers
  `((:server "localhost" :port 2806 :nick "minh"
             :password ,my-miau-password)
    (:server "localhost" :port 2807 :nick "minh"
             :password ,my-miau-password)))
(defun my-connect-erc ()
  "Connect to `my-erc-servers'."
  (interactive)
  (let ((lis my-erc-servers))
    (while lis
      (apply 'erc (car lis))
      (setq lis (cdr lis)))))


;;;;;; WWW

;; w3m.
(when (require 'w3m nil t)
  (setq w3m-terminal-coding-system 'utf-8)

  ;; We want images, cookies, but no tabs.
  (setq w3m-default-display-inline-images t
        w3m-toggle-inline-images-permanently nil
        w3m-use-cookies t
        w3m-use-tab nil)

  ;; XXX: Doc says don't do this but we need this for `w3m-region';
  ;; the `w3m-current-url' stuff is needed because w3m checks for this
  ;; when asynchronously displaying images, while newsticker clears
  ;; all local variables *after* it has rendered text...
  (setq-default w3m-display-inline-images t
                w3m-current-url "buffer://")

  ;; w3m gratuitously redefines `C-x b' without an apparent reason.
  (defun my-w3m-mode-init ()
    (define-key w3m-mode-map (kbd "C-x b") nil))
  (add-hook 'w3m-mode-hook 'my-w3m-mode-init))

;; Main News Ticker configuration.
;;(require 'newsticker)
;;(load (concat my-dot-emacs-dir "/newstrc"))

;; Shortcut to News Ticker.
;;(defun my-newsticker-ws ()
;;  (interactive)
;;  (mws-switch-to-layout 2)
;;  (newsticker-show-news))

;;;;;;;; Twitter.

(when (require 'twit nil t)
  (setq twit-protocol "https")
  (setq twit-user "nhatminhle"
	twit-pass my-twitter-password)
  (twit-set-auth twit-user twit-pass)
  ;;(twit-follow-recent-tweets)
  (global-set-key "\C-ctp" 'twit-post)
  (global-set-key "\C-ctr" 'twit-post-region)
  (global-set-key "\C-ctb" 'twit-post-buffer)
  (global-set-key "\C-ctf" 'twit-show-followers)
  (global-set-key "\C-cts" 'twit-show-recent-tweets))

;;;;;;;; URL handling.

;; XXX: `my-browse-url-get' is WIP (or rather, I don't work on it at
;; the moment, but it would be work-in-progress).

(defvar my-browse-url-get-program-name "ftp")
(defvar my-browse-url-get-output-option "-o")
(defvar my-browse-url-get-folder "~/tmp")

(defun my-browse-url-get (url &optional new-window)
  "Download URL."
  (interactive (browse-url-interactive-arg "URL: "))
  (let ((process-environment (browse-url-process-environment))
        process
	(purl (browse-url-encode-url url)))
    (message "Getting %s..." url)
    (setq process
          (start-process (concat "my-get " purl) nil
                         my-browse-url-get-program-name
                         my-browse-url-get-output-option
                         (expand-file-name
                          (concat my-browse-url-get-folder "/"
                                  (file-name-nondirectory url)))
                         url))
    (set-process-sentinel
     process
     `(lambda (process change)
        (my-browse-url-get-sentinel process ,url)))))

(defun my-browse-url-get-sentinel (process url)
  "Handle a change to the downloading process."
  (let ((status (process-exit-status process)))
    (cond
     ((eq status 0) (message "Getting %s... done" url))
     (t (message "Getting %s... error (exited with code %d)" url status)))))

(setq browse-url-browser-function
      '(("\\.torrent$" . my-browse-url-get)
        ("." . browse-url-firefox)))

(defun my-browse-url-at-point ()
  (interactive)
  (let ((url (w3m-anchor)))
      (if url
	  (browse-url url)
	(browse-url-at-point))))

(defun my-browse-last-url (n)
  (interactive "p")
  (save-excursion
    (while (and (> n 0) (re-search-backward "http://" nil t))
      (setq n (1- n)))
    (my-browse-url-at-point)))

(defun my-browse-url (which)
  (interactive "P")
  (if (numberp which)
      (my-browse-last-url which)
    (call-interactively (if which
                            'browse-url-emacs
                          'browse-url))))



;;;; Global keymap

;; Unneeded keys that can be used for something else.
(global-unset-key (kbd "C-z"))
(global-unset-key (kbd "C-/"))

;; Bind classic control combinations to more easily reachable keys (as
;; in most(?) terminal emulators).
(define-key key-translation-map (kbd "C-M-3") (kbd "C-M-["))
(define-key key-translation-map (kbd "C-3") (kbd "C-["))
(define-key key-translation-map (kbd "C-M-4") (kbd "C-M-\\"))
(define-key key-translation-map (kbd "C-4") (kbd "C-\\"))
(define-key key-translation-map (kbd "C-M-5") (kbd "C-M-]"))
(define-key key-translation-map (kbd "C-5") (kbd "C-]"))
(define-key key-translation-map (kbd "C-M-6") (kbd "C-M-^"))
(define-key key-translation-map (kbd "C-6") (kbd "C-^"))
(define-key key-translation-map (kbd "C-M-7") (kbd "C-M-_"))
(define-key key-translation-map (kbd "C-7") (kbd "C-_"))
(define-key key-translation-map (kbd "C-M-8") (kbd "M-DEL"))
(define-key key-translation-map (kbd "C-8") (kbd "DEL"))

;; IMHO more practical than C-x z z ...
(global-set-key (kbd "C-^") 'repeat)

;; Window management.
(global-set-key [(control tab)] 'other-window)
(global-set-key (kbd "C-c v") 'view-file)
(global-set-key (kbd "C-c o") 'bury-buffer)
(global-set-key (kbd "C-c k") 'kill-this-buffer)

;; Static work spaces.
(global-set-key (kbd "C-z 0") (lambda () (interactive) (mws-switch-to-layout 0)))
(global-set-key (kbd "C-z 1") (lambda () (interactive) (mws-switch-to-layout 1)))
(global-set-key (kbd "C-z 2") (lambda () (interactive) (mws-switch-to-layout 2)))
(global-set-key (kbd "C-z 3") (lambda () (interactive) (mws-switch-to-layout 3)))
(global-set-key (kbd "C-z 4") (lambda () (interactive) (mws-switch-to-layout 4)))
(global-set-key (kbd "C-z 5") (lambda () (interactive) (mws-switch-to-layout 5)))
(global-set-key (kbd "C-z 6") (lambda () (interactive) (mws-switch-to-layout 6)))
(global-set-key (kbd "C-z 7") (lambda () (interactive) (mws-switch-to-layout 7)))
(global-set-key (kbd "C-z 8") (lambda () (interactive) (mws-switch-to-layout 8)))
(global-set-key (kbd "C-z 9") (lambda () (interactive) (mws-switch-to-layout 9)))

;; Hungry delete everywhere!
;; FIXME: This does not work properly for `backward-delete-char-untabify'.
(global-set-key [remap backward-delete-char-untabify]
                'my-hungry-delete-backward)
(global-set-key [remap backward-delete-char] 'my-hungry-delete-backward)
(global-set-key [remap delete-backward-char] 'my-hungry-delete-backward)
(global-set-key [remap delete-char] 'my-hungry-delete-forward)

;; Switch ispell dictionary locally.
(global-set-key (kbd "C-c d e")
                (lambda () (interactive)
                  (ispell-change-dictionary "english")))
(global-set-key (kbd "C-c d f")
                (lambda () (interactive)
                  (ispell-change-dictionary "francais")))

;; Browse URLs.
(global-set-key (kbd "C-c g") 'my-browse-url)

;; My shortcuts to oft-used applications.
(global-set-key (kbd "C-c x i") 'my-connect-erc)
(global-set-key (kbd "C-c x m") 'my-wl-ws)
;; (global-set-key (kbd "C-c x m") 'my-gnus-ws)
(global-set-key (kbd "C-c x t") 'my-newsticker-ws)

;; Some useful commands which have no default key binding.

(global-set-key (kbd "C-c z") 'my-just-no-space)
(global-set-key (kbd "C-c x d") 'delete-region)

;; XXX: At the moment, there's no official binding on the following.
(global-set-key (kbd "C-M-l") 'my-kill-surrounding-parens)
(global-set-key (kbd "C-M-z") 'zap-up-to-char)
(global-set-key (kbd "M-o M-f") 'my-tab-to-right)

(global-set-key (kbd "C-c m") 'recompile)
(global-set-key (kbd "C-c n") 'customize-face)



;;;; Startup code

;; Common programs to launch at startup.
;; (condition-case nil
;;     (progn
;;       (my-wl-ws)
;;       (my-wl-biff)
;;       (my-newsticker-ws)
;;       (mws-switch-to-layout 0))
;;   (error nil))

;; Primitive external commands.
(defun my-sigusr1-handler ()
  (interactive)
  (signal 'quit nil))
(defun my-sigusr2-handler ()
  (interactive)
  (kill-emacs))
(define-key special-event-map [sigusr1] 'my-sigusr1-handler)
(define-key special-event-map [sigusr2] 'my-sigusr2-handler)