mdw@git.distorted.org.uk Git - profile/blob - dot-emacs.el

   1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
   2 ;;;
   3 ;;; $Id$
   4 ;;;
   5 ;;; Functions and macros for .emacs
   6 ;;;
   7 ;;; (c) 2004 Mark Wooding
   8 ;;;
   9
  10 ;;;----- Licensing notice ---------------------------------------------------
  11 ;;;
  12 ;;; This program is free software; you can redistribute it and/or modify
  13 ;;; it under the terms of the GNU General Public License as published by
  14 ;;; the Free Software Foundation; either version 2 of the License, or
  15 ;;; (at your option) any later version.
  16 ;;;
  17 ;;; This program is distributed in the hope that it will be useful,
  18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;;; GNU General Public License for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with this program; if not, write to the Free Software Foundation,
  24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 ;;;----- Some general utilities ---------------------------------------------
  27
  28 ;; --- Some error trapping ---
  29 ;;
  30 ;; If individual bits of this file go tits-up, we don't particularly want
  31 ;; the whole lot to stop right there and then, because it's bloody annoying.
  32
  33 (defmacro trap (&rest forms)
  34   "Execute FORMS without allowing errors to propagate outside."
  35   `(condition-case err
  36        ,(if (cdr forms) (cons 'progn forms) (car forms))
  37      (error (message "Error (trapped): %s in %s"
  38                      (error-message-string err)
  39                      ',forms))))
  40
  41 ;; --- Configuration reading ---
  42
  43 (defvar mdw-config nil)
  44 (defun mdw-config (sym)
  45   "Read the configuration variable named SYM."
  46   (unless mdw-config
  47     (setq mdw-config (with-temp-buffer
  48                        (insert-file-contents "~/.mdw.conf")
  49                        (replace-regexp "^[ \t]*\\(#.*\\|\\)\n" ""
  50                                        nil (point-min) (point-max))
  51                        (replace-regexp (concat "^[ \t]*"
  52                                                "\\([-a-zA-Z0-9_.]*\\)"
  53                                                "[ \t]*=[ \t]*"
  54                                                "\\(.*[^ \t\n]\\|\\)"
  55                                                "[ \t]**\\(\n\\|$\\)")
  56                                        "(\\1 . \"\\2\") "
  57                                        nil (point-min) (point-max))
  58                        (car (read-from-string
  59                              (concat "(" (buffer-string) ")"))))))
  60   (cdr (assq sym mdw-config)))
  61
  62 ;; --- Is an Emacs library available? ---
  63
  64 (defun library-exists-p (name)
  65   "Return non-nil if NAME.el (or NAME.elc) is somewhere on the Emacs load
  66 path.  The non-nil value is the filename we found for the library."
  67   (let ((path load-path) elt (foundp nil))
  68     (while (and path (not foundp))
  69       (setq elt (car path))
  70       (setq path (cdr path))
  71       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
  72                          (and (file-exists-p file) file))
  73                        (let ((file (concat elt "/" name ".el")))
  74                          (and (file-exists-p file) file)))))
  75     foundp))
  76
  77 (defun maybe-autoload (symbol file &optional docstring interactivep type)
  78   "Set an autoload if the file actually exists."
  79   (and (library-exists-p file)
  80        (autoload symbol file docstring interactivep type)))
  81
  82 ;; --- Splitting windows ---
  83
  84 (or (and (fboundp 'scroll-bar-columns)
  85          (fboundp 'fringe-columns))
  86     (progn
  87       (defun scroll-bar-columns (side)
  88         (cond ((eq side 'left) 0)
  89               (window-system 3)
  90               (t 1)))
  91       (defun fringe-columns (side)
  92         (cond ((not window-system) 0)
  93               ((eq side 'left) 1)
  94               (t 2)))))
  95
  96 (defun mdw-divvy-window (&optional w)
  97   "Split a wide window into appropriate widths."
  98   (interactive)
  99   (or w (setq w (if (and window-system
 100                          (>= emacs-major-version 22))
 101                     77
 102                   78)))
 103   (let* ((win (selected-window))
 104          (sb-width (if (not window-system)
 105                        1
 106                      (+ (scroll-bar-columns 'left)
 107                         (scroll-bar-columns 'right)
 108                         (fringe-columns 'left)
 109                         (fringe-columns 'right))))
 110          (c (/ (+ (window-width) sb-width)
 111                (+ w sb-width))))
 112     (while (> c 1)
 113       (setq c (1- c))
 114       (split-window-horizontally (+ w sb-width))
 115       (other-window 1))
 116     (select-window win)))
 117
 118 ;; --- Functions for sexp diary entries ---
 119
 120 (defun mdw-weekday (l)
 121   "Return non-nil if `date' falls on one of the days of the week in L.
 122
 123 L is a list of day numbers (from 0 to 6 for Sunday through to Saturday) or
 124 symbols `sunday', `monday', etc. (or a mixture).  If the date stored in
 125 `date' falls on a listed day, then the function returns non-nil."
 126   (let ((d (calendar-day-of-week date)))
 127     (or (memq d l)
 128         (memq (nth d '(sunday monday tuesday wednesday
 129                               thursday friday saturday)) l))))
 130
 131 (defun mdw-todo (&optional when)
 132   "Return non-nil today, or on WHEN, whichever is later."
 133   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 134         (d (calendar-absolute-from-gregorian date)))
 135     (if when
 136         (setq w (max w (calendar-absolute-from-gregorian
 137                         (cond
 138                          ((not european-calendar-style)
 139                           when)
 140                          ((> (car when) 100)
 141                           (list (nth 1 when)
 142                                 (nth 2 when)
 143                                 (nth 0 when)))
 144                          (t
 145                           (list (nth 1 when)
 146                                 (nth 0 when)
 147                                 (nth 2 when))))))))
 148     (eq w d)))
 149
 150 ;;;----- Utility functions --------------------------------------------------
 151
 152 (or (fboundp 'line-number-at-pos)
 153     (defun line-number-at-pos (&optional pos)
 154       (let ((opoint (or pos (point))) start)
 155         (save-excursion
 156           (save-restriction
 157             (goto-char (point-min))
 158             (widen)
 159             (forward-line 0)
 160             (setq start (point))
 161             (goto-char opoint)
 162             (forward-line 0)
 163             (1+ (count-lines 1 (point))))))))
 164
 165 ;; --- mdw-uniquify-alist ---
 166
 167 (defun mdw-uniquify-alist (&rest alists)
 168
 169   "Return the concatenation of the ALISTS with duplicate elements removed.
 170
 171 The first association with a given key prevails; others are ignored.  The
 172 input lists are not modified, although they'll probably become garbage."
 173
 174   (and alists
 175        (let ((start-list (cons nil nil)))
 176          (mdw-do-uniquify start-list
 177                           start-list
 178                           (car alists)
 179                           (cdr alists)))))
 180
 181 ;; --- mdw-do-uniquify ---
 182 ;;
 183 ;; The DONE argument is a list whose first element is `nil'.  It contains the
 184 ;; uniquified alist built so far.  The leading `nil' is stripped off at the
 185 ;; end of the operation; it's only there so that DONE always references a
 186 ;; cons cell.  END refers to the final cons cell in the DONE list; it is
 187 ;; modified in place each time to avoid the overheads of `append'ing all the
 188 ;; time.  The L argument is the alist we're currently processing; the
 189 ;; remaining alists are given in REST.
 190
 191 (defun mdw-do-uniquify (done end l rest)
 192   "A helper function for mdw-uniquify-alist."
 193
 194   ;; --- There are several different cases to deal with here ---
 195
 196   (cond
 197
 198    ;; --- Current list isn't empty ---
 199    ;;
 200    ;; Add the first item to the DONE list if there's not an item with the
 201    ;; same KEY already there.
 202
 203    (l (or (assoc (car (car l)) done)
 204           (progn
 205             (setcdr end (cons (car l) nil))
 206             (setq end (cdr end))))
 207       (mdw-do-uniquify done end (cdr l) rest))
 208
 209    ;; --- The list we were working on is empty ---
 210    ;;
 211    ;; Shunt the next list into the current list position and go round again.
 212
 213    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
 214
 215    ;; --- Everything's done ---
 216    ;;
 217    ;; Remove the leading `nil' from the DONE list and return it.  Finished!
 218
 219    (t (cdr done))))
 220
 221 ;; --- Insert a date ---
 222
 223 (defun date ()
 224   "Insert the current date in a pleasing way."
 225   (interactive)
 226   (insert (save-excursion
 227             (let ((buffer (get-buffer-create "*tmp*")))
 228               (unwind-protect (progn (set-buffer buffer)
 229                                      (erase-buffer)
 230                                      (shell-command "date +%Y-%m-%d" t)
 231                                      (goto-char (mark))
 232                                      (delete-backward-char 1)
 233                                      (buffer-string))
 234                 (kill-buffer buffer))))))
 235
 236 ;; --- UUencoding ---
 237
 238 (defun uuencode (file &optional name)
 239   "UUencodes a file, maybe calling it NAME, into the current buffer."
 240   (interactive "fInput file name: ")
 241
 242   ;; --- If NAME isn't specified, then guess from the filename ---
 243
 244   (if (not name)
 245       (setq name
 246             (substring file
 247                        (or (string-match "[^/]*$" file) 0))))
 248
 249   (print (format "uuencode `%s' `%s'" file name))
 250
 251   ;; --- Now actually do the thing ---
 252
 253   (call-process "uuencode" file t nil name))
 254
 255 (defvar np-file "~/.np"
 256   "*Where the `now-playing' file is.")
 257
 258 (defun np (&optional arg)
 259   "Grabs a `now-playing' string."
 260   (interactive)
 261   (save-excursion
 262     (or arg (progn
 263               (goto-char (point-max))
 264               (insert "\nNP: ")
 265               (insert-file np-file)))))
 266
 267 (trap
 268   (require 'tramp)
 269   (require 'autorevert)
 270   (defun mdw-check-autorevert ()
 271     (if (and (buffer-file-name)
 272              (tramp-tramp-file-p (buffer-file-name)))
 273         (unless global-auto-revert-ignore-buffer
 274           (setq global-auto-revert-ignore-buffer 'tramp))
 275         (if (eq global-auto-revert-ignore-buffer 'tramp)
 276             (setq global-auto-revert-ignore-buffer nil))))
 277   (defadvice find-file (after mdw-autorevert activate)
 278     (mdw-check-autorevert))
 279   (defadvice write-file (after mdw-autorevert activate)
 280     (mdw-check-autorevert)))
 281
 282 (defun mdwmail-mode ()
 283   "Major mode for editing news and mail messages from external programs
 284 Not much right now.  Just support for doing MailCrypt stuff."
 285   (interactive)
 286   (kill-all-local-variables)
 287   (use-local-map text-mode-map)
 288   (setq local-abbrev-table text-mode-abbrev-table)
 289   (setq major-mode 'mdwmail-mode)
 290   (setq mode-name "[mdw] mail")
 291   (make-local-variable 'paragraph-separate)
 292   (make-local-variable 'paragraph-start)
 293   (setq paragraph-start (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 294                                 paragraph-start))
 295   (setq paragraph-separate (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 296                                    paragraph-separate))
 297   (run-hooks 'text-mode-hook 'mdwmail-mode-hook 'mail-setup-hook))
 298
 299 ;; --- How to encrypt in mdwmail ---
 300
 301 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
 302   (or start
 303       (setq start (save-excursion
 304                     (goto-char (point-min))
 305                     (or (search-forward "\n\n" nil t) (point-min)))))
 306   (or end
 307       (setq end (point-max)))
 308   (mc-encrypt-generic recip scm start end from sign))
 309
 310 ;; --- How to sign in mdwmail ---
 311
 312 (defun mdwmail-mc-sign (key scm start end uclr)
 313   (or start
 314       (setq start (save-excursion
 315                     (goto-char (point-min))
 316                     (or (search-forward "\n\n" nil t) (point-min)))))
 317   (or end
 318       (setq end (point-max)))
 319   (mc-sign-generic key scm start end uclr))
 320
 321 ;; --- Some signature mangling ---
 322
 323 (defun mdwmail-mangle-signature ()
 324   (save-excursion
 325     (goto-char (point-min))
 326     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
 327 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
 328
 329 ;;;----- URL viewing --------------------------------------------------------
 330
 331 (defun mdw-w3m-browse-url (url &optional new-session-p)
 332   "Invoke w3m on the URL in its current window, or at least a different one.
 333 If NEW-SESSION-P, start a new session."
 334   (interactive "sURL: \nP")
 335   (save-excursion
 336     (let ((window (selected-window)))
 337       (unwind-protect
 338           (progn
 339             (select-window (or (and (not new-session-p)
 340                                     (get-buffer-window "*w3m*"))
 341                                (progn
 342                                  (if (one-window-p t) (split-window))
 343                                  (get-lru-window))))
 344             (w3m-browse-url url new-session-p))
 345         (select-window window)))))
 346
 347 (defvar mdw-good-url-browsers
 348   '((w3m . mdw-w3m-browse-url)
 349     browse-url-w3
 350     browse-url-mozilla)
 351   "List of good browsers for mdw-good-url-browsers; each item is a browser
 352 function name, or a cons (CHECK . FUNC).  A symbol FOO stands for (FOO
 353 . FOO).")
 354
 355 (defun mdw-good-url-browser ()
 356   "Return a good URL browser.  Trundle the list of such things, finding the
 357 first item for which CHECK is fboundp, and returning the correponding FUNC."
 358   (let ((bs mdw-good-url-browsers) b check func answer)
 359     (while (and bs (not answer))
 360       (setq b (car bs)
 361             bs (cdr bs))
 362       (if (consp b)
 363           (setq check (car b) func (cdr b))
 364         (setq check b func b))
 365       (if (fboundp check)
 366           (setq answer func)))
 367     answer))
 368
 369 ;;;----- Paragraph filling --------------------------------------------------
 370
 371 ;; --- Useful variables ---
 372
 373 (defvar mdw-fill-prefix nil
 374   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.  If there's
 375 no fill prefix currently set (by the `fill-prefix' variable) and there's
 376 a match from one of the regexps here, it gets used to set the fill-prefix
 377 for the current operation.
 378
 379 The variable is a list of items of the form `REGEXP . PREFIX'; if the
 380 REGEXP matches, the PREFIX is used to set the fill prefix.  It in turn is
 381 a list of things:
 382
 383   STRING -- insert a literal string
 384   (match . N) -- insert the thing matched by bracketed subexpression N
 385   (pad . N) -- a string of whitespace the same width as subexpression N
 386   (expr . FORM) -- the result of evaluating FORM")
 387
 388 (make-variable-buffer-local 'mdw-fill-prefix)
 389
 390 (defvar mdw-hanging-indents
 391   "\\(\\(\\([*o]\\|--\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)[ \t]+\\)?\\)"
 392   "*Standard regular expression matching things which might be part of a
 393 hanging indent.  This is mainly useful in `auto-fill-mode'.")
 394
 395 ;; --- Setting things up ---
 396
 397 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
 398
 399 ;; --- Utility functions ---
 400
 401 (defun mdw-tabify (s)
 402   "Tabify the string S.  This is a horrid hack."
 403   (save-excursion
 404     (save-match-data
 405       (let (start end)
 406         (beginning-of-line)
 407         (setq start (point-marker))
 408         (insert s "\n")
 409         (setq end (point-marker))
 410         (tabify start end)
 411         (setq s (buffer-substring start (1- end)))
 412         (delete-region start end)
 413         (set-marker start nil)
 414         (set-marker end nil)
 415         s))))
 416
 417 (defun mdw-examine-fill-prefixes (l)
 418   "Given a list of dynamic fill prefixes, pick one which matches context and
 419 return the static fill prefix to use.  Point must be at the start of a line,
 420 and match data must be saved."
 421   (cond ((not l) nil)
 422                ((looking-at (car (car l)))
 423                 (mdw-tabify (apply (function concat)
 424                                    (mapcar (function mdw-do-prefix-match)
 425                                            (cdr (car l))))))
 426                (t (mdw-examine-fill-prefixes (cdr l)))))
 427
 428 (defun mdw-maybe-car (p)
 429   "If P is a pair, return (car P), otherwise just return P."
 430   (if (consp p) (car p) p))
 431
 432 (defun mdw-padding (s)
 433   "Return a string the same width as S but made entirely from whitespace."
 434   (let* ((l (length s)) (i 0) (n (make-string l ? )))
 435     (while (< i l)
 436       (if (= 9 (aref s i))
 437           (aset n i 9))
 438       (setq i (1+ i)))
 439     n))
 440
 441 (defun mdw-do-prefix-match (m)
 442   "Expand a dynamic prefix match element.  See `mdw-fill-prefix' for
 443 details."
 444   (cond ((not (consp m)) (format "%s" m))
 445            ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
 446            ((eq (car m) 'pad) (mdw-padding (match-string
 447                                             (mdw-maybe-car (cdr m)))))
 448            ((eq (car m) 'eval) (eval (cdr m)))
 449            (t "")))
 450
 451 (defun mdw-choose-dynamic-fill-prefix ()
 452   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
 453   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
 454            ((not mdw-fill-prefix) fill-prefix)
 455            (t (save-excursion
 456                 (beginning-of-line)
 457                 (save-match-data
 458                   (mdw-examine-fill-prefixes mdw-fill-prefix))))))
 459
 460 (defun do-auto-fill ()
 461   "Handle auto-filling, working out a dynamic fill prefix in the case where
 462 there isn't a sensible static one."
 463   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 464     (mdw-do-auto-fill)))
 465
 466 (defun mdw-fill-paragraph ()
 467   "Fill paragraph, getting a dynamic fill prefix."
 468   (interactive)
 469   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 470     (fill-paragraph nil)))
 471
 472 (defun mdw-standard-fill-prefix (rx &optional mat)
 473   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
 474 This is just a short-cut for setting the thing by hand, and by design it
 475 doesn't cope with anything approximating a complicated case."
 476   (setq mdw-fill-prefix
 477            `((,(concat rx mdw-hanging-indents)
 478               (match . 1)
 479               (pad . ,(or mat 2))))))
 480
 481 ;;;----- Other common declarations ------------------------------------------
 482
 483 (defun mdw-set-frame-transparency (&optional n)
 484   (interactive "P")
 485   (let* ((alist (frame-parameters))
 486          (trans (assq 'transparency alist)))
 487     (if trans
 488         (rplacd trans (not (if n (zerop n) (cdr trans))))
 489       (setq trans (cons 'transparency (not (equal 0 n)))))
 490     (modify-frame-parameters (selected-frame) (list trans))))
 491
 492 ;; --- Mouse wheel support ---
 493
 494 (defconst mdw-wheel-scroll-amount 15)
 495 (defun mdw-wheel-up (click)
 496   (interactive "@e")
 497   (mdw-wheel-scroll click (function scroll-down)))
 498 (defun mdw-wheel-down (click)
 499   (interactive "@e")
 500   (mdw-wheel-scroll click (function scroll-up)))
 501
 502 (defun mdw-wheel-scroll (click func)
 503   (let ((win (selected-window)))
 504     (unwind-protect
 505         (progn
 506           (select-window (posn-window (event-start click)))
 507           (let ((arg 2))
 508             (funcall func (/ (window-height) 2))))
 509       (select-window win))))
 510
 511 ;; --- Going backwards ---
 512
 513 (defun other-window-backwards (arg)
 514   (interactive "p")
 515   (other-window (- arg)))
 516
 517 ;; --- Common mode settings ---
 518
 519 (defvar mdw-auto-indent t
 520   "Whether to indent automatically after a newline.")
 521
 522 (defun mdw-misc-mode-config ()
 523   (and mdw-auto-indent
 524        (cond ((eq major-mode 'lisp-mode)
 525               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 526              ((or (eq major-mode 'slime-repl-mode)
 527                   (eq major-mode 'asm-mode))
 528               nil)
 529              (t
 530               (local-set-key "\C-m" 'newline-and-indent))))
 531   (local-set-key [C-return] 'newline)
 532   (or (eq major-mode 'asm-mode)
 533       (local-set-key [?\;] 'self-insert-command))
 534   (local-set-key [?\#] 'self-insert-command)
 535   (local-set-key [?\"] 'self-insert-command)
 536   (setq comment-column 40)
 537   (auto-fill-mode 1)
 538   (setq fill-column 77)
 539   (setq show-trailing-whitespace t)
 540   (mdw-set-font))
 541
 542 ;; --- Set up all sorts of faces ---
 543
 544 (defvar mdw-set-font nil)
 545
 546 (defvar mdw-punct-face 'mdw-punct-face "Face to use for punctuation")
 547 (make-face 'mdw-punct-face)
 548 (defvar mdw-number-face 'mdw-number-face "Face to use for numbers")
 549 (make-face 'mdw-number-face)
 550
 551 ;;;----- General fontification ----------------------------------------------
 552
 553 (defun mdw-set-fonts (frame faces)
 554   (while faces
 555     (let ((face (caar faces)))
 556       (or (facep face) (make-face face))
 557       (set-face-attribute face frame
 558                           :family 'unspecified
 559                           :width 'unspecified
 560                           :height 'unspecified
 561                           :weight 'unspecified
 562                           :slant 'unspecified
 563                           :foreground 'unspecified
 564                           :background 'unspecified
 565                           :underline 'unspecified
 566                           :overline 'unspecified
 567                           :strike-through 'unspecified
 568                           :box 'unspecified
 569                           :inverse-video 'unspecified
 570                           :stipple 'unspecified
 571                           ;:font 'unspecified
 572                           :inherit 'unspecified)
 573       (apply 'set-face-attribute face frame (cdar faces))
 574       (setq faces (cdr faces)))))
 575
 576 (defun mdw-do-set-font (&optional frame)
 577   (interactive)
 578   (mdw-set-fonts (and (boundp 'frame) frame)  `(
 579     (default :foreground "white" :background "black"
 580       ,@(cond ((eq window-system 'w32)
 581                '(:family "courier new" :height 85))
 582               ((eq window-system 'x)
 583                '(:family "misc-fixed" :height 130 :width semi-condensed))))
 584     (fixed-pitch)
 585     (minibuffer-prompt)
 586     (mode-line :foreground "blue" :background "yellow"
 587                :box (:line-width 1 :style released-button))
 588     (mode-line-inactive :foreground "yellow" :background "blue"
 589                         :box (:line-width 1 :style released-button))
 590     (scroll-bar :foreground "black" :background "lightgrey")
 591     (fringe :foreground "yellow" :background "black")
 592     (show-paren-match-face :background "darkgreen")
 593     (show-paren-mismatch-face :background "red")
 594     (font-lock-warning-face :background "red" :weight bold)
 595     (highlight :background "DarkSeaGreen4")
 596     (holiday-face :background "red")
 597     (calendar-today-face :foreground "yellow" :weight bold)
 598     (comint-highlight-prompt :weight bold)
 599     (comint-highlight-input)
 600     (font-lock-builtin-face :weight bold)
 601     (font-lock-type-face :weight bold)
 602     (region :background "grey30")
 603     (isearch :background "palevioletred2")
 604     (mdw-punct-face :foreground ,(if window-system "burlywood2" "yellow"))
 605     (mdw-number-face :foreground "yellow")
 606     (font-lock-function-name-face :weight bold)
 607     (font-lock-variable-name-face :slant italic)
 608     (font-lock-comment-delimiter-face
 609        :foreground ,(if window-system "SeaGreen1" "green")
 610        :slant italic)
 611     (font-lock-comment-face
 612        :foreground ,(if window-system "SeaGreen1" "green")
 613        :slant italic)
 614     (font-lock-string-face :foreground ,(if window-system "SkyBlue1" "cyan"))
 615     (font-lock-keyword-face :weight bold)
 616     (font-lock-constant-face :weight bold)
 617     (font-lock-reference-face :weight bold)
 618     (woman-bold-face :weight bold)
 619     (woman-italic-face :slant italic)
 620     (diff-index :weight bold)
 621     (diff-file-header :weight bold)
 622     (diff-hunk-header :foreground "SkyBlue1")
 623     (diff-function :foreground "SkyBlue1" :weight bold)
 624     (diff-header :background "grey10")
 625     (diff-added :foreground "green")
 626     (diff-removed :foreground "red")
 627     (diff-context)
 628     (whizzy-slice-face :background "grey10")
 629     (whizzy-error-face :background "darkred")
 630     (trailing-whitespace :background "red")
 631 )))
 632
 633 (defun mdw-set-font ()
 634   (trap
 635     (turn-on-font-lock)
 636     (if (not mdw-set-font)
 637         (progn
 638           (setq mdw-set-font t)
 639           (mdw-do-set-font nil)))))
 640
 641 ;;;----- C programming configuration ----------------------------------------
 642
 643 ;; --- Linux kernel hacking ---
 644
 645 (defvar linux-c-mode-hook)
 646
 647 (defun linux-c-mode ()
 648   (interactive)
 649   (c-mode)
 650   (setq major-mode 'linux-c-mode)
 651   (setq mode-name "Linux C")
 652   (run-hooks 'linux-c-mode-hook))
 653
 654 ;; --- Make C indentation nice ---
 655
 656 (defun mdw-c-style ()
 657   (c-add-style "[mdw] C and C++ style"
 658                '((c-basic-offset . 2)
 659                  (c-tab-always-indent . nil)
 660                  (comment-column . 40)
 661                  (c-class-key . "class")
 662                  (c-offsets-alist (substatement-open . 0)
 663                                   (label . 0)
 664                                   (case-label . +)
 665                                   (access-label . -)
 666                                   (inclass . +)
 667                                   (inline-open . ++)
 668                                   (statement-cont . 0)
 669                                   (statement-case-intro . +)))
 670                t))
 671
 672 (defun mdw-fontify-c-and-c++ ()
 673
 674   ;; --- Fiddle with some syntax codes ---
 675
 676   (modify-syntax-entry ?_ "w")
 677   (modify-syntax-entry ?* ". 23")
 678   (modify-syntax-entry ?/ ". 124b")
 679   (modify-syntax-entry ?\n "> b")
 680
 681   ;; --- Other stuff ---
 682
 683   (mdw-c-style)
 684   (setq c-hanging-comment-ender-p nil)
 685   (setq c-backslash-column 72)
 686   (setq c-label-minimum-indentation 0)
 687   (setq mdw-fill-prefix
 688         `((,(concat "\\([ \t]*/?\\)"
 689                     "\\([\*/][ \t]*\\)"
 690                     "\\([A-Za-z]+:[ \t]*\\)?"
 691                     mdw-hanging-indents)
 692            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
 693
 694   ;; --- Now define things to be fontified ---
 695
 696   (make-local-variable 'font-lock-keywords)
 697   (let ((c-keywords
 698          (make-regexp '(
 699                         "and"           ;C++
 700                         "and_eq"        ;C++
 701                         "asm"           ;K&R, GCC
 702                         "auto"          ;K&R, C89
 703                         "bitand"        ;C++
 704                         "bitor"         ;C++
 705                         "bool"          ;C++, C9X macro
 706                         "break"         ;K&R, C89
 707                         "case"          ;K&R, C89
 708                         "catch"         ;C++
 709                         "char"          ;K&R, C89
 710                         "class"         ;C++
 711                         "complex"       ;C9X macro, C++ template type
 712                         "compl"         ;C++
 713                         "const"         ;C89
 714                         "const_cast"    ;C++
 715                         "continue"      ;K&R, C89
 716                         "defined"       ;C89 preprocessor
 717                         "default"       ;K&R, C89
 718                         "delete"        ;C++
 719                         "do"            ;K&R, C89
 720                         "double"        ;K&R, C89
 721                         "dynamic_cast"  ;C++
 722                         "else"          ;K&R, C89
 723                         ;; "entry"      ;K&R -- never used
 724                         "enum"          ;C89
 725                         "explicit"      ;C++
 726                         "export"        ;C++
 727                         "extern"        ;K&R, C89
 728                         "false"         ;C++, C9X macro
 729                         "float"         ;K&R, C89
 730                         "for"           ;K&R, C89
 731                         ;; "fortran"    ;K&R
 732                         "friend"        ;C++
 733                         "goto"          ;K&R, C89
 734                         "if"            ;K&R, C89
 735                         "imaginary"     ;C9X macro
 736                         "inline"        ;C++, C9X, GCC
 737                         "int"           ;K&R, C89
 738                         "long"          ;K&R, C89
 739                         "mutable"       ;C++
 740                         "namespace"     ;C++
 741                         "new"           ;C++
 742                         "operator"      ;C++
 743                         "or"            ;C++
 744                         "or_eq"         ;C++
 745                         "private"       ;C++
 746                         "protected"     ;C++
 747                         "public"        ;C++
 748                         "register"      ;K&R, C89
 749                         "reinterpret_cast" ;C++
 750                         "restrict"      ;C9X
 751                         "return"        ;K&R, C89
 752                         "short"         ;K&R, C89
 753                         "signed"        ;C89
 754                         "sizeof"        ;K&R, C89
 755                         "static"        ;K&R, C89
 756                         "static_cast"   ;C++
 757                         "struct"        ;K&R, C89
 758                         "switch"        ;K&R, C89
 759                         "template"      ;C++
 760                         "this"          ;C++
 761                         "throw"         ;C++
 762                         "true"          ;C++, C9X macro
 763                         "try"           ;C++
 764                         "this"          ;C++
 765                         "typedef"       ;C89
 766                         "typeid"        ;C++
 767                         "typeof"        ;GCC
 768                         "typename"      ;C++
 769                         "union"         ;K&R, C89
 770                         "unsigned"      ;K&R, C89
 771                         "using"         ;C++
 772                         "virtual"       ;C++
 773                         "void"          ;C89
 774                         "volatile"      ;C89
 775                         "wchar_t"       ;C++, C89 library type
 776                         "while"         ;K&R, C89
 777                         "xor"           ;C++
 778                         "xor_eq"        ;C++
 779                         "_Bool"         ;C9X
 780                         "_Complex"      ;C9X
 781                         "_Imaginary"    ;C9X
 782                         "_Pragma"       ;C9X preprocessor
 783                         "__alignof__"   ;GCC
 784                         "__asm__"       ;GCC
 785                         "__attribute__" ;GCC
 786                         "__complex__"   ;GCC
 787                         "__const__"     ;GCC
 788                         "__extension__" ;GCC
 789                         "__imag__"      ;GCC
 790                         "__inline__"    ;GCC
 791                         "__label__"     ;GCC
 792                         "__real__"      ;GCC
 793                         "__signed__"    ;GCC
 794                         "__typeof__"    ;GCC
 795                         "__volatile__"  ;GCC
 796                         )))
 797         (preprocessor-keywords
 798          (make-regexp '("assert" "define" "elif" "else" "endif" "error"
 799                         "ident" "if" "ifdef" "ifndef" "import" "include"
 800                         "line" "pragma" "unassert" "undef" "warning")))
 801         (objc-keywords
 802          (make-regexp '("class" "defs" "encode" "end" "implementation"
 803                         "interface" "private" "protected" "protocol" "public"
 804                         "selector"))))
 805
 806     (setq font-lock-keywords
 807           (list
 808
 809            ;; --- Fontify include files as strings ---
 810
 811            (list (concat "^[ \t]*\\#[ \t]*"
 812                          "\\(include\\|import\\)"
 813                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
 814                  '(2 font-lock-string-face))
 815
 816            ;; --- Preprocessor directives are `references'? ---
 817
 818            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
 819                          preprocessor-keywords
 820                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
 821                  '(1 font-lock-keyword-face))
 822
 823            ;; --- Handle the keywords defined above ---
 824
 825            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
 826                  '(0 font-lock-keyword-face))
 827
 828            (list (concat "\\<\\(" c-keywords "\\)\\>")
 829                  '(0 font-lock-keyword-face))
 830
 831            ;; --- Handle numbers too ---
 832            ;;
 833            ;; This looks strange, I know.  It corresponds to the
 834            ;; preprocessor's idea of what a number looks like, rather than
 835            ;; anything sensible.
 836
 837            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
 838                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
 839                  '(0 mdw-number-face))
 840
 841            ;; --- And anything else is punctuation ---
 842
 843            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
 844                  '(0 mdw-punct-face))))))
 845
 846 ;;;----- AP calc mode -------------------------------------------------------
 847
 848 (defun apcalc-mode ()
 849   (interactive)
 850   (c-mode)
 851   (setq major-mode 'apcalc-mode)
 852   (setq mode-name "AP Calc")
 853   (run-hooks 'apcalc-mode-hook))
 854
 855 (defun mdw-fontify-apcalc ()
 856
 857   ;; --- Fiddle with some syntax codes ---
 858
 859   (modify-syntax-entry ?_ "w")
 860   (modify-syntax-entry ?* ". 23")
 861   (modify-syntax-entry ?/ ". 14")
 862
 863   ;; --- Other stuff ---
 864
 865   (mdw-c-style)
 866   (setq c-hanging-comment-ender-p nil)
 867   (setq c-backslash-column 72)
 868   (setq comment-start "/* ")
 869   (setq comment-end " */")
 870   (setq mdw-fill-prefix
 871         `((,(concat "\\([ \t]*/?\\)"
 872                     "\\([\*/][ \t]*\\)"
 873                     "\\([A-Za-z]+:[ \t]*\\)?"
 874                     mdw-hanging-indents)
 875            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
 876
 877   ;; --- Now define things to be fontified ---
 878
 879   (make-local-variable 'font-lock-keywords)
 880   (let ((c-keywords
 881          (make-regexp '("break" "case" "cd" "continue" "define" "default"
 882                         "do" "else" "exit" "for" "global" "goto" "help" "if"
 883                         "local" "mat" "obj" "print" "quit" "read" "return"
 884                         "show" "static" "switch" "while" "write"))))
 885
 886     (setq font-lock-keywords
 887           (list
 888
 889            ;; --- Handle the keywords defined above ---
 890
 891            (list (concat "\\<\\(" c-keywords "\\)\\>")
 892                  '(0 font-lock-keyword-face))
 893
 894            ;; --- Handle numbers too ---
 895            ;;
 896            ;; This looks strange, I know.  It corresponds to the
 897            ;; preprocessor's idea of what a number looks like, rather than
 898            ;; anything sensible.
 899
 900            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
 901                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
 902                  '(0 mdw-number-face))
 903
 904            ;; --- And anything else is punctuation ---
 905
 906            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
 907                  '(0 mdw-punct-face))))))
 908
 909 ;;;----- Java programming configuration -------------------------------------
 910
 911 ;; --- Make indentation nice ---
 912
 913 (defun mdw-java-style ()
 914   (c-add-style "[mdw] Java style"
 915                '((c-basic-offset . 2)
 916                  (c-tab-always-indent . nil)
 917                  (c-offsets-alist (substatement-open . 0)
 918                                   (label . +)
 919                                   (case-label . +)
 920                                   (access-label . 0)
 921                                   (inclass . +)
 922                                   (statement-case-intro . +)))
 923                t))
 924
 925 ;; --- Declare Java fontification style ---
 926
 927 (defun mdw-fontify-java ()
 928
 929   ;; --- Other stuff ---
 930
 931   (mdw-java-style)
 932   (modify-syntax-entry ?_ "w")
 933   (setq c-hanging-comment-ender-p nil)
 934   (setq c-backslash-column 72)
 935   (setq comment-start "/* ")
 936   (setq comment-end " */")
 937   (setq mdw-fill-prefix
 938         `((,(concat "\\([ \t]*/?\\)"
 939                     "\\([\*/][ \t]*\\)"
 940                     "\\([A-Za-z]+:[ \t]*\\)?"
 941                     mdw-hanging-indents)
 942            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
 943
 944   ;; --- Now define things to be fontified ---
 945
 946   (make-local-variable 'font-lock-keywords)
 947   (let ((java-keywords
 948          (make-regexp '("abstract" "boolean" "break" "byte" "case" "catch"
 949                         "char" "class" "const" "continue" "default" "do"
 950                         "double" "else" "extends" "final" "finally" "float"
 951                         "for" "goto" "if" "implements" "import" "instanceof"
 952                         "int" "interface" "long" "native" "new" "package"
 953                         "private" "protected" "public" "return" "short"
 954                         "static" "super" "switch" "synchronized" "this"
 955                         "throw" "throws" "transient" "try" "void" "volatile"
 956                         "while"
 957
 958                         "false" "null" "true"))))
 959
 960     (setq font-lock-keywords
 961           (list
 962
 963            ;; --- Handle the keywords defined above ---
 964
 965            (list (concat "\\<\\(" java-keywords "\\)\\>")
 966                  '(0 font-lock-keyword-face))
 967
 968            ;; --- Handle numbers too ---
 969            ;;
 970            ;; The following isn't quite right, but it's close enough.
 971
 972            (list (concat "\\<\\("
 973                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
 974                          "[0-9]+\\(\\.[0-9]*\\|\\)"
 975                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
 976                          "[lLfFdD]?")
 977                  '(0 mdw-number-face))
 978
 979            ;; --- And anything else is punctuation ---
 980
 981            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
 982                  '(0 mdw-punct-face))))))
 983
 984 ;;;----- C# programming configuration ---------------------------------------
 985
 986 ;; --- Make indentation nice ---
 987
 988 (defun mdw-csharp-style ()
 989   (c-add-style "[mdw] C# style"
 990                '((c-basic-offset . 2)
 991                  (c-tab-always-indent . nil)
 992                  (c-offsets-alist (substatement-open . 0)
 993                                   (label . 0)
 994                                   (case-label . +)
 995                                   (access-label . 0)
 996                                   (inclass . +)
 997                                   (statement-case-intro . +)))
 998                t))
 999
1000 ;; --- Declare C# fontification style ---
1001
1002 (defun mdw-fontify-csharp ()
1003
1004   ;; --- Other stuff ---
1005
1006   (mdw-csharp-style)
1007   (modify-syntax-entry ?_ "w")
1008   (setq c-hanging-comment-ender-p nil)
1009   (setq c-backslash-column 72)
1010   (setq comment-start "/* ")
1011   (setq comment-end " */")
1012   (setq mdw-fill-prefix
1013         `((,(concat "\\([ \t]*/?\\)"
1014                     "\\([\*/][ \t]*\\)"
1015                     "\\([A-Za-z]+:[ \t]*\\)?"
1016                     mdw-hanging-indents)
1017            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1018
1019   ;; --- Now define things to be fontified ---
1020
1021   (make-local-variable 'font-lock-keywords)
1022   (let ((csharp-keywords
1023          (make-regexp '("abstract" "as" "base" "bool" "break"
1024                         "byte" "case" "catch" "char" "checked"
1025                         "class" "const" "continue" "decimal" "default"
1026                         "delegate" "do" "double" "else" "enum"
1027                         "event" "explicit" "extern" "false" "finally"
1028                         "fixed" "float" "for" "foreach" "goto"
1029                         "if" "implicit" "in" "int" "interface"
1030                         "internal" "is" "lock" "long" "namespace"
1031                         "new" "null" "object" "operator" "out"
1032                         "override" "params" "private" "protected" "public"
1033                         "readonly" "ref" "return" "sbyte" "sealed"
1034                         "short" "sizeof" "stackalloc" "static" "string"
1035                         "struct" "switch" "this" "throw" "true"
1036                         "try" "typeof" "uint" "ulong" "unchecked"
1037                         "unsafe" "ushort" "using" "virtual" "void"
1038                         "volatile" "while" "yield"))))
1039
1040     (setq font-lock-keywords
1041           (list
1042
1043            ;; --- Handle the keywords defined above ---
1044
1045            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1046                  '(0 font-lock-keyword-face))
1047
1048            ;; --- Handle numbers too ---
1049            ;;
1050            ;; The following isn't quite right, but it's close enough.
1051
1052            (list (concat "\\<\\("
1053                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1054                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1055                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1056                          "[lLfFdD]?")
1057                  '(0 mdw-number-face))
1058
1059            ;; --- And anything else is punctuation ---
1060
1061            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1062                  '(0 mdw-punct-face))))))
1063
1064 (defun csharp-mode ()
1065   (interactive)
1066   (java-mode)
1067   (setq major-mode 'csharp-mode)
1068   (setq mode-name "C#")
1069   (mdw-fontify-csharp)
1070   (run-hooks 'csharp-mode-hook))
1071
1072 ;;;----- Awk programming configuration --------------------------------------
1073
1074 ;; --- Make Awk indentation nice ---
1075
1076 (defun mdw-awk-style ()
1077   (c-add-style "[mdw] Awk style"
1078                '((c-basic-offset . 2)
1079                  (c-tab-always-indent . nil)
1080                  (c-offsets-alist (substatement-open . 0)
1081                                   (statement-cont . 0)
1082                                   (statement-case-intro . +)))
1083                t))
1084
1085 ;; --- Declare Awk fontification style ---
1086
1087 (defun mdw-fontify-awk ()
1088
1089   ;; --- Miscellaneous fiddling ---
1090
1091   (modify-syntax-entry ?_ "w")
1092   (mdw-awk-style)
1093   (setq c-backslash-column 72)
1094   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1095
1096   ;; --- Now define things to be fontified ---
1097
1098   (make-local-variable 'font-lock-keywords)
1099   (let ((c-keywords
1100          (make-regexp '("BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1101                         "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1102                         "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1103                         "RSTART" "RLENGTH" "RT" "SUBSEP"
1104                         "atan2" "break" "close" "continue" "cos" "delete"
1105                         "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1106                         "function" "gensub" "getline" "gsub" "if" "in"
1107                         "index" "int" "length" "log" "match" "next" "rand"
1108                         "return" "print" "printf" "sin" "split" "sprintf"
1109                         "sqrt" "srand" "strftime" "sub" "substr" "system"
1110                         "systime" "tolower" "toupper" "while"))))
1111
1112     (setq font-lock-keywords
1113           (list
1114
1115            ;; --- Handle the keywords defined above ---
1116
1117            (list (concat "\\<\\(" c-keywords "\\)\\>")
1118                  '(0 font-lock-keyword-face))
1119
1120            ;; --- Handle numbers too ---
1121            ;;
1122            ;; The following isn't quite right, but it's close enough.
1123
1124            (list (concat "\\<\\("
1125                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1126                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1127                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1128                          "[uUlL]*")
1129                  '(0 mdw-number-face))
1130
1131            ;; --- And anything else is punctuation ---
1132
1133            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1134                  '(0 mdw-punct-face))))))
1135
1136 ;;;----- Perl programming style ---------------------------------------------
1137
1138 ;; --- Perl indentation style ---
1139
1140 (setq cperl-tab-always-indent nil)
1141
1142 (setq cperl-indent-level 2)
1143 (setq cperl-continued-statement-offset 2)
1144 (setq cperl-continued-brace-offset 0)
1145 (setq cperl-brace-offset -2)
1146 (setq cperl-brace-imaginary-offset 0)
1147 (setq cperl-label-offset 0)
1148
1149 ;; --- Define perl fontification style ---
1150
1151 (defun mdw-fontify-perl ()
1152
1153   ;; --- Miscellaneous fiddling ---
1154
1155   (modify-syntax-entry ?_ "w")
1156   (modify-syntax-entry ?$ "\\")
1157   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1158   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1159
1160   ;; --- Now define fontification things ---
1161
1162   (make-local-variable 'font-lock-keywords)
1163   (let ((perl-keywords
1164          (make-regexp '("and" "cmp" "continue" "do" "else" "elsif" "eq"
1165                         "for" "foreach" "ge" "gt" "goto" "if"
1166                         "last" "le" "lt" "local" "my" "ne" "next" "or"
1167                         "package" "redo" "require" "return" "sub"
1168                         "undef" "unless" "until" "use" "while"))))
1169
1170     (setq font-lock-keywords
1171           (list
1172
1173            ;; --- Set up the keywords defined above ---
1174
1175            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1176                  '(0 font-lock-keyword-face))
1177
1178            ;; --- At least numbers are simpler than C ---
1179
1180            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1181                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1182                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1183                  '(0 mdw-number-face))
1184
1185            ;; --- And anything else is punctuation ---
1186
1187            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1188                  '(0 mdw-punct-face))))))
1189
1190 (defun perl-number-tests (&optional arg)
1191   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1192 strip numbers instead."
1193   (interactive "P")
1194   (save-excursion
1195     (goto-char (point-min))
1196     (let ((i 0) (fmt (if arg "" " %4d")))
1197       (while (search-forward "#t" nil t)
1198         (delete-region (point) (line-end-position))
1199         (setq i (1+ i))
1200         (insert (format fmt i)))
1201       (goto-char (point-min))
1202       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1203           (replace-match (format "\\1%d" i))))))
1204
1205 ;;;----- Python programming style -------------------------------------------
1206
1207 ;; --- Define Python fontification style ---
1208
1209 (trap (require 'pyrex-mode))
1210 (defun mdw-fontify-python ()
1211
1212   ;; --- Miscellaneous fiddling ---
1213
1214   (modify-syntax-entry ?_ "w")
1215   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1216
1217   ;; --- Now define fontification things ---
1218
1219   (make-local-variable 'font-lock-keywords)
1220   (let ((python-keywords
1221          (make-regexp '("and" "as" "assert" "break" "class" "continue" "def"
1222                         "del" "elif" "else" "except" "exec" "finally" "for"
1223                         "from" "global" "if" "import" "in" "is" "lambda"
1224                         "not" "or" "pass" "print" "raise" "return" "try"
1225                         "while" "yield"))))
1226     (setq font-lock-keywords
1227           (list
1228
1229            ;; --- Set up the keywords defined above ---
1230
1231            (list (concat "\\<\\(" python-keywords "\\)\\>")
1232                  '(0 font-lock-keyword-face))
1233
1234            ;; --- At least numbers are simpler than C ---
1235
1236            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1237                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1238                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1239                  '(0 mdw-number-face))
1240
1241            ;; --- And anything else is punctuation ---
1242
1243            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1244                  '(0 mdw-punct-face))))))
1245
1246 ;;;----- ARM assembler programming configuration ----------------------------
1247
1248 ;; --- There doesn't appear to be an Emacs mode for this yet ---
1249 ;;
1250 ;; Better do something about that, I suppose.
1251
1252 (defvar arm-assembler-mode-map nil)
1253 (defvar arm-assembler-abbrev-table nil)
1254 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1255
1256 (or arm-assembler-mode-map
1257     (progn
1258       (setq arm-assembler-mode-map (make-sparse-keymap))
1259       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1260       (define-key arm-assembler-mode-map [C-return] 'newline)
1261       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1262
1263 (defun arm-assembler-mode ()
1264   "Major mode for ARM assembler programs"
1265   (interactive)
1266
1267   ;; --- Do standard major mode things ---
1268
1269   (kill-all-local-variables)
1270   (use-local-map arm-assembler-mode-map)
1271   (setq local-abbrev-table arm-assembler-abbrev-table)
1272   (setq major-mode 'arm-assembler-mode)
1273   (setq mode-name "ARM assembler")
1274
1275   ;; --- Set up syntax table ---
1276
1277   (set-syntax-table arm-assembler-mode-syntax-table)
1278   (modify-syntax-entry ?;   ; Nasty hack
1279                        "<" arm-assembler-mode-syntax-table)
1280   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1281   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1282
1283   (make-local-variable 'comment-start)
1284   (setq comment-start ";")
1285   (make-local-variable 'comment-end)
1286   (setq comment-end "")
1287   (make-local-variable 'comment-column)
1288   (setq comment-column 48)
1289   (make-local-variable 'comment-start-skip)
1290   (setq comment-start-skip ";+[ \t]*")
1291
1292   ;; --- Play with indentation ---
1293
1294   (make-local-variable 'indent-line-function)
1295   (setq indent-line-function 'indent-relative-maybe)
1296
1297   ;; --- Set fill prefix ---
1298
1299   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1300
1301   ;; --- Fiddle with fontification ---
1302
1303   (make-local-variable 'font-lock-keywords)
1304   (setq font-lock-keywords
1305         (list
1306
1307          ;; --- Handle numbers too ---
1308          ;;
1309          ;; The following isn't quite right, but it's close enough.
1310
1311          (list (concat "\\("
1312                        "&[0-9a-fA-F]+\\|"
1313                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1314                        "\\)")
1315                '(0 mdw-number-face))
1316
1317          ;; --- Do something about operators ---
1318
1319          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1320                '(1 font-lock-keyword-face)
1321                '(2 font-lock-string-face))
1322          (list ":[a-zA-Z]+:"
1323                '(0 font-lock-keyword-face))
1324
1325          ;; --- Do menemonics and directives ---
1326
1327          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1328                '(1 font-lock-keyword-face))
1329
1330          ;; --- And anything else is punctuation ---
1331
1332          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1333                '(0 mdw-punct-face))))
1334
1335   (run-hooks 'arm-assembler-mode-hook))
1336
1337 ;;;----- Assembler mode -----------------------------------------------------
1338
1339 (defun mdw-fontify-asm ()
1340   (modify-syntax-entry ?' "\"")
1341   (modify-syntax-entry ?. "w")
1342   (setf fill-prefix nil)
1343   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1344
1345 ;;;----- TCL configuration --------------------------------------------------
1346
1347 (defun mdw-fontify-tcl ()
1348   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1349   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1350   (make-local-variable 'font-lock-keywords)
1351   (setq font-lock-keywords
1352         (list
1353          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1354                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1355                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1356                '(0 mdw-number-face))
1357          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1358                '(0 mdw-punct-face)))))
1359
1360 ;;;----- REXX configuration -------------------------------------------------
1361
1362 (defun mdw-rexx-electric-* ()
1363   (interactive)
1364   (insert ?*)
1365   (rexx-indent-line))
1366
1367 (defun mdw-rexx-indent-newline-indent ()
1368   (interactive)
1369   (rexx-indent-line)
1370   (if abbrev-mode (expand-abbrev))
1371   (newline-and-indent))
1372
1373 (defun mdw-fontify-rexx ()
1374
1375   ;; --- Various bits of fiddling ---
1376
1377   (setq mdw-auto-indent nil)
1378   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1379   (local-set-key [?*] 'mdw-rexx-electric-*)
1380   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1381           '(?. ?! ?? ?_ ?# ?@ ?$))
1382   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1383
1384   ;; --- Set up keywords and things for fontification ---
1385
1386   (make-local-variable 'font-lock-keywords-case-fold-search)
1387   (setq font-lock-keywords-case-fold-search t)
1388
1389   (setq rexx-indent 2)
1390   (setq rexx-end-indent rexx-indent)
1391   (setq rexx-tab-always-indent nil)
1392   (setq rexx-cont-indent rexx-indent)
1393
1394   (make-local-variable 'font-lock-keywords)
1395   (let ((rexx-keywords
1396          (make-regexp '("address" "arg" "by" "call" "digits" "do" "drop"
1397                         "else" "end" "engineering" "exit" "expose" "for"
1398                         "forever" "form" "fuzz" "if" "interpret" "iterate"
1399                         "leave" "linein" "name" "nop" "numeric" "off" "on"
1400                         "options" "otherwise" "parse" "procedure" "pull"
1401                         "push" "queue" "return" "say" "select" "signal"
1402                         "scientific" "source" "then" "trace" "to" "until"
1403                         "upper" "value" "var" "version" "when" "while"
1404                         "with"
1405
1406                         "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1407                         "center" "center" "charin" "charout" "chars"
1408                         "compare" "condition" "copies" "c2d" "c2x"
1409                         "datatype" "date" "delstr" "delword" "d2c" "d2x"
1410                         "errortext" "format" "fuzz" "insert" "lastpos"
1411                         "left" "length" "lineout" "lines" "max" "min"
1412                         "overlay" "pos" "queued" "random" "reverse" "right"
1413                         "sign" "sourceline" "space" "stream" "strip"
1414                         "substr" "subword" "symbol" "time" "translate"
1415                         "trunc" "value" "verify" "word" "wordindex"
1416                         "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1417                         "x2d"))))
1418
1419     (setq font-lock-keywords
1420           (list
1421
1422            ;; --- Set up the keywords defined above ---
1423
1424            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1425                  '(0 font-lock-keyword-face))
1426
1427            ;; --- Fontify all symbols the same way ---
1428
1429            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1430                          "[A-Za-z0-9.!?_#@$]+\\)")
1431                  '(0 font-lock-variable-name-face))
1432
1433            ;; --- And everything else is punctuation ---
1434
1435            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1436                  '(0 mdw-punct-face))))))
1437
1438 ;;;----- Standard ML programming style --------------------------------------
1439
1440 (defun mdw-fontify-sml ()
1441
1442   ;; --- Make underscore an honorary letter ---
1443
1444   (modify-syntax-entry ?_ "w")
1445   (modify-syntax-entry ?' "w")
1446
1447   ;; --- Set fill prefix ---
1448
1449   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1450
1451   ;; --- Now define fontification things ---
1452
1453   (make-local-variable 'font-lock-keywords)
1454   (let ((sml-keywords
1455          (make-regexp '("abstype" "and" "andalso" "as"
1456                         "case"
1457                         "datatype" "do"
1458                         "else" "end" "eqtype" "exception"
1459                         "fn" "fun" "functor"
1460                         "handle"
1461                         "if" "in" "include" "infix" "infixr"
1462                         "let" "local"
1463                         "nonfix"
1464                         "of" "op" "open" "orelse"
1465                         "raise" "rec"
1466                         "sharing" "sig" "signature" "struct" "structure"
1467                         "then" "type"
1468                         "val"
1469                         "where" "while" "with" "withtype"))))
1470
1471     (setq font-lock-keywords
1472           (list
1473
1474            ;; --- Set up the keywords defined above ---
1475
1476            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1477                  '(0 font-lock-keyword-face))
1478
1479            ;; --- At least numbers are simpler than C ---
1480
1481            (list (concat "\\<\\(\\~\\|\\)"
1482                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1483                                    "[wW][0-9]+\\)\\|"
1484                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1485                                          "\\([eE]\\(\\~\\|\\)"
1486                                                 "[0-9]+\\|\\)\\)\\)")
1487                  '(0 mdw-number-face))
1488
1489            ;; --- And anything else is punctuation ---
1490
1491            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1492                  '(0 mdw-punct-face))))))
1493
1494 ;;;----- Haskell configuration ----------------------------------------------
1495
1496 (defun mdw-fontify-haskell ()
1497
1498   ;; --- Fiddle with syntax table to get comments right ---
1499
1500   (modify-syntax-entry ?_ "w")
1501   (modify-syntax-entry ?' "\"")
1502   (modify-syntax-entry ?- ". 123")
1503   (modify-syntax-entry ?{ ". 1b")
1504   (modify-syntax-entry ?} ". 4b")
1505   (modify-syntax-entry ?\n ">")
1506
1507   ;; --- Set fill prefix ---
1508
1509   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1510
1511   ;; --- Fiddle with fontification ---
1512
1513   (make-local-variable 'font-lock-keywords)
1514   (let ((haskell-keywords
1515          (make-regexp '("as" "case" "ccall" "class" "data" "default"
1516                         "deriving" "do" "else" "foreign" "hiding" "if"
1517                         "import" "in" "infix" "infixl" "infixr" "instance"
1518                         "let" "module" "newtype" "of" "qualified" "safe"
1519                         "stdcall" "then" "type" "unsafe" "where"))))
1520
1521     (setq font-lock-keywords
1522           (list
1523            (list "--.*$"
1524                  '(0 font-lock-comment-face))
1525            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1526                  '(0 font-lock-keyword-face))
1527            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1528                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1529                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1530                  '(0 mdw-number-face))
1531            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1532                  '(0 mdw-punct-face))))))
1533
1534 ;;;----- Texinfo configuration ----------------------------------------------
1535
1536 (defun mdw-fontify-texinfo ()
1537
1538   ;; --- Set fill prefix ---
1539
1540   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1541
1542   ;; --- Real fontification things ---
1543
1544   (make-local-variable 'font-lock-keywords)
1545   (setq font-lock-keywords
1546         (list
1547
1548          ;; --- Environment names are keywords ---
1549
1550          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
1551                '(2 font-lock-keyword-face))
1552
1553          ;; --- Unmark escaped magic characters ---
1554
1555          (list "\\(@\\)\\([@{}]\\)"
1556                '(1 font-lock-keyword-face)
1557                '(2 font-lock-variable-name-face))
1558
1559          ;; --- Make sure we get comments properly ---
1560
1561          (list "@c\\(\\|omment\\)\\( .*\\)?$"
1562                '(0 font-lock-comment-face))
1563
1564          ;; --- Command names are keywords ---
1565
1566          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1567                '(0 font-lock-keyword-face))
1568
1569          ;; --- Fontify TeX special characters as punctuation ---
1570
1571          (list "[{}]+"
1572                '(0 mdw-punct-face)))))
1573
1574 ;;;----- TeX and LaTeX configuration ----------------------------------------
1575
1576 (defun mdw-fontify-tex ()
1577   (setq ispell-parser 'tex)
1578
1579   ;; --- Don't make maths into a string ---
1580
1581   (modify-syntax-entry ?$ ".")
1582   (modify-syntax-entry ?$ "." font-lock-syntax-table)
1583   (local-set-key [?$] 'self-insert-command)
1584
1585   ;; --- Set fill prefix ---
1586
1587   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1588
1589   ;; --- Real fontification things ---
1590
1591   (make-local-variable 'font-lock-keywords)
1592   (setq font-lock-keywords
1593         (list
1594
1595          ;; --- Environment names are keywords ---
1596
1597          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1598                        "{\\([^}\n]*\\)}")
1599                '(2 font-lock-keyword-face))
1600
1601          ;; --- Suspended environment names are keywords too ---
1602
1603          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1604                        "{\\([^}\n]*\\)}")
1605                '(3 font-lock-keyword-face))
1606
1607          ;; --- Command names are keywords ---
1608
1609          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1610                '(0 font-lock-keyword-face))
1611
1612          ;; --- Handle @/.../ for italics ---
1613
1614          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1615          ;;       '(1 font-lock-keyword-face)
1616          ;;       '(3 font-lock-keyword-face))
1617
1618          ;; --- Handle @*...* for boldness ---
1619
1620          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1621          ;;       '(1 font-lock-keyword-face)
1622          ;;       '(3 font-lock-keyword-face))
1623
1624          ;; --- Handle @`...' for literal syntax things ---
1625
1626          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1627          ;;       '(1 font-lock-keyword-face)
1628          ;;       '(3 font-lock-keyword-face))
1629
1630          ;; --- Handle @<...> for nonterminals ---
1631
1632          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
1633          ;;       '(1 font-lock-keyword-face)
1634          ;;       '(3 font-lock-keyword-face))
1635
1636          ;; --- Handle other @-commands ---
1637
1638          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
1639          ;;       '(0 font-lock-keyword-face))
1640
1641          ;; --- Make sure we get comments properly ---
1642
1643          (list "%.*"
1644                '(0 font-lock-comment-face))
1645
1646          ;; --- Fontify TeX special characters as punctuation ---
1647
1648          (list "[$^_{}#&]"
1649                '(0 mdw-punct-face)))))
1650
1651 ;;;----- SGML hacking -------------------------------------------------------
1652
1653 (defun mdw-sgml-mode ()
1654   (interactive)
1655   (sgml-mode)
1656   (mdw-standard-fill-prefix "")
1657   (make-variable-buffer-local 'sgml-delimiters)
1658   (setq sgml-delimiters
1659         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
1660           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
1661           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
1662           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
1663           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
1664           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
1665           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
1666           "NULL" ""))
1667   (setq major-mode 'mdw-sgml-mode)
1668   (setq mode-name "[mdw] SGML")
1669   (run-hooks 'mdw-sgml-mode-hook))
1670
1671 ;;;----- Shell scripts ------------------------------------------------------
1672
1673 (defun mdw-setup-sh-script-mode ()
1674
1675   ;; --- Fetch the shell interpreter's name ---
1676
1677   (let ((shell-name sh-shell-file))
1678
1679     ;; --- Try reading the hash-bang line ---
1680
1681     (save-excursion
1682       (goto-char (point-min))
1683       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
1684           (setq shell-name (match-string 1))))
1685
1686     ;; --- Now try to set the shell ---
1687     ;;
1688     ;; Don't let `sh-set-shell' bugger up my script.
1689
1690     (let ((executable-set-magic #'(lambda (s &rest r) s)))
1691       (sh-set-shell shell-name)))
1692
1693   ;; --- Now enable my keys and the fontification ---
1694
1695   (mdw-misc-mode-config)
1696
1697   ;; --- Set the indentation level correctly ---
1698
1699   (setq sh-indentation 2)
1700   (setq sh-basic-offset 2))
1701
1702 ;;;----- Messages-file mode -------------------------------------------------
1703
1704 (defun message-mode-guts ()
1705   (setq messages-mode-syntax-table (make-syntax-table))
1706   (set-syntax-table messages-mode-syntax-table)
1707   (modify-syntax-entry ?_ "w" messages-mode-syntax-table)
1708   (modify-syntax-entry ?- "w" messages-mode-syntax-table)
1709   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
1710   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
1711   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
1712   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
1713   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
1714   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
1715   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
1716   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
1717   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
1718   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
1719   (make-local-variable 'comment-start)
1720   (make-local-variable 'comment-end)
1721   (make-local-variable 'indent-line-function)
1722   (setq indent-line-function 'indent-relative)
1723   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1724   (make-local-variable 'font-lock-defaults)
1725   (make-local-variable 'message-mode-keywords)
1726   (let ((keywords
1727          (make-regexp '("array" "bitmap" "callback" "docs[ \t]+enum"
1728                         "export" "enum" "fixed-octetstring" "flags"
1729                         "harmless" "map" "nested" "optional"
1730                         "optional-tagged" "package" "primitive"
1731                         "primitive-nullfree" "relaxed[ \t]+enum"
1732                         "set" "table" "tagged-optional" "union"
1733                         "variadic" "vector" "version" "version-tag"))))
1734     (setq message-mode-keywords
1735           (list
1736            (list (concat "\\<\\(" keywords "\\)\\>:")
1737                  '(0 font-lock-keyword-face))
1738            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
1739            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
1740              (0 font-lock-variable-name-face))
1741            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
1742            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1743              (0 mdw-punct-face)))))
1744   (setq font-lock-defaults
1745         '(message-mode-keywords nil nil nil nil))
1746   (run-hooks 'messages-file-hook))
1747
1748 (defun messages-mode ()
1749   (interactive)
1750   (fundamental-mode)
1751   (setq major-mode 'messages-mode)
1752   (setq mode-name "Messages")
1753   (message-mode-guts)
1754   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
1755   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
1756   (setq comment-start "# ")
1757   (setq comment-end "")
1758   (turn-on-font-lock-if-enabled)
1759   (run-hooks 'messages-mode-hook))
1760
1761 (defun cpp-messages-mode ()
1762   (interactive)
1763   (fundamental-mode)
1764   (setq major-mode 'cpp-messages-mode)
1765   (setq mode-name "CPP Messages")
1766   (message-mode-guts)
1767   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
1768   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
1769   (setq comment-start "/* ")
1770   (setq comment-end " */")
1771   (let ((preprocessor-keywords
1772          (make-regexp '("assert" "define" "elif" "else" "endif" "error"
1773                        "ident" "if" "ifdef" "ifndef" "import" "include"
1774                        "line" "pragma" "unassert" "undef" "warning"))))
1775     (setq message-mode-keywords
1776           (append (list (list (concat "^[ \t]*\\#[ \t]*"
1777                                       "\\(include\\|import\\)"
1778                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1779                               '(2 font-lock-string-face))
1780                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1781                                       preprocessor-keywords
1782                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
1783                               '(1 font-lock-keyword-face)))
1784                   message-mode-keywords)))
1785   (turn-on-font-lock-if-enabled)
1786   (run-hooks 'cpp-messages-mode-hook))
1787
1788 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
1789 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
1790 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
1791
1792 ;;;----- Messages-file mode -------------------------------------------------
1793
1794 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
1795   "Face to use for subsittution directives.")
1796 (make-face 'mallow-driver-substitution-face)
1797 (defvar mallow-driver-text-face 'mallow-driver-text-face
1798   "Face to use for body text.")
1799 (make-face 'mallow-driver-text-face)
1800
1801 (defun mallow-driver-mode ()
1802   (interactive)
1803   (fundamental-mode)
1804   (setq major-mode 'mallow-driver-mode)
1805   (setq mode-name "Mallow driver")
1806   (setq mallow-driver-mode-syntax-table (make-syntax-table))
1807   (set-syntax-table mallow-driver-mode-syntax-table)
1808   (make-local-variable 'comment-start)
1809   (make-local-variable 'comment-end)
1810   (make-local-variable 'indent-line-function)
1811   (setq indent-line-function 'indent-relative)
1812   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1813   (make-local-variable 'font-lock-defaults)
1814   (make-local-variable 'mallow-driver-mode-keywords)
1815   (let ((keywords
1816          (make-regexp '("each" "divert" "file" "if"
1817                         "perl" "set" "string" "type" "write"))))
1818     (setq mallow-driver-mode-keywords
1819           (list
1820            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
1821                  '(0 font-lock-keyword-face))
1822            (list "^%\\s *\\(#.*\\|\\)$"
1823                  '(0 font-lock-comment-face))
1824            (list "^%"
1825                  '(0 font-lock-keyword-face))
1826            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
1827            (list "\\${[^}]*}"
1828                  '(0 mallow-driver-substitution-face t)))))
1829   (setq font-lock-defaults
1830         '(mallow-driver-mode-keywords nil nil nil nil))
1831   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
1832   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
1833   (setq comment-start "%# ")
1834   (setq comment-end "")
1835   (turn-on-font-lock-if-enabled)
1836   (run-hooks 'mallow-driver-mode-hook))
1837
1838 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
1839
1840 ;;;----- NFast debugs -------------------------------------------------------
1841
1842 (defun nfast-debug-mode ()
1843   (interactive)
1844   (fundamental-mode)
1845   (setq major-mode 'nfast-debug-mode)
1846   (setq mode-name "NFast debug")
1847   (setq messages-mode-syntax-table (make-syntax-table))
1848   (set-syntax-table messages-mode-syntax-table)
1849   (make-local-variable 'font-lock-defaults)
1850   (make-local-variable 'nfast-debug-mode-keywords)
1851   (setq truncate-lines t)
1852   (setq nfast-debug-mode-keywords
1853         (list
1854          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
1855            (0 font-lock-keyword-face))
1856          (list (concat "^[ \t]+\\(\\("
1857                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
1858                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
1859                        "[ \t]+\\)*"
1860                        "[0-9a-fA-F]+\\)[ \t]*$")
1861            '(0 mdw-number-face))
1862          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
1863            (1 font-lock-keyword-face))
1864          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
1865            (1 font-lock-warning-face))
1866          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
1867            (1 nil))
1868          (list (concat "^[ \t]+\\.cmd=[ \t]+"
1869                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
1870            '(1 font-lock-keyword-face))
1871          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
1872          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
1873          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
1874          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
1875   (setq font-lock-defaults
1876         '(nfast-debug-mode-keywords nil nil nil nil))
1877   (turn-on-font-lock-if-enabled)
1878   (run-hooks 'nfast-debug-mode-hook))
1879
1880 ;;;----- Other languages ----------------------------------------------------
1881
1882 ;; --- Smalltalk ---
1883
1884 (defun mdw-setup-smalltalk ()
1885   (and mdw-auto-indent
1886        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
1887   (make-variable-buffer-local 'mdw-auto-indent)
1888   (setq mdw-auto-indent nil)
1889   (local-set-key "\C-i" 'smalltalk-reindent))
1890
1891 (defun mdw-fontify-smalltalk ()
1892   (make-local-variable 'font-lock-keywords)
1893   (setq font-lock-keywords
1894         (list
1895          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
1896                '(0 font-lock-keyword-face))
1897          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1898                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1899                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1900                '(0 mdw-number-face))
1901          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1902                '(0 mdw-punct-face)))))
1903
1904 ;; --- Lispy languages ---
1905
1906 (defun mdw-indent-newline-and-indent ()
1907   (interactive)
1908   (indent-for-tab-command)
1909   (newline-and-indent))
1910
1911 (eval-after-load "cl-indent"
1912   '(progn
1913      (mapc #'(lambda (pair)
1914                (put (car pair)
1915                     'common-lisp-indent-function
1916                     (cdr pair)))
1917       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
1918         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
1919
1920 (defun mdw-common-lisp-indent ()
1921   (make-variable-buffer-local 'lisp-indent-function)
1922   (setq lisp-indent-function 'common-lisp-indent-function))
1923
1924 (defun mdw-fontify-lispy ()
1925
1926   ;; --- Set fill prefix ---
1927
1928   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1929
1930   ;; --- Not much fontification needed ---
1931
1932   (make-local-variable 'font-lock-keywords)
1933   (setq font-lock-keywords
1934         (list
1935          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1936                '(0 mdw-punct-face)))))
1937
1938 (defun comint-send-and-indent ()
1939   (interactive)
1940   (comint-send-input)
1941   (and mdw-auto-indent
1942        (indent-for-tab-command)))
1943
1944 (defun mdw-setup-m4 ()
1945   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
1946
1947 ;;;----- Text mode ----------------------------------------------------------
1948
1949 (defun mdw-text-mode ()
1950   (setq fill-column 72)
1951   (flyspell-mode t)
1952   (mdw-standard-fill-prefix
1953    "\\([ \t]*\\([A-Za-z0-9]*[>#|:] ?\\)*[ \t]*\\)" 3)
1954   (auto-fill-mode 1))
1955
1956 ;;;----- Shell mode ---------------------------------------------------------
1957
1958 (defun mdw-sh-mode-setup ()
1959   (local-set-key [?\C-a] 'comint-bol)
1960   (add-hook 'comint-output-filter-functions
1961             'comint-watch-for-password-prompt))
1962
1963 (defun mdw-term-mode-setup ()
1964   (setq term-prompt-regexp "^[^]#$%>»}\n]*[]#$%>»}] *")
1965   (make-local-variable 'mouse-yank-at-point)
1966   (make-local-variable 'transient-mark-mode)
1967   (setq mouse-yank-at-point t)
1968   (setq transient-mark-mode nil)
1969   (auto-fill-mode -1)
1970   (setq tab-width 8))
1971
1972 ;;;----- That's all, folks --------------------------------------------------
1973
1974 (provide 'dot-emacs)