(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)
(when (featurep 'mule)
(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))
(unless (get 'jit-ucs-charset-0 'last-allocated-character)
(decode-char 'ucs #x204a))
(setq-default
buffer-file-coding-system 'utf-8
buffer-file-coding-system-for-read 'undecided
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)
(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)))
(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))))
(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))
(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 nil #x201A #x0192 #x201E #x2026 #x2020 #x2021 #x02C6 #x2030 #x0160 #x2039 #x0152 nil #x017D nil nil #x2018 #x2019 #x201C #x201D #x2022 #x2013 #x2014 #x02DC #x2122 #x0161 #x203A #x0153 nil #x017E #x0178 ]))
(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-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))))
(add-hook 'sql-interactive-mode-hook 'sql-rename-buffer)
(setq user-full-name "Aidan Kehoe"
user-mail-address "kehoea@parhasard.net"
mail-specify-envelope-from t
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=\"mailto:kehoea@parhasard.net\">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 <"
"kehoea@parha"
"sard.net>\">\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"))
(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))
(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)))))
(defvar vm-spool-files ())
(defun initialise-vm-spool-files ()
"Initialise the list of spools that VM looks at for new mail."
(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")))
(initialise-vm-spool-files)
(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"
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"))
(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)
(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 "]")
(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)
(global-set-key '[f6] 'vm-visit-folder)
(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 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. ")
(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"))))
(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")
(require 'after-save-commands)
(let ((our-startup-file (or user-init-file
(expand-file-name "~/.xemacs/init.el")))
user-file-quoted procmailrc-file)
(if (equal (substring our-startup-file -4) ".elc")
(setq our-startup-file (substring our-startup-file 0 -1)))
(setq user-file-quoted (regexp-quote our-startup-file)
procmailrc-file (regexp-quote (expand-file-name "~/.procmailrc")))
(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))
(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)
(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
'( (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)
(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")
(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))))
(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)
(require 'redo)
(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")
(define-key global-map [(control h)] 'delete-backward-char)
(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"))))
(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))
(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)
(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)))
(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))))
(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)
(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)
(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 :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 #x201A ?\' #x201E ?\" #x2018 ?\' #x2019 ?\' #x201C ?\" #x201D ?\" #x2022 ?· #x2013 ?- #x2014 ?- #x02DC ?~ ))))
(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)]
'(lambda () (interactive) (insert (decode-char 'ucs #x20ac))))
(define-key global-map [(control x) #x60 ]
'(lambda () (interactive) (insert (decode-char 'ucs #x201c))))
(define-key global-map [(control x) #x27 ]
'(lambda () (interactive) (insert (decode-char 'ucs #x201d))))
(define-key global-map [(control x) #x2c ]
'(lambda () (interactive) (insert (decode-char 'ucs #x201e))))
(require 'cyrillic-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. "
(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. "
(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 ""))
(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)
(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))))
(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")))
(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)