+;;; -*-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)
~mdw / profile / commitdiff