X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/f617db13b0685c674817a6c7c1d148da3c07081f..852cd5fbddafbfed93df4cda8ba366b14922e95d:/dot-emacs.el

diff --git a/dot-emacs.el b/dot-emacs.el
index 66f9190..b66a1e0 100644
--- a/dot-emacs.el
+++ b/dot-emacs.el
@@ -13,12 +13,12 @@
 ;;; it under the terms of the GNU General Public License as published by
 ;;; the Free Software Foundation; either version 2 of the License, or
 ;;; (at your option) any later version.
-;;; 
+;;;
 ;;; This program is distributed in the hope that it will be useful,
 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;;; GNU General Public License for more details.
-;;; 
+;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
@@ -36,6 +36,47 @@
        ,(if (cdr forms) (cons 'progn forms) (car forms))
      (error (message "Error (trapped): %s" (error-message-string err)))))
 
+;; --- Configuration reading ---
+
+(defvar mdw-config nil)
+(defun mdw-config (sym)
+  "Read the configuration variable named SYM."
+  (unless mdw-config
+    (setq mdw-config (with-temp-buffer
+		       (insert-file-contents "~/.mdw.conf")
+		       (replace-regexp "^[ \t]*\\(#.*\\|\\)\n" ""
+				       nil (point-min) (point-max))
+		       (replace-regexp (concat "^[ \t]*"
+					       "\\([-a-zA-Z0-9_.]*\\)"
+					       "[ \t]*=[ \t]*"
+					       "\\(.*[^ \t\n]\\|\\)"
+					       "[ \t]**\\(\n\\|$\\)")
+				       "(\\1 . \"\\2\") "
+				       nil (point-min) (point-max))
+		       (car (read-from-string
+			     (concat "(" (buffer-string) ")"))))))
+  (cdr (assq sym mdw-config)))
+
+;; --- Is an Emacs library available? ---
+
+(defun library-exists-p (name)
+  "Return non-nil if NAME.el (or NAME.elc) is somewhere on the Emacs load
+path.  The non-nil value is the filename we found for the library."
+  (let ((path load-path) elt (foundp nil))
+    (while (and path (not foundp))
+      (setq elt (car path))
+      (setq path (cdr path))
+      (setq foundp (or (let ((file (concat elt "/" name ".elc")))
+			 (and (file-exists-p file) file))
+		       (let ((file (concat elt "/" name ".el")))
+			 (and (file-exists-p file) file)))))
+    foundp))
+
+(defun maybe-autoload (symbol file &optional docstring interactivep type)
+  "Set an autoload if the file actually exists."
+  (and (library-exists-p file)
+       (autoload symbol file docstring interactivep type)))
+
 ;; --- Splitting windows ---
 
 (defconst mdw-scrollbar-width (if window-system 6 1)
@@ -185,9 +226,9 @@ input lists are not modified, although they'll probably become garbage."
   (interactive)
   (save-excursion
     (or arg (progn
-              (goto-char (point-max))
+	      (goto-char (point-max))
 	      (insert "\nNP: ")
-              (insert-file np-file)))))
+	      (insert-file np-file)))))
 
 (trap
   (require 'tramp)
@@ -251,6 +292,46 @@ Not much right now.  Just support for doing MailCrypt stuff."
     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
 
+;;;----- URL viewing --------------------------------------------------------
+
+(defun mdw-w3m-browse-url (url &optional new-session-p)
+  "Invoke w3m on the URL in its current window, or at least a different one.
+If NEW-SESSION-P, start a new session."
+  (interactive "sURL: \nP")
+  (save-excursion
+    (let ((window (selected-window)))
+      (unwind-protect
+	  (progn
+	    (select-window (or (and (not new-session-p)
+				    (get-buffer-window "*w3m*"))
+			       (progn
+				 (if (one-window-p t) (split-window))
+				 (get-lru-window))))
+	    (w3m-browse-url url new-session-p))
+	(select-window window)))))
+
+(defvar mdw-good-url-browsers
+  '((w3m . mdw-w3m-browse-url)
+    browse-url-w3
+    browse-url-mozilla)
+  "List of good browsers for mdw-good-url-browsers; each item is a browser
+function name, or a cons (CHECK . FUNC).  A symbol FOO stands for (FOO
+. FOO).")
+
+(defun mdw-good-url-browser ()
+  "Return a good URL browser.  Trundle the list of such things, finding the
+first item for which CHECK is fboundp, and returning the correponding FUNC."
+  (let ((bs mdw-good-url-browsers) b check func answer)
+    (while (and bs (not answer))
+      (setq b (car bs)
+	    bs (cdr bs))
+      (if (consp b)
+	  (setq check (car b) func (cdr b))
+	(setq check b func b))
+      (if (fboundp check)
+	  (setq answer func)))
+    answer))
+
 ;;;----- Paragraph filling --------------------------------------------------
 
 ;; --- Useful variables ---
@@ -418,6 +499,7 @@ doesn't cope with anything approximating a complicated case."
   (setq comment-column 40)
   (auto-fill-mode 1)
   (setq fill-column 77)
+  (setq show-trailing-whitespace t)
   (mdw-set-font))
 
 ;; --- Set up all sorts of faces ---
@@ -431,26 +513,28 @@ doesn't cope with anything approximating a complicated case."
 
 ;;;----- General fontification ----------------------------------------------
 
-(defun mdw-set-fonts (frame ff)
-  (if ff (progn (set-face-attribute (caar ff) frame
-				    :family 'unspecified
-				    :width 'unspecified
-				    :height 'unspecified
-				    :weight 'unspecified
-				    :slant 'unspecified
-				    :foreground 'unspecified
-				    :background 'unspecified
-				    :underline 'unspecified
-				    :overline 'unspecified
-				    :strike-through 'unspecified
-				    :box 'unspecified
-				    :inverse-video 'unspecified
-				    :stipple 'unspecified
-;				    :font 'unspecified
-				    :inherit 'unspecified
-				    )
-		(apply 'set-face-attribute (caar ff) frame (cdar ff))
-		(mdw-set-fonts frame (cdr ff)))))
+(defun mdw-set-fonts (frame faces)
+  (while faces
+    (let ((face (caar faces)))
+      (or (facep face) (make-face face))
+      (set-face-attribute face frame
+			  :family 'unspecified
+			  :width 'unspecified
+			  :height 'unspecified
+			  :weight 'unspecified
+			  :slant 'unspecified
+			  :foreground 'unspecified
+			  :background 'unspecified
+			  :underline 'unspecified
+			  :overline 'unspecified
+			  :strike-through 'unspecified
+			  :box 'unspecified
+			  :inverse-video 'unspecified
+			  :stipple 'unspecified
+			  ;:font 'unspecified
+			  :inherit 'unspecified)
+      (apply 'set-face-attribute face frame (cdar faces))
+      (setq faces (cdr faces)))))
 
 (defun mdw-do-set-font (&optional frame)
   (interactive)
@@ -497,6 +581,7 @@ doesn't cope with anything approximating a complicated case."
     (diff-removed-face :foreground "white" :slant italic)
     (whizzy-slice-face :background "grey10")
     (whizzy-error-face :background "darkred")
+    (trailing-whitespace :background "red")
 )))
 
 (defun mdw-set-font ()
@@ -564,7 +649,7 @@ doesn't cope with anything approximating a complicated case."
 
   ;; --- Now define things to be fontified ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((c-keywords
 	 (make-regexp '(
 			;; "and"	;C++
@@ -748,7 +833,7 @@ doesn't cope with anything approximating a complicated case."
 
   ;; --- Now define things to be fontified ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((c-keywords
 	 (make-regexp '("break" "case" "cd" "continue" "define" "default"
 			"do" "else" "exit" "for" "global" "goto" "help" "if"
@@ -816,7 +901,7 @@ doesn't cope with anything approximating a complicated case."
 
   ;; --- Now define things to be fontified ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((java-keywords
 	 (make-regexp '("abstract" "boolean" "break" "byte" "case" "catch"
 			"char" "class" "const" "continue" "default" "do"
@@ -881,7 +966,7 @@ doesn't cope with anything approximating a complicated case."
 
   ;; --- Now define things to be fontified ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((c-keywords
 	 (make-regexp '("BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
 			"ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
@@ -946,7 +1031,7 @@ doesn't cope with anything approximating a complicated case."
 
   ;; --- Now define fontification things ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((perl-keywords
 	 (make-regexp '("and" "cmp" "continue" "do" "else" "elsif" "eq"
 			"for" "foreach" "ge" "gt" "goto" "if"
@@ -1004,13 +1089,13 @@ strip numbers instead."
 
   ;; --- Now define fontification things ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((python-keywords
 	 (make-regexp '("and" "as" "assert" "break" "class" "continue" "def"
 			"del" "elif" "else" "except" "exec" "finally" "for"
 			"from" "global" "if" "import" "in" "is" "lambda"
 			"not" "or" "pass" "print" "raise" "return" "try"
-			"while"))))
+			"while" "yield"))))
     (setq font-lock-keywords
 	  (list
 	   't
@@ -1089,7 +1174,7 @@ strip numbers instead."
 
   ;; --- Fiddle with fontification ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (setq font-lock-keywords
 	(list
 	 't
@@ -1129,7 +1214,7 @@ strip numbers instead."
 (defun mdw-fontify-tcl ()
   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (setq font-lock-keywords
 	(list
 	 't
@@ -1174,7 +1259,7 @@ strip numbers instead."
   (setq rexx-tab-always-indent nil)
   (setq rexx-cont-indent rexx-indent)
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((rexx-keywords
 	 (make-regexp '("address" "arg" "by" "call" "digits" "do" "drop"
 			"else" "end" "engineering" "exit" "expose" "for"
@@ -1234,7 +1319,7 @@ strip numbers instead."
 
   ;; --- Now define fontification things ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((sml-keywords
 	 (make-regexp '("abstype" "and" "andalso" "as"
 			"case"
@@ -1265,10 +1350,10 @@ strip numbers instead."
 
 	   (list (concat "\\<\\(\\~\\|\\)"
 			    "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
-			           "[wW][0-9]+\\)\\|"
-			        "\\([0-9]+\\(\\.[0-9]+\\|\\)"
-			                 "\\([eE]\\(\\~\\|\\)"
-					        "[0-9]+\\|\\)\\)\\)")
+				   "[wW][0-9]+\\)\\|"
+				"\\([0-9]+\\(\\.[0-9]+\\|\\)"
+					 "\\([eE]\\(\\~\\|\\)"
+						"[0-9]+\\|\\)\\)\\)")
 		 '(0 mdw-number-face))
 
 	   ;; --- And anything else is punctuation ---
@@ -1295,7 +1380,7 @@ strip numbers instead."
 
   ;; --- Fiddle with fontification ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (let ((haskell-keywords
 	 (make-regexp '("as" "case" "ccall" "class" "data" "default"
 			"deriving" "do" "else" "foreign" "hiding" "if"
@@ -1327,7 +1412,7 @@ strip numbers instead."
 
   ;; --- Real fontification things ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (setq font-lock-keywords
 	(list
 	 't
@@ -1375,7 +1460,7 @@ strip numbers instead."
 
   ;; --- Real fontification things ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (setq font-lock-keywords
 	(list
 	 't
@@ -1400,31 +1485,31 @@ strip numbers instead."
 	 ;; --- Handle @/.../ for italics ---
 
 	 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
-	 ;; 	  '(1 font-lock-keyword-face)
-	 ;; 	  '(3 font-lock-keyword-face))
+	 ;;	  '(1 font-lock-keyword-face)
+	 ;;	  '(3 font-lock-keyword-face))
 
 	 ;; --- Handle @*...* for boldness ---
 
 	 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
-	 ;; 	  '(1 font-lock-keyword-face)
-	 ;; 	  '(3 font-lock-keyword-face))
+	 ;;	  '(1 font-lock-keyword-face)
+	 ;;	  '(3 font-lock-keyword-face))
 
 	 ;; --- Handle @`...' for literal syntax things ---
 
 	 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
-	 ;; 	  '(1 font-lock-keyword-face)
-	 ;; 	  '(3 font-lock-keyword-face))
+	 ;;	  '(1 font-lock-keyword-face)
+	 ;;	  '(3 font-lock-keyword-face))
 
 	 ;; --- Handle @<...> for nonterminals ---
 
 	 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
-	 ;; 	  '(1 font-lock-keyword-face)
-	 ;; 	  '(3 font-lock-keyword-face))
+	 ;;	  '(1 font-lock-keyword-face)
+	 ;;	  '(3 font-lock-keyword-face))
 
 	 ;; --- Handle other @-commands ---
 
 	 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
-	 ;;       '(0 font-lock-keyword-face))
+	 ;;	  '(0 font-lock-keyword-face))
 
 	 ;; --- Make sure we get comments properly ---
 
@@ -1547,15 +1632,14 @@ strip numbers instead."
 			      '(2 font-lock-string-face))
 			(list (concat "^\\([ \t]*#[ \t]*\\(\\("
 				      preprocessor-keywords
- 				      "\\)\\>\\|[0-9]+\\|$\\)\\)")
+				      "\\)\\>\\|[0-9]+\\|$\\)\\)")
 			      '(1 font-lock-keyword-face)))
 		  message-mode-keywords)))
-  (setq font-lock-defaults
-	'(message-mode-keywords nil nil nil nil))
   (turn-on-font-lock-if-enabled)
-  (run-hooks 'messages-mode-hook))
+  (run-hooks 'cpp-messages-mode-hook))
 
-(add-hook 'messages-file-hook 'mdw-misc-mode-config t)
+(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
+(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
 
 ;;;----- Messages-file mode -------------------------------------------------
@@ -1658,7 +1742,7 @@ strip numbers instead."
   (local-set-key "\C-i" 'smalltalk-reindent))
 
 (defun mdw-fontify-smalltalk ()
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (setq font-lock-keywords
 	(list
 	 't
@@ -1699,7 +1783,7 @@ strip numbers instead."
 
   ;; --- Not much fontification needed ---
 
-  (make-local-variable  'font-lock-keywords)
+  (make-local-variable 'font-lock-keywords)
   (setq font-lock-keywords
 	(list
 	 't
@@ -1729,7 +1813,7 @@ strip numbers instead."
 	    'comint-watch-for-password-prompt))
 
 (defun mdw-term-mode-setup ()
-  (setq term-prompt-regexp "^[^]#$%>»\n]*[]#$%>»] *")
+  (setq term-prompt-regexp "^[^]#$%>»}\n]*[]#$%>»}] *")
   (make-local-variable 'mouse-yank-at-point)
   (make-local-variable 'transient-mark-mode)
   (setq mouse-yank-at-point t)