X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/c9f00bd07474abfc4dccad6ae9f6f72b5baee4f2..1b239a706933a7252f4a737db92b70f294320d8f:/el/dot-emacs.el diff --git a/el/dot-emacs.el b/el/dot-emacs.el index 19d594d..7d3bc10 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 @@ -1113,30 +1244,66 @@ doesn't match any of the regular expressions in (t :background "red" :foreground "white" :weight bold)) (mdw-define-face message-cited-text (default :slant italic) - (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) + (((type tty)) :foreground "cyan") (t :foreground "SkyBlue1")) (mdw-define-face message-header-cc - (default :weight bold) + (default :slant italic) (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) (mdw-define-face message-header-newsgroups - (default :weight bold) + (default :slant italic) (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) (mdw-define-face message-header-subject - (default :weight bold) (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) (mdw-define-face message-header-to - (default :weight bold) (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) (mdw-define-face message-header-xheader - (default :weight bold) + (default :slant italic) (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) (mdw-define-face message-header-other - (default :weight bold) + (default :slant italic) (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) (mdw-define-face message-header-name + (default :weight bold) (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) + (mdw-define-face which-func (t nil)) +(mdw-define-face gnus-header-name + (default :weight bold) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face gnus-header-subject + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face gnus-header-from + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face gnus-header-to + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face gnus-header-content + (default :slant italic) + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) + +(mdw-define-face gnus-cite-1 + (((type tty)) :foreground "cyan") (t :foreground "SkyBlue1")) +(mdw-define-face gnus-cite-2 + (((type tty)) :foreground "blue") (t :foreground "RoyalBlue2")) +(mdw-define-face gnus-cite-3 + (((type tty)) :foreground "magenta") (t :foreground "MediumOrchid")) +(mdw-define-face gnus-cite-4 + (((type tty)) :foreground "red") (t :foreground "firebrick2")) +(mdw-define-face gnus-cite-5 + (((type tty)) :foreground "yellow") (t :foreground "burlywood2")) +(mdw-define-face gnus-cite-6 + (((type tty)) :foreground "green") (t :foreground "SeaGreen1")) +(mdw-define-face gnus-cite-7 + (((type tty)) :foreground "cyan") (t :foreground "SlateBlue1")) +(mdw-define-face gnus-cite-8 + (((type tty)) :foreground "blue") (t :foreground "RoyalBlue2")) +(mdw-define-face gnus-cite-9 + (((type tty)) :foreground "magenta") (t :foreground "purple2")) +(mdw-define-face gnus-cite-10 + (((type tty)) :foreground "red") (t :foreground "DarkOrange2")) +(mdw-define-face gnus-cite-11 + (t :foreground "grey")) + (mdw-define-face diff-header (t nil)) (mdw-define-face diff-index @@ -1173,7 +1340,7 @@ doesn't match any of the regular expressions in (t :foreground "SkyBlue1")) (mdw-define-face magit-item-highlight (((type tty)) :background "blue") - (t :background "DarkSeaGreen4")) + (t :background "grey11")) (mdw-define-face magit-log-head-label-remote (((type tty)) :background "cyan" :foreground "green") (t :background "grey11" :foreground "DarkSeaGreen2" :box t)) @@ -1325,17 +1492,20 @@ doesn't match any of the regular expressions in ;; Other stuff. (mdw-c-style) - (setq c-hanging-comment-ender-p nil) - (setq c-backslash-column 72) - (setq c-label-minimum-indentation 0) - (setq mdw-fill-prefix mdw-c-comment-fill-prefix) + (setq c-hanging-comment-ender-p nil + c-backslash-column 72 + c-label-minimum-indentation 0 + mdw-fill-prefix mdw-c-comment-fill-prefix) ;; Now define things to be fontified. (make-local-variable 'font-lock-keywords) (let ((c-keywords - (mdw-regexps "and" ;C++, C95 macro + (mdw-regexps "alignas" ;C11 macro, C++11 + "alignof" ;C++11 + "and" ;C++, C95 macro "and_eq" ;C++, C95 macro "asm" ;K&R, C++, GCC + "atomic" ;C11 macro, C++11 template type "auto" ;K&R, C89 "bitand" ;C++, C95 macro "bitor" ;C++, C95 macro @@ -1344,12 +1514,16 @@ doesn't match any of the regular expressions in "case" ;K&R, C89 "catch" ;C++ "char" ;K&R, C89 + "char16_t" ;C++11, C11 library type + "char32_t" ;C++11, C11 library type "class" ;C++ "complex" ;C99 macro, C++ template type "compl" ;C++, C95 macro "const" ;C89 + "constexpr" ;C++11 "const_cast" ;C++ "continue" ;K&R, C89 + "decltype" ;C++11 "defined" ;C89 preprocessor "default" ;K&R, C89 "delete" ;C++ @@ -1375,8 +1549,11 @@ doesn't match any of the regular expressions in "mutable" ;C++ "namespace" ;C++ "new" ;C++ + "noexcept" ;C++11 + "noreturn" ;C11 macro "not" ;C++, C95 macro "not_eq" ;C++, C95 macro + "nullptr" ;C++11 "operator" ;C++ "or" ;C++, C95 macro "or_eq" ;C++, C95 macro @@ -1391,12 +1568,14 @@ doesn't match any of the regular expressions in "signed" ;C89 "sizeof" ;K&R, C89 "static" ;K&R, C89 + "static_assert" ;C11 macro, C++11 "static_cast" ;C++ "struct" ;K&R, C89 "switch" ;K&R, C89 "template" ;C++ "throw" ;C++ "try" ;C++ + "thread_local" ;C11 macro, C++11 "typedef" ;C89 "typeid" ;C++ "typeof" ;GCC @@ -1411,10 +1590,17 @@ doesn't match any of the regular expressions in "while" ;K&R, C89 "xor" ;C++, C95 macro "xor_eq" ;C++, C95 macro + "_Alignas" ;C11 + "_Alignof" ;C11 + "_Atomic" ;C11 "_Bool" ;C99 "_Complex" ;C99 + "_Generic" ;C11 "_Imaginary" ;C99 + "_Noreturn" ;C11 "_Pragma" ;C99 preprocessor + "_Static_assert" ;C11 + "_Thread_local" ;C11 "__alignof__" ;GCC "__asm__" ;GCC "__attribute__" ;GCC @@ -2720,6 +2906,10 @@ strip numbers instead." (modify-syntax-entry ?$ "." font-lock-syntax-table) (local-set-key [?$] 'self-insert-command) + ;; Make `tab' be useful, given that tab stops in TeX don't work well. + (local-set-key "\C-i" 'indent-relative) + (setq indent-tabs-mode nil) + ;; Set fill prefix. (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")