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

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