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

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