;; Aidan's ~/.xemacs/init.el    -*- coding: iso-2022-8 -*-
;;
;; ^.*/\([0-9][0-9]\)-.*$ is the sort-regexp-fields-numerically first arg
;; for allofmp3.com address sorts.
(when (equal "/" (getenv "HOME"))
  (setenv "HOME" "/home/aidan"))

(setq gnuserv-program (format "%s/gnuserv" exec-directory))

(gnuserv-start)

(push (expand-file-name "~/emacs-lisp/") load-path)
(push (expand-file-name "~/emacs-lisp/vm-7.18") load-path)
;; (push (expand-file-name "~/.xemacs/xemacs-packages/lisp/preview/") load-path)
;; (load "/Sources/xemacs-21.5-address-easy-menu-bugs/lisp/easymenu.el")

(when (featurep 'mule)
 
  ;; "un-define" gives us UTF-8 in 21.4. The translation rules for
  ;; iso-8859-15 don't get initialised properly here; this is something I
  ;; should fix.
  (require 'latin-unity-latin7)
  (require 'latin-unity-latin8)
  (require 'latin-unity-latin9)

  (unless (or (coding-system-p (find-coding-system 'utf-8))
              (null (locate-library "un-define")))
    (require 'un-define)
    (require 'unidata))

  (defun-when-void decode-char (quote-ucs code &optional restriction) 
    "FSF compatibility--return Mule character with Unicode codepoint `code'.
The second argument must be 'ucs, the third argument is ignored.  "
    (assert (eq quote-ucs 'ucs) 
            "Sorry, decode-char doesn't yet support anything but the UCS.  ")
    (unicode-to-char code))

  ;; iso-2022-8 is Latin-1 compatible, which is fantastic, compared to the
  ;; situation with iso-2022-jp. On the other hand, I would prefer to use
  ;; set-coding-priority-list to default to UTF-8 for new files; but I
  ;; _think_--haven't tested in a couple of weeks--that's breaking VM.

  ;; Ah, no, my downfall was that I was explicitly setq-default'ing
  ;; coding-system-for-read, which is the wrong thing to
  ;; do. buffer-file-coding-system-for-read is more apropos. 

  (unless (get 'jit-ucs-charset-0 'last-allocated-character)
    ;; Launch the just-in-time Unicode charset allocation if that is
    ;; available.
    (decode-char 'ucs #x204a))

  (setq-default 
   ;; When a file is entirely ASCII, associate this coding system with it. 
   buffer-file-coding-system 'utf-8
   ;; When we don't know the coding system for a file, try to work it out. 
   buffer-file-coding-system-for-read 'undecided
   ;; Under gnuclient, pass across data in UTF-8.
   terminal-coding-system 'utf-8-unix
   unidata-default-file-name "/usr/lib/perl5/5.8.0/unicore/UnicodeData.txt")

  (setq file-name-coding-system 'utf-8)

  (modify-coding-system-alist 'file "/ChangeLog" 'iso-2022-8)
  (pushnew '("\\.signature$" . utf-8) file-coding-system-alist)
  (pushnew '("\\.mysql\.info$" . utf-8) file-coding-system-alist)
  ;; Important! There's no guarantee the underlying data will be preserved 
  ;; in UTF-8 as it stands. 
  (pushnew '("mysql" . binary) process-coding-system-alist)

  (when (fboundp 'set-unicode-conversion) 
    (defun initialise-unicode-conversion (charset codemap)
      (assert (and (listp codemap)) (= 0 (% (length codemap) 2)))
      (while codemap
        (set-unicode-conversion (make-char charset (pop codemap)) 
                                (pop codemap))))

  (require 'iso-8859-13-to-unicode)))

;; If my Unicode-handling code is in place in this XEmacs, prefer Unicode to
;; other character sets for Greek and the IPA; display those two-dimensional
;; charsets that don't have corresponding fonts on XFree86 servers using the
;; Unicode fonts.

(when (find-charset 'jit-ucs-charset-0)
  (assert (not (find-charset 'jit-ucs-charset-1)) t 
          "Haven't written this code to handle more than one JIT charset.")

  (let ((new-high-order (second (split-char 
                                 (get 'jit-ucs-charset-0
                                      'last-allocated-character))))
        ;; Greek fonts crash the server; IPA fonts are not available;
        ;; Cyrillic fonts are ugly.
        (charsets-to-remap '(greek-iso8859-7 ipa cyrillic-iso8859-5
                             hebrew-iso8859-8))
        conv)

    (assert (> 127 (+ new-high-order (length charsets-to-remap))) t
            "If this limit is hit, we need to rewrite the code. ")

    (dolist (charset charsets-to-remap)
      (incf new-high-order)
      (loop for low-order from 32 to 127 do
        (setq conv (char-to-unicode (make-char charset low-order)))
        (if (/= -1 conv)
            (set-unicode-conversion (make-char 'jit-ucs-charset-0 
                                               new-high-order
                                               low-order)
                                    conv))))


    (put 'jit-ucs-charset-0 'last-allocated-character 
         (make-char 'jit-ucs-charset-0 new-high-order 127))

  (set-language-unicode-precedence-list  
   '(ascii latin-iso8859-1 latin-iso8859-2 jit-ucs-charset-0 latin-iso8859-4  
     thai-tis620 latin-iso8859-13 greek-iso8859-7 arabic-iso8859-6  
     hebrew-iso8859-8 latin-iso8859-16 latin-iso8859-13
     katakana-jisx0201 latin-jisx0201 cyrillic-iso8859-5 latin-iso8859-9  
     latin-iso8859-13 latin-iso8859-15 composite control-1  
     japanese-jisx0208-1978 japanese-jisx0213-1 japanese-jisx0213-2 
     japanese-jisx0208 japanese-jisx0212 chinese-gb2312  
     chinese-big5-1 chinese-big5-2 korean-ksc5601 
     chinese-cns11643-1 chinese-cns11643-2  
     arabic-digit arabic-1-column arabic-2-column chinese-sisheng 
     ascii-right-to-left latin-iso8859-14 indian-is13194 lao ipa 
     vietnamese-viscii-upper vietnamese-viscii-lower latin-iso8859-16 
     latin-iso8859-13 chinese-cns11643-3 chinese-cns11643-4 
     chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7 
     chinese-isoir165 ethiopic indian-2-column indian-1-column 
     thai-xtis tibetan tibetan-1-column))

  ;; With the current font architecture, this gets picked up as the face for
  ;; the esoteric character sets, and the X11 resources are checked for the
  ;; others.
  (set-face-font 'default 
                 "-misc-fixed-medium-r-normal--13-120-75-75-c-70-iso10646-1")

  (dolist (charset 
         '(chinese-cns11643-1 chinese-cns11643-2 chinese-big5-1
           chinese-big5-2 arabic-digit arabic-1-column arabic-2-column
           chinese-sisheng ascii-right-to-left indian-is13194 lao ipa
           vietnamese-viscii-upper vietnamese-viscii-lower japanese-jisx0212
           chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
           chinese-cns11643-6 chinese-cns11643-7 chinese-isoir165 ethiopic
           indian-2-column indian-1-column japanese-jisx0213-1
           japanese-jisx0213-2 thai-xtis tibetan tibetan-1-column))
  (when (equal (charset-dimension charset) 2)
    (set-charset-ccl-program charset 'ccl-encode-to-ucs-2)
    (set-charset-registry charset "iso10646-1")))))

(setq inhibit-startup-message t)

(when (featurep 'xft-fonts)
  (define-specifier-tag 'lang-ja)
  (define-specifier-tag 'lang-ko)
  (define-specifier-tag 'lang-zh-cn)
  (define-specifier-tag 'lang-zh-tw)

  (set-face-font 'default "Lucida Console-10.5")
  (set-face-font 'default "MS Mincho-20" nil '(lang-ja) 'append)
  (set-face-font 'default "Batang-20" nil '(lang-ko) 'append)
  (set-face-font 'default "SimSun-20" nil '(lang-zh-cn) 'append)
  (set-face-font 'default "SimSun-20" nil '(lang-zh-tw) 'append))

(unless (or (featurep 'xft) (find-charset 'jit-ucs-charset-0))
  (set-face-font 'default 
                 "-*-andale mono-medium-r-*-*-*-115-*-*-*-*-iso8859-1"))

(unless (fboundp 'decode-char)
  (let ((ct (make-char-table 'char))
        (ucs-code nil) (mule-char nil)
        (windows-1252-extra-chars 
         [ #x20AC       ;; EURO SIGN
           nil;; UNDEFINED
           #x201A;; SINGLE LOW-9 QUOTATION MARK
           #x0192;; LATIN SMALL LETTER F WITH HOOK
           #x201E;; DOUBLE LOW-9 QUOTATION MARK
           #x2026;; HORIZONTAL ELLIPSIS
           #x2020;; DAGGER
           #x2021;; DOUBLE DAGGER
           #x02C6;; MODIFIER LETTER CIRCUMFLEX ACCENT
           #x2030;; PER MILLE SIGN
           #x0160;; LATIN CAPITAL LETTER S WITH CARON
           #x2039;; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
           #x0152;; LATIN CAPITAL LIGATURE OE
           nil;; UNDEFINED
           #x017D;; LATIN CAPITAL LETTER Z WITH CARON
           nil;; UNDEFINED
           nil;; UNDEFINED
           #x2018;; LEFT SINGLE QUOTATION MARK
           #x2019;; RIGHT SINGLE QUOTATION MARK
           #x201C;; LEFT DOUBLE QUOTATION MARK
           #x201D;; RIGHT DOUBLE QUOTATION MARK
           #x2022;; BULLET
           #x2013;; EN DASH
           #x2014;; EM DASH
           #x02DC;; SMALL TILDE
           #x2122;; TRADE MARK SIGN
           #x0161;; LATIN SMALL LETTER S WITH CARON
           #x203A;; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
           #x0153;; LATIN SMALL LIGATURE OE
           nil;; UNDEFINED
           #x017E;; LATIN SMALL LETTER Z WITH CARON
           #x0178;; LATIN CAPITAL LETTER Y WITH DIAERESIS
           ]))
    (dotimes (i (length windows-1252-extra-chars))
      (setq ucs-code (aref windows-1252-extra-chars i)
            mule-char (if ucs-code (decode-char 'ucs ucs-code) ucs-code))
      (when mule-char
        (put-char-table (make-char 'control-1 i) mule-char ct)))
    ct))

(condition-case () (require 'w3-auto "w3-auto") (error nil))

(defun apropos-man-page ()
  "Run the Unix apropos command, outputting to an Emacs buffer."
  (interactive)
  (let ((val (read-from-minibuffer "Keyword: "))) 
  (shell-command (concat "apropos " val) "*apropos-man-page*")))

(defun perlman-section (word) "Look for a section in a perl manpage \n"
  (interactive "sWord to look for : ")
  (re-search-forward (concat "^ +" word)))

(define-key help-map "\C-m" 'manual-entry)
(global-set-key "\C-ca" 'apropos-man-page)
(global-set-key "\C-cl" 'browse-url-at-point)
(global-set-key "\C-co" 'backward-other-window)
(global-set-key "\C-cu" 'fixup-whitespace)
;; (global-set-key "\C-xa" 'iso-accents-mode)
(global-set-key "\C-xf" 'perlman-section)

(setq display-time-echo-area t)
(display-time)

(defun run-psql ()
  "Run the PostgreSQL client, with input and output via buffer *psql*."
  (interactive)
  (require 'comint)
  (let ((oldpag (getenv "PAGER"))) (and
  (setenv "PAGER" "cat")
  (switch-to-buffer (make-comint "psql" "/usr/local/pgsql/bin/psql"))
  (setenv "PAGER" oldpag))))

;; Name SQL connection buffers according to the username and database,
;; unconditionally.
(add-hook 'sql-interactive-mode-hook 'sql-rename-buffer)

(setq user-full-name "Aidan Kehoe"
      user-mail-address "kehoea@parhasard.net"

      ;; Try and get SPF behaving properly. 
      mail-specify-envelope-from t

;;      mail-default-reply-to "Aidan Kehoe <kehoea@parhasard.net>"
      mail-archive-file-name "~/mail/outgoing"
      mail-from-style 'angles
      mail-signature t
      mail-yank-prefix "> ")

(defvar echelon-distraction-file "~/.echelon"
  "The file where generate-echelon-distraction looks for vocabulary.")

(defun generate-echelon-distraction () 
  "Add distracting elements to outgoing mail" 
  (let ((temp " ")) 
    (dotimes (i 6) 
      (setq temp
            (concat temp (cookie echelon-distraction-file "" "") " ")))
    (mail-position-on-field  "X-Echelon-distraction")
    (insert temp)
    (if (not (re-search-backward "^[Tt][oO]:[ \t]+$" nil t 1))
        (progn (end-of-buffer)
               (re-search-backward "^-- $" nil t 1)
               (beginning-of-line)
               (backward-char)
               )
      (end-of-line))))

(add-hook 'mail-setup-hook 'generate-echelon-distraction)

(setq ps-paper-type 'a4)

(setq browse-url-browser-function 'browse-url-netscape
      browse-url-netscape-command "~/bin/netscape-remote"
      browse-url-netscape-program "~/bin/netscape-remote")

(autoload 'browse-url-at-point "browse-url")
(setq html-helper-htmldtd-version 
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"
        \"http://www.w3.org/TR/html4/strict.dtd\">\n"

      html-helper-address-string  
      "<a href=\"&#109;&#97;&#105;&#108;&#116;&#111;&#58;&#107;&#101;&#104;&#111;&#101;&#97;&#64;&#112;&#97;&#114;&#104;&#97;&#115;&#97;&#114;&#100;&#46;&#110;&#101;&#116;\">Aidan Kehoe</a>"

      html-helper-new-buffer-template 
      '(html-helper-htmldtd-version
        "<html>\n"
        "  <head>\n"
        "    <title>" (p "Document Title: " title) "</title>\n"
        "    <meta http-equiv=\"Content-Type\""
        " content=\"text/html; charset=UTF-8\">\n"
        "    <meta name=\"Author\""
        " content=\"Aidan Kehoe &lt;"
        "&#107;&#101;&#104;&#111;&#101;&#97;&#64;&#112;&#97;&#114;&#104;&#97;"
        "&#115;&#97;&#114;&#100;&#46;&#110;&#101;&#116;&gt;\">\n"
        "    <link rel=\"stylesheet\" type=\"text/css\" href=\""
        (p "Stylesheet: " )"\">\n"
        "  </head>\n"
        "  <body>\n"
        "    <h1>" (s title) "</h1>\n\n"
        p
        "\n\n    <p> <hr>\n"
        "    <address>" html-helper-address-string "</address>\n"
        html-helper-timestamp-start
        html-helper-timestamp-end
        "\n"
        "    <!-- Local Variables: -->\n"
        "    <!-- coding: utf-8 -->\n"
        "    <!-- mode: html -->\n"
        "    <!-- End: -->\n"
        "  </p>\n"
        "  </body>\n</html>\n"))

;; I prefer using this function in the pull-spools-basenames-from-procmailrc
;; function, so define it if it's not available.
(defun-when-void hash-table-key-list (hash-table) 
  "Return a list of all keys in HASH-TABLE.  " 
  (let (ret) 
    (maphash (lambda (key value) (push key ret)) hash-table) 
    ret))
;;
;; (delete-backward-char)
;; *shiver* Nnngh, Redhat termcaps
;; (keyboard-translate ?\C-h ?\C-?)

;; Kyle Jones' VM Unix-mail(1) compatible email client.
;; (require 'vm-startup)

;; Initialise vm-spool-files. We should be pulling the list values from
;; .procmailrc, rather than specifying them statically here. Hmm, well
;; here's an initial attempt at it--it's very specific to my setup, though.

(defun pull-spools-basenames-from-procmailrc (filename) 
  "Return a list of the folders to which procmail delivers mail, without the
directory name or the `.spool' extension.  "
  (save-excursion
    (let ((retlist (make-hash-table :test 'equal)))
      (with-temp-buffer
        (insert-file-contents (expand-file-name filename))
        (while (re-search-forward "^\$MAILDIR/\\(.*\\)\\.spool$" nil t)
          (puthash (buffer-substring (match-beginning 1) (match-end 1)) t 
                   retlist)) 
        (sort (hash-table-key-list retlist) 'string-lessp)))))

;; It's very likely that vm-spool-files isn't bound at this point. Initialise
;; it to the empty list.
(defvar vm-spool-files ())

(defun initialise-vm-spool-files () 
  "Initialise the list of spools that VM looks at for new mail."
  ;; Now, generate the detail for vm-spool-files from the basenames that are
  ;; pulled from .procmailrc.
  (setq vm-spool-files nil)
  (mapc (lambda (x)
          (push (list (concat "~/mail/" x) (concat "~/mail/" x ".spool")
                      (concat "~/mail/" x ".crash")) vm-spool-files))
        (pull-spools-basenames-from-procmailrc "~/.procmailrc")))

;; Do it once at startup. Below, we add this function to the
;; After-save-alist, and we exec it on every save of ~/.procmailrc
(initialise-vm-spool-files)

;; now set the defaults for other folders:
(setq vm-crash-box-suffix ".crash"
      vm-spool-file-suffixes '(".spool")
      vm-index-file-suffix ".index"

      vm-primary-inbox "~/mail/inbox"
      vm-mime-attachment-save-directory "~/mail/attachments/"
      vm-mime-use-w3-for-text/html nil
      vm-mime-internal-content-types '("application/pgp" "text/plain")
      vm-mime-type-converter-alist '(("application/pgp" "text/plain" "cat"))

      vm-included-text-attribution-format 
                "\n Ar an %dú lá de mí %M, scríobh %F: \n\n" 

      vm-reply-subject-prefix "Re: "
      vm-forwarding-subject-format "Forwarded message from %F"

      vm-subject-ignored-prefix 
                "\\`\\(re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)+"

      vm-summary-uninteresting-senders "kehoea@parhasard.net"
      ;; Just show the destination address in mails from myself.
      vm-summary-uninteresting-senders-arrow " "

      vm-url-browser 'vm-mouse-send-url-to-netscape
      vm-netscape-program "~/bin/netscape-remote"
      vm-auto-displayed-mime-content-type-exceptions '("text/html")
      vm-mime-8bit-composition-charset "UTF-8"
      vm-mime-8bit-text-transfer-encoding '8bit

      vm-mime-default-face-charsets '("us-ascii" "X-UNKNOWN" "unknown-8bit")) 

;; Get our mail user agent to be VM, unconditionally. 
(require 'vm-startup)
(setq mail-user-agent 'vm-user-agent)

(setq cperl-indent-level 4
      cperl-continued-statement-offset 4
      cperl-brace-offset -4
      cperl-label-offset -4)

(autoload 'cperl-perldoc "cperl-mode" "Run `perldoc' on WORD.")
(define-key help-map "P" 'cperl-perldoc)

;; (if (not (getenv "DISPLAY"))
;;    (keyboard-translate ?\C-h ?\C-?))

(setq zenirc-nick-default "kehoea"
      zenirc-fingerdata "Aidan Kehoe <aidan@netsoc>"
      zenirc-timestamp t
      zenirc-delete-preceding-whitespaces t
      zenirc-send-confirmation 'message
      zenirc-timestamp-prefix "["
      zenirc-timestamp-suffix "]")

;; (require 'tex-site)

(toggle-text-mode-auto-fill)
(setq-default fill-column 76)
(setq display-warning-minimum-level 'error)

(defun update-markedup () 
  "Update the marked-up version of my .plan file"
  (and 
   (equal (format "%s" (current-buffer)) ".plan.scratch") 
   (progn
   (shell-command "$HOME/bin/typography -s $HOME/.plan.scratch $HOME/.plan.markedup")
   (shell-command "cat $HOME/.plan.scratch > $HOME/.plan"))))

(defun add-weblog-entry ()
  "Add a weblog entry."
  (interactive)
  (shell-command 
   "cp $HOME/.plan $HOME/www/plan/archive/`$HOME/bin/mtimenum $HOME/.plan`")
  (shell-command 
   "$HOME/bin/typography $HOME/www/plan/archive $HOME/www/plan/markedup")
  (find-file "~/.plan.scratch")
  (add-hook 'after-save-hook 'update-markedup)
  (text-mode))

(autoload 'mspools-show "mspools" "Show outstanding mail spools." t)

(setq mspools-folder-directory "~/mail/"
      mspools-vm-system-mail "~/mail/inbox.spool"
      mspools-show t
      mspools-update t)

(eval-after-load "mspools" 
  `(define-key mspools-mode-map "C" 'vm-continue-postponed-message))

(global-set-key '[f11] 'mspools-show)
(global-set-key '[f12] 'add-weblog-entry)
;; (require 'vm)
(global-set-key '[f6] 'vm-visit-folder)


;; (require 'pgp)

(require 'mailcrypt)
(mc-setversion "gpg")

(autoload 'mc-install-write-mode "mailcrypt" nil t)
(autoload 'mc-install-read-mode "mailcrypt" nil t)

(add-hook 'mail-mode-hook 'mc-install-write-mode)
(add-hook 'mail-mode-hook '(lambda () (cd "~/mail")))
(add-hook 'vm-mode-hook 'mc-install-read-mode)
(add-hook 'vm-summary-mode-hook 'mc-install-read-mode)
(add-hook 'vm-virtual-mode-hook 'mc-install-read-mode)
(add-hook 'vm-presentation-mode-hook 'mc-install-read-mode)
(add-hook 'vm-mail-mode-hook 'mc-install-write-mode)

(setq Manual-buffer-view-mode "view other window")

(cd "~/mail/")

(setq gc-cons-threshold 60000000
      garbage-collection-messages t)

(setq lazy-lock-minimum-size 1024
      font-lock-maximum-size nil)

(add-hook 'font-lock-mode-hook 'turn-on-lazy-lock)

(require 'font-lock)

(setq sendmail-program "/home/aidan/bin/sendmail-conall-net")
;; (setq mm-automatic-display (remove "text/html" mm-automatic-display))

(setq mouse-track-rectangle-p nil)

(defconst irish-month-list 
  [nil "Eanair" "Feabhra" "M\341rta" "Aibr\351an" "Bealtaine"  
       "Meitheamh" "I\372il" "L\372nasa" "M\351an F\363mhair"  
       "Deireadh F\363mhair" "na Samhain" "na Nollaig"] 
  "The months in Irish, in a format suitable to being preceded by mí.")

(defconst irish-day-ordinal-list  
  [nil "ch\351ad l\341" "dara l\341" "tri\372 l\341"  
       "ceathr\372 l\341" "c\372igi\372 l\341" "s\351i\372 l\341"  
       "seacht\372 l\341" "t-ocht\372 l\341" "naoi\372 l\341"  
       "deichi\372 l\341" "t-aon\372 l\341 d\351ag" "dara l\341 d\351ag" 
       "tri\372 l\341 d\351ag" "ceathr\372 l\341 d\351ag"  
       "c\372igi\372 l\341 d\351ag" "s\351\372 l\341 d\351ag"  
       "seacht\372 l\341 d\351ag" "t-ocht\372 l\341 d\351ag"  
       "nao\372 l\341 d\351ag" "fichi\372 l\341"  
       "ch\351ad l\341 is fiche" "dara l\341 is fiche"  
       "tr\355\372 l\341 is fiche" "ceathr\372 l\341 is fiche" 
       "c\372igi\372 l\341 is fiche" "s\351\372 l\341 is fiche"  
       "seacht\372 l\341 is fiche" "t-ocht\372 l\341 is fiche"  
       "nao\372 l\341 is fiche" "triochad\372 l\341"  
       "t-aon\372 l\341 is triochad" "dara l\341 is triochad"]
  "The ordinal names of the days of the month, in Irish.")

(require 'timezone)
(require 'mail-extr)
(require 'nnheader)
(require 'message)

(defvar correspondents-attribution-remapping 
  (list (list (downcase "Hrvoje Niksic") (format "Hrvoje Nik%ci%c"  
                                                 (or (decode-char 'ucs #x161)  
                                                     ?s)
                                                 (or (decode-char 'ucs #x107)
                                                     ?c)))
        (list (downcase "Tamara Lopez") "Tamara L\363pez")) 
  "An alist of people whose names should be remapped in the attribution 
line, and what those names should be remapped to. ") 

;; Some gnus handling.

(defun message-insert-citation-as-gaeilge ()
  "Insert a citation line in Irish."
  (when message-reply-headers
    (let* 
        ((iso-date-list 
          (timezone-parse-date (mail-header-date message-reply-headers)))
          (month (string-to-int (elt iso-date-list 1)))
          (day (string-to-int (elt iso-date-list 2)))
          (full-from (mail-extract-address-components 
                      (mail-header-from message-reply-headers)))
          (sender (or (first full-from) (second full-from)))
          (remap (assoc (downcase sender) 
                        correspondents-attribution-remapping)))
      (if remap 
          (setq sender (second remap)))
      (insert "\n Ar an " (elt irish-day-ordinal-list day) " de m\355 "
              (elt irish-month-list month) ", scr\355obh " sender
              ": \n\n"))))

;; (set-console-tty-coding-system (selected-console) 'iso-8859-15)

(setq message-citation-line-function  'message-insert-citation-as-gaeilge
      message-yank-cited-prefix " > "
      message-yank-prefix  " > "
      message-default-headers "Fcc: ~/mail/outgoing
X-NS5-file-as-sent: t\nBCC: aidan@icarus.conall.net\n"
      message-wide-reply-confirm-recipients nil)

(setq mail-default-headers 
      "X-NS5-file-as-sent: t\nBCC: aidan@icarus.conall.net\n")

;; (global-set-key "\C-z" 'suspend-emacs-or-iconify-frame)

;; When I'm changing ~/.xemacs/init.el, I want it automatically recompiled
;; on every save.
(require 'after-save-commands)

(let ((our-startup-file (or user-init-file 
                            (expand-file-name "~/.xemacs/init.el")))
      user-file-quoted procmailrc-file)

  ;; Chop off the c of the ".elc", if it's there.
  (if (equal (substring our-startup-file -4) ".elc")
      (setq our-startup-file (substring our-startup-file 0 -1)))

  ;; Quote it as a regexp. 
  (setq user-file-quoted (regexp-quote our-startup-file)
        procmailrc-file (regexp-quote (expand-file-name "~/.procmailrc")))

  ;; Now, push it onto the After-save-alist, together with the lisp
  ;; necessary to recompile it on every save.
  (push `(,user-file-quoted nil nil (byte-compile-file ,our-startup-file))
        After-save-alist)
  (push `(,procmailrc-file nil nil (initialise-vm-spool-files))
        After-save-alist))

;; No confirmation on changing shell scripts' modes after editing them. 
(delq '((eq major-mode (quote sh-mode)) nil t "chmod a+x $f") 
      After-save-alist)
(push '((eq major-mode (quote sh-mode)) nil nil "chmod a+x $f")
      After-save-alist)

(defun move-selected-console-to-latin-9 ()
  "Change the input and output coding systems of the current console
to ISO8859 15."
  (interactive)
  (assert (coding-system-p (find-coding-system 'iso-8859-15)))
  (message "Setting this console's coding system to Latin 9 ...")
  (set-console-tty-coding-system (selected-console) 'iso-8859-15)
  (message "Setting this console's coding system to Latin 9 ... done."))

(defun move-selected-console-to-utf-8 ()
  "Change the input and output coding systems of the current console
to UTF-8"
  (interactive)
  (assert (coding-system-p (find-coding-system 'utf-8)))
  (message "Setting this console's coding system to UTF-8 ...")
  (set-console-tty-coding-system (selected-console) 'utf-8)
  (message "Setting this console's coding system to UTF-8 ... done."))

(global-set-key "\C-c9" 'move-selected-console-to-latin-9)
(global-set-key "\C-c8" 'move-selected-console-to-utf-8)

;; If we already include similar code in the dumped XEmacs, don't run this.
(when (not (fboundp 'select-convert-from-image/xpm))

  (defun select-convert-from-targets (selection type value) 
    value) 
 
  (defun select-convert-from-utf-8-string (selection type value) 
    (unless (or (coding-system-p (find-coding-system 'utf-8))  
                (null (locate-library "un-define")))  
      (require 'un-define)) 
    (decode-coding-string value 'utf-8)) 

  (defun select-convert-from-xpm (selection type value)
    value)

  (setq selection-converter-in-alist 
      '(; Specific types that get handled by generic converters  
        (image/xpm . select-convert-from-xpm)
        (UTF8_STRING . select-convert-from-utf-8-string) 
        (COMPOUND_TEXT . select-convert-from-text) 
        (SOURCE_LOC . select-convert-from-text) 
        (OWNER_OS . select-convert-from-text) 
        (HOST_NAME . select-convert-from-text) 
        (USER . select-convert-from-text) 
        (CLASS . select-convert-from-text) 
        (NAME . select-convert-from-text) 
        ; Generic types 
        (INTEGER . select-convert-from-integer) 
        (TEXT . select-convert-from-text) 
        (STRING . select-convert-from-text) 
        (LENGTH . select-convert-from-length) 
        (FILE_NAME . select-convert-from-filename) 
        (CF_TEXT . select-convert-from-cf-text) 
        (CF_UNICODETEXT . select-convert-from-cf-unicodetext) 
        )) 

  (push '(TARGETS . select-convert-from-targets) 
        selection-converter-in-alist) 
 
  (defun insert-selection (&optional check-cutbuffer-p move-point-event) 
    "Insert the current selection into buffer at point." 
    (interactive "P") 
    ;; we fallback to the clipboard if the current selection is not existent 
    (let ((text (or (get-selection-no-error 'PRIMARY   'UTF8_STRING) 
                    (get-selection-no-error 'PRIMARY   'STRING) 
                    (and check-cutbuffer-p (get-cutbuffer)) 
                    (get-selection-no-error 'CLIPBOARD 'UTF8_STRING) 
                    (get-selection-no-error 'CLIPBOARD 'STRING) 
                    (error "no selection: PRIMARY or CLIPBOARD")))) 
      (cond (move-point-event 
             (mouse-set-point move-point-event) 
             (push-mark (point))) 
            ((interactive-p) 
             (push-mark (point)))) 
      (insert text))) 

  (setq selection-converter-out-alist
        '((UTF8_STRING . select-convert-to-utf-8-string)        
          (TEXT . select-convert-to-text)
          (STRING . select-convert-to-string)
          (COMPOUND_TEXT . select-convert-to-compound-text)
          (TARGETS . select-convert-to-targets)
          (LENGTH . select-convert-to-length)
          (DELETE . select-convert-to-delete)
          (FILE_NAME . select-convert-to-filename)
          (CHARACTER_POSITION . select-convert-to-charpos)
          (SOURCE_LOC . select-convert-to-sourceloc)
          (LINE_NUMBER . select-convert-to-lineno)
          (COLUMN_NUMBER . select-convert-to-colno)
          (OWNER_OS . select-convert-to-os)
          (HOST_NAME . select-convert-to-host)
          (USER . select-convert-to-user)
          (CLASS . select-convert-to-class)
          (NAME . select-convert-to-name)
          (ATOM . select-convert-to-atom)
          (INTEGER . select-convert-to-integer)
          (CF_TEXT . select-convert-to-cf-text)
          (CF_UNICODETEXT . select-convert-to-cf-unicodetext)))

  (defun select-convert-to-utf-8-string (selection type value)
    (cond ((stringp value)
           (cons 'UTF8_STRING (encode-coding-string value 'utf-8)))
          ((extentp value)
           (save-excursion
             (set-buffer (extent-object value))
             (save-restriction
               (widen)
               (cons 'UTF8_STRING 
                     (encode-coding-string 
                      (buffer-substring (extent-start-position value)
                                        (extent-end-position value)) 'utf-8)))))
          ((and (consp value)
                (markerp (car value))
                (markerp (cdr value)))
           (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
               (signal 'error
                       (list "markers must be in the same buffer"
                             (car value) (cdr value))))
           (save-excursion
             (set-buffer (or (marker-buffer (car value))
                             (error "selection is in a killed buffer")))
             (save-restriction
               (widen)
               (cons 'UTF8_STRING (encode-coding-string 
                                   (buffer-substring (car value) (cdr value))
                                   'utf-8)))))
          (t nil))))

;; Do some sanity-checking for our coding systems being broken. If any of
;; these are set, VM and GNUS stuff will break, because they need to access
;; files on disk using a binary coding system, and this'll overwrite that.
(unless (eq (find-coding-system 'undecided) 
            (coding-system-base 
             (find-coding-system 
              (default-value 'buffer-file-coding-system-for-read))))
  (display-warning 'error
    (concat "You shouldn't be defaulting buffer-file-coding-system-for-read "
            "to anything other than 'undecided! You _will_ lose data!")))

(when (or (not (null coding-system-for-read))
        (not (null (default-value coding-system-for-read))))
  (display-warning 'error
    (concat "You shouldn't be setting coding-system-for-read globally, "
            "nor initialising its default value to anything but nil. "
            "You _will_ lose data!")))

(when (or (not (null coding-system-for-write))
        (not (null (default-value coding-system-for-write))))
  (display-warning 'error 
    (concat "You shouldn't be setting coding-system-for-write globally,"
            "nor initialising its default value to anything but nil. " 
            "You _will_ lose data!")))

(require 'savehist)
(setq savehist-length nil)
(savehist-load)

(message "Need to add a check for add-submenu to the recent-files package.")
(unless (fboundp 'add-submenu)
  (defun add-submenu (&rest args)
    "Hi there!"))

(require 'recent-files)
(recent-files-initialize)
(require 'blink-paren)
(require 'desktop)

;; (desktop-load-default)
;; (desktop-read)

(require 'redo)
;; (require 'scroll-in-place)

;; I'm storing website passwords, etc, in ~/mail/accounts.asc . Crypt++
;; allows me to visit this transparently from vm. Problems with this
;; approach; the buffer can be swapped out, the admin can kill the machine,
;; and the info will be written to swap space when the machine comes back
;; up. Also, VM uses index files, which write subject and other info to
;; other, non-encrypted files.

(modify-coding-system-alist 'file "\\.gpg\\'" 'no-conversion-unix)
(setq crypt-encryption-file-extension "\\(\\.asc\\)$"
      crypt-encryption-type 'gpg)

(require 'crypt++ "/home/aidan/emacs-lisp/crypt++.el-2.92")

;; This may have to be changed to be context-sensitive.
(define-key global-map [(control h)] 'delete-backward-char)

;; Handy for when I just want to check what mail, etc has come in. 
(defun watch-stuff-window-configuration ()
  "Go to the default window set up; zenirc, *spools* and the Gnus *Group* 
buffer."
  (interactive)
  (select-frame (make-frame))
  (split-window)
  (split-window)
  (zenirc)
  (other-window 1)
  (mspools-show)
  (other-window 1)
  (gnus)
  (balance-windows))

(define-key global-map [f10] 'watch-stuff-window-configuration)

(defun fixup-gnus-windows ()
  "Twelve lines at the top, article below. "
  (interactive)
  (split-window-vertically 12)
  (other-window 1)
  (switch-to-buffer "*Article*"))

(setq vm-save-killed-message nil)

(setq gnus-summary-mode-map 
      (let ((km (make-sparse-keymap)))
        (suppress-keymap km)
        (dolist (key `([backspace] [delete] "\177" "\M-u"))
          (define-key km key 'undefined))
        km))

(define-key gnus-summary-mode-map [f9] 'fixup-gnus-windows)

(setq patcher-projects
      '(("XEmacs Packages" "/Sources/packages"
         :to-address "xemacs-patches@xemacs.org")
        ("XEmacs Packages (existing ChangeLogs)" "/Sources/packages"
         :to-address "xemacs-patches@xemacs.org"
         :change-logs-updating manual)
        ("XEmacs Stable" "/Sources/xemacs-21.4"
         :to-address "xemacs-patches@xemacs.org")
        ("XEmacs Trunk" "/Sources/xemacs-21.5"
         :to-address "xemacs-patches@xemacs.org")
        ("XEmacs Trunk (existing ChangeLogs)" "/Sources/xemacs-21.5"
         :to-address "xemacs-patches@xemacs.org"
         :change-logs-updating manual)
        ("XEmacs latin-euro-standards" "/Sources/packages/mule-packages/latin-euro-standards"
         :to-address "xemacs-patches@xemacs.org")
        ("XEmacs sjt-xft" "/Sources/xemacs-sjt-xft"
         :to-address "xemacs-patches@xemacs.org")
        ("XEmacs Web" "/Sources/xemacsweb"
         :to-address "xemacs-patches@xemacs.org")
        ("GNU Emacs Trunk" "/Sources/emacs"
         :to-address "emacs-pretest-bug@gnu.org")))

(require 'calc)

(defun pop-up-calc-frame () 
  "Pop up a frame, with the *Calculator* buffer selected.  "
  (let ((gnuserv-frame t) 
        (pop-up-frames t))
    (calc-create-buffer)
    (pop-to-buffer "*Calculator*")))

(defadvice vm-make-message-id (after make-message-id-as-I-like activate) 
  "For whatever reasion, I don't like it underlined that my posting host is 
ns5.nestdesign.com. " 
  (let ((time (current-time))) 
    (setq ad-return-value (format "<%d.%d.%d.%d@%s>" 
                                  (pop time) (pop time) (pop time) 
                                  (random 999999) "parhasard.net")))) 
 
 
(defadvice message-make-message-id (after mm-message-as-I-like activate) 
  "For whatever reasion, I don't like it underlined that my posting host is 
ns5.nestdesign.com. " 
  (let ((time (current-time))) 
    (setq ad-return-value (format "<%d.%d.%d.%d@%s>" 
                                  (pop time) (pop time) (pop time)  
                                  (random 1000000) "parhasard.net")))) 

;; Try to get GNUS to do the sane thing when sending messages that can't be 
;; encoded in Latin 1. 
(defadvice mm-find-mime-charset-region (after do-sane-mime-charset-select 
                                                activate) 
   "Look at the contents of a message, and if they fit in ASCII, return nil. 
If they fit in ISO-8859-1, return `iso-8859-1', otherwise return `utf-8'.  
 
Should revise this to use Latin Unity, and a configurable list of preferred 
MIME character sets. " 
   (let ((charsets  
          (delq 'ascii (charsets-in-region (ad-get-arg 0) (ad-get-arg 1))))) 
     (setq ad-return-value (cond ((null charsets) nil)  
                                 ((and (eq 1 (length charsets))  
                                       (eq 'latin-iso8859-1 (car charsets))) 
                                  '(iso-8859-1)) 
                                 (t '(utf-8)))))) 

(setq mm-coding-system-priorities '(iso-8859-1 utf-8))

(defadvice patcher-change-logs-diff-error (before p-c-l-d-e activate) 
  "Give a list of the differing ChangeLog files when running Patcher. " 
  (assert (boundp 'buffer))
  ;; There's got to be a better way to suppress the byte-compiler warnings.
  (patcher-change-logs (symbol-value 'buffer)))

(setq system-type
      (intern (replace-in-string 
               (substring (shell-command-to-string "uname -sp") 0 -1) 
               "[ \n]" "-")))

(setq message-courtesy-message nil) 

;; Define a function to conveniently determine where time is being
;; spent when executing commands or Lisp code.
(defun toggle-profiling ()
  "Start profiling, or stop it and print results.
This lets you figure out where time is being spent when executing Lisp code."
  (interactive)  
  (if (profiling-active-p) 
      (progn  
        (stop-profiling) 
        (message "...Finished profiling")
        (profile-results))
    (message "Profiling...") 
    (clear-profiling-info) 
    (start-profiling)))

;; Note that sequences of C-c plus a letter are specifically
;; reserved for users and should never be bound by any packages.

(global-set-key "\C-cp" 'toggle-profiling)

(autoload 'gid "id-utils")

(global-set-key "\C-cg" 'gid)

(defun perhaps-insert-space ()
  "If the previous five characters are \\nFrom, insert U+00A0 NO-BREAK SPACE
otherwise, insert the character typed.  This should work around quite
effectively the broken Unix mail format.  "
  (interactive)
  (let ((lastfive (condition-case nil
                      (buffer-substring (- (point) 5) (point)) (t))))
    (if (and lastfive
             (equal (downcase lastfive) "\nfrom"))
        (insert (make-char 'latin-iso8859-1 #xa0))
      (self-insert-command 1))))

(require 'tex-site)

(defvar TeX-open-quote) 
(defvar TeX-close-quote) 
(defvar vmpc-done nil) 

(autoload 'vmpc-automorph "vm-pcrisis")

(defun silly-directed-quotes-hook ()  
  "I like having directed quotes in my mail." 
  (make-local-variable 'TeX-open-quote) 
  (make-local-variable 'TeX-close-quote) 
  (make-local-variable 'vmpc-done) 
  (setq TeX-open-quote (format "%c" (or (decode-char 'ucs #x201c) ?'))
        TeX-close-quote (format "%c" (or (decode-char 'ucs #x201d) ?')) 
        vmpc-done nil) 
  (local-set-key "\"" 'TeX-insert-quote) 

  (if (not (memq major-mode '(mail-mode message-mode)))
      (local-set-key "'" '(lambda ()  
                          "Insert the Unicode right single quote"
                          (interactive) 
                          (insert (decode-char 'ucs #x2019))))
    ;; These last two bindings should be distinct from the directed quotes
    ;; functionality.
    (local-set-key 'space 'perhaps-insert-space)
    (local-set-key "'" '(lambda ()  
                          "Insert the Unicode right single quote, and do the 
right thing with VMPC's headers.  "  
                          (interactive) 
                          (insert (decode-char 'ucs #x2019)) 
                          (vmpc-automorph)))))

(add-hook 'mail-mode-hook 'silly-directed-quotes-hook) 
(add-hook 'message-mode-hook 'silly-directed-quotes-hook) 
 
(add-hook 'mail-mode-hook 'mc-install-write-mode) 
(add-hook 'mail-mode-hook '(lambda () (setq buffer-file-coding-system  
                                            'escape-quoted) 
                             (cd "~/mail")
                             (font-lock-fontify-buffer)))

(add-hook 'vm-mail-mode-hook '(lambda () (setq buffer-file-coding-system  
                                            'escape-quoted) 
                             (cd "~/mail")
                             (font-lock-fontify-buffer)))

(defun compile-using-previous-command ()
  "Equivalent to M-x compile RET RET\n."
  (interactive)
  (compile (car compile-history)))

(define-key global-map "\C-cc" 'compile-using-previous-command)

(setq edict-dictionaries '("/usr/pkg/share/edict/edict"))

(add-hook 'create-console-hook 
          '(lambda (con) 
             (when (eq (device-type (car (console-device-list con)))
                       'tty)
               (set-input-mode t nil 1 nil con)
               (set-console-tty-coding-system con 'utf-8))))

(set-input-mode t nil 1)

(defun alternative-get-selection-internal (where type)
  (condition-case nil
      (get-selection-internal where type)
    (error
     nil)))

(autoload 'mpg123 "mpg123" "Call mpg123 on file" t)

(setq mpg123-lazy-check "\\.mp3$"
      mpg123-startup-volume 220
      )

(setq gnus-select-method '(nntp "news.individual.net")
      gnus-treat-display-smileys nil
      gnus-emphasis-alist nil)

(defun trim-buffer-to-latin-1 () 
  "If I'm corresponding with someone who's using a mail client that chokes 
on UTF-8, and they're not vaguely techie, there's no reason to give them 
hassle with the broken UTF-8.  Call this function after writing a mail, in 
that case. " 
  (interactive) 
  (save-excursion 
    (save-restriction 
      (let (skipped)
        (message "Trimming buffer to Latin 1 ...") 
        (goto-char (point-min)) 
        (while (not (zerop (setq skipped (skip-chars-forward "\001-\377") 
                                 skipped (skip-chars-forward "^\001-\377")))) 
          (translate-region (point) (- (point) skipped)  
                            sundry-chars-to-latin-1-map)) 
        (goto-char (point-min)) 
        (while (search-forward "\0" nil t) 
          (replace-match "." nil t)) 
        (message "Trimming buffer to Latin 1 ... done."))))) 
 
(define-key global-map [(control c) ?1] 'trim-buffer-to-latin-1) 

;; Robert Widhopf-Fenk's add-on.
(autoload 'vm-mail-get-header-contents "vm-pine")
 
(defvar people-with-shit-mail-clients nil 
  "If I'm corresponding with someone on this list, the buffer should be 
trimmed to Latin 1 before sending.  Intended to be people with whom I 
correspond who shouldn't have to fix their mail clients; not to be used with 
people techie enough to do that.  ") 

(defun trim-to-latin-1-as-necessary () 
  "If the message is to be sent to someone in the list 
`people-with-shit-mail-clients', trim it to Latin 1.  " 
  (let ((possible-people-regexp  
         (concat "\\(" 
                 (mapconcat 'regexp-quote people-with-shit-mail-clients "\\|") 
                 "\\)")) 
        (recipients (concat (vm-mail-get-header-contents "To") " " 
                            (vm-mail-get-header-contents "CC") " " 
                            (vm-mail-get-header-contents "BCC")))) 
    (when (and people-with-shit-mail-clients 
               (string-match possible-people-regexp recipients)) 
      (trim-buffer-to-latin-1)))) 
 
(defvar vm-mail-send-hook nil)

(pushnew 'trim-to-latin-1-as-necessary vm-mail-send-hook) 
 
(push "kali301083@yahoo.fr" people-with-shit-mail-clients) 
(push "alea_iacta@yahoo.com" people-with-shit-mail-clients)  
(push "gavinjkelleher2002@yahoo.de" people-with-shit-mail-clients) 
(push "dueninn@hotmail.com" people-with-shit-mail-clients) 

;; Never make any group invisible in the *Group* buffer.  
(setq gnus-permanently-visible-groups "^.*") 

(autoload 'vm-quit "vm-folder")

(defun kill-any-outgoing-vm-folder () 
  "If `~/mail/outgoing'is opened as a VM folder, close it.  This prevents 
corruption of that file when FCCing from message mode. " 
  (let ((buf (find-buffer-visiting (expand-file-name "~/mail/outgoing")))) 
    (when buf 
      (save-excursion 
        (set-buffer buf) 
        (vm-quit))))) 
 
(pushnew 'kill-any-outgoing-vm-folder message-send-hook) 
 
(setq message-courtesy-message nil 
      system-type (intern (replace-in-string 
                           (substring (shell-command-to-string "uname -sm")  
                                      0 -1) "[ \n]" "-"))) 

(defcustom lazy-lock-mode nil
  "Non nil means `lazy-lock-mode' is on."
  :group 'lazy-lock
  :require 'lazy-lock ;; which in turn requires font-lock.
  :type 'boolean
  :initialize 'custom-initialize-default
  :set '(lambda (var val)
          (if val
              (progn
                (lazy-lock-mode 1)
                (add-hook 'font-lock-mode-hook 'turn-on-lazy-lock))
            (lazy-lock-mode -1)
            (remove-hook 'font-lock-mode-hook 'turn-on-lazy-lock))))

(setq diff-switches "-u")

(defun tetris ()
  "D'oh. "
  (interactive)
  (message "Get back to work!"))

(defconst sundry-chars-to-latin-1-map 
  (let ((ct (make-char-table 'char))  
        (chars-to-map  
         #s(hash-table data  
                       (#x20AC  ?e  ;; EURO SIGN  
                        #x201A  ?\' ;; SINGLE LOW-9 QUOTATION MARK  
                        #x201E  ?\" ;; DOUBLE LOW-9 QUOTATION MARK  
                        #x2018  ?\' ;; LEFT SINGLE QUOTATION MARK  
                        #x2019  ?\' ;; RIGHT SINGLE QUOTATION MARK  
                        #x201C  ?\" ;; LEFT DOUBLE QUOTATION MARK  
                        #x201D  ?\" ;; RIGHT DOUBLE QUOTATION MARK  
                        #x2022  ?·  ;; BULLET  
                        #x2013  ?-  ;; EN DASH  
                        #x2014  ?-  ;; EM DASH  
                        #x02DC  ?~  ;; SMALL TILDE 
                        )))) 
    (maphash '(lambda (key value)  
                (if (setq key (decode-char 'ucs key)) 
                    (put-char-table key value ct))) 
             chars-to-map) 
    ct) 
  "Mapping from some random Unicode code points to Latin 1.  
To be used when sending mail to non-techie people whose mail clients choke 
on UTF-8. ") 

(define-key global-map [(control meta e)] 
  ;; EURO SIGN
  '(lambda () (interactive) (insert (decode-char 'ucs #x20ac))))

;; (format "%x" (char-int ?`)) => 60
(define-key global-map [(control x) #x60 ]
  ;; LEFT DOUBLE QUOTATION MARK
  '(lambda () (interactive) (insert (decode-char 'ucs #x201c))))

;; (format "%x" (char-int ?')) => 27
(define-key global-map [(control x) #x27 ]
  ;; RIGHT DOUBLE QUOTATION MARK
  '(lambda () (interactive) (insert (decode-char 'ucs #x201d))))

;; #x2c is the ASCII comma. 
(define-key global-map [(control x) #x2c ]
  ;; DOUBLE LOW-9 QUOTATION MARK
  '(lambda () (interactive) (insert (decode-char 'ucs #x201e))))

;; Load my Cyrillic input method, which has support for the extra characters
;; necessary for Tajik, but unsupported by ISO 8859-5. (Whence the necessity
;; for the file to be encoded in UTF-8.)
(require 'cyrillic-im-utf-8)

;; Load my IPA input method. In contrast to the Cyrillic, this supports less
;; characters than the default one; it does, however, when loaded after the
;; above Unicode conversion re-ordering has been put into place, encode the
;; characters into the jit-ucs-charset-0 character set, which means they
;; display under X11--not the case for the IPA character set.
;; (require 'ipa-im-utf-8)
(require 'ipa)

(defvar duden-oxford-coding-system 'utf-8
  "Coding system for the Duden/Oxford dictionary files. ")

(defconst deutsch-english-path "/home/aidan/duden-oxford/deutsch-english.txt"
  "Path to the German-English dictionary")

(defconst english-deutsch-path "/home/aidan/duden-oxford/english-deutsch.txt"
  "Path to the English-German dictionary")

(defun look-up-deutsch-english ()
  "Find a German entry in the Duden dictionary. "
  ;; Should be able to parse the arguments with an interactive declaration,
  ;; but I haven't managed to do that quite yet. And, sure, it'll work fine
  ;; without me doing it.
  (interactive)
  (let ((manipulated-arg "^[*]\\{0,1\\}")
        (list-matching-lines-whole-buffer t)
        (german "")
        (dict-buffer nil)
        (coding-system-for-read duden-oxford-coding-system))
    (setq german (or current-prefix-arg
                     (read-from-minibuffer "German word to look up: "
                                           (thing-at-point 'word))))
    (dolist (letter (append german nil))
      (setq manipulated-arg (format "%s%c[%c%c]\\{0,1\\}" 
                                    manipulated-arg 
                                    letter
                                    (decode-char 'ucs #xb7)
                                    (decode-char 'ucs #x7c))))
    (setq dict-buffer
          (find-file-noselect deutsch-english-path))
    (save-excursion
      (set-buffer dict-buffer)
      (occur manipulated-arg))))

(defun look-up-english-deutsch ()
  "Find an English entry in the Duden dictionary. "
  ;; Should be able to parse the arguments with an interactive declaration,
  ;; but I haven't managed to do that quite yet. And, sure, it'll work fine
  ;; without me doing it.
  (interactive)
  (let ((manipulated-arg "^[*]\\{0,1\\}")
        (list-matching-lines-whole-buffer t)
        (english "")
        (dict-buffer nil)
        (coding-system-for-read duden-oxford-coding-system))
    (setq english (or current-prefix-arg
                     (read-from-minibuffer "English word to look up: "
                                           (thing-at-point 'word))))
    (dolist (letter (append english nil))
      (setq manipulated-arg (format "%s%c[%c'| ]\\{0,1\\}" 
                                    manipulated-arg 
                                    letter
                                    (decode-char 'ucs #xb7))))
    (setq dict-buffer
          (find-file-noselect english-deutsch-path))
    (save-excursion
      (set-buffer dict-buffer)
      (occur manipulated-arg))))

(global-set-key "\C-cd" 'look-up-deutsch-english)

(global-set-key "\C-ce" 'look-up-english-deutsch)

(defun generate-c-format-utf-8-chars (string)
  "Insert a string mapping from characters to their C-string encoding."
  (interactive "sCharacters to insert: ")
  (let ((res ""))
    ;; (append [something] nil) returns a list form of [something], if that
    ;; data type can be represented as a list.
    (dolist (char (append string nil))
      (setq res (format "%s\"%c\" => \"%s\",\n" res
                        char
                        (mapconcat 
                         '(lambda (newchar) "" (format "\\x%x" newchar))
                         (append (encode-coding-string char 'utf-8) nil) 
                         ""))))
    (insert res)))

(global-set-key "\C-c8" 'generate-c-format-utf-8-chars)

(setq truncate-partial-width-windows nil)

;; (autoload 'vm-url-decode-string "vm-misc")

(defun view-del.icio.us-url-history (url)
  "Load the del.icio.us that displays information on who saved and when they
saved `URL'. "
  (browse-url (concat "http://del.icio.us/url/" (md5 url))))

;; Keeping around some input methods, and I prefer to keep them buffer local
;; and settable with file local variables.

(make-variable-buffer-local 'default-input-method)
(make-variable-buffer-local 'input-method-history)

(setq-default default-input-method "latin-1-postfix"
              input-method-history
              '("cyrillic-translit-aidan" "ipa" "latin-1-postfix"))

(autoload 'erc-select-read-args "erc") 
 
(erc-timestamp-mode) 
(setq erc-default-coding-system 'utf-8 
      erc-nick "kehoea" 
      erc-user-full-name "Aidan Kehoe" 
      erc-email-userid "aidan" 
      erc-autojoin-channels-alist '(("efnet.xs4all.nl" "#iegoth"))) 

;; Doing this unconditionally should be fine. 
(define-key global-map [kp-f1] 'help-command)
(global-set-key '[f1] 'help-command)

(defun time-stamp-to-string (time-stamp)
  "Return TIME-STAMP as a string in English."
  (check-argument-type 'integerp time-stamp)
  (current-time-string (cons (lsh time-stamp -16) (logand #xFFFF time-stamp))))

(autoload 'blog-init-entry "blog-signing"
  "Set up a mail to myself, intended as a weblog entry." t)

(define-key global-map [(control c) i] 'blog-init-entry)

(setq sha1-use-external nil) 

(setq progress-feedback-use-echo-area t)

(require 'regexp-opt)
(require 'gnus)
(require 'gnus-start)
(require 'gnus-xmas)
(require 'gnus-agent)