X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/cc71d815da7ea76f48c2a3e67ec6e3627ea630bd..40a3fc1dc55b7302e797c29efe2c9bd3af376a94:/el/dot-emacs.el

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index 11be2ac..dd8dc2f 100644
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -57,6 +57,12 @@ This may be at the expense of cool features.")
   (interactive)
   (error "wrong button"))
 
+(defun mdw-emacs-version-p (major &optional minor)
+  "Return non-nil if the running Emacs is at least version MAJOR.MINOR."
+  (or (> emacs-major-version major)
+      (and (= emacs-major-version major)
+	   (>= emacs-minor-version (or minor 0)))))
+
 ;; Some error trapping.
 ;;
 ;; If individual bits of this file go tits-up, we don't particularly want
@@ -189,8 +195,7 @@ fringes is not taken out of the allowance for WIDTH, unlike
   "Split a wide window into appropriate widths."
   (interactive "P")
   (setq width (cond (width (prefix-numeric-value width))
-		    ((and window-system
-			  (>= emacs-major-version 22))
+		    ((and window-system (mdw-emacs-version-p 22))
 		     77)
 		    (t 78)))
   (let* ((win (selected-window))
@@ -233,6 +238,32 @@ frame is actually mapped on the screen."
   "Save match data around the `markdown-mode' `after-change-functions' hook."
   (save-match-data ad-do-it))
 
+;; Bug fix for `bbdb-canonicalize-address': on Emacs 24, `run-hook-with-args'
+;; always returns nil, with the result that all email addresses are lost.
+;; Replace the function entirely.
+(defadvice bbdb-canonicalize-address
+    (around mdw-bug-fix activate compile)
+  "Don't use `run-hook-with-args', because that doesn't work."
+  (let ((net (ad-get-arg 0)))
+
+    ;; Make sure this is a proper hook list.
+    (if (functionp bbdb-canonicalize-net-hook)
+	(setq bbdb-canonicalize-net-hook (list bbdb-canonicalize-net-hook)))
+
+    ;; Iterate over the hooks until things converge.
+    (let ((donep nil))
+      (while (not donep)
+	(let (next (changep nil)
+	      hook (hooks bbdb-canonicalize-net-hook))
+	  (while hooks
+	    (setq hook (pop hooks))
+	    (setq next (funcall hook net))
+	    (if (not (equal next net))
+		(setq changep t
+		      net next)))
+	  (setq donep (not changep)))))
+    (setq ad-return-value net)))
+
 ;; Transient mark mode hacks.
 
 (defadvice exchange-point-and-mark
@@ -254,6 +285,11 @@ it's currently off."
 
 ;; Functions for sexp diary entries.
 
+(defun mdw-not-org-mode (form)
+  "As FORM, but not in Org mode agenda."
+  (and (not mdw-diary-for-org-mode-p)
+       (eval form)))
+
 (defun mdw-weekday (l)
   "Return non-nil if `date' falls on one of the days of the week in L.
 L is a list of day numbers (from 0 to 6 for Sunday through to
@@ -265,6 +301,50 @@ function returns non-nil."
 	(memq (nth d '(sunday monday tuesday wednesday
 			      thursday friday saturday)) l))))
 
+(defun mdw-discordian-date (date)
+  "Return the Discordian calendar date corresponding to DATE.
+
+The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
+
+The original is by David Pearson.  I modified it to produce date components
+as output rather than a string."
+  (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
+		"Prickle-Prickle" "Setting Orange"])
+	 (months ["Chaos" "Discord" "Confusion"
+		  "Bureaucracy" "Aftermath"])
+	 (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
+	 (year (- (extract-calendar-year date) 1900))
+	 (month (1- (extract-calendar-month date)))
+	 (day (1- (extract-calendar-day date)))
+	 (julian (+ (aref day-count month) day))
+	 (dyear	(+ year 3066)))
+    (if (and (= month 1) (= day 28))
+	(cons dyear 'st-tibs-day)
+      (list dyear
+	    (aref months (floor (/ julian 73)))
+	    (1+ (mod julian 73))
+	    (aref days (mod julian 5))))))
+
+(defun mdw-diary-discordian-date ()
+  "Convert the date in `date' to a string giving the Discordian date."
+  (let* ((ddate (mdw-discordian-date date))
+	 (tail (format "in the YOLD %d" (car ddate))))
+    (if (eq (cdr ddate) 'st-tibs-day)
+	(format "St Tib's Day %s" tail)
+      (let ((season (cadr ddate))
+	    (daynum (caddr ddate))
+	    (dayname (cadddr ddate)))
+      (format "%s, the %d%s day of %s %s"
+	      dayname
+	      daynum
+	      (let ((ldig (mod daynum 10)))
+		(cond ((= ldig 1) "st")
+		      ((= ldig 2) "nd")
+		      ((= ldig 3) "rd")
+		      (t "th")))
+	      season
+	      tail)))))
+
 (defun mdw-todo (&optional when)
   "Return non-nil today, or on WHEN, whichever is later."
   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
@@ -284,6 +364,34 @@ function returns non-nil."
 				(nth 2 when))))))))
     (eq w d)))
 
+(defvar mdw-diary-for-org-mode-p nil)
+
+(defadvice org-agenda-list (around mdw-preserve-links activate)
+  (let ((mdw-diary-for-org-mode-p t))
+    ad-do-it))
+
+(defadvice diary-add-to-list (before mdw-trim-leading-space activate)
+  "Trim leading space from the diary entry string."
+  (save-match-data
+    (let ((str (ad-get-arg 1)))
+      (ad-set-arg 1
+		  (cond ((null str) nil)
+			((and mdw-diary-for-org-mode-p
+			      (string-match (concat
+					     "^[ \t]*"
+					     "\\(" diary-time-regexp
+					     "\\(-" diary-time-regexp "\\)?"
+					     "\\)[ \t]+")
+					    str))
+			 (replace-match "\\1 " nil nil str))
+			((string-match "^[ \t]+" str)
+			 (replace-match "" nil nil str))
+			((and (not mdw-diary-for-org-mode-p)
+			      (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]"
+					    str))
+			 (replace-match "\\1" nil nil str))
+			(t str))))))
+
 ;; Fighting with Org-mode's evil key maps.
 
 (defvar mdw-evil-keymap-keys
@@ -451,6 +559,27 @@ so that it can be used for convenient filtering."
 	  (setenv "REAL_MOVEMAIL" try))
       (setq path (cdr path)))))
 
+;; AUTHINFO GENERIC kludge.
+
+(defvar nntp-authinfo-generic nil
+  "Set to the `NNTPAUTH' string to pass on to `authinfo-kludge'.
+
+Use this to arrange for per-server settings.")
+
+(defun nntp-open-authinfo-kludge (buffer)
+  "Open a connection to SERVER using `authinfo-kludge'."
+  (let ((proc (start-process "nntpd" buffer
+			     "env" (concat "NNTPAUTH="
+					   (or nntp-authinfo-generic
+					       (getenv "NNTPAUTH")
+					       (error "NNTPAUTH unset")))
+			     "authinfo-kludge" nntp-address)))
+    (set-buffer buffer)
+    (nntp-wait-for-string "^\r*200")
+    (beginning-of-line)
+    (delete-region (point-min) (point))
+    proc))
+
 (eval-after-load "erc"
     '(load "~/.ercrc.el"))
 
@@ -995,12 +1124,14 @@ doesn't match any of the regular expressions in
 ;;;--------------------------------------------------------------------------
 ;;; General fontification.
 
+(make-face 'mdw-virgin-face)
+
 (defmacro mdw-define-face (name &rest body)
   "Define a face, and make sure it's actually set as the definition."
   (declare (indent 1)
 	   (debug 0))
   `(progn
-     (make-face ',name)
+     (copy-face 'mdw-virgin-face ',name)
      (defvar ,name ',name)
      (put ',name 'face-defface-spec ',body)
      (face-spec-set ',name ',body nil)))
@@ -1014,7 +1145,7 @@ doesn't match any of the regular expressions in
   (((type w32)) :family "courier new" :height 85)
   (((type x)) :family "6x13" :foundry "trad" :height 130)
   (t :foreground "white" :background "black"))
-(if (>= emacs-major-version 23)
+(if (mdw-emacs-version-p 23)
     (mdw-define-face variable-pitch
       (((type x)) :family "sans" :height 100))
   (mdw-define-face variable-pitch