chiark / gitweb /
el/dot-emacs.el: Add missing parent argument to `mdw-define-c-style' calls.
[profile] / el / dot-emacs.el
index d2b9dccef345a06cf94beef78b9e5aaf8ddf61bd..ce78d105d0228334334f3eea365317907f08502c 100644 (file)
@@ -169,6 +169,17 @@ (defun mdw-kick-menu-bar (&optional frame)
     (set-frame-parameter frame 'menu-bar-lines 0)
     (set-frame-parameter frame 'menu-bar-lines old)))
 
+;; Page motion.
+
+(defun mdw-fixup-page-position ()
+  (unless (eq (char-before (point)) ?\f)
+    (forward-line 0)))
+
+(defadvice backward-page (after mdw-fixup compile activate)
+  (mdw-fixup-page-position))
+(defadvice forward-page (after mdw-fixup compile activate)
+  (mdw-fixup-page-position))
+
 ;; Splitting windows.
 
 (unless (fboundp 'scroll-bar-columns)
@@ -240,6 +251,14 @@ (defun mdw-set-frame-width (columns &optional width)
                        sb-width))
     (mdw-divvy-window width)))
 
+(defvar mdw-frame-width-fudge
+  (cond ((<= emacs-major-version 20) 1)
+       ((= emacs-major-version 26) 3)
+       (t 0))
+  "The number of extra columns to add to the desired frame width.
+
+This is sadly necessary because Emacs 26 is broken in this regard.")
+
 ;; Don't raise windows unless I say so.
 
 (defvar mdw-inhibit-raise-frame nil
@@ -347,9 +366,9 @@ (defun mdw-discordian-date (date)
         (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)))
+        (year (- (calendar-extract-year date) 1900))
+        (month (1- (calendar-extract-month date)))
+        (day (1- (calendar-extract-day date)))
         (julian (+ (aref day-count month) day))
         (dyear (+ year 3066)))
     (if (and (= month 1) (= day 28))
@@ -569,6 +588,34 @@ (defadvice display-buffer (before mdw-inhibit-other-frames activate)
 Pretend they don't exist.  They might be on other display devices."
   (ad-set-arg 2 nil))
 
+;; Rename buffers along with files.
+
+(defvar mdw-inhibit-rename-buffer nil
+  "If non-nil, `rename-file' won't rename the buffer visiting the file.")
+
+(defmacro mdw-advise-to-inhibit-rename-buffer (function)
+  "Advise FUNCTION to set `mdw-inhibit-rename-buffer' while it runs.
+
+This will prevent `rename-file' from renaming the buffer."
+  `(defadvice ,function (around mdw-inhibit-rename-buffer compile activate)
+     "Don't rename the buffer when renaming the underlying file."
+     (let ((mdw-inhibit-rename-buffer t))
+       ad-do-it)))
+(mdw-advise-to-inhibit-rename-buffer recode-file-name)
+(mdw-advise-to-inhibit-rename-buffer set-visited-file-name)
+(mdw-advise-to-inhibit-rename-buffer backup-buffer)
+
+(defadvice rename-file (after mdw-rename-buffers (from to &optional forcep)
+                       compile activate)
+  "If a buffer is visiting the file, rename it to match the new name.
+
+Don't do this if `mdw-inhibit-rename-buffer' is non-nil."
+  (unless mdw-inhibit-rename-buffer
+    (let ((buffer (get-file-buffer from)))
+      (when buffer
+       (with-current-buffer buffer
+         (set-visited-file-name to nil t))))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Improved compilation machinery.
 
@@ -800,7 +847,7 @@ (defun mdw-nnimap-transform-headers ()
          (delete-region (+ (match-beginning 0) 2) (point))
          (setq string (buffer-substring (point) (+ (point) size)))
          (delete-region (point) (+ (point) size))
-         (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))
+         (insert (format "%S" (subst-char-in-string ?\n ?\s string)))
          ;; [mdw] missing from upstream
          (backward-char 1))
        (beginning-of-line)
@@ -846,6 +893,18 @@ (eval-after-load 'nnimap
   '(defalias 'nnimap-transform-headers
      (symbol-function 'mdw-nnimap-transform-headers)))
 
+(defadvice gnus-other-frame (around mdw-hack-frame-width compile activate)
+  "Always arrange for mail/news frames to be 80 columns wide."
+  (let ((default-frame-alist (cons `(width . ,(+ 80 mdw-frame-width-fudge))
+                                  (cl-delete 'width default-frame-alist
+                                             :key #'car))))
+    ad-do-it))
+
+;; Preferred programs.
+
+(setq mailcap-user-mime-data
+      '(((type . "application/pdf") (viewer . "mupdf %s"))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Utility functions.
 
@@ -1260,7 +1319,14 @@ (defun mdw-misc-mode-config ()
   (set (make-local-variable 'mdw-do-misc-mode-hacking) t)
   (local-set-key [C-return] 'newline)
   (make-local-variable 'page-delimiter)
-  (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
+  (setq page-delimiter (concat       "^" "\f"
+                              "\\|" "^"
+                                    ".\\{0,4\\}"
+                                    "-\\{5\\}"
+                                    "\\(" " " ".*" " " "\\)?"
+                                    "-+"
+                                    ".\\{0,2\\}"
+                                    "$"))
   (setq comment-column 40)
   (auto-fill-mode 1)
   (setq fill-column mdw-text-width)
@@ -1404,11 +1470,8 @@ (mdw-define-face fixed-pitch-serif
   (((type w32)) :family "courier new" :height 85 :weight bold)
   (((type x)) :family "6x13" :foundry "trad" :height 130 :weight bold)
   (t :foreground "white" :background "black" :weight bold))
-(if (mdw-emacs-version-p 23)
-    (mdw-define-face variable-pitch
-      (((type x)) :family "sans" :height 100))
-  (mdw-define-face variable-pitch
-    (((type x)) :family "helvetica" :height 90)))
+(mdw-define-face variable-pitch
+  (((type x)) :family "helvetica" :height 120))
 (mdw-define-face region
   (((min-colors 64)) :background "grey30")
   (((class color)) :background "blue")
@@ -1856,6 +1919,21 @@ (define-globalized-minor-mode mdw-global-point-overlay-mode
   mdw-point-overlay-mode
   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
 
+(defvar mdw-terminal-title-alist nil)
+(defun mdw-update-terminal-title ()
+  (when (let ((term (frame-parameter nil 'tty-type)))
+         (and term (string-match "^xterm" term)))
+    (let* ((tty (frame-parameter nil 'tty))
+          (old (assoc tty mdw-terminal-title-alist))
+          (new (format-mode-line frame-title-format)))
+      (unless (and old (equal (cdr old) new))
+       (if old (rplacd old new)
+         (setq mdw-terminal-title-alist
+               (cons (cons tty new) mdw-terminal-title-alist)))
+       (send-string-to-terminal (concat "\e]2;" new "\e\\"))))))
+
+(add-hook 'post-command-hook 'mdw-update-terminal-title)
+
 ;;;--------------------------------------------------------------------------
 ;;; C programming configuration.
 
@@ -1896,50 +1974,48 @@ (defun mdw-c-indent-arglist-nested (langelem)
 (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.
+(defun mdw-merge-style-alists (first second)
+  (let ((output nil))
+    (dolist (item first)
+      (let ((key (car item)) (value (cdr item)))
+       (if (string-suffix-p "-alist" (symbol-name key))
+           (push (cons key
+                       (mdw-merge-style-alists value
+                                               (cdr (assoc key second))))
+                 output)
+         (push item output))))
+    (dolist (item second)
+      (unless (assoc (car item) first)
+       (push item output)))
+    (nreverse output)))
+
+(cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
+  "Define a C style, called NAME (a symbol) based on PARENT, 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))
+        (var (intern (concat "mdw-c-style/" name-string)))
         (func (intern (concat "mdw-define-c-style/" name-string))))
     `(progn
-       (defun ,func () (c-add-style ,name-string ',assocs))
+       (setq ,var
+            ',(if (null parent)
+                  assocs
+                (let ((parent-list (symbol-value
+                                    (intern (concat "mdw-c-style/"
+                                                    (symbol-name parent))))))
+                  (mdw-merge-style-alists assocs parent-list))))
+       (defun ,func () (c-add-style ,name-string ,var))
        (and (featurep 'cc-mode) (,func))
-       (add-hook 'mdw-define-c-styles-hook ',func))))
+       (add-hook 'mdw-define-c-styles-hook ',func)
+       ',name)))
 
 (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 . -2)
-                  (inclass . +)
-                  (inline-open . ++)
-                  (statement-cont . +)
-                  (statement-case-intro . +)))
-
-(mdw-define-c-style mdw-c
+(mdw-define-c-style mdw-c ()
   (c-basic-offset . 2)
   (comment-column . 40)
   (c-class-key . "class")
@@ -1960,6 +2036,18 @@             (defun-open . (add 0 c-indent-one-line-block))
                   (statement-cont . +)
                   (statement-case-intro . +)))
 
+(mdw-define-c-style mdw-trustonic-basic-c (mdw-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-offsets-alist (access-label . -2)))
+
+(mdw-define-c-style mdw-trustonic-c (mdw-trustonic-basic-c)
+  (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested)))
+
 (defun mdw-set-default-c-style (modes style)
   "Update the default CC Mode style for MODES to be STYLE.
 
@@ -2231,7 +2319,7 @@ (progn
 
 ;; Make indentation nice.
 
-(mdw-define-c-style mdw-java
+(mdw-define-c-style mdw-java ()
   (c-basic-offset . 2)
   (c-backslash-column . 72)
   (c-offsets-alist (substatement-open . 0)
@@ -2443,7 +2531,7 @@ (progn
 
 ;; Make indentation nice.
 
-(mdw-define-c-style mdw-csharp
+(mdw-define-c-style mdw-csharp ()
   (c-basic-offset . 2)
   (c-backslash-column . 72)
   (c-offsets-alist (substatement-open . 0)
@@ -4440,6 +4528,41 @@ (defadvice gdb-set-window-buffer
   "Don't make windows dedicated.  Seriously."
   (set-window-dedicated-p (or window (selected-window)) nil))
 
+;;;--------------------------------------------------------------------------
+;;; Man pages.
+
+;; Turn off `noip' when running `man': it interferes with `man-db''s own
+;; seccomp(2)-based sandboxing, which is (in this case, at least) strictly
+;; better.
+(defadvice Man-getpage-in-background
+    (around mdw-inhibit-noip (topic) compile activate)
+  "Inhibit the `noip' preload hack when invoking `man'."
+  (let* ((old-preload (getenv "LD_PRELOAD"))
+        (preloads (save-match-data (split-string old-preload ":")))
+        (any nil)
+        (filtered nil))
+    (while preloads
+      (let ((item (pop preloads)))
+       (if (save-match-data
+             (string-match  "\\(/\\|^\\)noip\.so\\(:\\|$\\)" item))
+           (setq any t)
+         (push item filtered))))
+    (if any
+       (unwind-protect
+           (progn
+             (setenv "LD_PRELOAD"
+                     (and filtered
+                          (with-output-to-string
+                            (setq filtered (nreverse filtered))
+                            (let ((first t))
+                              (while filtered
+                                (if first (setq first nil)
+                                  (write-char ?:))
+                                (write-string (pop filtered)))))))
+             ad-do-it)
+         (setenv "LD_PRELOAD" old-preload))
+      ad-do-it)))
+
 ;;;--------------------------------------------------------------------------
 ;;; MPC configuration.