--- /dev/null
+;;; -*-emacs-lisp-*-
+;;;
+;;; $Id$
+;;;
+;;; Functions and macros for .emacs
+;;;
+;;; (c) 2004 Mark Wooding
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+;;;----- Some general utilities ---------------------------------------------
+
+;; --- Some error trapping ---
+;;
+;; If individual bits of this file go tits-up, we don't particularly want
+;; the whole lot to stop right there and then, because it's bloody annoying.
+
+(defmacro trap (&rest forms)
+ "Execute FORMS without allowing errors to propagate outside."
+ `(condition-case err
+ ,(if (cdr forms) (cons 'progn forms) (car forms))
+ (error (message "Error (trapped): %s" (error-message-string err)))))
+
+;; --- Splitting windows ---
+
+(defconst mdw-scrollbar-width (if window-system 6 1)
+ "Guessed width of scroll bar.")
+(defun mdw-divvy-window (&optional w)
+ "Split a wide window into appropriate widths."
+ (interactive)
+ (or w (setq w 78))
+ (let ((win (selected-window))
+ (c (/ (+ (window-width) mdw-scrollbar-width)
+ (+ w mdw-scrollbar-width))))
+ (while (> c 1)
+ (setq c (1- c))
+ (split-window-horizontally (+ w mdw-scrollbar-width))
+ (other-window 1))
+ (select-window win)))
+
+;; --- Functions for sexp diary entries ---
+
+(defun mdw-weekday (l)
+ "Return non-nil if `date' falls on one of the days of the week in L.
+
+L is a list of day numbers (from 0 to 6 for Sunday through to Saturday) or
+symbols `sunday', `monday', etc. (or a mixture). If the date stored in
+`date' falls on a listed day, then the function returns non-nil."
+ (let ((d (calendar-day-of-week date)))
+ (or (memq d l)
+ (memq (nth d '(sunday monday tuesday wednesday
+ thursday friday saturday)) l))))
+
+(defun mdw-todo (&optional when)
+ "Return non-nil today, or on WHEN, whichever is later."
+ (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
+ (d (calendar-absolute-from-gregorian date)))
+ (if when
+ (setq w (max w (calendar-absolute-from-gregorian
+ (cond
+ ((not european-calendar-style)
+ when)
+ ((> (car when) 100)
+ (list (nth 1 when)
+ (nth 2 when)
+ (nth 0 when)))
+ (t
+ (list (nth 1 when)
+ (nth 0 when)
+ (nth 2 when))))))))
+ (eq w d)))
+
+;;;----- Utility functions --------------------------------------------------
+
+;; --- mdw-uniquify-alist ---
+
+(defun mdw-uniquify-alist (&rest alists)
+
+ "Return the concatenation of the ALISTS with duplicate elements removed.
+
+The first association with a given key prevails; others are ignored. The
+input lists are not modified, although they'll probably become garbage."
+
+ (and alists
+ (let ((start-list (cons nil nil)))
+ (mdw-do-uniquify start-list
+ start-list
+ (car alists)
+ (cdr alists)))))
+
+;; --- mdw-do-uniquify ---
+;;
+;; The DONE argument is a list whose first element is `nil'. It contains the
+;; uniquified alist built so far. The leading `nil' is stripped off at the
+;; end of the operation; it's only there so that DONE always references a
+;; cons cell. END refers to the final cons cell in the DONE list; it is
+;; modified in place each time to avoid the overheads of `append'ing all the
+;; time. The L argument is the alist we're currently processing; the
+;; remaining alists are given in REST.
+
+(defun mdw-do-uniquify (done end l rest)
+ "A helper function for mdw-uniquify-alist."
+
+ ;; --- There are several different cases to deal with here ---
+
+ (cond
+
+ ;; --- Current list isn't empty ---
+ ;;
+ ;; Add the first item to the DONE list if there's not an item with the
+ ;; same KEY already there.
+
+ (l (or (assoc (car (car l)) done)
+ (progn
+ (setcdr end (cons (car l) nil))
+ (setq end (cdr end))))
+ (mdw-do-uniquify done end (cdr l) rest))
+
+ ;; --- The list we were working on is empty ---
+ ;;
+ ;; Shunt the next list into the current list position and go round again.
+
+ (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
+
+ ;; --- Everything's done ---
+ ;;
+ ;; Remove the leading `nil' from the DONE list and return it. Finished!
+
+ (t (cdr done))))
+
+;; --- Insert a date ---
+
+(defun date ()
+ "Insert the current date in a pleasing way."
+ (interactive)
+ (insert (save-excursion
+ (let ((buffer (get-buffer-create "*tmp*")))
+ (unwind-protect (progn (set-buffer buffer)
+ (erase-buffer)
+ (shell-command "date +%Y-%m-%d" t)
+ (goto-char (mark))
+ (delete-backward-char 1)
+ (buffer-string))
+ (kill-buffer buffer))))))
+
+;; --- UUencoding ---
+
+(defun uuencode (file &optional name)
+ "UUencodes a file, maybe calling it NAME, into the current buffer."
+ (interactive "fInput file name: ")
+
+ ;; --- If NAME isn't specified, then guess from the filename ---
+
+ (if (not name)
+ (setq name
+ (substring file
+ (or (string-match "[^/]*$" file) 0))))
+
+ (print (format "uuencode `%s' `%s'" file name))
+
+ ;; --- Now actually do the thing ---
+
+ (call-process "uuencode" file t nil name))
+
+(defvar np-file "~/.np"
+ "*Where the `now-playing' file is.")
+
+(defun np (&optional arg)
+ "Grabs a `now-playing' string."
+ (interactive)
+ (save-excursion
+ (or arg (progn
+ (goto-char (point-max))
+ (insert "\nNP: ")
+ (insert-file np-file)))))
+
+(trap
+ (require 'tramp)
+ (require 'autorevert)
+ (defun mdw-check-autorevert ()
+ (if (and (buffer-file-name)
+ (tramp-tramp-file-p (buffer-file-name)))
+ (unless global-auto-revert-ignore-buffer
+ (setq global-auto-revert-ignore-buffer 'tramp))
+ (if (eq global-auto-revert-ignore-buffer 'tramp)
+ (setq global-auto-revert-ignore-buffer nil))))
+ (defadvice find-file (after mdw-autorevert activate)
+ (mdw-check-autorevert))
+ (defadvice write-file (after mdw-autorevert activate)
+ (mdw-check-autorevert)))
+
+(defun mdwmail-mode ()
+ "Major mode for editing news and mail messages from external programs
+Not much right now. Just support for doing MailCrypt stuff."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map text-mode-map)
+ (setq local-abbrev-table text-mode-abbrev-table)
+ (setq major-mode 'mdwmail-mode)
+ (setq mode-name "[mdw] mail")
+ (make-local-variable 'paragraph-separate)
+ (make-local-variable 'paragraph-start)
+ (setq paragraph-start (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
+ paragraph-start))
+ (setq paragraph-separate (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
+ paragraph-separate))
+ (run-hooks 'text-mode-hook 'mdwmail-mode-hook 'mail-setup-hook))
+
+;; --- How to encrypt in mdwmail ---
+
+(defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
+ (or start
+ (setq start (save-excursion
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-min)))))
+ (or end
+ (setq end (point-max)))
+ (mc-encrypt-generic recip scm start end from sign))
+
+;; --- How to sign in mdwmail ---
+
+(defun mdwmail-mc-sign (key scm start end uclr)
+ (or start
+ (setq start (save-excursion
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-min)))))
+ (or end
+ (setq end (point-max)))
+ (mc-sign-generic key scm start end uclr))
+
+;; --- Some signature mangling ---
+
+(defun mdwmail-mangle-signature ()
+ (save-excursion
+ (goto-char (point-min))
+ (perform-replace "\n-- \n" "\n-- " nil nil nil)))
+(add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
+
+;;;----- Paragraph filling --------------------------------------------------
+
+;; --- Useful variables ---
+
+(defvar mdw-fill-prefix nil
+ "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'. If there's
+no fill prefix currently set (by the `fill-prefix' variable) and there's
+a match from one of the regexps here, it gets used to set the fill-prefix
+for the current operation.
+
+The variable is a list of items of the form `REGEXP . PREFIX'; if the
+REGEXP matches, the PREFIX is used to set the fill prefix. It in turn is
+a list of things:
+
+ STRING -- insert a literal string
+ (match . N) -- insert the thing matched by bracketed subexpression N
+ (pad . N) -- a string of whitespace the same width as subexpression N
+ (expr . FORM) -- the result of evaluating FORM")
+
+(make-variable-buffer-local 'mdw-fill-prefix)
+
+(defvar mdw-hanging-indents
+ "\\(\\(\\([*o]\\|--\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)[ \t]+\\)?\\)"
+ "*Standard regular expression matching things which might be part of a
+hanging indent. This is mainly useful in `auto-fill-mode'.")
+
+;; --- Setting things up ---
+
+(fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
+
+;; --- Utility functions ---
+
+(defun mdw-tabify (s)
+ "Tabify the string S. This is a horrid hack."
+ (save-excursion
+ (save-match-data
+ (let (start end)
+ (beginning-of-line)
+ (setq start (point-marker))
+ (insert s "\n")
+ (setq end (point-marker))
+ (tabify start end)
+ (setq s (buffer-substring start (1- end)))
+ (delete-region start end)
+ (set-marker start nil)
+ (set-marker end nil)
+ s))))
+
+(defun mdw-examine-fill-prefixes (l)
+ "Given a list of dynamic fill prefixes, pick one which matches context and
+return the static fill prefix to use. Point must be at the start of a line,
+and match data must be saved."
+ (cond ((not l) nil)
+ ((looking-at (car (car l)))
+ (mdw-tabify (apply (function concat)
+ (mapcar (function mdw-do-prefix-match)
+ (cdr (car l))))))
+ (t (mdw-examine-fill-prefixes (cdr l)))))
+
+(defun mdw-maybe-car (p)
+ "If P is a pair, return (car P), otherwise just return P."
+ (if (consp p) (car p) p))
+
+(defun mdw-padding (s)
+ "Return a string the same width as S but made entirely from whitespace."
+ (let* ((l (length s)) (i 0) (n (make-string l ? )))
+ (while (< i l)
+ (if (= 9 (aref s i))
+ (aset n i 9))
+ (setq i (1+ i)))
+ n))
+
+(defun mdw-do-prefix-match (m)
+ "Expand a dynamic prefix match element. See `mdw-fill-prefix' for
+details."
+ (cond ((not (consp m)) (format "%s" m))
+ ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
+ ((eq (car m) 'pad) (mdw-padding (match-string
+ (mdw-maybe-car (cdr m)))))
+ ((eq (car m) 'eval) (eval (cdr m)))
+ (t "")))
+
+(defun mdw-choose-dynamic-fill-prefix ()
+ "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
+ (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
+ ((not mdw-fill-prefix) fill-prefix)
+ (t (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ (mdw-examine-fill-prefixes mdw-fill-prefix))))))
+
+(defun do-auto-fill ()
+ "Handle auto-filling, working out a dynamic fill prefix in the case where
+there isn't a sensible static one."
+ (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
+ (mdw-do-auto-fill)))
+
+(defun mdw-fill-paragraph ()
+ "Fill paragraph, getting a dynamic fill prefix."
+ (interactive)
+ (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
+ (fill-paragraph nil)))
+
+(defun mdw-standard-fill-prefix (rx &optional mat)
+ "Set the dynamic fill prefix, handling standard hanging indents and stuff.
+This is just a short-cut for setting the thing by hand, and by design it
+doesn't cope with anything approximating a complicated case."
+ (setq mdw-fill-prefix
+ `((,(concat rx mdw-hanging-indents)
+ (match . 1)
+ (pad . ,(or mat 2))))))
+
+;;;----- Other common declarations ------------------------------------------
+
+(defun mdw-set-frame-transparency (&optional n)
+ (interactive "P")
+ (let* ((alist (frame-parameters))
+ (trans (assq 'transparency alist)))
+ (if trans
+ (rplacd trans (not (if n (zerop n) (cdr trans))))
+ (setq trans (cons 'transparency (not (equal 0 n)))))
+ (modify-frame-parameters (selected-frame) (list trans))))
+
+;; --- Mouse wheel support ---
+
+(defconst mdw-wheel-scroll-amount 15)
+(defun mdw-wheel-up (click)
+ (interactive "@e")
+ (mdw-wheel-scroll click (function scroll-down)))
+(defun mdw-wheel-down (click)
+ (interactive "@e")
+ (mdw-wheel-scroll click (function scroll-up)))
+
+(defun mdw-wheel-scroll (click func)
+ (let ((win (selected-window)))
+ (unwind-protect
+ (progn
+ (select-window (posn-window (event-start click)))
+ (let ((arg 2))
+ (funcall func (/ (window-height) 2))))
+ (select-window win))))
+
+;; --- Going backwards ---
+
+(defun other-window-backwards (arg)
+ (interactive "p")
+ (other-window (- arg)))
+
+;; --- Common mode settings ---
+
+(defvar mdw-auto-indent t
+ "Whether to indent automatically after a newline.")
+
+(defun mdw-misc-mode-config ()
+ (and mdw-auto-indent
+ (cond ((eq major-mode 'lisp-mode)
+ (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
+ ((eq major-mode 'slime-repl-mode) nil)
+ (t
+ (local-set-key "\C-m" 'newline-and-indent))))
+ (local-set-key [C-return] 'newline)
+ (local-set-key [?\;] 'self-insert-command)
+ (local-set-key [?\#] 'self-insert-command)
+ (local-set-key [?\"] 'self-insert-command)
+ (setq comment-column 40)
+ (auto-fill-mode 1)
+ (setq fill-column 77)
+ (mdw-set-font))
+
+;; --- Set up all sorts of faces ---
+
+(defvar mdw-set-font nil)
+
+(defvar mdw-punct-face 'mdw-punct-face "Face to use for punctuation")
+(make-face 'mdw-punct-face)
+(defvar mdw-number-face 'mdw-number-face "Face to use for numbers")
+(make-face 'mdw-number-face)
+
+;;;----- General fontification ----------------------------------------------
+
+(defun mdw-set-fonts (frame ff)
+ (if ff (progn (set-face-attribute (caar ff) frame
+ :family 'unspecified
+ :width 'unspecified
+ :height 'unspecified
+ :weight 'unspecified
+ :slant 'unspecified
+ :foreground 'unspecified
+ :background 'unspecified
+ :underline 'unspecified
+ :overline 'unspecified
+ :strike-through 'unspecified
+ :box 'unspecified
+ :inverse-video 'unspecified
+ :stipple 'unspecified
+; :font 'unspecified
+ :inherit 'unspecified
+ )
+ (apply 'set-face-attribute (caar ff) frame (cdar ff))
+ (mdw-set-fonts frame (cdr ff)))))
+
+(defun mdw-do-set-font (&optional frame)
+ (interactive)
+ (mdw-set-fonts (and (boundp 'frame) frame) `(
+ (default :foreground "white" :background "black"
+ ,@(cond ((eq window-system 'w32)
+ '(:family "courier new" :height 85))
+ ((eq window-system 'x)
+ '(:family "misc-fixed" :width semi-condensed))))
+ (modeline :foreground "blue" :background "yellow"
+ :box (:line-width 1 :style released-button))
+ (scroll-bar :foreground "black" :background "lightgrey")
+ (fringe :foreground "yellow" :background "grey30")
+ (show-paren-match-face :background "darkgreen")
+ (show-paren-mismatch-face :background "red")
+ (font-lock-warning-face :background "red" :weight bold)
+ (highlight :background "DarkSeaGreen4")
+ (holiday-face :background "red")
+ (calendar-today-face :foreground "yellow" :weight bold)
+ (comint-highlight-prompt :weight bold)
+ (comint-highlight-input)
+ (font-lock-builtin-face :weight bold)
+ (font-lock-type-face :weight bold)
+ (region :background "grey30")
+ (isearch :background "palevioletred2")
+ (mdw-punct-face :foreground ,(if window-system "burlywood2" "yellow"))
+ (mdw-number-face :foreground "yellow")
+ (font-lock-function-name-face :weight bold)
+ (font-lock-variable-name-face :slant italic)
+ (font-lock-comment-face
+ :foreground ,(if window-system "SeaGreen1" "green")
+ :slant italic)
+ (font-lock-string-face :foreground ,(if window-system "SkyBlue1" "cyan"))
+ (font-lock-keyword-face :weight bold)
+ (font-lock-constant-face :weight bold)
+ (font-lock-reference-face :weight bold)
+ (woman-bold-face :weight bold)
+ (woman-italic-face :slant italic)
+ (diff-header-face :foreground "skyblue1")
+ (diff-index-face :weight bold)
+ (diff-file-header-face)
+ (diff-context-face :foreground "grey70")
+ (diff-added-face :foreground "white")
+ (diff-removed-face :foreground "white" :slant italic)
+ (whizzy-slice-face :background "grey10")
+ (whizzy-error-face :background "darkred")
+)))
+
+(defun mdw-set-font ()
+ (trap
+ (turn-on-font-lock)
+ (if (not mdw-set-font)
+ (progn
+ (setq mdw-set-font t)
+ (mdw-do-set-font nil)))))
+
+;;;----- C programming configuration ----------------------------------------
+
+;; --- Linux kernel hacking ---
+
+(defvar linux-c-mode-hook)
+
+(defun linux-c-mode ()
+ (interactive)
+ (c-mode)
+ (setq major-mode 'linux-c-mode)
+ (setq mode-name "Linux C")
+ (run-hooks 'linux-c-mode-hook))
+
+;; --- Make C indentation nice ---
+
+(defun mdw-c-style ()
+ (c-add-style "[mdw] C and C++ style"
+ '((c-basic-offset . 2)
+ (c-tab-always-indent . nil)
+ (comment-column . 40)
+ (c-class-key . "class")
+ (c-offsets-alist (substatement-open . 0)
+ (label . 0)
+ (case-label . +)
+ (access-label . -)
+ (inclass . ++)
+ (inline-open . ++)
+ (statement-cont . 0)
+ (statement-case-intro . +)))
+ t))
+
+(defun mdw-fontify-c-and-c++ ()
+
+ ;; --- Fiddle with some syntax codes ---
+
+ (modify-syntax-entry ?_ "w")
+ (modify-syntax-entry ?* ". 23")
+ (modify-syntax-entry ?/ ". 124b")
+ (modify-syntax-entry ?\n "> b")
+
+ ;; --- Other stuff ---
+
+ (mdw-c-style)
+ (setq c-hanging-comment-ender-p nil)
+ (setq c-backslash-column 72)
+ (setq c-label-minimum-indentation 0)
+ (setq comment-start "/* ")
+ (setq comment-end " */")
+ (setq mdw-fill-prefix
+ `((,(concat "\\([ \t]*/?\\)"
+ "\\([\*/][ \t]*\\)"
+ "\\([A-Za-z]+:[ \t]*\\)?"
+ mdw-hanging-indents)
+ (pad . 1) (match . 2) (pad . 3) (pad . 4))))
+
+ ;; --- Now define things to be fontified ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((c-keywords
+ (make-regexp '(
+ ;; "and" ;C++
+ ;; "and_eq" ;C++
+ "asm" ;K&R, GCC
+ "auto" ;K&R, C89
+ ;; "bitand" ;C++
+ ;; "bitor" ;C++
+ "bool" ;C++, C9X macro
+ "break" ;K&R, C89
+ "case" ;K&R, C89
+ "catch" ;C++
+ "char" ;K&R, C89
+ "class" ;C++
+ "complex" ;C9X macro, C++ template type
+ ;; "compl" ;C++
+ "const" ;C89
+ "const_cast" ;C++
+ "continue" ;K&R, C89
+ "defined" ;C89 preprocessor
+ "default" ;K&R, C89
+ "delete" ;C++
+ "do" ;K&R, C89
+ "double" ;K&R, C89
+ "dynamic_cast" ;C++
+ "else" ;K&R, C89
+ ;; "entry" ;K&R -- never used
+ "enum" ;C89
+ "explicit" ;C++
+ ;; "export" ;C++
+ "extern" ;K&R, C89
+ "false" ;C++, C9X macro
+ "float" ;K&R, C89
+ "for" ;K&R, C89
+ "fortran" ;K&R
+ "friend" ;C++
+ "goto" ;K&R, C89
+ "if" ;K&R, C89
+ "imaginary" ;C9X macro
+ "inline" ;C++, C9X, GCC
+ "int" ;K&R, C89
+ "long" ;K&R, C89
+ "mutable" ;C++
+ "namespace" ;C++
+ "new" ;C++
+ "operator" ;C++
+ ;; "or" ;C++
+ ;; "or_eq" ;C++
+ "private" ;C++
+ "protected" ;C++
+ "public" ;C++
+ "register" ;K&R, C89
+ "reinterpret_cast" ;C++
+ "restrict" ;C9X
+ "return" ;K&R, C89
+ "short" ;K&R, C89
+ "signed" ;C89
+ "sizeof" ;K&R, C89
+ "static" ;K&R, C89
+ "static_cast" ;C++
+ "struct" ;K&R, C89
+ "switch" ;K&R, C89
+ "template" ;C++
+ "this" ;C++
+ "throw" ;C++
+ "true" ;C++, C9X macro
+ "try" ;C++
+ "this" ;C++
+ "typedef" ;C89
+ "typeid" ;C++
+ "typeof" ;GCC
+ "typename" ;C++
+ "union" ;K&R, C89
+ "unsigned" ;K&R, C89
+ "using" ;C++
+ "virtual" ;C++
+ "void" ;C89
+ "volatile" ;C89
+ "wchar_t" ;C++, C89 library type
+ "while" ;K&R, C89
+ ;; "xor" ;C++
+ ;; "xor_eq" ;C++
+ "_Bool" ;C9X
+ "_Complex" ;C9X
+ "_Imaginary" ;C9X
+ "_Pragma" ;C9X preprocessor
+ "__alignof__" ;GCC
+ "__asm__" ;GCC
+ "__attribute__" ;GCC
+ "__complex__" ;GCC
+ "__const__" ;GCC
+ "__extension__" ;GCC
+ "__imag__" ;GCC
+ "__inline__" ;GCC
+ "__label__" ;GCC
+ "__real__" ;GCC
+ "__signed__" ;GCC
+ "__typeof__" ;GCC
+ "__volatile__" ;GCC
+ )))
+ (preprocessor-keywords
+ (make-regexp '("assert" "define" "elif" "else" "endif" "error"
+ "ident" "if" "ifdef" "ifndef" "import" "include"
+ "line" "pragma" "unassert" "undef" "warning")))
+ (objc-keywords
+ (make-regexp '("class" "defs" "encode" "end" "implementation"
+ "interface" "private" "protected" "protocol" "public"
+ "selector"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Fontify include files as strings ---
+
+ (list (concat "^[ \t]*\\#[ \t]*"
+ "\\(include\\|import\\)"
+ "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
+ '(2 font-lock-string-face))
+
+ ;; --- Preprocessor directives are `references'? ---
+
+ (list (concat "^\\([ \t]*#[ \t]*\\(\\("
+ preprocessor-keywords
+ "\\)\\>\\|[0-9]+\\|$\\)\\)")
+ '(1 font-lock-keyword-face))
+
+ ;; --- Handle the keywords defined above ---
+
+ (list (concat "@\\<\\(" objc-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ (list (concat "\\<\\(" c-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- Handle numbers too ---
+ ;;
+ ;; This looks strange, I know. It corresponds to the
+ ;; preprocessor's idea of what a number looks like, rather than
+ ;; anything sensible.
+
+ (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
+ "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
+ '(0 mdw-number-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- AP calc mode -------------------------------------------------------
+
+(defun apcalc-mode ()
+ (interactive)
+ (c-mode)
+ (setq major-mode 'apcalc-mode)
+ (setq mode-name "AP Calc")
+ (run-hooks 'apcalc-mode-hook))
+
+(defun mdw-fontify-apcalc ()
+
+ ;; --- Fiddle with some syntax codes ---
+
+ (modify-syntax-entry ?_ "w")
+ (modify-syntax-entry ?* ". 23")
+ (modify-syntax-entry ?/ ". 14")
+
+ ;; --- Other stuff ---
+
+ (mdw-c-style)
+ (setq c-hanging-comment-ender-p nil)
+ (setq c-backslash-column 72)
+ (setq comment-start "/* ")
+ (setq comment-end " */")
+ (setq mdw-fill-prefix
+ `((,(concat "\\([ \t]*/?\\)"
+ "\\([\*/][ \t]*\\)"
+ "\\([A-Za-z]+:[ \t]*\\)?"
+ mdw-hanging-indents)
+ (pad . 1) (match . 2) (pad . 3) (pad . 4))))
+
+ ;; --- Now define things to be fontified ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((c-keywords
+ (make-regexp '("break" "case" "cd" "continue" "define" "default"
+ "do" "else" "exit" "for" "global" "goto" "help" "if"
+ "local" "mat" "obj" "print" "quit" "read" "return"
+ "show" "static" "switch" "while" "write"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Handle the keywords defined above ---
+
+ (list (concat "\\<\\(" c-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- Handle numbers too ---
+ ;;
+ ;; This looks strange, I know. It corresponds to the
+ ;; preprocessor's idea of what a number looks like, rather than
+ ;; anything sensible.
+
+ (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
+ "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
+ '(0 mdw-number-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- Java programming configuration -------------------------------------
+
+;; --- Make indentation nice ---
+
+(defun mdw-java-style ()
+ (c-add-style "[mdw] Java style"
+ '((c-basic-offset . 2)
+ (c-tab-always-indent . nil)
+ (c-offsets-alist (substatement-open . 0)
+ (label . +)
+ (case-label . +)
+ (access-label . 0)
+ (inclass . +)
+ (statement-case-intro . +)))
+ t))
+
+;; --- Declare Java fontification style ---
+
+(defun mdw-fontify-java ()
+
+ ;; --- Other stuff ---
+
+ (mdw-java-style)
+ (modify-syntax-entry ?_ "w")
+ (setq c-hanging-comment-ender-p nil)
+ (setq c-backslash-column 72)
+ (setq comment-start "/* ")
+ (setq comment-end " */")
+ (setq mdw-fill-prefix
+ `((,(concat "\\([ \t]*/?\\)"
+ "\\([\*/][ \t]*\\)"
+ "\\([A-Za-z]+:[ \t]*\\)?"
+ mdw-hanging-indents)
+ (pad . 1) (match . 2) (pad . 3) (pad . 4))))
+
+ ;; --- Now define things to be fontified ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((java-keywords
+ (make-regexp '("abstract" "boolean" "break" "byte" "case" "catch"
+ "char" "class" "const" "continue" "default" "do"
+ "double" "else" "extends" "final" "finally" "float"
+ "for" "goto" "if" "implements" "import" "instanceof"
+ "int" "interface" "long" "native" "new" "package"
+ "private" "protected" "public" "return" "short"
+ "static" "super" "switch" "synchronized" "this"
+ "throw" "throws" "transient" "try" "void" "volatile"
+ "while"
+
+ "false" "null" "true"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Handle the keywords defined above ---
+
+ (list (concat "\\<\\(" java-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- Handle numbers too ---
+ ;;
+ ;; The following isn't quite right, but it's close enough.
+
+ (list (concat "\\<\\("
+ "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
+ "[0-9]+\\(\\.[0-9]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
+ "[lLfFdD]?")
+ '(0 mdw-number-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- Awk programming configuration --------------------------------------
+
+;; --- Make Awk indentation nice ---
+
+(defun mdw-awk-style ()
+ (c-add-style "[mdw] Awk style"
+ '((c-basic-offset . 2)
+ (c-tab-always-indent . nil)
+ (c-offsets-alist (substatement-open . 0)
+ (statement-cont . 0)
+ (statement-case-intro . +)))
+ t))
+
+;; --- Declare Awk fontification style ---
+
+(defun mdw-fontify-awk ()
+
+ ;; --- Miscellaneous fiddling ---
+
+ (modify-syntax-entry ?_ "w")
+ (mdw-awk-style)
+ (setq c-backslash-column 72)
+ (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
+
+ ;; --- Now define things to be fontified ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((c-keywords
+ (make-regexp '("BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
+ "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
+ "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
+ "RSTART" "RLENGTH" "RT" "SUBSEP"
+ "atan2" "break" "close" "continue" "cos" "delete"
+ "do" "else" "exit" "exp" "fflush" "file" "for" "func"
+ "function" "gensub" "getline" "gsub" "if" "in"
+ "index" "int" "length" "log" "match" "next" "rand"
+ "return" "print" "printf" "sin" "split" "sprintf"
+ "sqrt" "srand" "strftime" "sub" "substr" "system"
+ "systime" "tolower" "toupper" "while"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Handle the keywords defined above ---
+
+ (list (concat "\\<\\(" c-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- Handle numbers too ---
+ ;;
+ ;; The following isn't quite right, but it's close enough.
+
+ (list (concat "\\<\\("
+ "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
+ "[0-9]+\\(\\.[0-9]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
+ "[uUlL]*")
+ '(0 mdw-number-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- Perl programming style ---------------------------------------------
+
+;; --- Perl indentation style ---
+
+(setq cperl-tab-always-indent nil)
+
+(setq cperl-indent-level 2)
+(setq cperl-continued-statement-offset 2)
+(setq cperl-continued-brace-offset 0)
+(setq cperl-brace-offset -2)
+(setq cperl-brace-imaginary-offset 0)
+(setq cperl-label-offset 0)
+
+;; --- Define perl fontification style ---
+
+(defun mdw-fontify-perl ()
+
+ ;; --- Miscellaneous fiddling ---
+
+ (modify-syntax-entry ?_ "w")
+ (modify-syntax-entry ?$ "\\")
+ (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
+ (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
+
+ ;; --- Now define fontification things ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((perl-keywords
+ (make-regexp '("and" "cmp" "continue" "do" "else" "elsif" "eq"
+ "for" "foreach" "ge" "gt" "goto" "if"
+ "last" "le" "lt" "local" "my" "ne" "next" "or"
+ "package" "redo" "require" "return" "sub"
+ "undef" "unless" "until" "use" "while"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Set up the keywords defined above ---
+
+ (list (concat "\\<\\(" perl-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- At least numbers are simpler than C ---
+
+ (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
+ "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
+ '(0 mdw-number-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+(defun perl-number-tests (&optional arg)
+ "Assign consecutive numbers to lines containing `#t'. With ARG,
+strip numbers instead."
+ (interactive "P")
+ (save-excursion
+ (goto-char (point-min))
+ (let ((i 0) (fmt (if arg "" " %4d")))
+ (while (search-forward "#t" nil t)
+ (delete-region (point) (line-end-position))
+ (setq i (1+ i))
+ (insert (format fmt i)))
+ (goto-char (point-min))
+ (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
+ (replace-match (format "\\1%d" i))))))
+
+;;;----- Python programming style -------------------------------------------
+
+;; --- Define Python fontification style ---
+
+(trap (require 'pyrex-mode))
+(defun mdw-fontify-python ()
+
+ ;; --- Miscellaneous fiddling ---
+
+ (modify-syntax-entry ?_ "w")
+ (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
+
+ ;; --- Now define fontification things ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((python-keywords
+ (make-regexp '("and" "as" "assert" "break" "class" "continue" "def"
+ "del" "elif" "else" "except" "exec" "finally" "for"
+ "from" "global" "if" "import" "in" "is" "lambda"
+ "not" "or" "pass" "print" "raise" "return" "try"
+ "while"))))
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Set up the keywords defined above ---
+
+ (list (concat "\\<\\(" python-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- At least numbers are simpler than C ---
+
+ (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
+ "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
+ '(0 mdw-number-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- ARM assembler programming configuration ----------------------------
+
+;; --- There doesn't appear to be an Emacs mode for this yet ---
+;;
+;; Better do something about that, I suppose.
+
+(defvar arm-assembler-mode-map nil)
+(defvar arm-assembler-abbrev-table nil)
+(defvar arm-assembler-mode-syntax-table (make-syntax-table))
+
+(or arm-assembler-mode-map
+ (progn
+ (setq arm-assembler-mode-map (make-sparse-keymap))
+ (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
+ (define-key arm-assembler-mode-map [C-return] 'newline)
+ (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
+
+(defun arm-assembler-mode ()
+ "Major mode for ARM assembler programs"
+ (interactive)
+
+ ;; --- Do standard major mode things ---
+
+ (kill-all-local-variables)
+ (use-local-map arm-assembler-mode-map)
+ (setq local-abbrev-table arm-assembler-abbrev-table)
+ (setq major-mode 'arm-assembler-mode)
+ (setq mode-name "ARM assembler")
+
+ ;; --- Set up syntax table ---
+
+ (set-syntax-table arm-assembler-mode-syntax-table)
+ (modify-syntax-entry ?; ; Nasty hack
+ "<" arm-assembler-mode-syntax-table)
+ (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
+ (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
+
+ (make-local-variable 'comment-start)
+ (setq comment-start ";")
+ (make-local-variable 'comment-end)
+ (setq comment-end "")
+ (make-local-variable 'comment-column)
+ (setq comment-column 48)
+ (make-local-variable 'comment-start-skip)
+ (setq comment-start-skip ";+[ \t]*")
+
+ ;; --- Play with indentation ---
+
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'indent-relative-maybe)
+
+ ;; --- Set fill prefix ---
+
+ (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
+
+ ;; --- Fiddle with fontification ---
+
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Handle numbers too ---
+ ;;
+ ;; The following isn't quite right, but it's close enough.
+
+ (list (concat "\\("
+ "&[0-9a-fA-F]+\\|"
+ "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
+ "\\)")
+ '(0 mdw-number-face))
+
+ ;; --- Do something about operators ---
+
+ (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
+ '(1 font-lock-keyword-face)
+ '(2 font-lock-string-face))
+ (list ":[a-zA-Z]+:"
+ '(0 font-lock-keyword-face))
+
+ ;; --- Do menemonics and directives ---
+
+ (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
+ '(1 font-lock-keyword-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))
+
+ (run-hooks 'arm-assembler-mode-hook))
+
+;;;----- TCL configuration --------------------------------------------------
+
+(defun mdw-fontify-tcl ()
+ (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
+ (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords
+ (list
+ 't
+ (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
+ "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
+ '(0 mdw-number-face))
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face)))))
+
+;;;----- REXX configuration -------------------------------------------------
+
+(defun mdw-rexx-electric-* ()
+ (interactive)
+ (insert ?*)
+ (rexx-indent-line))
+
+(defun mdw-rexx-indent-newline-indent ()
+ (interactive)
+ (rexx-indent-line)
+ (if abbrev-mode (expand-abbrev))
+ (newline-and-indent))
+
+(defun mdw-fontify-rexx ()
+
+ ;; --- Various bits of fiddling ---
+
+ (setq mdw-auto-indent nil)
+ (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
+ (local-set-key [?*] 'mdw-rexx-electric-*)
+ (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
+ '(?. ?! ?? ?_ ?# ?@ ?$))
+ (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
+
+ ;; --- Set up keywords and things for fontification ---
+
+ (make-local-variable 'font-lock-keywords-case-fold-search)
+ (setq font-lock-keywords-case-fold-search t)
+
+ (setq rexx-indent 2)
+ (setq rexx-end-indent rexx-indent)
+ (setq rexx-tab-always-indent nil)
+ (setq rexx-cont-indent rexx-indent)
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((rexx-keywords
+ (make-regexp '("address" "arg" "by" "call" "digits" "do" "drop"
+ "else" "end" "engineering" "exit" "expose" "for"
+ "forever" "form" "fuzz" "if" "interpret" "iterate"
+ "leave" "linein" "name" "nop" "numeric" "off" "on"
+ "options" "otherwise" "parse" "procedure" "pull"
+ "push" "queue" "return" "say" "select" "signal"
+ "scientific" "source" "then" "trace" "to" "until"
+ "upper" "value" "var" "version" "when" "while"
+ "with"
+
+ "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
+ "center" "center" "charin" "charout" "chars"
+ "compare" "condition" "copies" "c2d" "c2x"
+ "datatype" "date" "delstr" "delword" "d2c" "d2x"
+ "errortext" "format" "fuzz" "insert" "lastpos"
+ "left" "length" "lineout" "lines" "max" "min"
+ "overlay" "pos" "queued" "random" "reverse" "right"
+ "sign" "sourceline" "space" "stream" "strip"
+ "substr" "subword" "symbol" "time" "translate"
+ "trunc" "value" "verify" "word" "wordindex"
+ "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
+ "x2d"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Set up the keywords defined above ---
+
+ (list (concat "\\<\\(" rexx-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- Fontify all symbols the same way ---
+
+ (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
+ "[A-Za-z0-9.!?_#@$]+\\)")
+ '(0 font-lock-variable-name-face))
+
+ ;; --- And everything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- Standard ML programming style --------------------------------------
+
+(defun mdw-fontify-sml ()
+
+ ;; --- Make underscore an honorary letter ---
+
+ (modify-syntax-entry ?_ "w")
+ (modify-syntax-entry ?' "w")
+
+ ;; --- Set fill prefix ---
+
+ (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
+
+ ;; --- Now define fontification things ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((sml-keywords
+ (make-regexp '("abstype" "and" "andalso" "as"
+ "case"
+ "datatype" "do"
+ "else" "end" "eqtype" "exception"
+ "fn" "fun" "functor"
+ "handle"
+ "if" "in" "include" "infix" "infixr"
+ "let" "local"
+ "nonfix"
+ "of" "op" "open" "orelse"
+ "raise" "rec"
+ "sharing" "sig" "signature" "struct" "structure"
+ "then" "type"
+ "val"
+ "where" "while" "with" "withtype"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Set up the keywords defined above ---
+
+ (list (concat "\\<\\(" sml-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+
+ ;; --- At least numbers are simpler than C ---
+
+ (list (concat "\\<\\(\\~\\|\\)"
+ "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
+ "[wW][0-9]+\\)\\|"
+ "\\([0-9]+\\(\\.[0-9]+\\|\\)"
+ "\\([eE]\\(\\~\\|\\)"
+ "[0-9]+\\|\\)\\)\\)")
+ '(0 mdw-number-face))
+
+ ;; --- And anything else is punctuation ---
+
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- Haskell configuration ----------------------------------------------
+
+(defun mdw-fontify-haskell ()
+
+ ;; --- Fiddle with syntax table to get comments right ---
+
+ (modify-syntax-entry ?_ "w")
+ (modify-syntax-entry ?' "\"")
+ (modify-syntax-entry ?- ". 123")
+ (modify-syntax-entry ?{ ". 1b")
+ (modify-syntax-entry ?} ". 4b")
+ (modify-syntax-entry ?\n ">")
+
+ ;; --- Set fill prefix ---
+
+ (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
+
+ ;; --- Fiddle with fontification ---
+
+ (make-local-variable 'font-lock-keywords)
+ (let ((haskell-keywords
+ (make-regexp '("as" "case" "ccall" "class" "data" "default"
+ "deriving" "do" "else" "foreign" "hiding" "if"
+ "import" "in" "infix" "infixl" "infixr" "instance"
+ "let" "module" "newtype" "of" "qualified" "safe"
+ "stdcall" "then" "type" "unsafe" "where"))))
+
+ (setq font-lock-keywords
+ (list
+ 't
+ (list "--.*$"
+ '(0 font-lock-comment-face))
+ (list (concat "\\<\\(" haskell-keywords "\\)\\>")
+ '(0 font-lock-keyword-face))
+ (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
+ "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
+ '(0 mdw-number-face))
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face))))))
+
+;;;----- Texinfo configuration ----------------------------------------------
+
+(defun mdw-fontify-texinfo ()
+
+ ;; --- Set fill prefix ---
+
+ (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
+
+ ;; --- Real fontification things ---
+
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Environment names are keywords ---
+
+ (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
+ '(2 font-lock-keyword-face))
+
+ ;; --- Unmark escaped magic characters ---
+
+ (list "\\(@\\)\\([@{}]\\)"
+ '(1 font-lock-keyword-face)
+ '(2 font-lock-variable-name-face))
+
+ ;; --- Make sure we get comments properly ---
+
+ (list "@c\\(\\|omment\\)\\( .*\\)?$"
+ '(0 font-lock-comment-face))
+
+ ;; --- Command names are keywords ---
+
+ (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
+ '(0 font-lock-keyword-face))
+
+ ;; --- Fontify TeX special characters as punctuation ---
+
+ (list "[{}]+"
+ '(0 mdw-punct-face)))))
+
+;;;----- TeX and LaTeX configuration ----------------------------------------
+
+(defun mdw-fontify-tex ()
+ (setq ispell-parser 'tex)
+
+ ;; --- Don't make maths into a string ---
+
+ (modify-syntax-entry ?$ ".")
+ (modify-syntax-entry ?$ "." font-lock-syntax-table)
+ (local-set-key [?$] 'self-insert-command)
+
+ ;; --- Set fill prefix ---
+
+ (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
+
+ ;; --- Real fontification things ---
+
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords
+ (list
+ 't
+
+ ;; --- Environment names are keywords ---
+
+ (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
+ "{\\([^}\n]*\\)}")
+ '(2 font-lock-keyword-face))
+
+ ;; --- Suspended environment names are keywords too ---
+
+ (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
+ "{\\([^}\n]*\\)}")
+ '(3 font-lock-keyword-face))
+
+ ;; --- Command names are keywords ---
+
+ (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
+ '(0 font-lock-keyword-face))
+
+ ;; --- Handle @/.../ for italics ---
+
+ ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
+ ;; '(1 font-lock-keyword-face)
+ ;; '(3 font-lock-keyword-face))
+
+ ;; --- Handle @*...* for boldness ---
+
+ ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
+ ;; '(1 font-lock-keyword-face)
+ ;; '(3 font-lock-keyword-face))
+
+ ;; --- Handle @`...' for literal syntax things ---
+
+ ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
+ ;; '(1 font-lock-keyword-face)
+ ;; '(3 font-lock-keyword-face))
+
+ ;; --- Handle @<...> for nonterminals ---
+
+ ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
+ ;; '(1 font-lock-keyword-face)
+ ;; '(3 font-lock-keyword-face))
+
+ ;; --- Handle other @-commands ---
+
+ ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
+ ;; '(0 font-lock-keyword-face))
+
+ ;; --- Make sure we get comments properly ---
+
+ (list "%.*"
+ '(0 font-lock-comment-face))
+
+ ;; --- Fontify TeX special characters as punctuation ---
+
+ (list "[$^_{}#&]"
+ '(0 mdw-punct-face)))))
+
+;;;----- Shell scripts ------------------------------------------------------
+
+(defun mdw-setup-sh-script-mode ()
+
+ ;; --- Fetch the shell interpreter's name ---
+
+ (let ((shell-name sh-shell-file))
+
+ ;; --- Try reading the hash-bang line ---
+
+ (save-excursion
+ (goto-char (point-min))
+ (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
+ (setq shell-name (match-string 1))))
+
+ ;; --- Now try to set the shell ---
+ ;;
+ ;; Don't let `sh-set-shell' bugger up my script.
+
+ (let ((executable-set-magic #'(lambda (s &rest r) s)))
+ (sh-set-shell shell-name)))
+
+ ;; --- Now enable my keys and the fontification ---
+
+ (mdw-misc-mode-config)
+
+ ;; --- Set the indentation level correctly ---
+
+ (setq sh-indentation 2)
+ (setq sh-basic-offset 2))
+
+;;;----- Messages-file mode -------------------------------------------------
+
+(defun message-mode-guts ()
+ (setq messages-mode-syntax-table (make-syntax-table))
+ (set-syntax-table messages-mode-syntax-table)
+ (modify-syntax-entry ?_ "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?- "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
+ (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
+ (make-local-variable 'comment-start)
+ (make-local-variable 'comment-end)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'indent-relative)
+ (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
+ (make-local-variable 'font-lock-defaults)
+ (make-local-variable 'message-mode-keywords)
+ (let ((keywords
+ (make-regexp '("array" "bitmap" "callback" "docs[ \t]+enum"
+ "export" "enum" "fixed-octetstring" "flags"
+ "harmless" "map" "nested" "optional"
+ "optional-tagged" "package" "primitive"
+ "primitive-nullfree" "relaxed[ \t]+enum"
+ "set" "table" "tagged-optional" "union"
+ "variadic" "vector" "version" "version-tag"))))
+ (setq message-mode-keywords
+ (list
+ (list (concat "\\<\\(" keywords "\\)\\>:")
+ '(0 font-lock-keyword-face))
+ '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
+ '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
+ (0 font-lock-variable-name-face))
+ '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
+ '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ (0 mdw-punct-face)))))
+ (setq font-lock-defaults
+ '(message-mode-keywords nil nil nil nil))
+ (run-hooks 'messages-file-hook))
+
+(defun messages-mode ()
+ (interactive)
+ (fundamental-mode)
+ (setq major-mode 'messages-mode)
+ (setq mode-name "Messages")
+ (message-mode-guts)
+ (modify-syntax-entry ?# "<" messages-mode-syntax-table)
+ (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
+ (setq comment-start "# ")
+ (setq comment-end "")
+ (turn-on-font-lock-if-enabled)
+ (run-hooks 'messages-mode-hook))
+
+(defun cpp-messages-mode ()
+ (interactive)
+ (fundamental-mode)
+ (setq major-mode 'cpp-messages-mode)
+ (setq mode-name "CPP Messages")
+ (message-mode-guts)
+ (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
+ (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
+ (setq comment-start "/* ")
+ (setq comment-end " */")
+ (let ((preprocessor-keywords
+ (make-regexp '("assert" "define" "elif" "else" "endif" "error"
+ "ident" "if" "ifdef" "ifndef" "import" "include"
+ "line" "pragma" "unassert" "undef" "warning"))))
+ (setq message-mode-keywords
+ (append (list (list (concat "^[ \t]*\\#[ \t]*"
+ "\\(include\\|import\\)"
+ "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
+ '(2 font-lock-string-face))
+ (list (concat "^\\([ \t]*#[ \t]*\\(\\("
+ preprocessor-keywords
+ "\\)\\>\\|[0-9]+\\|$\\)\\)")
+ '(1 font-lock-keyword-face)))
+ message-mode-keywords)))
+ (setq font-lock-defaults
+ '(message-mode-keywords nil nil nil nil))
+ (turn-on-font-lock-if-enabled)
+ (run-hooks 'messages-mode-hook))
+
+(add-hook 'messages-file-hook 'mdw-misc-mode-config t)
+; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
+
+;;;----- Messages-file mode -------------------------------------------------
+
+(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
+ "Face to use for subsittution directives.")
+(make-face 'mallow-driver-substitution-face)
+(defvar mallow-driver-text-face 'mallow-driver-text-face
+ "Face to use for body text.")
+(make-face 'mallow-driver-text-face)
+
+(defun mallow-driver-mode ()
+ (interactive)
+ (fundamental-mode)
+ (setq major-mode 'mallow-driver-mode)
+ (setq mode-name "Mallow driver")
+ (setq mallow-driver-mode-syntax-table (make-syntax-table))
+ (set-syntax-table mallow-driver-mode-syntax-table)
+ (make-local-variable 'comment-start)
+ (make-local-variable 'comment-end)
+ (make-local-variable 'indent-line-function)
+ (setq indent-line-function 'indent-relative)
+ (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
+ (make-local-variable 'font-lock-defaults)
+ (make-local-variable 'mallow-driver-mode-keywords)
+ (let ((keywords
+ (make-regexp '("each" "divert" "file" "if"
+ "perl" "set" "string" "type" "write"))))
+ (setq mallow-driver-mode-keywords
+ (list
+ (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
+ '(0 font-lock-keyword-face))
+ (list "^%\\s *\\(#.*\\|\\)$"
+ '(0 font-lock-comment-face))
+ (list "^%"
+ '(0 font-lock-keyword-face))
+ (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
+ (list "\\${[^}]*}"
+ '(0 mallow-driver-substitution-face t)))))
+ (setq font-lock-defaults
+ '(mallow-driver-mode-keywords nil nil nil nil))
+ (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
+ (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
+ (setq comment-start "%# ")
+ (setq comment-end "")
+ (turn-on-font-lock-if-enabled)
+ (run-hooks 'mallow-driver-mode-hook))
+
+(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
+
+;;;----- NFast debugs -------------------------------------------------------
+
+(defun nfast-debug-mode ()
+ (interactive)
+ (fundamental-mode)
+ (setq major-mode 'nfast-debug-mode)
+ (setq mode-name "NFast debug")
+ (setq messages-mode-syntax-table (make-syntax-table))
+ (set-syntax-table messages-mode-syntax-table)
+ (make-local-variable 'font-lock-defaults)
+ (make-local-variable 'nfast-debug-mode-keywords)
+ (setq truncate-lines t)
+ (setq nfast-debug-mode-keywords
+ (list
+ '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
+ (0 font-lock-keyword-face))
+ (list (concat "^[ \t]+\\(\\("
+ "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
+ "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
+ "[ \t]+\\)*"
+ "[0-9a-fA-F]+\\)[ \t]*$")
+ '(0 mdw-number-face))
+ '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
+ (1 font-lock-keyword-face))
+ '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
+ (1 font-lock-warning-face))
+ '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
+ (1 nil))
+ (list (concat "^[ \t]+\\.cmd=[ \t]+"
+ "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
+ '(1 font-lock-keyword-face))
+ '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
+ '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
+ '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
+ '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
+ (setq font-lock-defaults
+ '(nfast-debug-mode-keywords nil nil nil nil))
+ (turn-on-font-lock-if-enabled)
+ (run-hooks 'nfast-debug-mode-hook))
+
+;;;----- Other languages ----------------------------------------------------
+
+;; --- Smalltalk ---
+
+(defun mdw-setup-smalltalk ()
+ (and mdw-auto-indent
+ (local-set-key "\C-m" 'smalltalk-newline-and-indent))
+ (make-variable-buffer-local 'mdw-auto-indent)
+ (setq mdw-auto-indent nil)
+ (local-set-key "\C-i" 'smalltalk-reindent))
+
+(defun mdw-fontify-smalltalk ()
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords
+ (list
+ 't
+ (list "\\<[A-Z][a-zA-Z0-9]*\\>"
+ '(0 font-lock-keyword-face))
+ (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
+ "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
+ "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
+ '(0 mdw-number-face))
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face)))))
+
+;; --- Lispy languages ---
+
+(defun mdw-indent-newline-and-indent ()
+ (interactive)
+ (indent-for-tab-command)
+ (newline-and-indent))
+
+(eval-after-load "cl-indent"
+ '(progn
+ (mapc #'(lambda (pair)
+ (put (car pair)
+ 'common-lisp-indent-function
+ (cdr pair)))
+ '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
+ (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
+
+(defun mdw-common-lisp-indent ()
+ (make-variable-buffer-local 'lisp-indent-function)
+ (setq lisp-indent-function 'common-lisp-indent-function))
+
+(defun mdw-fontify-lispy ()
+
+ ;; --- Set fill prefix ---
+
+ (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
+
+ ;; --- Not much fontification needed ---
+
+ (make-local-variable 'font-lock-keywords)
+ (setq font-lock-keywords
+ (list
+ 't
+ (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
+ '(0 mdw-punct-face)))))
+
+(defun comint-send-and-indent ()
+ (interactive)
+ (comint-send-input)
+ (and mdw-auto-indent
+ (indent-for-tab-command)))
+
+;;;----- Text mode ----------------------------------------------------------
+
+(defun mdw-text-mode ()
+ (setq fill-column 72)
+ (flyspell-mode t)
+ (mdw-standard-fill-prefix
+ "\\([ \t]*\\([A-Za-z0-9]*[>#|:] ?\\)*[ \t]*\\)" 3)
+ (auto-fill-mode 1))
+
+;;;----- Shell mode ---------------------------------------------------------
+
+(defun mdw-sh-mode-setup ()
+ (local-set-key [?\C-a] 'comint-bol)
+ (add-hook 'comint-output-filter-functions
+ 'comint-watch-for-password-prompt))
+
+(defun mdw-term-mode-setup ()
+ (setq term-prompt-regexp "^[^]#$%>»\n]*[]#$%>»] *")
+ (make-local-variable 'mouse-yank-at-point)
+ (make-local-variable 'transient-mark-mode)
+ (setq mouse-yank-at-point t)
+ (setq transient-mark-mode nil)
+ (auto-fill-mode -1)
+ (setq tab-width 8))
+
+;;;----- That's all, folks --------------------------------------------------
+
+(provide 'dot-emacs)
--- /dev/null
+;;; -*-emacs-lisp-*-
+;;;
+;;; $Id: .emacs,v 1.11 1997/01/01 18:47:09 mdw Exp $
+;;;
+;;; Emacs configuration file
+;;;
+;;; (c) 1996-1999 Mark Wooding
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+
+(setq load-path (nconc load-path (list "~/lib/emacs")))
+(require 'dot-emacs)
+
+;;;----- Some random initialisation -----------------------------------------
+
+(setq mdw-init-window (selected-window))
+
+;; --- Load some other bits of code ---
+
+(setq load-path (cons "~/lib/emacs" load-path))
+
+(autoload 'cc-mode "cc-mode" nil t)
+(autoload 'rexx-mode "rexx-mode" nil t)
+(autoload 'cvs-update "pcl-cvs" nil t)
+(autoload 'debian-changelog-mode "debian-changelog-mode" nil t)
+
+(trap
+ (or (fboundp 'make-regexp)
+ (load "make-regexp")))
+
+(trap (require 'tex-site))
+
+;; --- Skeleton stuff ---
+
+(trap (require 'skel-init))
+
+;; --- Window system-dependent things ---
+
+(require 'paren)
+(trap (show-paren-mode t))
+(or window-system (menu-bar-mode -1))
+
+;; --- Temporary directory handling ---
+
+(defun mdw-check-dir-exists (dir)
+ (and dir
+ (file-directory-p dir)
+ dir))
+(setq tmpdir (or (mdw-check-dir-exists (getenv "TMPDIR"))
+ (mdw-check-dir-exists (format "/tmp/%s" (user-login-name)))
+ "/tmp"))
+
+;; --- Emacs server behaviour ---
+
+(and window-system
+ (trap (gnuserv-start)
+ (setq server-temp-file-regexp (concat "^" tmpdir "\\|/draft$"))))
+
+;; --- Control backup behaviour ---
+
+(setq backup-by-copying nil)
+(setq backup-by-copying-when-linked t)
+(setq backup-by-copying-when-mismatch t)
+
+;; --- Calculator fiddling ---
+
+(setq calc-settings-file "~/.emacs-calc")
+(load calc-settings-file)
+
+;; ---- Some mail and news configuration ---
+
+(setq mail-from-style 'parens)
+(setq mail-signature t)
+(setq mail-yank-prefix "> ")
+(setq mail-archive-file-name "~/Mail/sent")
+
+(setq rmail-display-summary t)
+(setq rmail-file-name "~/Mail/rmail")
+
+;; --- GNUS configuration ---
+
+(setq gnus-select-method '(nntp "tux.nsict.org"))
+(setq gnus-read-active-file 'some)
+(setq gnus-inhibit-startup-message t)
+(setq gnus-large-newsgroup 500)
+
+;; --- Internationalization twiddling ---
+
+(trap
+ (standard-display-european 1)
+ (let ((im (current-input-mode)))
+ (apply #'set-input-mode
+ (nconc (list (nth 0 im) (nth 1 im) 0) (nthcdr 3 im))))
+ (set-language-environment "Latin-1"))
+
+;; --- Don't disable any commands ---
+
+(mapatoms #'(lambda (sym) (put sym 'disabled nil)))
+
+;; --- Split a wide window ---
+
+(mdw-divvy-window)
+
+;; --- Other goodies ---
+
+(resize-minibuffer-mode 1) ;Make minibuffer grow dynamically
+(auto-compression-mode 1) ;Enable automatic compression
+(setq dabbrev-case-replace nil) ;Retain case when completing
+(setq next-line-add-newlines nil) ;Don't add weird newlines
+(setq split-height-threshold 45) ;Reuse windows where sensible
+(setq dired-deletion-confirmer ;Make deletion easier in dired
+ (symbol-function 'y-or-n-p))
+(setq dired-listing-switches "-alF") ;Do `ls -F' things in dired windows
+(setq case-fold-file-names nil) ;Don't translate file names (grr...)
+(setq scroll-step 5) ;Don't scroll too much at a time
+(setq-default fill-column 77) ;I use rather narrow windows
+(setq-default comment-column 40) ;Set a standard comment column
+(setq-default truncate-partial-width-windows nil)
+(setq diff-switches "-u" ;I like reading unified diffs
+ cvs-diff-flags (list diff-switches))
+(setq echo-keystrokes 10) ;Long delay before keystrokes echo
+(setq ange-ftp-ftp-program-name "pftp") ;Use passive FTP
+(setq find-ls-option ;Build file lists efficiently
+ '("-print0 | xargs -0r ls -ld" . "ld"))
+(setq Info-fontify-maximum-menu-size 60000)
+(setq ispell-dictionary "british"
+ flyspell-default-dictionary "british")
+(setq browse-url-browser-function 'browse-url-mozilla
+ browse-url-mozilla-program "firefox")
+(trap
+ (require 'uniquify)
+ (setq uniquify-buffer-name-style 'post-forward-angle-brackets)
+ (setq uniquify-after-kill-buffer-p t))
+(transient-mark-mode t)
+(trap
+ (tooltip-mode 0)
+ (tool-bar-mode 0))
+(trap (global-auto-revert-mode t))
+(setq psgml-html-build-new-buffer nil)
+
+(setq cltl2-root-url
+ "http://metalzone.distorted.org.uk/doc/cltl/")
+(setq common-lisp-hyperspec-root
+ "http://metalzone.distorted.org.uk/doc/hyperspec/")
+
+;;;----- Calendar configuration ---------------------------------------------
+
+;; --- Trivial stuff for the sunrise/sunset calculations ---
+
+(setq calendar-latitude 52.2)
+(setq calendar-longitude 0.1)
+(setq calendar-location-name "Cambridge, UK")
+
+;; --- Date format fiddling ---
+
+(setq european-calendar-style t)
+
+(setq diary-date-forms '((day "[-/]" month "[^-/0-9]")
+ (day " *" monthname "[ \t]*\\(\^M\\|\n\\)")
+ (backup day " *" monthname "\\W+\\<[^*0-9]")
+ (day "[-/]" month "[-/]" year "[^0-9]")
+ (day " *" monthname " *" year "[^0-9]")
+ (year "[-/]" month "[-/]" day "[^0-9]")
+ (dayname "\\W")))
+
+;; --- Fancy diary handling ---
+
+(add-hook 'diary-display-hook 'fancy-diary-display)
+(setq diary-list-include-blanks t)
+(add-hook 'list-diary-entries-hook 'sort-diary-entries t)
+(add-hook 'list-diary-entries-hook 'include-other-diary-files)
+(add-hook 'mark-diary-entries-hook 'mark-included-diary-files)
+
+;; --- Appointment management ---
+
+(add-hook 'diary-hook 'appt-make-list)
+(setq appt-issue-message t)
+(setq appt-display-interval 3)
+(setq appt-message-warning-time 10)
+
+;; --- Cosmetic stuff ---
+
+(setq display-time-24hr-format t)
+(display-time)
+(trap
+ (if window-system
+ (let ((view-diary-entries-initially t))
+ (calendar))))
+
+(defvar mdw-black-background t)
+
+;; --- Define more mode hooks for MailCrypt ---
+
+(setq mdw-mc-modes
+ '((mdwmail-mode (encrypt . mdwmail-mc-encrypt)
+ (sign . mdwmail-mc-sign))))
+
+;; --- Load the MailCrypt support ---
+
+(trap
+ (and (string-match "linux" (symbol-name system-type))
+ (progn (require 'mailcrypt-init)
+ (require 'mailcrypt)
+ (setq mc-default-scheme 'mc-scheme-gpg)
+ (setq mc-pgp-user-id "mdw-nsict-pgp")
+ (setq mc-gpg-user-id "mdw-nsict-gpg")
+ (setq mc-modes-alist (append mc-modes-alist mdw-mc-modes))
+ (setq mc-pgp-always-sign t)
+ (setq mc-gpg-always-sign t)
+ (setq mc-always-replace 'never)
+ (setq mc-passwd-timeout 3600)
+ (setq mc-temp-directory tmpdir)
+ (setq mc-modes-alist (append mc-modes-alist mdw-mc-modes))
+ (define-key mc-write-mode-map "\C-c/S" 'mc-sign-region)
+ (define-key mc-write-mode-map "\C-c/E" 'mc-encrypt-region)
+ (add-hook 'text-mode-hook 'mc-install-write-mode))))
+
+;;;----- Other common declarations ------------------------------------------
+
+;; --- Default frame size ---
+
+(setq default-frame-alist
+ (mdw-uniquify-alist
+ '((width . 78)
+ (height . 33)
+ (vertical-scroll-bars . right))
+ (and window-system
+ '((cursor-type . bar)
+ (cursor-blink . t)))
+ '((cursor-color . "red"))
+ (if mdw-black-background
+ '((background-color . "black")
+ (foreground-color . "white")
+ (background-mode . dark))
+ '((background-mode . light)))
+ (and (eq window-system 'pm)
+ '((font . "-os2-System VIO-medium-r-normal--*-40-*-*-m-*-cp850")
+ (menu-font . "8.Helv")
+ (background-color . "lightgrey")))
+ '((transparency . t))
+ default-frame-alist))
+
+;; --- Other frame fiddling ---
+
+(setq frame-title-format '("" invocation-name "@" system-name ": %b"))
+
+;; --- Global keymap changes ---
+
+(trap
+ (windmove-default-keybindings)
+ (setq windmove-wrap-around t))
+(trap (iswitchb-mode))
+(global-set-key [f4] 'query-replace-regexp)
+(global-set-key [f5] 'goto-line)
+(global-set-key [f6] 'auto-fill-mode)
+(global-set-key [f7] 'occur)
+(global-set-key [f8] 'undo)
+(global-set-key [f9] 'mdw-divvy-window)
+(global-set-key [insertchar] 'overwrite-mode)
+(global-set-key "\C-xm" 'vm-mail)
+(global-set-key "\C-x\C-n" 'skel-create-file)
+(global-set-key "\C-x4n" 'skel-create-file-other-window)
+(global-set-key "\C-x5n" 'skel-create-file-other-frame)
+(global-set-key [delete] 'delete-char)
+(global-set-key "\C-[\C-m" 'call-last-kbd-macro)
+(global-set-key "\M-q" 'mdw-fill-paragraph)
+(global-set-key "\C-h\C-m" 'manual-entry)
+(global-set-key [mode-line C-mouse-1] 'mouse-tear-off-window)
+(global-set-key [vertical-scroll-bar C-down-mouse-1]
+ 'mouse-drag-vertical-line)
+(global-set-key [vertical-scroll-bar C-mouse-1]
+ #'(lambda () (interactive)))
+(global-set-key [mouse-4] 'mdw-wheel-up)
+(global-set-key [mouse-5] 'mdw-wheel-down)
+
+;; --- Recognising types of files ---
+
+(setq auto-mode-alist
+ (append `(("\\.p[lm]$" . perl-mode)
+ ("\\.m$" . objc-mode)
+ ("\\.mxd$" . c-mode)
+ ;; ("/[ch]/" . c-mode)
+ (,(concat "/\\("
+ "\\.stgit\\.msg" "\\|"
+ "\\.git/COMMIT_EDITMSG" "\\|"
+ "svn-commit\\.tmp" "\\|"
+ "svk-commit[^/.]*\\.tmp"
+ "\\)$")
+ . text-mode)
+ (,(concat "^" tmpdir "/\\("
+ "svk-commit[^/.]*\\.tmp" "\\|"
+ "gitci\\.[^/.]*" "\\|"
+ "cvs[^/.]\\{6\\}" "\\|"
+ "\\)$")
+ . text-mode)
+ ("\\.calc?$" . apcalc-mode)
+ ("/src/linux/.*\\.\\(c\\|h\\|cc\\)$" . linux-c-mode)
+ ("/\\(s\\|sh\\)/" . arm-assembler-mode)
+ ("\\.\\(cmd\\|exec\\|rexx\\)$" . rexx-mode)
+ ("\\.st$" . smalltalk-mode)
+ ("\\.\\(tex\\|dtx\\)$" . latex-mode)
+ ("\\.gc$" . haskell.-mode)
+ (,(concat "^" (getenv "HOME") "/News/") . mdwmail-mode)
+ (,(concat "^" tmpdir "/\\(SLRN\\|snd\\|pico\\)")
+ . mdwmail-mode))
+ auto-mode-alist))
+
+(setq completion-ignored-extensions
+ (append `(".hc" ".hi") completion-ignored-extensions))
+
+;; --- Some common local definitions ---
+
+(make-variable-buffer-local 'mdw-auto-indent)
+
+(mapcar (lambda (hook) (add-hook hook 'mdw-misc-mode-config))
+ '(c-mode-hook c++-mode-hook objc-mode-hook java-mode-hook
+ perl-mode-hook cperl-mode-hook python-mode-hook awk-mode-hook
+ tcl-mode-hook
+ TeX-mode-hook LaTeX-mode-hook TeXinfo-mode-hook
+ tex-mode-hook latex-mode-hook texinfo-mode-hook
+ emacs-lisp-mode-hook scheme-mode-hook
+ lisp-mode-hook lisp-interaction-mode-hook inferior-lisp-mode-hook
+ slime-repl-mode-hook
+ sml-mode-hook haskell-mode-hook
+ smalltalk-mode-hook rexx-mode-hook
+ arm-assembler-mode-hook))
+
+(global-font-lock-mode t)
+(defalias 'perl-mode 'cperl-mode)
+
+;;;----- Rootly editingness -------------------------------------------------
+
+(eval-after-load "tramp"
+ '(progn
+ (setq tramp-methods
+ (mdw-uniquify-alist
+ `(("become"
+ (tramp-connection-function tramp-open-connection-su)
+ (tramp-remote-sh "/bin/sh")
+ (tramp-login-program "become")
+ (tramp-copy-program nil)
+ (tramp-copy-args nil)
+ (tramp-copy-keep-date-arg nil)
+ (tramp-login-args ("TERM=dumb" "%u")))
+ ("really"
+ (tramp-connection-function tramp-open-connection-su)
+ (tramp-login-program "really")
+ (tramp-login-args ("-u" "%u" "--"
+ "env" "TERM=dumb" "/bin/sh"))
+ (tramp-copy-program nil)
+ (tramp-copy-args nil)
+ (tramp-copy-keep-date-arg nil)
+ (tramp-remote-sh "/bin/sh"))
+ ,@tramp-methods)))
+ (setq tramp-multi-connection-function-alist
+ (mdw-uniquify-alist
+ '(("bc" tramp-multi-connect-su "become TERM=dumb %u%n"))
+ '(("r" tramp-multi-connect-su "really -u %u%n"))
+ tramp-multi-connection-function-alist))
+ (setq tramp-default-method "ssh")
+ (setq tramp-default-method-alist
+ `(("\\`localhost\\'" ""
+ ,(cond ((executable-find "become") "become")
+ ((executable-find "really") "really")
+ (t "su")))))))
+
+;;;----- General fontification ----------------------------------------------
+
+;; --- Configure lazy fontification ---
+
+(setq font-lock-support-mode 'lazy-lock-mode)
+; (setq lazy-lock-defer-contextually t)
+(setq lazy-lock-defer-time nil)
+(setq font-lock-maximum-decoration 3)
+(setq lazy-lock-minimum-size 0)
+(setq lazy-lock-stealth-time 5)
+(setq lazy-lock-stealth-lines 100)
+(setq lazy-lock-stealth-verbose t)
+
+(add-hook 'after-make-frame-functions 'mdw-do-set-font)
+(add-hook 'term-setup-hook (lambda () (mdw-do-set-font (selected-frame))))
+(add-hook 'window-setup-hook (lambda () (mdw-do-set-font (selected-frame))))
+
+(add-hook 'c-mode-hook 'mdw-fontify-c-and-c++ t)
+(add-hook 'objc-mode-hook 'mdw-fontify-c-and-c++ t)
+(add-hook 'c++-mode-hook 'mdw-fontify-c-and-c++ t)
+(add-hook 'linux-c-mode-hook #'(lambda () (setq c-basic-offset 8)))
+
+(add-hook 'apcalc-mode-hook 'mdw-misc-mode-config t)
+(add-hook 'apcalc-mode-hook 'mdw-fontify-apcalc t)
+
+(add-hook 'java-mode-hook 'mdw-fontify-java t)
+
+(add-hook 'awk-mode-hook 'mdw-fontify-awk t)
+
+(add-hook 'perl-mode-hook 'mdw-fontify-perl t)
+(add-hook 'cperl-mode-hook 'mdw-fontify-perl t)
+
+(setq-default py-indent-offset 2)
+(add-hook 'python-mode-hook 'mdw-fontify-python t)
+
+(setq-default tcl-indent-level 2)
+(add-hook 'tcl-mode-hook 'mdw-fontify-tcl t)
+
+(add-hook 'rexx-mode-hook 'mdw-fontify-rexx t)
+
+(setq sml-nested-if-indent t)
+(setq sml-case-indent nil)
+(setq sml-indent-level 4)
+(setq sml-type-of-indent nil)
+(add-hook 'sml-mode-hook 'mdw-fontify-sml t)
+
+(add-hook 'haskell-mode-hook 'mdw-fontify-haskell t)
+(setq-default haskell-indent-offset 2)
+
+(add-hook 'texinfo-mode-hook 'mdw-fontify-texinfo t)
+(add-hook 'TeXinfo-mode-hook 'mdw-fontify-texinfo t)
+
+(setq LaTeX-table-label "tbl:")
+(setq-default TeX-master nil)
+;; (setq TeX-parse-self t)
+;; (setq TeX-auto-save t)
+(setq TeX-auto-untabify nil)
+(add-hook 'TeX-mode-hook 'mdw-fontify-tex t)
+(add-hook 'tex-mode-hook 'mdw-fontify-tex t)
+(add-hook 'LaTeX-mode-hook 'mdw-fontify-tex t)
+(add-hook 'latex-mode-hook 'mdw-fontify-tex t)
+
+(add-hook 'sh-mode-hook #'mdw-setup-sh-script-mode)
+
+(add-hook 'smalltalk-mode-hook 'mdw-fontify-smalltalk t)
+(add-hook 'smalltalk-mode-hook 'mdw-setup-smalltalk t)
+
+(add-hook 'emacs-lisp-mode-hook 'mdw-fontify-lispy t)
+(add-hook 'scheme-mode-hook 'mdw-fontify-lispy t)
+(add-hook 'lisp-mode-hook 'mdw-fontify-lispy t)
+(add-hook 'inferior-lisp-mode-hook 'mdw-fontify-lispy t)
+(add-hook 'lisp-interaction-mode-hook 'mdw-fontify-lispy t)
+(add-hook 'slime-repl-mode-hook 'mdw-fontify-lispy t)
+(add-hook 'lisp-mode-hook 'mdw-common-lisp-indent t)
+(require 'slime)
+(slime-setup :autodoc t)
+(trap (require 'xscheme))
+(setq-default xscheme-process-command-line "scheme -large -emacs")
+(add-hook 'inferior-lisp-mode-hook
+ #'(lambda ()
+ (local-set-key "\C-m" 'comint-send-and-indent)) t)
+
+(add-hook 'text-mode-hook 'mdw-text-mode t)
+
+;;;----- Shell mode ---------------------------------------------------------
+
+;; --- Make the shell mode aware of my prompt ---
+
+(setq shell-prompt-pattern "^[^]#$%>»\n]*[]#$%>»] *")
+(setq comint-password-prompt-regexp
+ (concat "\\(\\([Oo]ld \\|[Nn]ew \\|[a-zA-Z0-9_]*'s \\|^\\)"
+ "[Pp]assword\\|pass phrase\\):\\s *\\'"))
+
+;; --- Notice passwords, and make C-a work right ---
+
+(add-hook 'shell-mode-hook #'mdw-sh-mode-setup)
+
+(add-hook 'term-mode-hook #'mdw-term-mode-setup)
+
+;;;----- Finishing touches --------------------------------------------------
+
+(trap (select-window mdw-init-window))
+(provide 'emacs-init)
+
+;;;----- Emacs customization crud -------------------------------------------
+
+(custom-set-variables
+ ;; custom-set-variables was added by Custom -- don't edit or cut/paste it!
+ ;; Your init file should contain only one such instance.
+ '(url-cookie-untrusted-urls (quote (".")))
+ '(url-proxy-services (quote (("http" . "tux.nsict.org:3128") ("ftp" . "tux.nsict.org:3128") ("gopher" . "tux.nsict.org:3128"))))
+ '(w3-do-incremental-display t)
+ '(w3-honor-stylesheets nil)
+ '(w3-use-menus (quote (file edit view go bookmark options buffers style search emacs nil help)))
+ '(w3m-display-inline-image t)
+ '(w3m-key-binding (quote info)))
+(custom-set-faces
+ ;; custom-set-faces was added by Custom -- don't edit or cut/paste it!
+ ;; Your init file should contain only one such instance.
+ )
+
+;;;----- That's all, folks --------------------------------------------------
~mdw / profile / commitdiff