Updated v1.05 for Savannah and GNU ELPA

[gnu-emacs-elpa] / delight.el

diff --git a/delight.el b/delight.el
index 989bb8cca065996e589922543746efa3efb25714..3edee24c124542cf8e4380613120b40d68785d10 100644 (file)
--- a/delight.el
+++ b/delight.el
@@ -1,10 +1,26 @@
-;;; delight.el - A dimmer switch for your lighter text.
+;;; delight.el --- A dimmer switch for your lighter text.

 ;;
 ;;

-;; Author: Phil S.
+;; Copyright (C) 2013, 2014, 2016 Phil Sainty
+;; Author: Phil Sainty <psainty@orcon.net.nz>

 ;; URL: http://www.emacswiki.org/emacs/DelightedModes
 ;; URL: http://www.emacswiki.org/emacs/DelightedModes

-;; Version: 1.01
+;; Keywords: convenience
+;; Created: 25 Jun 2013
+;; Version: 1.05

 
 

-;; Commentary:
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:

 ;;
 ;; Enables you to customise the mode names displayed in the mode line.
 ;;
 ;;
 ;; Enables you to customise the mode names displayed in the mode line.
 ;;


@@ -21,8 +37,30 @@
 ;;            (smart-tab-mode " \\t" "smart-tab")
 ;;            (eldoc-mode nil "eldoc")
 ;;            (rainbow-mode)
 ;;            (smart-tab-mode " \\t" "smart-tab")
 ;;            (eldoc-mode nil "eldoc")
 ;;            (rainbow-mode)

+;;            (overwrite-mode " Ov" t)

 ;;            (emacs-lisp-mode "Elisp" :major)))
 ;;
 ;;            (emacs-lisp-mode "Elisp" :major)))
 ;;

+;; The first argument is the mode symbol.
+;;
+;; The second argument is the replacement name to use in the mode line
+;; (or nil to hide it).
+;;
+;; The third argument is either the keyword :major for major modes or,
+;; for minor modes, the library which defines the mode. This is passed
+;; to ‘eval-after-load’ and so should be either the name (as a string)
+;; of the library file which defines the mode, or the feature (symbol)
+;; provided by that library. If this argument is nil, the mode symbol
+;; will be passed as the feature. If this argument is either t or 'emacs
+;; then it is assumed that the mode is already loaded (you can use this
+;; with standard minor modes that are pre-loaded by default when Emacs
+;; starts).
+;;
+;; To determine which library defines a mode, use e.g.: C-h f
+;; eldoc-mode RET. The name of the library is displayed in the first
+;; paragraph, with an “.el” suffix (in this example it displays
+;; “eldoc.el”, and therefore we could use the value “eldoc” for the
+;; library).
+;;

 ;; Important note:
 ;;
 ;; Although strings are common, any mode-line construct is permitted
 ;; Important note:
 ;;
 ;; Although strings are common, any mode-line construct is permitted


@@ -50,13 +88,23 @@
 ;; you change the sorting criteria) in which cases this library may
 ;; prove inadequate.
 
 ;; you change the sorting criteria) in which cases this library may
 ;; prove inadequate.
 

-;;; Changelog:
+;;; Change Log:

 ;;
 ;;

-;; 1.01 - Added support for using the keyword :major as the FILE argument
-;;        for major modes, to avoid also processing them as minor modes.
+;; 1.05 (2016-03-01) Support FILE value t, meaning that the minor MODE
+;;       in question is guaranteed to already be loaded.
+;; 1.04 (2016-02-28) Respect `inhibit-mode-name-delight' when already set.
+;; 1.03 (2014-05-30) Added support for `mode-line-mode-menu'.
+;; 1.02 (2014-05-04) Bug fix for missing 'cl requirement for
+;;       destructuring-bind macro.
+;; 1.01 (2014-05-04) Allow the keyword :major as the FILE argument for
+;;       major modes, to avoid also processing them as minor modes.
+;; 1.00 (2013-06-25) Initial release.

 
 ;;; Code:
 
 
 ;;; Code:
 

+(eval-when-compile
+  (require 'cl))
+

 (defvar delighted-modes ()
   "List of specs for modifying the display of mode names in the mode line.
 
 (defvar delighted-modes ()
   "List of specs for modifying the display of mode names in the mode line.
 


@@ -77,11 +125,13 @@ replacement buffer-local `mode-name' value to use when a buffer changes to
 that mode.
 
 In both cases VALUE is commonly a string, but may in fact contain any valid
 that mode.
 
 In both cases VALUE is commonly a string, but may in fact contain any valid

-mode-line construct. See `mode-line-format' for details.
+mode-line construct. For details see the `mode-line-format' variable, and
+Info node `(elisp) Mode Line Format'.

 
 The FILE argument is passed through to `eval-after-load'. If FILE is nil then
 
 The FILE argument is passed through to `eval-after-load'. If FILE is nil then

-the mode symbol is passed as the required feature. Both of these cases are
-relevant to minor modes only.
+the mode symbol is passed as the required feature. If FILE is t then it is
+assumed that the mode is already loaded. (Note that you can also use 'emacs
+for this purpose). These FILE options are relevant to minor modes only.

 
 For major modes you should specify the keyword :major as the value of FILE,
 to prevent the mode being treated as a minor mode."
 
 For major modes you should specify the keyword :major as the value of FILE,
 to prevent the mode being treated as a minor mode."


@@ -92,10 +142,49 @@ to prevent the mode being treated as a minor mode."
         (assq-delete-all mode delighted-modes)
         (add-to-list 'delighted-modes (list mode value file))
         (unless (eq file :major)
         (assq-delete-all mode delighted-modes)
         (add-to-list 'delighted-modes (list mode value file))
         (unless (eq file :major)

-          (eval-after-load (or file mode)
+          (eval-after-load (if (eq file t) 'emacs (or file mode))

             `(let ((minor-delight (assq ',mode minor-mode-alist)))
                (when minor-delight
             `(let ((minor-delight (assq ',mode minor-mode-alist)))
                (when minor-delight

-                 (setcar (cdr minor-delight) ',value)))))))))
+                 (setcar (cdr minor-delight) ',value)
+                 (delight-mode-line-mode-menu ',mode ',value)))))))))
+
+(defun delight-mode-line-mode-menu (mode value)
+  "Delight `mode-line-mode-menu' (the \"Toggle minor modes\" menu)
+so that the Lighter text displayed in the menu matches that displayed in
+the mode line (when such menu items exist).
+
+The expected naming scheme for the menu items is: \"Friendly name (Lighter)\"
+e.g.: \"Highlight changes (Chg)\".
+
+We replace the \"Lighter\" portion of that with our delighted VALUE, for the
+specified MODE, unless VALUE is empty/nil, in which case we remove the text
+and parentheses altogether.
+
+If the delighted VALUE is not a string and not nil, we do nothing."
+  (when (string-or-null-p value)
+    (let* ((menu-keymap mode-line-mode-menu)
+           (menu-item (assq mode (cdr menu-keymap))))
+      (when menu-item
+        ;; Lighter text is typically prefixed with a space to separate
+        ;; it from the preceding lighter. We need to trim that space.
+        (let* ((trimmed-value (if (and value (string-match "\\`\\s-+" value))
+                                  (replace-match "" t t value)
+                                value))
+               (wrapped-value (if (> (length trimmed-value) 0)
+                                  (concat " (" trimmed-value ")")
+                                ""))
+               (menu-def (cdr menu-item))
+               (label (cadr menu-def))
+               (new-label (and (stringp label)
+                               (or (string-match "\\s-+(.+?)\\s-*\\'" label)
+                                   (string-match "\\s-*\\'" label))
+                               (replace-match wrapped-value t t label))))
+          (when new-label
+            ;; Pure storage is used for the default menu items, so we
+            ;; cannot modify those objects directly.
+            (setq menu-def (copy-sequence menu-def))
+            (setf (cadr menu-def) new-label)
+            (define-key menu-keymap (vector mode) menu-def)))))))

 
 (defun delight-major-mode ()
   "Delight the 'pretty name' of the current buffer's major mode
 
 (defun delight-major-mode ()
   "Delight the 'pretty name' of the current buffer's major mode


@@ -109,10 +198,15 @@ When `mode-name' is displayed in other contexts (such as in the
                         ,mode-name ;; glum
                         ,(cadr major-delight)))))) ;; delighted
 
                         ,mode-name ;; glum
                         ,(cadr major-delight)))))) ;; delighted
 

+(defvar inhibit-mode-name-delight)
+

 (defadvice format-mode-line (around delighted-modes-are-glum activate)
   "Delighted modes should exhibit their original `mode-name' when
 `format-mode-line' is called. See `delight-major-mode'."
 (defadvice format-mode-line (around delighted-modes-are-glum activate)
   "Delighted modes should exhibit their original `mode-name' when
 `format-mode-line' is called. See `delight-major-mode'."

-  (let ((inhibit-mode-name-delight t))
+  (let ((inhibit-mode-name-delight (if (boundp 'inhibit-mode-name-delight)
+                                       inhibit-mode-name-delight
+                                     t)))

     ad-do-it))
 
 (provide 'delight)
     ad-do-it))
 
 (provide 'delight)

+;;; delight.el ends here