code.delx.au - gnu-emacs-elpa/blob - delight.el

   1 ;;; delight.el --- A dimmer switch for your lighter text.
   2 ;;
   3 ;; Author: Phil S.
   4 ;; URL: http://www.emacswiki.org/emacs/DelightedModes
   5 ;; Keywords: convenience
   6 ;; Created: 25 Jun 2013
   7 ;; Version: 1.04
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; This file is free software: you can redistribute it and/or modify it under
  12 ;; the terms of the GNU General Public License as published by the Free Software
  13 ;; Foundation, either version 3 of the License, or (at your option) any later
  14 ;; version. See <http://www.gnu.org/licenses/>.
  15
  16 ;;; Commentary:
  17 ;;
  18 ;; Enables you to customise the mode names displayed in the mode line.
  19 ;;
  20 ;; For major modes, the buffer-local `mode-name' variable is modified.
  21 ;; For minor modes, the associated value in `minor-mode-alist' is set.
  22 ;;
  23 ;; Example usage:
  24 ;;
  25 ;; (require 'delight)
  26 ;;
  27 ;; (delight 'abbrev-mode " Abv" "abbrev")
  28 ;;
  29 ;; (delight '((abbrev-mode " Abv" "abbrev")
  30 ;;            (smart-tab-mode " \\t" "smart-tab")
  31 ;;            (eldoc-mode nil "eldoc")
  32 ;;            (rainbow-mode)
  33 ;;            (emacs-lisp-mode "Elisp" :major)))
  34 ;;
  35 ;; Important note:
  36 ;;
  37 ;; Although strings are common, any mode-line construct is permitted
  38 ;; as the value (for both minor and major modes); so before you
  39 ;; override a value you should check the existing one, as you may
  40 ;; want to replicate any structural elements in your replacement
  41 ;; if it turns out not to be a simple string.
  42 ;;
  43 ;; For major modes, M-: mode-name
  44 ;; For minor modes, M-: (cadr (assq 'MODE minor-mode-alist))
  45 ;; for the minor MODE in question.
  46 ;;
  47 ;; Conversely, you may incorporate additional mode-line constructs in
  48 ;; your replacement values, if you so wish. e.g.:
  49 ;;
  50 ;; (delight 'emacs-lisp-mode
  51 ;;          '("Elisp" (lexical-binding ":Lex" ":Dyn"))
  52 ;;          :major)
  53 ;;
  54 ;; See `mode-line-format' for information about mode-line constructs,
  55 ;; and M-: (info "(elisp) Mode Line Format") for further details.
  56 ;;
  57 ;; Also bear in mind that some modes may dynamically update these
  58 ;; values themselves (for instance dired-mode updates mode-name if
  59 ;; you change the sorting criteria) in which cases this library may
  60 ;; prove inadequate.
  61
  62 ;;; Changelog:
  63 ;;
  64 ;; 1.04 (2016-02-28) Respect `inhibit-mode-name-delight' when already set.
  65 ;; 1.03 (2014-05-30) Added support for `mode-line-mode-menu'.
  66 ;; 1.02 (2014-05-04) Bug fix for missing 'cl requirement for
  67 ;;       destructuring-bind macro.
  68 ;; 1.01 (2014-05-04) Allow the keyword :major as the FILE argument for
  69 ;;       major modes, to avoid also processing them as minor modes.
  70 ;; 1.00 (2013-06-25) Initial release.
  71
  72 ;;; Code:
  73
  74 (eval-when-compile
  75   (require 'cl))
  76
  77 (defvar delighted-modes ()
  78   "List of specs for modifying the display of mode names in the mode line.
  79
  80 See `delight'.")
  81
  82 ;;;###autoload
  83 (defun delight (spec &optional value file)
  84   "Modify the lighter value displayed in the mode line for the given mode SPEC
  85 if and when the mode is loaded.
  86
  87 SPEC can be either a mode symbol, or a list containing multiple elements of
  88 the form (MODE VALUE FILE). In the latter case the two optional arguments are
  89 omitted, as they are instead specified for each element of the list.
  90
  91 For minor modes, VALUE is the replacement lighter value (or nil to disable)
  92 to set in the `minor-mode-alist' variable. For major modes VALUE is the
  93 replacement buffer-local `mode-name' value to use when a buffer changes to
  94 that mode.
  95
  96 In both cases VALUE is commonly a string, but may in fact contain any valid
  97 mode-line construct. For details see the `mode-line-format' variable, and
  98 Info node `(elisp) Mode Line Format'.
  99
 100 The FILE argument is passed through to `eval-after-load'. If FILE is nil then
 101 the mode symbol is passed as the required feature. Both of these cases are
 102 relevant to minor modes only.
 103
 104 For major modes you should specify the keyword :major as the value of FILE,
 105 to prevent the mode being treated as a minor mode."
 106   (add-hook 'after-change-major-mode-hook 'delight-major-mode)
 107   (let ((glum (if (consp spec) spec (list (list spec value file)))))
 108     (while glum
 109       (destructuring-bind (mode &optional value file) (pop glum)
 110         (assq-delete-all mode delighted-modes)
 111         (add-to-list 'delighted-modes (list mode value file))
 112         (unless (eq file :major)
 113           (eval-after-load (or file mode)
 114             `(let ((minor-delight (assq ',mode minor-mode-alist)))
 115                (when minor-delight
 116                  (setcar (cdr minor-delight) ',value)
 117                  (delight-mode-line-mode-menu ',mode ',value)))))))))
 118
 119 (defun delight-mode-line-mode-menu (mode value)
 120   "Delight `mode-line-mode-menu' (the \"Toggle minor modes\" menu)
 121 so that the Lighter text displayed in the menu matches that displayed in
 122 the mode line (when such menu items exist).
 123
 124 The expected naming scheme for the menu items is: \"Friendly name (Lighter)\"
 125 e.g.: \"Highlight changes (Chg)\".
 126
 127 We replace the \"Lighter\" portion of that with our delighted VALUE, for the
 128 specified MODE, unless VALUE is empty/nil, in which case we remove the text
 129 and parentheses altogether.
 130
 131 If the delighted VALUE is not a string and not nil, we do nothing."
 132   (when (string-or-null-p value)
 133     (let* ((menu-keymap mode-line-mode-menu)
 134            (menu-item (assq mode (cdr menu-keymap))))
 135       (when menu-item
 136         ;; Lighter text is typically prefixed with a space to separate
 137         ;; it from the preceding lighter. We need to trim that space.
 138         (let* ((trimmed-value (if (and value (string-match "\\`\\s-+" value))
 139                                   (replace-match "" t t value)
 140                                 value))
 141                (wrapped-value (if (> (length trimmed-value) 0)
 142                                   (concat " (" trimmed-value ")")
 143                                 ""))
 144                (menu-def (cdr menu-item))
 145                (label (cadr menu-def))
 146                (new-label (and (stringp label)
 147                                (or (string-match "\\s-+(.+?)\\s-*\\'" label)
 148                                    (string-match "\\s-*\\'" label))
 149                                (replace-match wrapped-value t t label))))
 150           (when new-label
 151             ;; Pure storage is used for the default menu items, so we
 152             ;; cannot modify those objects directly.
 153             (setq menu-def (copy-sequence menu-def))
 154             (setf (cadr menu-def) new-label)
 155             (define-key menu-keymap (vector mode) menu-def)))))))
 156
 157 (defun delight-major-mode ()
 158   "Delight the 'pretty name' of the current buffer's major mode
 159 when displayed in the mode-line.
 160
 161 When `mode-name' is displayed in other contexts (such as in the
 162 `describe-mode' help buffer), its original value will be used."
 163   (let ((major-delight (assq major-mode delighted-modes)))
 164     (when major-delight
 165       (setq mode-name `(inhibit-mode-name-delight
 166                         ,mode-name ;; glum
 167                         ,(cadr major-delight)))))) ;; delighted
 168
 169 (defvar inhibit-mode-name-delight)
 170
 171 (defadvice format-mode-line (around delighted-modes-are-glum activate)
 172   "Delighted modes should exhibit their original `mode-name' when
 173 `format-mode-line' is called. See `delight-major-mode'."
 174   (let ((inhibit-mode-name-delight (if (boundp 'inhibit-mode-name-delight)
 175                                        inhibit-mode-name-delight
 176                                      t)))
 177     ad-do-it))
 178
 179 (provide 'delight)
 180 ;;; delight.el ends here