X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/9906310798d936a6cacd0ec5a2d3b607e911c423..a0d16e44fe6acd44350922958f063a7598cd8b36:/el/dot-emacs.el diff --git a/el/dot-emacs.el b/el/dot-emacs.el index f687acb..eb30141 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -21,7 +21,8 @@ ;;; along with this program; if not, write to the Free Software Foundation, ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;;;----- Check command-line ------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Check command-line. (defvar mdw-fast-startup nil "Whether .emacs should optimize for rapid startup. @@ -37,7 +38,8 @@ This may be at the expense of cool features.") (setq probe next))) (setq next (cdr next)))) -;;;----- Some general utilities --------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Some general utilities. (eval-when-compile (unless (fboundp 'make-regexp) @@ -46,22 +48,26 @@ This may be at the expense of cool features.") (defmacro mdw-regexps (&rest list) "Turn a LIST of strings into a single regular expression at compile-time." + (declare (indent nil) + (debug 0)) `',(make-regexp list)) -;; --- Some error trapping --- +;; 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." + (declare (indent 0) + (debug t)) `(condition-case err ,(if (cdr forms) (cons 'progn forms) (car forms)) (error (message "Error (trapped): %s in %s" (error-message-string err) ',forms)))) -;; --- Configuration reading --- +;; Configuration reading. (defvar mdw-config nil) (defun mdw-config (sym) @@ -85,7 +91,7 @@ This may be at the expense of cool features.") (concat "(" (buffer-string) ")"))))))) (cdr (assq sym mdw-config))) -;; --- Set up the load path convincingly --- +;; Set up the load path convincingly. (dolist (dir (append (and (boundp 'debian-emacs-flavor) (list (concat "/usr/share/" @@ -96,11 +102,13 @@ This may be at the expense of cool features.") (not (member sub load-path))) (setq load-path (nconc load-path (list sub)))))) -;; --- Is an Emacs library available? --- +;; Is an Emacs library available? (defun library-exists-p (name) - "Return non-nil if NAME.el (or NAME.elc) is somewhere on the Emacs load -path. The non-nil value is the filename we found for the library." + "Return non-nil if NAME is an available library. +Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs +load path. The non-nil value is the filename we found for the +library." (let ((path load-path) elt (foundp nil)) (while (and path (not foundp)) (setq elt (car path)) @@ -116,7 +124,15 @@ path. The non-nil value is the filename we found for the library." (and (library-exists-p file) (autoload symbol file docstring interactivep type))) -;; --- Splitting windows --- +(defun mdw-kick-menu-bar (&optional frame) + "Regenerate FRAME's menu bar so it doesn't have empty menus." + (interactive) + (unless frame (setq frame (selected-frame))) + (let ((old (frame-parameter frame 'menu-bar-lines))) + (set-frame-parameter frame 'menu-bar-lines 0) + (set-frame-parameter frame 'menu-bar-lines old))) + +;; Splitting windows. (unless (fboundp 'scroll-bar-columns) (defun scroll-bar-columns (side) @@ -129,6 +145,33 @@ path. The non-nil value is the filename we found for the library." ((eq side 'left) 1) (t 2)))) +(defun mdw-horizontal-window-overhead () + "Computes the horizontal window overhead. +This is the number of columns used by fringes, scroll bars and other such +cruft." + (if (not window-system) + 1 + (let ((tot 0)) + (dolist (what '(scroll-bar fringe)) + (dolist (side '(left right)) + (incf tot (funcall (intern (concat (symbol-name what) "-columns")) + side)))) + tot))) + +(defun mdw-split-window-horizontally (&optional width) + "Split a window horizontally. +Without a numeric argument, split the window approximately in +half. With a numeric argument WIDTH, allocate WIDTH columns to +the left-hand window (if positive) or -WIDTH columns to the +right-hand window (if negative). Space for scroll bars and +fringes is not taken out of the allowance for WIDTH, unlike +\\[split-window-horizontally]." + (interactive "P") + (split-window-horizontally + (cond ((null width) nil) + ((>= width 0) (+ width (mdw-horizontal-window-overhead))) + ((< width 0) width)))) + (defun mdw-divvy-window (&optional width) "Split a wide window into appropriate widths." (interactive "P") @@ -138,16 +181,7 @@ path. The non-nil value is the filename we found for the library." 77) (t 78))) (let* ((win (selected-window)) - (sb-width (if (not window-system) - 1 - (let ((tot 0)) - (dolist (what '(scroll-bar fringe)) - (dolist (side '(left right)) - (incf tot - (funcall (intern (concat (symbol-name what) - "-columns")) - side)))) - tot))) + (sb-width (mdw-horizontal-window-overhead)) (c (/ (+ (window-width) sb-width) (+ width sb-width)))) (while (> c 1) @@ -156,14 +190,56 @@ path. The non-nil value is the filename we found for the library." (other-window 1)) (select-window win))) -;; --- Functions for sexp diary entries --- +;; Don't raise windows unless I say so. + +(defvar mdw-inhibit-raise-frame nil + "*Whether `raise-frame' should do nothing when the frame is mapped.") + +(defadvice raise-frame + (around mdw-inhibit (&optional frame) activate compile) + "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the +frame is actually mapped on the screen." + (if mdw-inhibit-raise-frame + (make-frame-visible frame) + ad-do-it)) + +(defmacro mdw-advise-to-inhibit-raise-frame (function) + "Advise the FUNCTION not to raise frames, even if it wants to." + `(defadvice ,function + (around mdw-inhibit-raise (&rest hunoz) activate compile) + "Don't raise the window unless you have to." + (let ((mdw-inhibit-raise-frame t)) + ad-do-it))) + +(mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus) + +;; Transient mark mode hacks. + +(defadvice exchange-point-and-mark + (around mdw-highlight (&optional arg) activate compile) + "Maybe don't actually exchange point and mark. +If `transient-mark-mode' is on and the mark is inactive, then +just activate it. A non-trivial prefix argument will force the +usual behaviour. A trivial prefix argument (i.e., just C-u) will +activate the mark and temporarily enable `transient-mark-mode' if +it's currently off." + (cond ((or mark-active + (and (not transient-mark-mode) (not arg)) + (and arg (or (not (consp arg)) + (not (= (car arg) 4))))) + ad-do-it) + (t + (or transient-mark-mode (setq transient-mark-mode 'only)) + (set-mark (mark t))))) + +;; 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." +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 @@ -188,7 +264,7 @@ symbols `sunday', `monday', etc. (or a mixture). If the date stored in (nth 2 when)))))))) (eq w d))) -;; --- Fighting with Org-mode's evil key maps --- +;; Fighting with Org-mode's evil key maps. (defvar mdw-evil-keymap-keys '(([S-up] . [?\C-c up]) @@ -225,10 +301,31 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." (dolist (key replacements) (define-key keymap key binding)))))) -;;;----- Mail and news hacking ---------------------------------------------- +(eval-after-load "org-latex" + '(progn + (push '("strayman" + "\\documentclass{strayman} +\\usepackage[utf8]{inputenc} +\\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts} +\\usepackage[T1]{fontenc} +\\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}") + ("\\paragraph{%s}" . "\\paragraph*{%s}") + ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) + org-export-latex-classes))) + +(setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i" + org-export-docbook-xsl-fo-proc-command "fop %i.safe %o" + org-export-docbook-xslt-stylesheet + "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl") + +;;;-------------------------------------------------------------------------- +;;; Mail and news hacking. (define-derived-mode mdwmail-mode mail-mode "[mdw] mail" - "Major mode for editing news and mail messages from external programs + "Major mode for editing news and mail messages from external programs. Not much right now. Just support for doing MailCrypt stuff." :syntax-table nil :abbrev-table nil @@ -248,7 +345,7 @@ Not much right now. Just support for doing MailCrypt stuff." (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" paragraph-separate)))) -;; --- How to encrypt in mdwmail --- +;; How to encrypt in mdwmail. (defun mdwmail-mc-encrypt (&optional recip scm start end from sign) (or start @@ -259,7 +356,7 @@ Not much right now. Just support for doing MailCrypt stuff." (setq end (point-max))) (mc-encrypt-generic recip scm start end from sign)) -;; --- How to sign in mdwmail --- +;; How to sign in mdwmail. (defun mdwmail-mc-sign (key scm start end uclr) (or start @@ -270,7 +367,7 @@ Not much right now. Just support for doing MailCrypt stuff." (setq end (point-max))) (mc-sign-generic key scm start end uclr)) -;; --- Some signature mangling --- +;; Some signature mangling. (defun mdwmail-mangle-signature () (save-excursion @@ -279,14 +376,14 @@ Not much right now. Just support for doing MailCrypt stuff." (add-hook 'mail-setup-hook 'mdwmail-mangle-signature) (add-hook 'message-setup-hook 'mdwmail-mangle-signature) -;; --- Insert my login name into message-ids, so I can score replies --- +;; Insert my login name into message-ids, so I can score replies. (defadvice message-unique-id (after mdw-user-name last activate compile) "Ensure that the user's name appears at the end of the message-id string, so that it can be used for convenient filtering." (setq ad-return-value (concat ad-return-value "." (user-login-name)))) -;; --- Tell my movemail hack where movemail is --- +;; Tell my movemail hack where movemail is. ;; ;; This is needed to shup up warnings about LD_PRELOAD. @@ -297,7 +394,11 @@ so that it can be used for convenient filtering." (setenv "REAL_MOVEMAIL" try)) (setq path (cdr path))))) -;;;----- Utility functions -------------------------------------------------- +(eval-after-load "erc" + '(load "~/.ercrc.el")) + +;;;-------------------------------------------------------------------------- +;;; Utility functions. (or (fboundp 'line-number-at-pos) (defun line-number-at-pos (&optional pos) @@ -312,15 +413,11 @@ so that it can be used for convenient filtering." (forward-line 0) (1+ (count-lines 1 (point)))))))) -;; --- 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." - +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 @@ -328,48 +425,36 @@ input lists are not modified, although they'll probably become garbage." (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 --- - + "A helper function for mdw-uniquify-alist. +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." + + ;; 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. - + ;; 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. - + ;; 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! - + ;; 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) @@ -383,23 +468,18 @@ input lists are not modified, although they'll probably become garbage." (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 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 --- - + ;; Now actually do the thing. (call-process "uuencode" file t nil name)) (defvar np-file "~/.np" @@ -414,10 +494,25 @@ input lists are not modified, although they'll probably become garbage." (insert "\nNP: ") (insert-file-contents np-file))))) +(defun mdw-version-< (ver-a ver-b) + "Answer whether VER-A is strictly earlier than VER-B. +VER-A and VER-B are version numbers, which are strings containing digit +sequences separated by `.'." + (let* ((la (mapcar (lambda (x) (car (read-from-string x))) + (split-string ver-a "\\."))) + (lb (mapcar (lambda (x) (car (read-from-string x))) + (split-string ver-b "\\.")))) + (catch 'done + (while t + (cond ((null la) (throw 'done lb)) + ((null lb) (throw 'done nil)) + ((< (car la) (car lb)) (throw 'done t)) + ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb)))))))) + (defun mdw-check-autorevert () - "Sets global-auto-revert-ignore-buffer appropriately for this buffer, -taking into consideration whether it's been found using tramp, which seems to -get itself into a twist." + "Sets global-auto-revert-ignore-buffer appropriately for this buffer. +This takes into consideration whether it's been found using +tramp, which seems to get itself into a twist." (cond ((not (boundp 'global-auto-revert-ignore-buffer)) nil) ((and (buffer-file-name) @@ -433,14 +528,16 @@ get itself into a twist." (defadvice write-file (after mdw-autorevert activate) (mdw-check-autorevert)) -;;;----- Dired hacking ------------------------------------------------------ +;;;-------------------------------------------------------------------------- +;;; Dired hacking. (defadvice dired-maybe-insert-subdir (around mdw-marked-insertion first activate) - "The DIRNAME may be a list of directory names to insert. Interactively, if -files are marked, then insert all of them. With a numeric prefix argument, -select that many entries near point; with a non-numeric prefix argument, -prompt for listing options." + "The DIRNAME may be a list of directory names to insert. +Interactively, if files are marked, then insert all of them. +With a numeric prefix argument, select that many entries near +point; with a non-numeric prefix argument, prompt for listing +options." (interactive (list (dired-get-marked-files nil (and (integerp current-prefix-arg) @@ -456,7 +553,8 @@ prompt for listing options." (ad-set-arg 0 dir) ad-do-it))) -;;;----- URL viewing -------------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; URL viewing. (defun mdw-w3m-browse-url (url &optional new-session-p) "Invoke w3m on the URL in its current window, or at least a different one. @@ -475,16 +573,18 @@ If NEW-SESSION-P, start a new session." (select-window window))))) (defvar mdw-good-url-browsers - '((w3m . mdw-w3m-browse-url) - browse-url-w3 - browse-url-mozilla) - "List of good browsers for mdw-good-url-browsers; each item is a browser -function name, or a cons (CHECK . FUNC). A symbol FOO stands for (FOO -. FOO).") + '(browse-url-mozilla + browse-url-generic + (w3m . mdw-w3m-browse-url) + browse-url-w3) + "List of good browsers for mdw-good-url-browsers. +Each item is a browser function name, or a cons (CHECK . FUNC). +A symbol FOO stands for (FOO . FOO).") (defun mdw-good-url-browser () - "Return a good URL browser. Trundle the list of such things, finding the -first item for which CHECK is fboundp, and returning the correponding FUNC." + "Return a good URL browser. +Trundle the list of such things, finding the first item for which +CHECK is fboundp, and returning the correponding FUNC." (let ((bs mdw-good-url-browsers) b check func answer) (while (and bs (not answer)) (setq b (car bs) @@ -496,19 +596,56 @@ first item for which CHECK is fboundp, and returning the correponding FUNC." (setq answer func))) answer)) -;;;----- Paragraph filling -------------------------------------------------- - -;; --- Useful variables --- +(eval-after-load "w3m-search" + '(progn + (dolist + (item + '(("g" "Google" "http://www.google.co.uk/search?q=%s") + ("gd" "Google Directory" + "http://www.google.com/search?cat=gwd/Top&q=%s") + ("gg" "Google Groups" "http://groups.google.com/groups?q=%s") + ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s") + ("gi" "Images" "http://images.google.com/images?q=%s") + ("rfc" "RFC" + "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz") + ("wp" "Wikipedia" + "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s") + ("imdb" "IMDb" "http://www.imdb.com/Find?%s") + ("nc-wiki" "nCipher wiki" + "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s") + ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en") + ("lp" "Launchpad bug by number" + "https://bugs.launchpad.net/bugs/%s") + ("lppkg" "Launchpad bugs by package" + "https://bugs.launchpad.net/%s") + ("msdn" "MSDN" + "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8") + ("debbug" "Debian bug by number" + "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s") + ("debbugpkg" "Debian bugs by package" + "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s") + ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml"))) + (add-to-list 'w3m-search-engine-alist + (list (cadr item) (caddr item) nil)) + (add-to-list 'w3m-uri-replace-alist + (list (concat "\\`" (car item) ":") + 'w3m-search-uri-replace + (cadr item)))))) + +;;;-------------------------------------------------------------------------- +;;; 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. + "*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: +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 @@ -519,43 +656,37 @@ a list of things: (defvar mdw-hanging-indents (concat "\\(\\(" - "\\([*o]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)" + "\\([*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'.") + "*Standard regexp matching parts of a hanging indent. +This is mainly useful in `auto-fill-mode'.") -;; --- Setting things up --- +;; Setting things up. (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill)) -;; --- Utility functions --- +;; 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)) +(defun mdw-maybe-tabify (s) + "Tabify or untabify the string S, according to `indent-tabs-mode'." + (let ((tabfun (if indent-tabs-mode #'tabify #'untabify))) + (with-temp-buffer + (save-match-data (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)))) + (let ((start (point-min)) (end (point-max))) + (funcall tabfun (point-min) (point-max)) + (setq s (buffer-substring (point-min) (1- (point-max))))))))) (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." + "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)))))) + (mdw-maybe-tabify (apply #'concat + (mapcar #'mdw-do-prefix-match + (cdr (car l)))))) (t (mdw-examine-fill-prefixes (cdr l))))) (defun mdw-maybe-car (p) @@ -572,8 +703,8 @@ and match data must be saved." n)) (defun mdw-do-prefix-match (m) - "Expand a dynamic prefix match element. See `mdw-fill-prefix' for -details." + "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 @@ -591,8 +722,8 @@ details." (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." + "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))) @@ -604,20 +735,31 @@ there isn't a sensible static one." (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." +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 ------------------------------------------ +;;;-------------------------------------------------------------------------- +;;; Other common declarations. -;; --- Common mode settings --- +;; Common mode settings. (defvar mdw-auto-indent t "Whether to indent automatically after a newline.") +(defun mdw-whitespace-mode (&optional arg) + "Turn on/off whitespace mode, but don't highlight trailing space." + (interactive "P") + (when (and (boundp 'whitespace-style) + (fboundp 'whitespace-mode)) + (let ((whitespace-style (remove 'trailing whitespace-style))) + (whitespace-mode arg)) + (setq show-trailing-whitespace whitespace-mode))) + (defun mdw-misc-mode-config () (and mdw-auto-indent (cond ((eq major-mode 'lisp-mode) @@ -628,40 +770,45 @@ doesn't cope with anything approximating a complicated case." (t (local-set-key "\C-m" 'newline-and-indent)))) (local-set-key [C-return] 'newline) - (make-variable-buffer-local 'page-delimiter) + (make-local-variable 'page-delimiter) (setq page-delimiter "\f\\|^.*-\\{6\\}.*$") (setq comment-column 40) (auto-fill-mode 1) (setq fill-column 77) (setq show-trailing-whitespace t) + (mdw-whitespace-mode 1) (and (fboundp 'gtags-mode) (gtags-mode)) - (outline-minor-mode t) - (mdw-set-font)) - -(eval-after-load 'gtags - '(dolist (key '([mouse-2] [mouse-3])) - (define-key gtags-mode-map key nil))) + (if (fboundp 'hs-minor-mode) + (trap (hs-minor-mode t)) + (outline-minor-mode t)) + (reveal-mode t) + (trap (turn-on-font-lock))) -;; --- Set up all sorts of faces --- +(defun mdw-post-config-mode-hack () + (mdw-whitespace-mode 1)) -(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) +(eval-after-load 'gtags + '(progn + (dolist (key '([mouse-2] [mouse-3])) + (define-key gtags-mode-map key nil)) + (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event) + (define-key gtags-select-mode-map [C-S-mouse-2] + 'gtags-select-tag-by-event) + (dolist (map (list gtags-mode-map gtags-select-mode-map)) + (define-key map [C-S-mouse-3] 'gtags-pop-stack)))) -;; --- Backup file handling --- +;; Backup file handling. (defvar mdw-backup-disable-regexps nil - "*List of regular expressions: if a file name matches any of these then the -file is not backed up.") + "*List of regular expressions: if a file name matches any of +these then the file is not backed up.") (defun mdw-backup-enable-predicate (name) - "[mdw]'s default backup predicate: allows a backup if the -standard predicate would allow it, and it doesn't match any of -the regular expressions in `mdw-backup-disable-regexps'." + "[mdw]'s default backup predicate. +Allows a backup if the standard predicate would allow it, and it +doesn't match any of the regular expressions in +`mdw-backup-disable-regexps'." (and (normal-backup-enable-predicate name) (let ((answer t) (list mdw-backup-disable-regexps)) (save-match-data @@ -672,133 +819,281 @@ the regular expressions in `mdw-backup-disable-regexps'." answer)))) (setq backup-enable-predicate 'mdw-backup-enable-predicate) -;;;----- General fontification ---------------------------------------------- - -(defun mdw-set-fonts (frame faces) - (while faces - (let ((face (caar faces))) - (or (facep face) (make-face face)) - (set-face-attribute face 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 face frame (cdar faces)) - (setq faces (cdr faces))))) - -(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" :height 130 :width semi-condensed)))) - (fixed-pitch) - (minibuffer-prompt) - (mode-line :foreground "blue" :background "yellow" - :box (:line-width 1 :style released-button)) - (mode-line-inactive :foreground "yellow" :background "blue" - :box (:line-width 1 :style released-button)) - (scroll-bar :foreground "black" :background "lightgrey") - (fringe :foreground "yellow" :background "black") - (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 ,(if window-system "grey30" "blue")) - (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-delimiter-face - :foreground ,(if window-system "SeaGreen1" "green") - :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) - (message-cited-text - :foreground ,(if window-system "SeaGreen1" "green") - :slant italic) - (message-separator :background "red" :foreground "white" :weight bold) - (message-header-cc - :foreground ,(if window-system "SeaGreen1" "green") - :weight bold) - (message-header-newsgroups - :foreground ,(if window-system "SeaGreen1" "green") - :weight bold) - (message-header-subject - :foreground ,(if window-system "SeaGreen1" "green") - :weight bold) - (message-header-to - :foreground ,(if window-system "SeaGreen1" "green") - :weight bold) - (message-header-xheader - :foreground ,(if window-system "SeaGreen1" "green") - :weight bold) - (message-header-other - :foreground ,(if window-system "SeaGreen1" "green") - :weight bold) - (message-header-name - :foreground ,(if window-system "SeaGreen1" "green")) - (woman-bold :weight bold) - (woman-italic :slant italic) - (p4-depot-added-face :foreground "green") - (p4-depot-branch-op-face :foreground "yellow") - (p4-depot-deleted-face :foreground "red") - (p4-depot-unmapped-face - :foreground ,(if window-system "SkyBlue1" "cyan")) - (p4-diff-change-face :foreground "yellow") - (p4-diff-del-face :foreground "red") - (p4-diff-file-face :foreground "SkyBlue1") - (p4-diff-head-face :background "grey10") - (p4-diff-ins-face :foreground "green") - (diff-index :weight bold) - (diff-file-header :weight bold) - (diff-hunk-header :foreground "SkyBlue1") - (diff-function :foreground "SkyBlue1" :weight bold) - (diff-header :background "grey10") - (diff-added :foreground "green") - (diff-removed :foreground "red") - (diff-context) - (whizzy-slice-face :background "grey10") - (whizzy-error-face :background "darkred") - (trailing-whitespace :background "red") -))) - -(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 --- +;; Frame cleanup. + +(defun mdw-last-one-out-turn-off-the-lights (frame) + "Disconnect from an X display if this was the last frame on that display." + (let ((frame-display (frame-parameter frame 'display))) + (when (and frame-display + (eq window-system 'x) + (not (some (lambda (fr) + (and (not (eq fr frame)) + (string= (frame-parameter fr 'display) + frame-display))) + (frame-list)))) + (run-with-idle-timer 0 nil #'x-close-connection frame-display)))) +(add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights) + +;;;-------------------------------------------------------------------------- +;;; General fontification. + +(defmacro mdw-define-face (name &rest body) + "Define a face, and make sure it's actually set as the definition." + (declare (indent 1) + (debug 0)) + `(progn + (make-face ',name) + (defvar ,name ',name) + (put ',name 'face-defface-spec ',body) + (face-spec-set ',name ',body nil))) + +(mdw-define-face default + (((type w32)) :family "courier new" :height 85) + (((type x)) :family "6x13" :foundry "trad" :height 130) + (((type color)) :foreground "white" :background "black") + (t nil)) +(mdw-define-face fixed-pitch + (((type w32)) :family "courier new" :height 85) + (((type x)) :family "6x13" :foundry "trad" :height 130) + (t :foreground "white" :background "black")) +(if (>= emacs-major-version 23) + (mdw-define-face variable-pitch + (((type x)) :family "sans" :height 100)) + (mdw-define-face variable-pitch + (((type x)) :family "helvetica" :height 90))) +(mdw-define-face region + (((type tty) (class color)) :background "blue") + (((type tty) (class mono)) :inverse-video t) + (t :background "grey30")) +(mdw-define-face mc/cursor-face + (((type tty) (class mono)) :inverse-video t) + (t :background "red")) +(mdw-define-face minibuffer-prompt + (t :weight bold)) +(mdw-define-face mode-line + (((class color)) :foreground "blue" :background "yellow" + :box (:line-width 1 :style released-button)) + (t :inverse-video t)) +(mdw-define-face mode-line-inactive + (((class color)) :foreground "yellow" :background "blue" + :box (:line-width 1 :style released-button)) + (t :inverse-video t)) +(mdw-define-face nobreak-space + (((type tty))) + (t :inherit escape-glyph :underline t)) +(mdw-define-face scroll-bar + (t :foreground "black" :background "lightgrey")) +(mdw-define-face fringe + (t :foreground "yellow")) +(mdw-define-face show-paren-match + (((class color)) :background "darkgreen") + (t :underline t)) +(mdw-define-face show-paren-mismatch + (((class color)) :background "red") + (t :inverse-video t)) +(mdw-define-face highlight + (((type x) (class color)) :background "DarkSeaGreen4") + (((type tty) (class color)) :background "cyan") + (t :inverse-video t)) + +(mdw-define-face holiday-face + (t :background "red")) +(mdw-define-face calendar-today-face + (t :foreground "yellow" :weight bold)) + +(mdw-define-face comint-highlight-prompt + (t :weight bold)) +(mdw-define-face comint-highlight-input + (t nil)) + +(mdw-define-face dired-directory + (t :foreground "cyan" :weight bold)) +(mdw-define-face dired-symlink + (t :foreground "cyan")) +(mdw-define-face dired-perm-write + (t nil)) + +(mdw-define-face trailing-whitespace + (((class color)) :background "red") + (t :inverse-video t)) +(mdw-define-face mdw-punct-face + (((type tty)) :foreground "yellow") (t :foreground "burlywood2")) +(mdw-define-face mdw-number-face + (t :foreground "yellow")) +(mdw-define-face mdw-trivial-face) +(mdw-define-face font-lock-function-name-face + (t :slant italic)) +(mdw-define-face font-lock-keyword-face + (t :weight bold)) +(mdw-define-face font-lock-constant-face + (t :slant italic)) +(mdw-define-face font-lock-builtin-face + (t :weight bold)) +(mdw-define-face font-lock-type-face + (t :weight bold :slant italic)) +(mdw-define-face font-lock-reference-face + (t :weight bold)) +(mdw-define-face font-lock-variable-name-face + (t :slant italic)) +(mdw-define-face font-lock-comment-delimiter-face + (((class mono)) :weight bold) + (((type tty) (class color)) :foreground "green") + (t :slant italic :foreground "SeaGreen1")) +(mdw-define-face font-lock-comment-face + (((class mono)) :weight bold) + (((type tty) (class color)) :foreground "green") + (t :slant italic :foreground "SeaGreen1")) +(mdw-define-face font-lock-string-face + (((class mono)) :weight bold) + (((class color)) :foreground "SkyBlue1")) + +(mdw-define-face message-separator + (t :background "red" :foreground "white" :weight bold)) +(mdw-define-face message-cited-text + (default :slant italic) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face message-header-cc + (default :weight bold) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face message-header-newsgroups + (default :weight bold) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face message-header-subject + (default :weight bold) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face message-header-to + (default :weight bold) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face message-header-xheader + (default :weight bold) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face message-header-other + (default :weight bold) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face message-header-name + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face which-func + (t nil)) + +(mdw-define-face diff-header + (t nil)) +(mdw-define-face diff-index + (t :weight bold)) +(mdw-define-face diff-file-header + (t :weight bold)) +(mdw-define-face diff-hunk-header + (t :foreground "SkyBlue1")) +(mdw-define-face diff-function + (t :foreground "SkyBlue1" :weight bold)) +(mdw-define-face diff-header + (t :background "grey10")) +(mdw-define-face diff-added + (t :foreground "green")) +(mdw-define-face diff-removed + (t :foreground "red")) +(mdw-define-face diff-context + (t nil)) +(mdw-define-face diff-refine-change + (((class color) (type x)) :background "RoyalBlue4") + (t :underline t)) + +(mdw-define-face dylan-header-background + (((class color) (type x)) :background "NavyBlue") + (t :background "blue")) + +(mdw-define-face magit-diff-add + (t :foreground "green")) +(mdw-define-face magit-diff-del + (t :foreground "red")) +(mdw-define-face magit-diff-file-header + (t :weight bold)) +(mdw-define-face magit-diff-hunk-header + (t :foreground "SkyBlue1")) +(mdw-define-face magit-item-highlight + (((type tty)) :background "blue") + (t :background "DarkSeaGreen4")) +(mdw-define-face magit-log-head-label-remote + (((type tty)) :background "cyan" :foreground "green") + (t :background "grey11" :foreground "DarkSeaGreen2" :box t)) +(mdw-define-face magit-log-head-label-local + (((type tty)) :background "cyan" :foreground "yellow") + (t :background "grey11" :foreground "LightSkyBlue1" :box t)) +(mdw-define-face magit-log-head-label-tags + (((type tty)) :background "red" :foreground "yellow") + (t :background "LemonChiffon1" :foreground "goldenrod4" :box t)) +(mdw-define-face magit-log-graph + (((type tty)) :foreground "magenta") + (t :foreground "grey80")) + +(mdw-define-face erc-input-face + (t :foreground "red")) + +(mdw-define-face woman-bold + (t :weight bold)) +(mdw-define-face woman-italic + (t :slant italic)) + +(eval-after-load "rst" + '(progn + (mdw-define-face rst-level-1-face + (t :foreground "SkyBlue1" :weight bold)) + (mdw-define-face rst-level-2-face + (t :foreground "SeaGreen1" :weight bold)) + (mdw-define-face rst-level-3-face + (t :weight bold)) + (mdw-define-face rst-level-4-face + (t :slant italic)) + (mdw-define-face rst-level-5-face + (t :underline t)) + (mdw-define-face rst-level-6-face + ()))) + +(mdw-define-face p4-depot-added-face + (t :foreground "green")) +(mdw-define-face p4-depot-branch-op-face + (t :foreground "yellow")) +(mdw-define-face p4-depot-deleted-face + (t :foreground "red")) +(mdw-define-face p4-depot-unmapped-face + (t :foreground "SkyBlue1")) +(mdw-define-face p4-diff-change-face + (t :foreground "yellow")) +(mdw-define-face p4-diff-del-face + (t :foreground "red")) +(mdw-define-face p4-diff-file-face + (t :foreground "SkyBlue1")) +(mdw-define-face p4-diff-head-face + (t :background "grey10")) +(mdw-define-face p4-diff-ins-face + (t :foreground "green")) + +(mdw-define-face w3m-anchor-face + (t :foreground "SkyBlue1" :underline t)) +(mdw-define-face w3m-arrived-anchor-face + (t :foreground "SkyBlue1" :underline t)) + +(mdw-define-face whizzy-slice-face + (t :background "grey10")) +(mdw-define-face whizzy-error-face + (t :background "darkred")) + +;; Ellipses used to indicate hidden text (and similar). +(mdw-define-face mdw-ellipsis-face + (((type tty)) :foreground "blue") (t :foreground "grey60")) +(let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face)) + (backslash (make-glyph-code ?\ 'mdw-ellipsis-face)) + (dot (make-glyph-code ?. 'mdw-ellipsis-face)) + (bar (make-glyph-code ?| mdw-ellipsis-face))) + (set-display-table-slot standard-display-table 0 dollar) + (set-display-table-slot standard-display-table 1 backslash) + (set-display-table-slot standard-display-table 4 + (vector dot dot dot)) + (set-display-table-slot standard-display-table 5 bar)) + +;;;-------------------------------------------------------------------------- +;;; C programming configuration. + +;; Linux kernel hacking. (defvar linux-c-mode-hook) @@ -809,12 +1104,7 @@ the regular expressions in `mdw-backup-disable-regexps'." (setq mode-name "Linux C") (run-hooks 'linux-c-mode-hook)) -;; --- Make C indentation nice --- - -(eval-after-load "cc-mode" - '(progn - (define-key c-mode-map "*" nil) - (define-key c-mode-map "/" nil))) +;; Make C indentation nice. (defun mdw-c-lineup-arglist (langelem) "Hack for DWIMmery in c-lineup-arglist." @@ -844,39 +1134,41 @@ the regular expressions in `mdw-backup-disable-regexps'." (arglist-cont-nonempty . mdw-c-lineup-arglist) (topmost-intro . mdw-c-indent-extern-mumble) (cpp-define-intro . 0) + (knr-argdecl . 0) (inextern-lang . [0]) (label . 0) (case-label . +) (access-label . -) (inclass . +) (inline-open . ++) - (statement-cont . 0) + (statement-cont . +) (statement-case-intro . +))) t)) -(defun mdw-fontify-c-and-c++ () +(defvar mdw-c-comment-fill-prefix + `((,(concat "\\([ \t]*/?\\)" + "\\(\*\\|//]\\)" + "\\([ \t]*\\)" + "\\([A-Za-z]+:[ \t]*\\)?" + mdw-hanging-indents) + (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5))) + "Fill prefix matching C comments (both kinds).") - ;; --- Fiddle with some syntax codes --- +(defun mdw-fontify-c-and-c++ () + ;; Fiddle with some syntax codes. (modify-syntax-entry ?* ". 23") (modify-syntax-entry ?/ ". 124b") (modify-syntax-entry ?\n "> b") - ;; --- Other stuff --- - + ;; Other stuff. (mdw-c-style) (setq c-hanging-comment-ender-p nil) (setq c-backslash-column 72) (setq c-label-minimum-indentation 0) - (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 --- + (setq mdw-fill-prefix mdw-c-comment-fill-prefix) + ;; Now define things to be fontified. (make-local-variable 'font-lock-keywords) (let ((c-keywords (mdw-regexps "and" ;C++ @@ -908,7 +1200,6 @@ the regular expressions in `mdw-backup-disable-regexps'." "explicit" ;C++ "export" ;C++ "extern" ;K&R, C89 - "false" ;C++, C9X macro "float" ;K&R, C89 "for" ;K&R, C89 ;; "fortran" ;K&R @@ -940,9 +1231,7 @@ the regular expressions in `mdw-backup-disable-regexps'." "struct" ;K&R, C89 "switch" ;K&R, C89 "template" ;C++ - "this" ;C++ "throw" ;C++ - "true" ;C++, C9X macro "try" ;C++ "this" ;C++ "typedef" ;C89 @@ -977,6 +1266,11 @@ the regular expressions in `mdw-backup-disable-regexps'." "__typeof__" ;GCC "__volatile__" ;GCC )) + (c-constants + (mdw-regexps "false" ;C++, C9X macro + "this" ;C++ + "true" ;C++, C9X macro + )) (preprocessor-keywords (mdw-regexps "assert" "define" "elif" "else" "endif" "error" "ident" "if" "ifdef" "ifndef" "import" "include" @@ -989,44 +1283,45 @@ the regular expressions in `mdw-backup-disable-regexps'." (setq font-lock-keywords (list - ;; --- Fontify include files as strings --- - + ;; Fontify include files as strings. (list (concat "^[ \t]*\\#[ \t]*" "\\(include\\|import\\)" "[ \t]*\\(<[^>]+\\(>\\|\\)\\)") '(2 font-lock-string-face)) - ;; --- Preprocessor directives are `references'? --- - + ;; Preprocessor directives are `references'?. (list (concat "^\\([ \t]*#[ \t]*\\(\\(" preprocessor-keywords "\\)\\>\\|[0-9]+\\|$\\)\\)") '(1 font-lock-keyword-face)) - ;; --- Handle the keywords defined above --- - + ;; 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 --- + (list (concat "\\<\\(" c-constants "\\)\\>") + '(0 font-lock-variable-name-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 --- - + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face)))) + + (mdw-post-config-mode-hack))) -;;;----- AP calc mode ------------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; AP calc mode. (defun apcalc-mode () (interactive) @@ -1037,27 +1332,19 @@ the regular expressions in `mdw-backup-disable-regexps'." (defun mdw-fontify-apcalc () - ;; --- Fiddle with some syntax codes --- - + ;; Fiddle with some syntax codes. (modify-syntax-entry ?* ". 23") (modify-syntax-entry ?/ ". 14") - ;; --- Other stuff --- - + ;; 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 --- + (setq mdw-fill-prefix mdw-c-comment-fill-prefix) + ;; Now define things to be fontified. (make-local-variable 'font-lock-keywords) (let ((c-keywords (mdw-regexps "break" "case" "cd" "continue" "define" "default" @@ -1068,29 +1355,29 @@ the regular expressions in `mdw-backup-disable-regexps'." (setq font-lock-keywords (list - ;; --- Handle the keywords defined above --- - + ;; Handle the keywords defined above. (list (concat "\\<\\(" c-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- Handle numbers too --- + ;; 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 --- - + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) -;;;----- Java programming configuration ------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Java programming configuration. -;; --- Make indentation nice --- +;; Make indentation nice. (defun mdw-java-style () (c-add-style "[mdw] Java style" @@ -1103,26 +1390,17 @@ the regular expressions in `mdw-backup-disable-regexps'." (statement-case-intro . +))) t)) -;; --- Declare Java fontification style --- +;; Declare Java fontification style. (defun mdw-fontify-java () - ;; --- Other stuff --- - + ;; Other stuff. (mdw-java-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 --- + (setq mdw-fill-prefix mdw-c-comment-fill-prefix) + ;; Now define things to be fontified. (make-local-variable 'font-lock-keywords) (let ((java-keywords (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch" @@ -1131,24 +1409,26 @@ the regular expressions in `mdw-backup-disable-regexps'." "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" + "static" "switch" "synchronized" "throw" "throws" + "transient" "try" "void" "volatile" "while")) - "false" "null" "true"))) + (java-constants + (mdw-regexps "false" "null" "super" "this" "true"))) (setq font-lock-keywords (list - ;; --- Handle the keywords defined above --- - + ;; Handle the keywords defined above. (list (concat "\\<\\(" java-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- Handle numbers too --- + ;; Handle the magic constants defined above. + (list (concat "\\<\\(" java-constants "\\)\\>") + '(0 font-lock-variable-name-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]*\\|\\)" @@ -1156,14 +1436,151 @@ the regular expressions in `mdw-backup-disable-regexps'." "[lLfFdD]?") '(0 mdw-number-face)) - ;; --- And anything else is punctuation --- + ;; And anything else is punctuation. + (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) + +;;;-------------------------------------------------------------------------- +;;; Javascript programming configuration. +(defun mdw-javascript-style () + (setq js-indent-level 2) + (setq js-expr-indent-offset 0)) + +(defun mdw-fontify-javascript () + + ;; Other stuff. + (mdw-javascript-style) + (setq js-auto-indent-flag t) + + ;; Now define things to be fontified. + (make-local-variable 'font-lock-keywords) + (let ((javascript-keywords + (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch" + "char" "class" "const" "continue" "debugger" "default" + "delete" "do" "double" "else" "enum" "export" "extends" + "final" "finally" "float" "for" "function" "goto" "if" + "implements" "import" "in" "instanceof" "int" + "interface" "let" "long" "native" "new" "package" + "private" "protected" "public" "return" "short" + "static" "super" "switch" "synchronized" "throw" + "throws" "transient" "try" "typeof" "var" "void" + "volatile" "while" "with" "yield" + + "boolean" "byte" "char" "double" "float" "int" "long" + "short" "void")) + (javascript-constants + (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true" + "arguments" "this"))) + + (setq font-lock-keywords + (list + + ;; Handle the keywords defined above. + (list (concat "\\_<\\(" javascript-keywords "\\)\\_>") + '(0 font-lock-keyword-face)) + + ;; Handle the predefined constants defined above. + (list (concat "\\_<\\(" javascript-constants "\\)\\_>") + '(0 font-lock-variable-name-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)))))) + '(0 mdw-punct-face))))) -;;;----- C# programming configuration --------------------------------------- + (mdw-post-config-mode-hack)) -;; --- Make indentation nice --- +;;;-------------------------------------------------------------------------- +;;; Scala programming configuration. + +(defun mdw-fontify-scala () + + ;; Comment filling. + (setq mdw-fill-prefix mdw-c-comment-fill-prefix) + + ;; Define things to be fontified. + (make-local-variable 'font-lock-keywords) + (let ((scala-keywords + (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else" + "extends" "final" "finally" "for" "forSome" "if" + "implicit" "import" "lazy" "match" "new" "object" + "override" "package" "private" "protected" "return" + "sealed" "throw" "trait" "try" "type" "val" + "var" "while" "with" "yield")) + (scala-constants + (mdw-regexps "false" "null" "super" "this" "true")) + (punctuation "[-!%^&*=+:@#~/?\\|`]")) + + (setq font-lock-keywords + (list + + ;; Magical identifiers between backticks. + (list (concat "`\\([^`]+\\)`") + '(1 font-lock-variable-name-face)) + + ;; Handle the keywords defined above. + (list (concat "\\_<\\(" scala-keywords "\\)\\_>") + '(0 font-lock-keyword-face)) + + ;; Handle the constants defined above. + (list (concat "\\_<\\(" scala-constants "\\)\\_>") + '(0 font-lock-variable-name-face)) + + ;; Magical identifiers between backticks. + (list (concat "`\\([^`]+\\)`") + '(1 font-lock-variable-name-face)) + + ;; Handle numbers too. + ;; + ;; As usual, not quite right. + (list (concat "\\_<\\(" + "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|" + "[0-9]+\\(\\.[0-9]*\\|\\)" + "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)" + "[lLfFdD]?") + '(0 mdw-number-face)) + + ;; Identifiers with trailing operators. + (list (concat "_\\(" punctuation "\\)+") + '(0 mdw-trivial-face)) + + ;; And everything else is punctuation. + (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" + '(0 mdw-punct-face))) + + font-lock-syntactic-keywords + (list + + ;; Single quotes around characters. But not when used to quote + ;; symbol names. Ugh. + (list (concat "\\('\\)" + "\\(" "." + "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*" + "u+" "[0-9a-fA-F]\\{4\\}" + "\\|" "\\\\" "[0-7]\\{1,3\\}" + "\\|" "\\\\" "." "\\)" + "\\('\\)") + '(1 "\"") + '(4 "\""))))) + + (mdw-post-config-mode-hack)) + +;;;-------------------------------------------------------------------------- +;;; C# programming configuration. + +;; Make indentation nice. (defun mdw-csharp-style () (c-add-style "[mdw] C# style" @@ -1176,57 +1593,50 @@ the regular expressions in `mdw-backup-disable-regexps'." (statement-case-intro . +))) t)) -;; --- Declare C# fontification style --- +;; Declare C# fontification style. (defun mdw-fontify-csharp () - ;; --- Other stuff --- - + ;; Other stuff. (mdw-csharp-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 --- + (setq mdw-fill-prefix mdw-c-comment-fill-prefix) + ;; Now define things to be fontified. (make-local-variable 'font-lock-keywords) (let ((csharp-keywords - (mdw-regexps "abstract" "as" "base" "bool" "break" - "byte" "case" "catch" "char" "checked" - "class" "const" "continue" "decimal" "default" - "delegate" "do" "double" "else" "enum" - "event" "explicit" "extern" "false" "finally" - "fixed" "float" "for" "foreach" "goto" - "if" "implicit" "in" "int" "interface" - "internal" "is" "lock" "long" "namespace" - "new" "null" "object" "operator" "out" - "override" "params" "private" "protected" "public" - "readonly" "ref" "return" "sbyte" "sealed" - "short" "sizeof" "stackalloc" "static" "string" - "struct" "switch" "this" "throw" "true" - "try" "typeof" "uint" "ulong" "unchecked" - "unsafe" "ushort" "using" "virtual" "void" - "volatile" "while" "yield"))) + (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch" + "char" "checked" "class" "const" "continue" "decimal" + "default" "delegate" "do" "double" "else" "enum" + "event" "explicit" "extern" "finally" "fixed" "float" + "for" "foreach" "goto" "if" "implicit" "in" "int" + "interface" "internal" "is" "lock" "long" "namespace" + "new" "object" "operator" "out" "override" "params" + "private" "protected" "public" "readonly" "ref" + "return" "sbyte" "sealed" "short" "sizeof" + "stackalloc" "static" "string" "struct" "switch" + "throw" "try" "typeof" "uint" "ulong" "unchecked" + "unsafe" "ushort" "using" "virtual" "void" "volatile" + "while" "yield")) + + (csharp-constants + (mdw-regexps "base" "false" "null" "this" "true"))) (setq font-lock-keywords (list - ;; --- Handle the keywords defined above --- - + ;; Handle the keywords defined above. (list (concat "\\<\\(" csharp-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- Handle numbers too --- + ;; Handle the magic constants defined above. + (list (concat "\\<\\(" csharp-constants "\\)\\>") + '(0 font-lock-variable-name-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]*\\|\\)" @@ -1234,22 +1644,204 @@ the regular expressions in `mdw-backup-disable-regexps'." "[lLfFdD]?") '(0 mdw-number-face)) - ;; --- And anything else is punctuation --- + ;; And anything else is punctuation. + (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) + +(define-derived-mode csharp-mode java-mode "C#" + "Major mode for editing C# code.") + +;;;-------------------------------------------------------------------------- +;;; F# programming configuration. + +(setq fsharp-indent-offset 2) + +(defun mdw-fontify-fsharp () + + (let ((punct "=<>+-*/|&%!@?")) + (do ((i 0 (1+ i))) + ((>= i (length punct))) + (modify-syntax-entry (aref punct i) "."))) + + (modify-syntax-entry ?_ "_") + (modify-syntax-entry ?( "(") + (modify-syntax-entry ?) ")") + + (setq indent-tabs-mode nil) + + (let ((fsharp-keywords + (mdw-regexps "abstract" "and" "as" "assert" "atomic" + "begin" "break" + "checked" "class" "component" "const" "constraint" + "constructor" "continue" + "default" "delegate" "do" "done" "downcast" "downto" + "eager" "elif" "else" "end" "exception" "extern" + "finally" "fixed" "for" "fori" "fun" "function" + "functor" + "global" + "if" "in" "include" "inherit" "inline" "interface" + "internal" + "lazy" "let" + "match" "measure" "member" "method" "mixin" "module" + "mutable" + "namespace" "new" + "object" "of" "open" "or" "override" + "parallel" "params" "private" "process" "protected" + "public" "pure" + "rec" "recursive" "return" + "sealed" "sig" "static" "struct" + "tailcall" "then" "to" "trait" "try" "type" + "upcast" "use" + "val" "virtual" "void" "volatile" + "when" "while" "with" + "yield")) + + (fsharp-builtins + (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod" + "base" "false" "null" "true")) + + (bang-keywords + (mdw-regexps "do" "let" "return" "use" "yield")) + + (preprocessor-keywords + (mdw-regexps "if" "indent" "else" "endif"))) + + (setq font-lock-keywords + (list (list (concat "\\(^\\|[^\"]\\)" + "\\(" "(\\*" + "[^*]*\\*+" + "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*" + ")" + "\\|" + "//.*" + "\\)") + '(2 font-lock-comment-face)) + + (list (concat "'" "\\(" + "\\\\" + "\\(" "[ntbr'\\]" + "\\|" "[0-9][0-9][0-9]" + "\\|" "u" "[0-9a-fA-F]\\{4\\}" + "\\|" "U" "[0-9a-fA-F]\\{8\\}" + "\\)" + "\\|" + "." "\\)" "'" + "\\|" + "\"" "[^\"\\]*" + "\\(" "\\\\" "\\(.\\|\n\\)" + "[^\"\\]*" "\\)*" + "\\(\"\\|\\'\\)") + '(0 font-lock-string-face)) + + (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|" + "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>" + "\\|" + "\\_<\\(" fsharp-keywords "\\)\\_>") + '(0 font-lock-keyword-face)) + (list (concat "\\<\\(" fsharp-builtins "\\)\\_>") + '(0 font-lock-variable-name-face)) + + (list (concat "\\_<" + "\\(" "0[bB][01]+" "\\|" + "0[oO][0-7]+" "\\|" + "0[xX][0-9a-fA-F]+" "\\)" + "\\(" "lf\\|LF" "\\|" + "[uU]?[ysnlL]?" "\\)" + "\\|" + "\\_<" + "[0-9]+" "\\(" + "[mMQRZING]" + "\\|" + "\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?" + "[fFmM]?" + "\\|" + "[uU]?[ysnlL]?" + "\\)") + '(0 mdw-number-face)) + + (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) + +(defun mdw-fontify-inferior-fsharp () + (mdw-fontify-fsharp) + (setq font-lock-keywords + (append (list (list "^[#-]" '(0 font-lock-comment-face)) + (list "^>" '(0 font-lock-keyword-face))) + font-lock-keywords))) + +;;;-------------------------------------------------------------------------- +;;; Go programming configuration. +(defun mdw-fontify-go () + + (make-local-variable 'font-lock-keywords) + (let ((go-keywords + (mdw-regexps "break" "case" "chan" "const" "continue" + "default" "defer" "else" "fallthrough" "for" + "func" "go" "goto" "if" "import" + "interface" "map" "package" "range" "return" + "select" "struct" "switch" "type" "var")) + (go-intrinsics + (mdw-regexps "bool" "byte" "complex64" "complex128" "error" + "float32" "float64" "int" "uint8" "int16" "int32" + "int64" "rune" "string" "uint" "uint8" "uint16" + "uint32" "uint64" "uintptr" "void" + "false" "iota" "nil" "true" + "init" "main" + "append" "cap" "copy" "delete" "imag" "len" "make" + "new" "panic" "real" "recover"))) + + (setq font-lock-keywords + (list + + ;; Handle the keywords defined above. + (list (concat "\\<\\(" go-keywords "\\)\\>") + '(0 font-lock-keyword-face)) + (list (concat "\\<\\(" go-intrinsics "\\)\\>") + '(0 font-lock-variable-name-face)) + + ;; Strings and characters. + (list (concat "'" + "\\(" "[^\\']" "\\|" + "\\\\" + "\\(" "[abfnrtv\\'\"]" "\\|" + "[0-7]\\{3\\}" "\\|" + "x" "[0-9A-Fa-f]\\{2\\}" "\\|" + "u" "[0-9A-Fa-f]\\{4\\}" "\\|" + "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)" + "'" + "\\|" + "\"" + "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*" + "\\(\"\\|$\\)" + "\\|" + "`" "[^`]+" "`") + '(0 font-lock-string-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]+\\|\\)\\)") + '(0 mdw-number-face)) + + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) -(defun csharp-mode () - (interactive) - (java-mode) - (setq major-mode 'csharp-mode) - (setq mode-name "C#") - (mdw-fontify-csharp) - (run-hooks 'csharp-mode-hook)) + (mdw-post-config-mode-hack)) -;;;----- Awk programming configuration -------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Awk programming configuration. -;; --- Make Awk indentation nice --- +;; Make Awk indentation nice. (defun mdw-awk-style () (c-add-style "[mdw] Awk style" @@ -1259,18 +1851,16 @@ the regular expressions in `mdw-backup-disable-regexps'." (statement-case-intro . +))) t)) -;; --- Declare Awk fontification style --- +;; Declare Awk fontification style. (defun mdw-fontify-awk () - ;; --- Miscellaneous fiddling --- - + ;; Miscellaneous fiddling. (mdw-awk-style) (setq c-backslash-column 72) (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") - ;; --- Now define things to be fontified --- - + ;; Now define things to be fontified. (make-local-variable 'font-lock-keywords) (let ((c-keywords (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT" @@ -1288,15 +1878,13 @@ the regular expressions in `mdw-backup-disable-regexps'." (setq font-lock-keywords (list - ;; --- Handle the keywords defined above --- - + ;; Handle the keywords defined above. (list (concat "\\<\\(" c-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- Handle numbers too --- + ;; 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]*\\|\\)" @@ -1304,15 +1892,18 @@ the regular expressions in `mdw-backup-disable-regexps'." "[uUlL]*") '(0 mdw-number-face)) - ;; --- And anything else is punctuation --- - + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) -;;;----- Perl programming style --------------------------------------------- + (mdw-post-config-mode-hack)) -;; --- Perl indentation style --- +;;;-------------------------------------------------------------------------- +;;; Perl programming style. +;; Perl indentation style. + +(fset 'perl-mode 'cperl-mode) (setq cperl-indent-level 2) (setq cperl-continued-statement-offset 2) (setq cperl-continued-brace-offset 0) @@ -1320,45 +1911,42 @@ the regular expressions in `mdw-backup-disable-regexps'." (setq cperl-brace-imaginary-offset 0) (setq cperl-label-offset 0) -;; --- Define perl fontification style --- +;; Define perl fontification style. (defun mdw-fontify-perl () - ;; --- Miscellaneous fiddling --- - + ;; Miscellaneous fiddling. (modify-syntax-entry ?$ "\\") (modify-syntax-entry ?$ "\\" font-lock-syntax-table) (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") - ;; --- Now define fontification things --- - + ;; Now define fontification things. (make-local-variable 'font-lock-keywords) (let ((perl-keywords - (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq" - "for" "foreach" "ge" "gt" "goto" "if" + (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq" + "for" "foreach" "ge" "given" "gt" "goto" "if" "last" "le" "lt" "local" "my" "ne" "next" "or" - "package" "redo" "require" "return" "sub" - "undef" "unless" "until" "use" "while"))) + "our" "package" "redo" "require" "return" "sub" + "undef" "unless" "until" "use" "when" "while"))) (setq font-lock-keywords (list - ;; --- Set up the keywords defined above --- - + ;; Set up the keywords defined above. (list (concat "\\<\\(" perl-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- At least numbers are simpler than C --- - + ;; 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 --- - + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) (defun perl-number-tests (&optional arg) "Assign consecutive numbers to lines containing `#t'. With ARG, @@ -1375,64 +1963,73 @@ strip numbers instead." (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t) (replace-match (format "\\1%d" i)))))) -;;;----- Python programming style ------------------------------------------- - -;; --- Define Python fontification style --- +;;;-------------------------------------------------------------------------- +;;; Python programming style. -(defun mdw-fontify-python () - - ;; --- Miscellaneous fiddling --- +(defun mdw-fontify-pythonic (keywords) + ;; Miscellaneous fiddling. (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") + (setq indent-tabs-mode nil) - ;; --- Now define fontification things --- - + ;; Now define fontification things. (make-local-variable 'font-lock-keywords) - (let ((python-keywords - (mdw-regexps "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" "with" "yield"))) - (setq font-lock-keywords - (list - - ;; --- Set up the keywords defined above --- - - (list (concat "\\<\\(" python-keywords "\\)\\>") - '(0 font-lock-keyword-face)) + (setq font-lock-keywords + (list - ;; --- At least numbers are simpler than C --- + ;; Set up the keywords defined above. + (list (concat "\\_<\\(" 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_]+\\|[lL]\\|\\)") - '(0 mdw-number-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 --- + ;; And anything else is punctuation. + (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" + '(0 mdw-punct-face)))) - (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + (mdw-post-config-mode-hack)) -;;;----- Icon programming style --------------------------------------------- +;; Define Python fontification styles. -;; --- Icon indentation style --- +(defun mdw-fontify-python () + (mdw-fontify-pythonic + (mdw-regexps "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" "with" "yield"))) + +(defun mdw-fontify-pyrex () + (mdw-fontify-pythonic + (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue" + "ctypedef" "def" "del" "elif" "else" "except" "exec" + "extern" "finally" "for" "from" "global" "if" + "import" "in" "is" "lambda" "not" "or" "pass" "print" + "raise" "return" "struct" "try" "while" "with" + "yield"))) + +;;;-------------------------------------------------------------------------- +;;; Icon programming style. + +;; Icon indentation style. (setq icon-brace-offset 0 icon-continued-brace-offset 0 icon-continued-statement-offset 2 icon-indent-level 2) -;; --- Define Icon fontification style --- +;; Define Icon fontification style. (defun mdw-fontify-icon () - ;; --- Miscellaneous fiddling --- - + ;; Miscellaneous fiddling. (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") - ;; --- Now define fontification things --- - + ;; Now define fontification things. (make-local-variable 'font-lock-keywords) (let ((icon-keywords (mdw-regexps "break" "by" "case" "create" "default" "do" "else" @@ -1446,38 +2043,36 @@ strip numbers instead." (setq font-lock-keywords (list - ;; --- Set up the keywords defined above --- - + ;; Set up the keywords defined above. (list (concat "\\<\\(" icon-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- The things that Icon calls keywords --- - + ;; The things that Icon calls keywords. (list "&\\sw+\\>" '(0 font-lock-variable-name-face)) - ;; --- At least numbers are simpler than C --- - + ;; At least numbers are simpler than C. (list (concat "\\<[0-9]+" "\\([rR][0-9a-zA-Z]+\\|" "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|" "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>") '(0 mdw-number-face)) - ;; --- Preprocessor --- - + ;; Preprocessor. (list (concat "^[ \t]*$[ \t]*\\<\\(" preprocessor-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- And anything else is punctuation --- - + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) -;;;----- ARM assembler programming configuration ---------------------------- +;;;-------------------------------------------------------------------------- +;;; ARM assembler programming configuration. -;; --- There doesn't appear to be an Emacs mode for this yet --- +;; There doesn't appear to be an Emacs mode for this yet. ;; ;; Better do something about that, I suppose. @@ -1496,21 +2091,20 @@ strip numbers instead." "Major mode for ARM assembler programs" (interactive) - ;; --- Do standard major mode things --- - + ;; 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 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) + (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table) (make-local-variable 'comment-start) (setq comment-start ";") @@ -1521,52 +2115,47 @@ strip numbers instead." (make-local-variable 'comment-start-skip) (setq comment-start-skip ";+[ \t]*") - ;; --- Play with indentation --- - + ;; Play with indentation. (make-local-variable 'indent-line-function) (setq indent-line-function 'indent-relative-maybe) - ;; --- Set fill prefix --- - + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)") - ;; --- Fiddle with fontification --- - + ;; Fiddle with fontification. (make-local-variable 'font-lock-keywords) (setq font-lock-keywords (list - ;; --- Handle numbers too --- + ;; 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 --- - + ;; 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 --- - + ;; Do menemonics and directives. (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)" '(1 font-lock-keyword-face)) - ;; --- And anything else is punctuation --- - + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" '(0 mdw-punct-face)))) + (mdw-post-config-mode-hack) (run-hooks 'arm-assembler-mode-hook)) -;;;----- Assembler mode ----------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Assembler mode. (defun mdw-fontify-asm () (modify-syntax-entry ?' "\"") @@ -1574,7 +2163,8 @@ strip numbers instead." (setf fill-prefix nil) (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")) -;;;----- TCL configuration -------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; TCL configuration. (defun mdw-fontify-tcl () (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$)) @@ -1587,9 +2177,123 @@ strip numbers instead." "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)") '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face))))) + '(0 mdw-punct-face)))) + (mdw-post-config-mode-hack)) + +;;;-------------------------------------------------------------------------- +;;; Dylan programming configuration. + +(defun mdw-fontify-dylan () + + (make-local-variable 'font-lock-keywords) + + ;; Horrors. `dylan-mode' sets the `major-mode' name after calling this + ;; hook, which undoes all of our configuration. + (setq major-mode 'dylan-mode) + (font-lock-set-defaults) + + (let* ((word "[-_a-zA-Z!*@<>$%]+") + (dylan-keywords (mdw-regexps + + "C-address" "C-callable-wrapper" "C-function" + "C-mapped-subtype" "C-pointer-type" "C-struct" + "C-subtype" "C-union" "C-variable" + + "above" "abstract" "afterwards" "all" + "begin" "below" "block" "by" + "case" "class" "cleanup" "constant" "create" + "define" "domain" + "else" "elseif" "end" "exception" "export" + "finally" "for" "from" "function" + "generic" + "handler" + "if" "in" "instance" "interface" "iterate" + "keyed-by" + "let" "library" "local" + "macro" "method" "module" + "otherwise" + "profiling" + "select" "slot" "subclass" + "table" "then" "to" + "unless" "until" "use" + "variable" "virtual" + "when" "while")) + (sharp-keywords (mdw-regexps + "all-keys" "key" "next" "rest" "include" + "t" "f"))) + (setq font-lock-keywords + (list (list (concat "\\<\\(" dylan-keywords + "\\|" "with\\(out\\)?-" word + "\\)\\>") + '(0 font-lock-keyword-face)) + (list (concat "\\<" word ":" "\\|" + "#\\(" sharp-keywords "\\)\\>") + '(0 font-lock-variable-name-face)) + (list (concat "\\(" + "\\([-+]\\|\\<\\)[0-9]+" "\\(" + "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?" + "\\|" "/[0-9]+" + "\\)" + "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?" + "\\|" "#b[01]+" + "\\|" "#o[0-7]+" + "\\|" "#x[0-9a-zA-Z]+" + "\\)\\>") + '(0 mdw-number-face)) + (list (concat "\\(" + "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|" + "\\_<[-+*/=<>:&|]+\\_>" + "\\)") + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) + +;;;-------------------------------------------------------------------------- +;;; Algol 68 configuration. + +(setq a68-indent-step 2) + +(defun mdw-fontify-algol-68 () + + ;; Fix up the syntax table. + (modify-syntax-entry ?# "!" a68-mode-syntax-table) + (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&)) + (modify-syntax-entry ch "." a68-mode-syntax-table)) -;;;----- REXX configuration ------------------------------------------------- + (make-local-variable 'font-lock-keywords) + + (let ((not-comment + (let ((word "COMMENT")) + (do ((regexp (concat "[^" (substring word 0 1) "]+") + (concat regexp "\\|" + (substring word 0 i) + "[^" (substring word i (1+ i)) "]")) + (i 1 (1+ i))) + ((>= i (length word)) regexp))))) + (setq font-lock-keywords + (list (list (concat "\\" + "\\(" not-comment "\\)\\{0,5\\}" + "\\(\\'\\|\\\\)") + '(0 font-lock-comment-face)) + (list (concat "\\" + "\\([^C]+\\|C[^O]\\)\\{0,5\\}" + "\\($\\|\\\\)") + '(0 font-lock-comment-face)) + (list "\\<[A-Z_]+\\>" + '(0 font-lock-keyword-face)) + (list (concat "\\<" + "[0-9]+" + "\\(\\.[0-9]+\\)?" + "\\([eE][-+]?[0-9]+\\)?" + "\\>") + '(0 mdw-number-face)) + (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/" + '(0 mdw-punct-face))))) + + (mdw-post-config-mode-hack)) + +;;;-------------------------------------------------------------------------- +;;; REXX configuration. (defun mdw-rexx-electric-* () (interactive) @@ -1604,8 +2308,7 @@ strip numbers instead." (defun mdw-fontify-rexx () - ;; --- Various bits of fiddling --- - + ;; 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-*) @@ -1613,8 +2316,7 @@ strip numbers instead." '(?! ?? ?# ?@ ?$)) (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)") - ;; --- Set up keywords and things for fontification --- - + ;; Set up keywords and things for fontification. (make-local-variable 'font-lock-keywords-case-fold-search) (setq font-lock-keywords-case-fold-search t) @@ -1650,36 +2352,33 @@ strip numbers instead." (setq font-lock-keywords (list - ;; --- Set up the keywords defined above --- - + ;; Set up the keywords defined above. (list (concat "\\<\\(" rexx-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- Fontify all symbols the same way --- - + ;; 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 --- - + ;; And everything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) -;;;----- Standard ML programming style -------------------------------------- + (mdw-post-config-mode-hack)) -(defun mdw-fontify-sml () +;;;-------------------------------------------------------------------------- +;;; Standard ML programming style. - ;; --- Make underscore an honorary letter --- +(defun mdw-fontify-sml () + ;; Make underscore an honorary letter. (modify-syntax-entry ?' "w") - ;; --- Set fill prefix --- - + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)") - ;; --- Now define fontification things --- - + ;; Now define fontification things. (make-local-variable 'font-lock-keywords) (let ((sml-keywords (mdw-regexps "abstype" "and" "andalso" "as" @@ -1701,13 +2400,11 @@ strip numbers instead." (setq font-lock-keywords (list - ;; --- Set up the keywords defined above --- - + ;; Set up the keywords defined above. (list (concat "\\<\\(" sml-keywords "\\)\\>") '(0 font-lock-keyword-face)) - ;; --- At least numbers are simpler than C --- - + ;; At least numbers are simpler than C. (list (concat "\\<\\(\\~\\|\\)" "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|" "[wW][0-9]+\\)\\|" @@ -1716,63 +2413,103 @@ strip numbers instead." "[0-9]+\\|\\)\\)\\)") '(0 mdw-number-face)) - ;; --- And anything else is punctuation --- - + ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) -;;;----- Haskell configuration ---------------------------------------------- + (mdw-post-config-mode-hack)) -(defun mdw-fontify-haskell () +;;;-------------------------------------------------------------------------- +;;; Haskell configuration. - ;; --- Fiddle with syntax table to get comments right --- +(defun mdw-fontify-haskell () - (modify-syntax-entry ?' "\"") - (modify-syntax-entry ?- ". 123") - (modify-syntax-entry ?{ ". 1b") - (modify-syntax-entry ?} ". 4b") + ;; Fiddle with syntax table to get comments right. + (modify-syntax-entry ?' "_") + (modify-syntax-entry ?- ". 12") (modify-syntax-entry ?\n ">") - ;; --- Set fill prefix --- + ;; Make punctuation be punctuation + (let ((punct "=<>+-*/|&%!@?$.^:#`")) + (do ((i 0 (1+ i))) + ((>= i (length punct))) + (modify-syntax-entry (aref punct i) "."))) + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)") - ;; --- Fiddle with fontification --- - + ;; Fiddle with fontification. (make-local-variable 'font-lock-keywords) (let ((haskell-keywords - (mdw-regexps "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"))) + (mdw-regexps "as" + "case" "ccall" "class" + "data" "default" "deriving" "do" + "else" "exists" + "forall" "foreign" + "hiding" + "if" "import" "in" "infix" "infixl" "infixr" "instance" + "let" + "mdo" "module" + "newtype" + "of" + "proc" + "qualified" + "rec" + "safe" "stdcall" + "then" "type" + "unsafe" + "where")) + (control-sequences + (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4" + "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF" + "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH" + "SP" "STX" "SUB" "SYN" "US" "VT"))) (setq font-lock-keywords (list - (list "--.*$" + (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*" + "\\(-+}\\|-*\\'\\)" + "\\|" + "--.*$") '(0 font-lock-comment-face)) - (list (concat "\\<\\(" haskell-keywords "\\)\\>") + (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]*\\|\\)" + (list (concat "'\\(" + "[^\\]" + "\\|" + "\\\\" + "\\(" "[abfnrtv\\\"']" "\\|" + "^" "\\(" control-sequences "\\|" + "[]A-Z@[\\^_]" "\\)" "\\|" + "\\|" + "[0-9]+" "\\|" + "[oO][0-7]+" "\\|" + "[xX][0-9A-Fa-f]+" + "\\)" + "\\)'") + '(0 font-lock-string-face)) + (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>" + '(0 font-lock-variable-name-face)) + (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|" + "\\_<[0-9]+\\(\\.[0-9]*\\|\\)" "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)") '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) -;;;----- Erlang configuration ----------------------------------------------- + (mdw-post-config-mode-hack)) -(setq erlang-electric-commannds - '(erlang-electric-newline erlang-electric-semicolon)) +;;;-------------------------------------------------------------------------- +;;; Erlang configuration. -(defun mdw-fontify-erlang () +(setq erlang-electric-commands nil) - ;; --- Set fill prefix --- +(defun mdw-fontify-erlang () + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)") - ;; --- Fiddle with fontification --- - + ;; Fiddle with fontification. (make-local-variable 'font-lock-keywords) (let ((erlang-keywords (mdw-regexps "after" "and" "andalso" @@ -1793,133 +2530,122 @@ strip numbers instead." (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>" '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))))) + '(0 mdw-punct-face))))) -;;;----- Texinfo configuration ---------------------------------------------- + (mdw-post-config-mode-hack)) -(defun mdw-fontify-texinfo () +;;;-------------------------------------------------------------------------- +;;; Texinfo configuration. - ;; --- Set fill prefix --- +(defun mdw-fontify-texinfo () + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)") - ;; --- Real fontification things --- - + ;; Real fontification things. (make-local-variable 'font-lock-keywords) (setq font-lock-keywords (list - ;; --- Environment names are keywords --- - + ;; Environment names are keywords. (list "@\\(end\\) *\\([a-zA-Z]*\\)?" '(2 font-lock-keyword-face)) - ;; --- Unmark escaped magic characters --- - + ;; Unmark escaped magic characters. (list "\\(@\\)\\([@{}]\\)" '(1 font-lock-keyword-face) '(2 font-lock-variable-name-face)) - ;; --- Make sure we get comments properly --- - + ;; Make sure we get comments properly. (list "@c\\(\\|omment\\)\\( .*\\)?$" '(0 font-lock-comment-face)) - ;; --- Command names are keywords --- - + ;; Command names are keywords. (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)" '(0 font-lock-keyword-face)) - ;; --- Fontify TeX special characters as punctuation --- - + ;; Fontify TeX special characters as punctuation. (list "[{}]+" - '(0 mdw-punct-face))))) + '(0 mdw-punct-face)))) -;;;----- TeX and LaTeX configuration ---------------------------------------- + (mdw-post-config-mode-hack)) + +;;;-------------------------------------------------------------------------- +;;; TeX and LaTeX configuration. (defun mdw-fontify-tex () (setq ispell-parser 'tex) (turn-on-reftex) - ;; --- Don't make maths into a string --- - + ;; 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 --- - + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)") - ;; --- Real fontification things --- - + ;; Real fontification things. (make-local-variable 'font-lock-keywords) (setq font-lock-keywords (list - ;; --- Environment names are keywords --- - + ;; Environment names are keywords. (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)" "{\\([^}\n]*\\)}") '(2 font-lock-keyword-face)) - ;; --- Suspended environment names are keywords too --- - + ;; Suspended environment names are keywords too. (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?" "{\\([^}\n]*\\)}") '(3 font-lock-keyword-face)) - ;; --- Command names are keywords --- - + ;; Command names are keywords. (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)" '(0 font-lock-keyword-face)) - ;; --- Handle @/.../ for italics --- - + ;; Handle @/.../ for italics. ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)" ;; '(1 font-lock-keyword-face) ;; '(3 font-lock-keyword-face)) - ;; --- Handle @*...* for boldness --- - + ;; Handle @*...* for boldness. ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)" ;; '(1 font-lock-keyword-face) ;; '(3 font-lock-keyword-face)) - ;; --- Handle @`...' for literal syntax things --- - + ;; Handle @`...' for literal syntax things. ;; (list "\\(@`\\)\\([^']*\\)\\('\\)" ;; '(1 font-lock-keyword-face) ;; '(3 font-lock-keyword-face)) - ;; --- Handle @<...> for nonterminals --- - + ;; Handle @<...> for nonterminals. ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)" ;; '(1 font-lock-keyword-face) ;; '(3 font-lock-keyword-face)) - ;; --- Handle other @-commands --- - + ;; Handle other @-commands. ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)" ;; '(0 font-lock-keyword-face)) - ;; --- Make sure we get comments properly --- - + ;; Make sure we get comments properly. (list "%.*" '(0 font-lock-comment-face)) - ;; --- Fontify TeX special characters as punctuation --- - + ;; Fontify TeX special characters as punctuation. (list "[$^_{}#&]" - '(0 mdw-punct-face))))) + '(0 mdw-punct-face)))) + + (mdw-post-config-mode-hack)) -;;;----- SGML hacking ------------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; SGML hacking. (defun mdw-sgml-mode () (interactive) (sgml-mode) (mdw-standard-fill-prefix "") - (make-variable-buffer-local 'sgml-delimiters) + (make-local-variable 'sgml-delimiters) (setq sgml-delimiters '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]" "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\"" @@ -1933,38 +2659,152 @@ strip numbers instead." (setq mode-name "[mdw] SGML") (run-hooks 'mdw-sgml-mode-hook)) -;;;----- Shell scripts ------------------------------------------------------ +;;;-------------------------------------------------------------------------- +;;; Configuration files. + +(defvar mdw-conf-quote-normal nil + "*Control syntax category of quote characters `\"' and `''. +If this is `t', consider quote characters to be normal +punctuation, as for `conf-quote-normal'. If this is `nil' then +leave quote characters as quotes. If this is a list, then +consider the quote characters in the list to be normal +punctuation. If this is a single quote character, then consider +that character only to be normal punctuation.") +(defun mdw-conf-quote-normal-acceptable-value-p (value) + "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?" + (or (booleanp value) + (every (lambda (v) (memq v '(?\" ?'))) + (if (listp value) value (list value))))) +(put 'mdw-conf-quote-normal 'safe-local-variable ' + mdw-conf-quote-normal-acceptable-value-p) + +(defun mdw-fix-up-quote () + "Apply the setting of `mdw-conf-quote-normal'." + (let ((flag mdw-conf-quote-normal)) + (cond ((eq flag t) + (conf-quote-normal t)) + ((not flag) + nil) + (t + (let ((table (copy-syntax-table (syntax-table)))) + (mapc (lambda (ch) (modify-syntax-entry ch "." table)) + (if (listp flag) flag (list flag))) + (set-syntax-table table) + (and font-lock-mode (font-lock-fontify-buffer))))))) +(defun mdw-fix-up-quote-hack () + "Unpleasant hack to call `mdw-fix-up-quote' at the right time. +Annoyingly, `hack-local-variables' is done after `set-auto-mode' +so we wouldn't see a local-variable setting of +`mdw-conf-quote-normal' in `conf-mode-hook'. Instead, wire +ourselves onto `hack-local-variables-hook' here, and check the +setting once it's actually been made." + (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t)) +(add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t) + +;;;-------------------------------------------------------------------------- +;;; Shell scripts. (defun mdw-setup-sh-script-mode () - ;; --- Fetch the shell interpreter's name --- - + ;; Fetch the shell interpreter's name. (let ((shell-name sh-shell-file)) - ;; --- Try reading the hash-bang line --- - + ;; 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 --- + ;; 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 --- - + ;; Now enable my keys and the fontification. (mdw-misc-mode-config) - ;; --- Set the indentation level correctly --- - + ;; Set the indentation level correctly. (setq sh-indentation 2) (setq sh-basic-offset 2)) -;;;----- Messages-file mode ------------------------------------------------- +(setq sh-shell-file "/bin/sh") + +;; Awful hacking to override the shell detection for particular scripts. +(defmacro define-custom-shell-mode (name shell) + `(defun ,name () + (interactive) + (set (make-local-variable 'sh-shell-file) ,shell) + (sh-mode))) +(define-custom-shell-mode bash-mode "/bin/bash") +(define-custom-shell-mode rc-mode "/usr/bin/rc") +(put 'sh-shell-file 'permanent-local t) + +;; Hack the rc syntax table. Backquotes aren't paired in rc. +(eval-after-load "sh-script" + '(or (assq 'rc sh-mode-syntax-table-input) + (let ((frag '(nil + ?# "<" + ?\n ">#" + ?\" "\"\"" + ?\' "\"\'" + ?$ "'" + ?\` "." + ?! "_" + ?% "_" + ?. "_" + ?^ "_" + ?~ "_" + ?, "_" + ?= "." + ?< "." + ?> ".")) + (assoc (assq 'rc sh-mode-syntax-table-input))) + (if assoc + (rplacd assoc frag) + (setq sh-mode-syntax-table-input + (cons (cons 'rc frag) + sh-mode-syntax-table-input)))))) + +;;;-------------------------------------------------------------------------- +;;; Emacs shell mode. + +(defun mdw-eshell-prompt () + (let ((left "[") (right "]")) + (when (= (user-uid) 0) + (setq left "«" right "»")) + (concat left + (save-match-data + (replace-regexp-in-string "\\..*$" "" (system-name))) + " " + (let* ((pwd (eshell/pwd)) (npwd (length pwd)) + (home (expand-file-name "~")) (nhome (length home))) + (if (and (>= npwd nhome) + (or (= nhome npwd) + (= (elt pwd nhome) ?/)) + (string= (substring pwd 0 nhome) home)) + (concat "~" (substring pwd (length home))) + pwd)) + right))) +(setq eshell-prompt-function 'mdw-eshell-prompt) +(setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)") + +(defun eshell/e (file) (find-file file) nil) +(defun eshell/ee (file) (find-file-other-window file) nil) +(defun eshell/w3m (url) (w3m-goto-url url) nil) + +(mdw-define-face eshell-prompt (t :weight bold)) +(mdw-define-face eshell-ls-archive (t :weight bold :foreground "red")) +(mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic)) +(mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic)) +(mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic)) +(mdw-define-face eshell-ls-executable (t :weight bold)) +(mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold)) +(mdw-define-face eshell-ls-readonly (t nil)) +(mdw-define-face eshell-ls-symlink (t :foreground "cyan")) + +;;;-------------------------------------------------------------------------- +;;; Messages-file mode. (defun messages-mode-guts () (setq messages-mode-syntax-table (make-syntax-table)) @@ -2018,7 +2858,6 @@ strip numbers instead." (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 () @@ -2045,14 +2884,14 @@ strip numbers instead." "\\)\\>\\|[0-9]+\\|$\\)\\)") '(1 font-lock-keyword-face))) messages-mode-keywords))) - (turn-on-font-lock-if-enabled) (run-hooks 'cpp-messages-mode-hook)) (add-hook 'messages-mode-hook 'mdw-misc-mode-config t) (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t) ; (add-hook 'messages-file-hook 'mdw-fontify-messages t) -;;;----- Messages-file mode ------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Messages-file mode. (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face "Face to use for subsittution directives.") @@ -2095,12 +2934,12 @@ strip numbers instead." (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 ------------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; NFast debugs. (defun nfast-debug-mode () (interactive) @@ -2137,17 +2976,17 @@ strip numbers instead." '("\\(\\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 ---------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Other languages. -;; --- Smalltalk --- +;; 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) + (make-local-variable 'mdw-auto-indent) (setq mdw-auto-indent nil) (local-set-key "\C-i" 'smalltalk-reindent)) @@ -2162,9 +3001,10 @@ strip numbers instead." "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)") '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face))))) + '(0 mdw-punct-face)))) + (mdw-post-config-mode-hack)) -;; --- Lispy languages --- +;; Lispy languages. ;; Unpleasant bodge. (unless (boundp 'slime-repl-mode-map) @@ -2185,7 +3025,7 @@ strip numbers instead." (multiple-value-bind . ((&whole 4 &rest 1) 4 &body)))))) (defun mdw-common-lisp-indent () - (make-variable-buffer-local 'lisp-indent-function) + (make-local-variable 'lisp-indent-function) (setq lisp-indent-function 'common-lisp-indent-function)) (setq lisp-simple-loop-indentation 2 @@ -2194,17 +3034,34 @@ strip numbers instead." (defun mdw-fontify-lispy () - ;; --- Set fill prefix --- - + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)") - ;; --- Not much fontification needed --- - + ;; Not much fontification needed. (make-local-variable 'font-lock-keywords) (setq font-lock-keywords - (list - (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face))))) + (list (list (concat "\\(" + "\\_<[-+]?" + "\\(" "[0-9]+/[0-9]+" + "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|" + "\\.[0-9]+" "\\)" + "\\([dDeEfFlLsS][-+]?[0-9]+\\)?" + "\\)" + "\\|" + "#" + "\\(" "x" "[-+]?" + "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?" + "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?" + "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?" + "\\|" "[0-9]+" "r" "[-+]?" + "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?" + "\\)" + "\\)\\_>") + '(0 mdw-number-face)) + (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" + '(0 mdw-punct-face)))) + + (mdw-post-config-mode-hack)) (defun comint-send-and-indent () (interactive) @@ -2213,9 +3070,17 @@ strip numbers instead." (indent-for-tab-command))) (defun mdw-setup-m4 () + + ;; Inexplicably, Emacs doesn't match braces in m4 mode. This is very + ;; annoying: fix it. + (modify-syntax-entry ?{ "(") + (modify-syntax-entry ?} ")") + + ;; Fill prefix. (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\\\)[ \t]*\\)")) -;;;----- Text mode ---------------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Text mode. (defun mdw-text-mode () (setq fill-column 72) @@ -2224,7 +3089,8 @@ strip numbers instead." "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3) (auto-fill-mode 1)) -;;;----- Outline mode ------------------------------------------------------- +;;;-------------------------------------------------------------------------- +;;; Outline and hide/show modes. (defun mdw-outline-collapse-all () "Completely collapse everything in the entire buffer." @@ -2235,7 +3101,13 @@ strip numbers instead." (hide-subtree) (forward-line)))) -;;;----- Shell mode --------------------------------------------------------- +(setq hs-hide-comments-when-hiding-all nil) + +(defadvice hs-hide-all (after hide-first-comment activate) + (save-excursion (hs-hide-initial-comment-block))) + +;;;-------------------------------------------------------------------------- +;;; Shell mode. (defun mdw-sh-mode-setup () (local-set-key [?\C-a] 'comint-bol) @@ -2267,6 +3139,35 @@ strip numbers instead." (define-key term-raw-map [M-left] 'term-send-meta-left) (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left))) +(defadvice term-exec (before program-args-list compile activate) + "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES). +This allows you to pass a list of arguments through `ansi-term'." + (let ((program (ad-get-arg 2))) + (if (listp program) + (progn + (ad-set-arg 2 (car program)) + (ad-set-arg 4 (cdr program)))))) + +(defun ssh (host) + "Open a terminal containing an ssh session to the HOST." + (interactive "sHost: ") + (ansi-term (list "ssh" host) (format "ssh@%s" host))) + +;;;-------------------------------------------------------------------------- +;;; Inferior Emacs Lisp. + +(setq comint-prompt-read-only t) + +(eval-after-load "comint" + '(progn + (define-key comint-mode-map "\C-w" 'comint-kill-region) + (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line))) + +(eval-after-load "ielm" + '(progn + (define-key ielm-map "\C-w" 'comint-kill-region) + (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line))) + ;;;----- That's all, folks -------------------------------------------------- (provide 'dot-emacs)