X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/6cb52f8b2fc7fd42bce655735fd7723fe1d66842..ad305d7eb64395c1a2f9de06d3f67a0903f31df1:/el/dot-emacs.el

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index c972adc..4f9bd59 100644
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -124,6 +124,14 @@ library."
   (and (library-exists-p file)
        (autoload symbol file docstring interactivep type)))
 
+(defun mdw-kick-menu-bar (&optional frame)
+  "Regenerate FRAME's menu bar so it doesn't have empty menus."
+  (interactive)
+  (unless frame (setq frame (selected-frame)))
+  (let ((old (frame-parameter frame 'menu-bar-lines)))
+    (set-frame-parameter frame 'menu-bar-lines 0)
+    (set-frame-parameter frame 'menu-bar-lines old)))
+
 ;; Splitting windows.
 
 (unless (fboundp 'scroll-bar-columns)
@@ -637,21 +645,15 @@ This is mainly useful in `auto-fill-mode'.")
 
 ;; Utility functions.
 
-(defun mdw-tabify (s)
-  "Tabify the string S.  This is a horrid hack."
-  (save-excursion
-    (save-match-data
-      (let (start end)
-	(beginning-of-line)
-	(setq start (point-marker))
+(defun mdw-maybe-tabify (s)
+  "Tabify or untabify the string S, according to `indent-tabs-mode'."
+  (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
+    (with-temp-buffer
+      (save-match-data
 	(insert s "\n")
-	(setq end (point-marker))
-	(tabify start end)
-	(setq s (buffer-substring start (1- end)))
-	(delete-region start end)
-	(set-marker start nil)
-	(set-marker end nil)
-	s))))
+	(let ((start (point-min)) (end (point-max)))
+	  (funcall tabfun (point-min) (point-max))
+	  (setq s (buffer-substring (point-min) (1- (point-max)))))))))
 
 (defun mdw-examine-fill-prefixes (l)
   "Given a list of dynamic fill prefixes, pick one which matches
@@ -659,9 +661,9 @@ context and return the static fill prefix to use.  Point must be
 at the start of a line, and match data must be saved."
   (cond ((not l) nil)
 	       ((looking-at (car (car l)))
-		(mdw-tabify (apply (function concat)
-				   (mapcar (function mdw-do-prefix-match)
-					   (cdr (car l))))))
+		(mdw-maybe-tabify (apply #'concat
+					 (mapcar #'mdw-do-prefix-match
+						 (cdr (car l))))))
 	       (t (mdw-examine-fill-prefixes (cdr l)))))
 
 (defun mdw-maybe-car (p)
@@ -755,7 +757,7 @@ case."
   (and (fboundp 'gtags-mode)
        (gtags-mode))
   (if (fboundp 'hs-minor-mode)
-      (hs-minor-mode t)
+      (trap (hs-minor-mode t))
     (outline-minor-mode t))
   (reveal-mode t)
   (trap (turn-on-font-lock)))
@@ -824,12 +826,12 @@ doesn't match any of the regular expressions in
 
 (mdw-define-face default
   (((type w32)) :family "courier new" :height 85)
-  (((type x)) :family "6x13" :height 130)
+  (((type x)) :family "6x13" :foundry "trad" :height 130)
   (((type color)) :foreground "white" :background "black")
   (t nil))
 (mdw-define-face fixed-pitch
   (((type w32)) :family "courier new" :height 85)
-  (((type x)) :family "6x13" :height 130)
+  (((type x)) :family "6x13" :foundry "trad" :height 130)
   (t :foreground "white" :background "black"))
 (if (>= emacs-major-version 23)
     (mdw-define-face variable-pitch
@@ -861,7 +863,8 @@ doesn't match any of the regular expressions in
   (((class color)) :background "red")
   (t :inverse-video t))
 (mdw-define-face highlight
-  (((class color)) :background "DarkSeaGreen4")
+  (((type x) (class color)) :background "DarkSeaGreen4")
+  (((type tty) (class color)) :background "cyan")
   (t :inverse-video t))
 
 (mdw-define-face holiday-face
@@ -913,6 +916,7 @@ doesn't match any of the regular expressions in
 (mdw-define-face font-lock-string-face
   (((class mono)) :weight bold)
   (((class color)) :foreground "SkyBlue1"))
+
 (mdw-define-face message-separator
   (t :background "red" :foreground "white" :weight bold))
 (mdw-define-face message-cited-text
@@ -960,7 +964,24 @@ doesn't match any of the regular expressions in
 (mdw-define-face diff-context
   (t nil))
 (mdw-define-face diff-refine-change
-  (t :background "RoyalBlue4"))
+  (((class color) (type x)) :background "RoyalBlue4")
+  (t :underline t))
+
+(mdw-define-face dylan-header-background
+  (((class color) (type x)) :background "NavyBlue")
+  (t :background "blue"))
+
+(mdw-define-face magit-diff-add
+  (t :foreground "green"))
+(mdw-define-face magit-diff-del
+  (t :foreground "red"))
+(mdw-define-face magit-diff-file-header
+  (t :weight bold))
+(mdw-define-face magit-diff-hunk-header
+  (t :foreground "SkyBlue1"))
+(mdw-define-face magit-item-highlight
+  (((type tty)) :background "blue")
+  (t :background "DarkSeaGreen4"))
 
 (mdw-define-face erc-input-face
   (t :foreground "red"))
@@ -970,6 +991,21 @@ doesn't match any of the regular expressions in
 (mdw-define-face woman-italic
   (t :slant italic))
 
+(eval-after-load "rst"
+  '(progn
+     (mdw-define-face rst-level-1-face
+       (t :foreground "SkyBlue1" :weight bold))
+     (mdw-define-face rst-level-2-face
+       (t :foreground "SeaGreen1" :weight bold))
+     (mdw-define-face rst-level-3-face
+       (t :weight bold))
+     (mdw-define-face rst-level-4-face
+       (t :slant italic))
+     (mdw-define-face rst-level-5-face
+       (t :underline t))
+     (mdw-define-face rst-level-6-face
+       ())))
+
 (mdw-define-face p4-depot-added-face
   (t :foreground "green"))
 (mdw-define-face p4-depot-branch-op-face
@@ -989,6 +1025,11 @@ doesn't match any of the regular expressions in
 (mdw-define-face p4-diff-ins-face
   (t :foreground "green"))
 
+(mdw-define-face w3m-anchor-face
+  (t :foreground "SkyBlue1" :underline t))
+(mdw-define-face w3m-arrived-anchor-face
+  (t :foreground "SkyBlue1" :underline t))
+
 (mdw-define-face whizzy-slice-face
   (t :background "grey10"))
 (mdw-define-face whizzy-error-face
@@ -997,9 +1038,15 @@ doesn't match any of the regular expressions in
 ;; Ellipses used to indicate hidden text (and similar).
 (mdw-define-face mdw-ellipsis-face
   (((type tty)) :foreground "blue") (t :foreground "grey60"))
-(let ((dot (make-glyph-code ?. 'mdw-ellipsis-face)))
+(let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
+      (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
+      (dot (make-glyph-code ?. 'mdw-ellipsis-face))
+      (bar (make-glyph-code ?| mdw-ellipsis-face)))
+  (set-display-table-slot standard-display-table 0 dollar)
+  (set-display-table-slot standard-display-table 1 backslash)
   (set-display-table-slot standard-display-table 4
-			  (vector dot dot dot)))
+			  (vector dot dot dot))
+  (set-display-table-slot standard-display-table 5 bar))
 
 ;;;--------------------------------------------------------------------------
 ;;; C programming configuration.
@@ -1381,17 +1428,17 @@ doesn't match any of the regular expressions in
 	  (list
 
 	   ;; Handle the keywords defined above.
-	   (list (concat "\\<\\(" javascript-keywords "\\)\\>")
+	   (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
 		 '(0 font-lock-keyword-face))
 
 	   ;; Handle the predefined constants defined above.
-	   (list (concat "\\<\\(" javascript-constants "\\)\\>")
+	   (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
 		 '(0 font-lock-variable-name-face))
 
 	   ;; Handle numbers too.
 	   ;;
 	   ;; The following isn't quite right, but it's close enough.
-	   (list (concat "\\<\\("
+	   (list (concat "\\_<\\("
 			 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
 			 "[0-9]+\\(\\.[0-9]*\\|\\)"
 			 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
@@ -1651,12 +1698,12 @@ strip numbers instead."
 	(list
 
 	 ;; Set up the keywords defined above.
-	 (list (concat "\\<\\(" keywords "\\)\\>")
+	 (list (concat "\\_<\\(" keywords "\\)\\_>")
 	       '(0 font-lock-keyword-face))
 
 	 ;; At least numbers are simpler than C.
-	 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
-		       "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
+	 (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
+		       "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
 		       "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
 	       '(0 mdw-number-face))
 
@@ -1822,9 +1869,9 @@ strip numbers instead."
 
 	 ;; And anything else is punctuation.
 	 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
-	       '(0 mdw-punct-face)))
+	       '(0 mdw-punct-face))))
 
-  (mdw-post-config-mode-hack))
+  (mdw-post-config-mode-hack)
   (run-hooks 'arm-assembler-mode-hook))
 
 ;;;--------------------------------------------------------------------------
@@ -1854,6 +1901,74 @@ strip numbers instead."
   (mdw-post-config-mode-hack))
 
 ;;;--------------------------------------------------------------------------
+;;; Dylan programming configuration.
+
+(defun mdw-fontify-dylan ()
+
+  (make-local-variable 'font-lock-keywords)
+
+  ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
+  ;; hook, which undoes all of our configuration.
+  (setq major-mode 'dylan-mode)
+  (font-lock-set-defaults)
+
+  (let* ((word "[-_a-zA-Z!*@<>$%]+")
+	 (dylan-keywords (mdw-regexps
+
+			  "C-address" "C-callable-wrapper" "C-function"
+			  "C-mapped-subtype" "C-pointer-type" "C-struct"
+			  "C-subtype" "C-union" "C-variable"
+
+			  "above" "abstract" "afterwards" "all"
+			  "begin" "below" "block" "by"
+			  "case" "class" "cleanup" "constant" "create"
+			  "define" "domain"
+			  "else" "elseif" "end" "exception" "export"
+			  "finally" "for" "from" "function"
+			  "generic"
+			  "handler"
+			  "if" "in" "instance" "interface" "iterate"
+			  "keyed-by"
+			  "let" "library" "local"
+			  "macro" "method" "module"
+			  "otherwise"
+			  "profiling"
+			  "select" "slot" "subclass"
+			  "table" "then" "to"
+			  "unless" "until" "use"
+			  "variable" "virtual"
+			  "when" "while"))
+	 (sharp-keywords (mdw-regexps
+			  "all-keys" "key" "next" "rest" "include"
+			  "t" "f")))
+    (setq font-lock-keywords
+	  (list (list (concat "\\<\\(" dylan-keywords
+			      "\\|" (concat "with\\(out\\)?-" word)
+			      "\\|" (concat word ":")
+			      "\\)\\>")
+		      '(0 font-lock-keyword-face))
+		(list (concat "#\\(" sharp-keywords "\\)\\>")
+		      '(0 font-lock-variable-name-face))
+		(list (concat "\\("
+			      "\\([-+]\\|\\<\\)[0-9]+" "\\("
+				"\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
+				"\\|" "/[0-9]+"
+			      "\\)"
+			      "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
+			      "\\|" "#b[01]+"
+			      "\\|" "#o[0-7]+"
+			      "\\|" "#x[0-9a-zA-Z]+"
+			      "\\)\\>")
+		      '(0 mdw-number-face))
+		(list (concat "\\("
+			      "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
+			      "\\_<[-+*/=<>:&|]+\\_>"
+			      "\\)")
+		      '(0 mdw-punct-face)))))
+
+  (mdw-post-config-mode-hack))
+
+;;;--------------------------------------------------------------------------
 ;;; REXX configuration.
 
 (defun mdw-rexx-electric-* ()