X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/fff80d993fbf831f2cdffcbf2c0bc8f95d65b0a9..22e3f2873ee1856f0416f777cf2c625c5e4ddd2d:/el/dot-emacs.el diff --git a/el/dot-emacs.el b/el/dot-emacs.el index dd8dc2f..d883666 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -370,27 +370,45 @@ as output rather than a string." (let ((mdw-diary-for-org-mode-p t)) ad-do-it)) -(defadvice diary-add-to-list (before mdw-trim-leading-space activate) +(defadvice diary-add-to-list (before mdw-trim-leading-space compile 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) + (let ((str (ad-get-arg 1)) + (done nil) old) + (while (not done) + (setq old str) + (setq str (cond ((null str) nil) + ((string-match "\\(^\\|\n\\)[ \t]+" str) + (replace-match "\\1" nil nil str)) ((and mdw-diary-for-org-mode-p (string-match (concat - "^[ \t]*" + "\\(^\\|\n\\)" "\\(" diary-time-regexp "\\(-" diary-time-regexp "\\)?" - "\\)[ \t]+") + "\\)" + "\\(\t[ \t]*\\| [ \t]+\\)") str)) - (replace-match "\\1 " nil nil str)) - ((string-match "^[ \t]+" str) - (replace-match "" nil nil str)) + (replace-match "\\1\\2 " nil nil str)) ((and (not mdw-diary-for-org-mode-p) (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]" str)) (replace-match "\\1" nil nil str)) - (t str)))))) + (t str))) + (if (equal str old) (setq done t))) + (ad-set-arg 1 str)))) + +(defadvice org-bbdb-anniversaries (after mdw-fixup-list compile activate) + "Return a string rather than a list." + (with-temp-buffer + (let ((anyp nil)) + (dolist (e (let ((ee ad-return-value)) + (if (atom ee) (list ee) ee))) + (when e + (when anyp (insert ?\n)) + (insert e) + (setq anyp t))) + (setq ad-return-value + (and anyp (buffer-string)))))) ;; Fighting with Org-mode's evil key maps. @@ -979,10 +997,20 @@ case." (mdw-whitespace-mode 1))) (add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config) -(defadvice toggle-read-only (after mdw-angry-fruit-salad activate) - (when mdw-do-misc-mode-hacking - (setq show-trailing-whitespace (not buffer-read-only)) - (mdw-whitespace-mode (if buffer-read-only 0 1)))) +(defmacro mdw-advise-update-angry-fruit-salad (&rest funcs) + `(progn ,@(mapcar (lambda (func) + `(defadvice ,func + (after mdw-angry-fruit-salad activate) + (when mdw-do-misc-mode-hacking + (setq show-trailing-whitespace + (not buffer-read-only)) + (mdw-whitespace-mode (if buffer-read-only 0 1))))) + funcs))) +(mdw-advise-update-angry-fruit-salad toggle-read-only + read-only-mode + view-mode + view-mode-enable + view-mode-disable) (eval-after-load 'gtags '(progn @@ -1209,6 +1237,9 @@ doesn't match any of the regular expressions in (mdw-define-face trailing-whitespace (((class color)) :background "red") (t :inverse-video t)) +(mdw-define-face whitespace-line + (((class color)) :background "darkred") + (t :inverse-video :t)) (mdw-define-face mdw-punct-face (((type tty)) :foreground "yellow") (t :foreground "burlywood2")) (mdw-define-face mdw-number-face @@ -1244,30 +1275,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 @@ -1289,6 +1356,12 @@ doesn't match any of the regular expressions in (mdw-define-face diff-refine-change (((class color) (type x)) :background "RoyalBlue4") (t :underline t)) +(mdw-define-face diff-refine-removed + (((class color) (type x)) :background "#500") + (t :underline t)) +(mdw-define-face diff-refine-added + (((class color) (type x)) :background "#050") + (t :underline t)) (mdw-define-face dylan-header-background (((class color) (type x)) :background "NavyBlue") @@ -1386,17 +1459,6 @@ doesn't match any of the regular expressions in ;;;-------------------------------------------------------------------------- ;;; C programming configuration. -;; Linux kernel hacking. - -(defvar linux-c-mode-hook) - -(defun linux-c-mode () - (interactive) - (c-mode) - (setq major-mode 'linux-c-mode) - (setq mode-name "Linux C") - (run-hooks 'linux-c-mode-hook)) - ;; Make C indentation nice. (defun mdw-c-lineup-arglist (langelem) @@ -1415,28 +1477,108 @@ doesn't match any of the regular expressions in c-basic-offset nil))) -(defun mdw-c-style () - (c-add-style "[mdw] C and C++ style" - '((c-basic-offset . 2) - (comment-column . 40) - (c-class-key . "class") - (c-backslash-column . 72) - (c-offsets-alist - (substatement-open . (add 0 c-indent-one-line-block)) - (defun-open . (add 0 c-indent-one-line-block)) - (arglist-cont-nonempty . mdw-c-lineup-arglist) - (topmost-intro . mdw-c-indent-extern-mumble) - (cpp-define-intro . 0) - (knr-argdecl . 0) - (inextern-lang . [0]) - (label . 0) - (case-label . +) - (access-label . -) - (inclass . +) - (inline-open . ++) - (statement-cont . +) - (statement-case-intro . +))) - t)) +(defun mdw-c-indent-arglist-nested (langelem) + "Indent continued argument lists. +If we've nested more than one argument list, then only introduce a single +indentation anyway." + (let ((context c-syntactic-context) + (pos (c-langelem-2nd-pos c-syntactic-element)) + (should-indent-p t)) + (while (and context + (eq (caar context) 'arglist-cont-nonempty)) + (when (and (= (caddr (pop context)) pos) + context + (memq (caar context) '(arglist-intro + arglist-cont-nonempty))) + (setq should-indent-p nil))) + (if should-indent-p '+ 0))) + +(defvar mdw-define-c-styles-hook nil + "Hook run when `cc-mode' starts up to define styles.") + +(defmacro mdw-define-c-style (name &rest assocs) + "Define a C style, called NAME (a symbol), setting ASSOCs. +A function, named `mdw-define-c-style/NAME', is defined to actually install +the style using `c-add-style', and added to the hook +`mdw-define-c-styles-hook'. If CC Mode is already loaded, then the style is +set." + (declare (indent defun)) + (let* ((name-string (symbol-name name)) + (func (intern (concat "mdw-define-c-style/" name-string)))) + `(progn + (defun ,func () (c-add-style ,name-string ',assocs)) + (and (featurep 'cc-mode) (,func)) + (add-hook 'mdw-define-c-styles-hook ',func)))) + +(eval-after-load "cc-mode" + '(run-hooks 'mdw-define-c-styles-hook)) + +(mdw-define-c-style mdw-trustonic-c + (c-basic-offset . 4) + (comment-column . 0) + (c-indent-comment-alist (anchored-comment . (column . 0)) + (end-block . (space . 1)) + (cpp-end-block . (space . 1)) + (other . (space . 1))) + (c-class-key . "class") + (c-backslash-column . 0) + (c-auto-align-backslashes . nil) + (c-label-minimum-indentation . 0) + (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block)) + (defun-open . (add 0 c-indent-one-line-block)) + (arglist-cont-nonempty . mdw-c-indent-arglist-nested) + (topmost-intro . mdw-c-indent-extern-mumble) + (cpp-define-intro . 0) + (knr-argdecl . 0) + (inextern-lang . [0]) + (label . 0) + (case-label . +) + (access-label . -) + (inclass . +) + (inline-open . ++) + (statement-cont . +) + (statement-case-intro . +))) + +(mdw-define-c-style mdw-c + (c-basic-offset . 2) + (comment-column . 40) + (c-class-key . "class") + (c-backslash-column . 72) + (c-label-minimum-indentation . 0) + (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block)) + (defun-open . (add 0 c-indent-one-line-block)) + (arglist-cont-nonempty . mdw-c-lineup-arglist) + (topmost-intro . mdw-c-indent-extern-mumble) + (cpp-define-intro . 0) + (knr-argdecl . 0) + (inextern-lang . [0]) + (label . 0) + (case-label . +) + (access-label . -) + (inclass . +) + (inline-open . ++) + (statement-cont . +) + (statement-case-intro . +))) + +(defun mdw-set-default-c-style (modes style) + "Update the default CC Mode style for MODES to be STYLE. + +MODES may be a list of major mode names or a singleton. STYLE is a style +name, as a symbol." + (let ((modes (if (listp modes) modes (list modes))) + (style (symbol-name style))) + (setq c-default-style + (append (mapcar (lambda (mode) + (cons mode style)) + modes) + (remove-if (lambda (assoc) + (memq (car assoc) modes)) + (if (listp c-default-style) + c-default-style + (list (cons 'other c-default-style)))))))) +(setq c-default-style "mdw-c") + +(mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c) (defvar mdw-c-comment-fill-prefix `((,(concat "\\([ \t]*/?\\)" @@ -1455,10 +1597,6 @@ doesn't match any of the regular expressions in (modify-syntax-entry ?\n "> b") ;; 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) ;; Now define things to be fontified. @@ -1634,12 +1772,8 @@ doesn't match any of the regular expressions in ;;;-------------------------------------------------------------------------- ;;; AP calc mode. -(defun apcalc-mode () - (interactive) - (c-mode) - (setq major-mode 'apcalc-mode) - (setq mode-name "AP Calc") - (run-hooks 'apcalc-mode-hook)) +(define-derived-mode apcalc-mode c-mode "AP Calc" + "Major mode for editing Calc code.") (defun mdw-fontify-apcalc () @@ -1648,9 +1782,6 @@ doesn't match any of the regular expressions in (modify-syntax-entry ?/ ". 14") ;; Other stuff. - (mdw-c-style) - (setq c-hanging-comment-ender-p nil) - (setq c-backslash-column 72) (setq comment-start "/* ") (setq comment-end " */") (setq mdw-fill-prefix mdw-c-comment-fill-prefix) @@ -1688,25 +1819,22 @@ doesn't match any of the regular expressions in ;; Make indentation nice. -(defun mdw-java-style () - (c-add-style "[mdw] Java style" - '((c-basic-offset . 2) - (c-offsets-alist (substatement-open . 0) - (label . +) - (case-label . +) - (access-label . 0) - (inclass . +) - (statement-case-intro . +))) - t)) +(mdw-define-c-style mdw-java + (c-basic-offset . 2) + (c-backslash-column . 72) + (c-offsets-alist (substatement-open . 0) + (label . +) + (case-label . +) + (access-label . 0) + (inclass . +) + (statement-case-intro . +))) +(mdw-set-default-c-style 'java-mode 'mdw-java) ;; Declare Java fontification style. (defun mdw-fontify-java () ;; Other stuff. - (mdw-java-style) - (setq c-hanging-comment-ender-p nil) - (setq c-backslash-column 72) (setq mdw-fill-prefix mdw-c-comment-fill-prefix) ;; Now define things to be fontified. @@ -1885,25 +2013,22 @@ doesn't match any of the regular expressions in ;; Make indentation nice. -(defun mdw-csharp-style () - (c-add-style "[mdw] C# style" - '((c-basic-offset . 2) - (c-offsets-alist (substatement-open . 0) - (label . 0) - (case-label . +) - (access-label . 0) - (inclass . +) - (statement-case-intro . +))) - t)) +(mdw-define-c-style mdw-csharp + (c-basic-offset . 2) + (c-backslash-column . 72) + (c-offsets-alist (substatement-open . 0) + (label . 0) + (case-label . +) + (access-label . 0) + (inclass . +) + (statement-case-intro . +))) +(mdw-set-default-c-style 'csharp-mode 'mdw-csharp) ;; Declare C# fontification style. (defun mdw-fontify-csharp () ;; Other stuff. - (mdw-csharp-style) - (setq c-hanging-comment-ender-p nil) - (setq c-backslash-column 72) (setq mdw-fill-prefix mdw-c-comment-fill-prefix) ;; Now define things to be fontified. @@ -2216,21 +2341,19 @@ doesn't match any of the regular expressions in ;; Make Awk indentation nice. -(defun mdw-awk-style () - (c-add-style "[mdw] Awk style" - '((c-basic-offset . 2) - (c-offsets-alist (substatement-open . 0) - (statement-cont . 0) - (statement-case-intro . +))) - t)) +(mdw-define-c-style mdw-awk + (c-basic-offset . 2) + (c-offsets-alist (substatement-open . 0) + (c-backslash-column . 72) + (statement-cont . 0) + (statement-case-intro . +))) +(mdw-set-default-c-style 'awk-mode 'mdw-awk) ;; Declare Awk fontification style. (defun mdw-fontify-awk () ;; Miscellaneous fiddling. - (mdw-awk-style) - (setq c-backslash-column 72) (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") ;; Now define things to be fontified.