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

   1 ;;; rich-minority.el --- Clean-up and Beautify the list of minor-modes.
   2
   3 ;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
   6 ;; URL: https://github.com/Malabarba/rich-minority
   7 ;; Package-Requires: ((cl-lib "0.5"))
   8 ;; Version: 1.0.1
   9 ;; Keywords: mode-line faces
  10
  11 ;;; Commentary:
  12 ;;
  13 ;;   Emacs package for hiding and/or highlighting the list of minor-modes
  14 ;;   in the mode-line.
  15 ;;
  16 ;;
  17 ;; Usage
  18 ;; ─────
  19 ;;
  20 ;;   To activate the enrichment of your minor-modes list, call `M-x
  21 ;;   rich-minority-mode', or add this to your init file:
  22 ;;
  23 ;;   ┌────
  24 ;;   │ (rich-minority-mode 1)
  25 ;;   └────
  26 ;;
  27 ;;   By default, this has a couple of small effects (provided as examples)
  28 ;;   it is up to you to customize it to your liking with the following
  29 ;;   three variables:
  30 ;;
  31 ;;   `rm-blacklist': List of minor mode names that will be hidden from the
  32 ;;                   minor-modes list. Use this to hide *only* a few modes
  33 ;;                   that are always active and don’t really contribute
  34 ;;                   information.
  35 ;;   `rm-whitelist': List of minor mode names that are allowed on the
  36 ;;                   minor-modes list. Use this to hide *all but* a few
  37 ;;                   modes.
  38 ;;   `rm-text-properties': List text properties to apply to each minor-mode
  39 ;;                         lighter. For instance, by default we highlight
  40 ;;                         `Ovwrt' with a red face, so you always know if
  41 ;;                         you’re in `overwrite-mode'.
  42 ;;
  43 ;;
  44 ;; Comparison to Diminish
  45 ;; ──────────────────────
  46 ;;
  47 ;;   Diminish is an established player in the mode-line world, who also
  48 ;;   handles the minor-modes list. What can rich-minority /offer in
  49 ;;   contrast/?
  50 ;;
  51 ;;   • rich-minority is more versatile:
  52 ;;     1. It accepts *regexps*, instead of having to specify each
  53 ;;        minor-mode individually;
  54 ;;     2. It also offers a *whitelist* behaviour, in addition to the
  55 ;;        blacklist;
  56 ;;     3. It supports *highlighting* specific minor-modes with completely
  57 ;;        arbitrary text properties.
  58 ;;   • rich-minority takes a cleaner, functional approach. It doesn’t hack
  59 ;;     into the `minor-mode-alist' variable.
  60 ;;
  61 ;;   What is rich-minority /missing/?
  62 ;;
  63 ;;   1. It doesn’t have a quick and simple replacement functionality yet.
  64 ;;      Although you can set the `display' property of a minor-mode to
  65 ;;      whatever string you want and that will function as a replacement.
  66 ;;   2. Its source comments lack [Will Mengarini’s poetry]. :-)
  67 ;;
  68 ;;
  69 ;;   [Will Mengarini’s poetry] http://www.eskimo.com/~seldon/diminish.el
  70 ;;
  71 ;;
  72 ;; Installation
  73 ;; ────────────
  74 ;;
  75 ;;   This package is available fom Melpa, you may install it by calling
  76 ;;   `M-x package-install'.
  77
  78 \f
  79 ;;; Code:
  80 (require 'cl-lib)
  81
  82 (declare-function lm-version "lisp-mnt")
  83 (defun rm-bug-report ()
  84   "Opens github issues page in a web browser. Please send any bugs you find.
  85 Please include your Emacs and rich-minority versions."
  86   (interactive)
  87   (require 'lisp-mnt)
  88   (message "Your rm-version is: %s, and your emacs version is: %s.\nPlease include this in your report!"
  89            (lm-version "rich-minority.el") emacs-version)
  90   (browse-url "https://github.com/Malabarba/rich-minority/issues/new"))
  91 (defun rm-customize ()
  92   "Open the customization menu in the `rich-minority' group."
  93   (interactive)
  94   (customize-group 'rich-minority t))
  95
  96 \f
  97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  98 ;; Customization variables.
  99 (defcustom rm-blacklist '(" hl-p")
 100   "List of minor modes you want to hide from the mode-line.
 101
 102 Has three possible values:
 103
 104 - nil: All minor modes are shown in the mode-line (but see also
 105   `rm-whitelist').
 106
 107 - List of strings: Represents a list of minor mode names that
 108   will be hidden from the minor-modes list.
 109
 110 - A string: If this variable is set to a single string, this
 111   string must be a regexp. This regexp will be compared to each
 112   minor-mode lighter, and those which match are hidden from the
 113   minor-mode list.
 114
 115 If you'd like to use a list of regexps, simply use something like the following:
 116     (setq rm-blacklist (mapconcat 'identity list-of-regexps \"\\\\|\"))
 117
 118 Don't forget to start each string with a blank space, as most
 119 minor-mode lighters start with a space."
 120   :type '(choice (repeat string)
 121                  (regexp :tag "Regular expression."))
 122   :group 'rich-minority
 123   :package-version '(rich-minority . "0.1.1"))
 124 (define-obsolete-variable-alias 'rm-excluded-modes 'rm-blacklist "0.1.1")
 125 (define-obsolete-variable-alias 'rm-hidden-modes 'rm-blacklist "0.1.1")
 126
 127 (defcustom rm-whitelist nil
 128   "List of minor modes you want to include in the mode-line.
 129
 130 - nil: All minor modes are shown in the mode-line (but see also
 131   `rm-blacklist').
 132
 133 - List of strings: Represents a list of minor mode names that are
 134   allowed on the minor-modes list. Any minor-mode whose lighter
 135   is not in this list will NOT be displayed.
 136
 137 - A string: If this variable is set to a single string, this
 138   string must be a regexp. This regexp will be compared to each
 139   minor-mode lighter, and only those which match are displayed on
 140   the minor-mode list.
 141
 142 If you'd like to use a list of regexps, simply use something like the following:
 143     (setq rm-whitelist (mapconcat 'identity list-of-regexps \"\\\\|\"))
 144
 145 Don't forget to start each string with a blank space, as most
 146 minor-mode lighters start with a space."
 147   :type '(choice (repeat string)
 148                  (regexp :tag "Regular expression."))
 149   :group 'rich-minority
 150   :package-version '(rich-minority . "0.1.1"))
 151 (define-obsolete-variable-alias 'rm-included-modes 'rm-whitelist "0.1.1")
 152
 153 (defcustom rm-text-properties
 154   '(("\\` Ovwrt\\'" 'face 'font-lock-warning-face))
 155   "Alist of text properties to be applied to minor-mode lighters.
 156 The car of each element must be a regexp, and the cdr must be a
 157 list of text properties.
 158
 159     (REGEXP PROPERTY-NAME PROPERTY-VALUE ...)
 160
 161 If the regexp matches a minor mode lighter, the text properties
 162 are applied to it. They are tested in order, and search stops at
 163 the first match.
 164
 165 These properties take priority over those defined in
 166 `rm-base-text-properties'."
 167   :type '(repeat (cons regexp (repeat sexp)))
 168   :group 'rich-minority
 169   :package-version '(rich-minority . "0.1"))
 170
 171 \f
 172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 173 ;; Functions and Defvars
 174 (defconst rm--help-echo-bottom
 175   "Mouse-1: Mode Menu.\nMouse-2: Mode Help.\nMouse-3: Toggle Minor Modes.")
 176
 177 (defvar-local rm--help-echo nil
 178   "Used to set the help-echo string dynamically.")
 179
 180 ;;;###autoload
 181 (defun rm--mode-list-as-string-list ()
 182   "Return `minor-mode-list' as a simple list of strings."
 183   (let ((full-list (delete "" (mapcar #'format-mode-line minor-mode-alist))))
 184     (setq rm--help-echo
 185           (format "Full list:\n   %s\n\n%s"
 186                   (mapconcat 'identity full-list "\n   ")
 187                   rm--help-echo-bottom))
 188     (mapcar #'rm--propertize
 189             (rm--remove-hidden-modes full-list))))
 190
 191 (defcustom rm-base-text-properties
 192   '('help-echo 'rm--help-echo
 193                'mouse-face 'mode-line-highlight
 194                'local-map mode-line-minor-mode-keymap)
 195   "List of text propeties to apply to every minor mode."
 196   :type '(repeat sexp)
 197   :group 'rich-minority
 198   :package-version '(rich-minority . "0.1"))
 199
 200 (defun rm--propertize (mode)
 201   "Propertize the string MODE according to `rm-text-properties'."
 202   (if (null (stringp mode))
 203       `(:propertize ,mode ,@rm-base-text-properties)
 204     (let ((al rm-text-properties)
 205           done prop)
 206       (while (and (null done) al)
 207         (setq done (pop al))
 208         (if (string-match (car done) mode)
 209             (setq prop (cdr done))
 210           (setq done nil)))
 211       (eval `(propertize ,mode ,@prop ,@rm-base-text-properties)))))
 212
 213 (defun rm--remove-hidden-modes (li)
 214   "Remove from LI elements that match `rm-blacklist' or don't match `rm-whitelist'."
 215   (let ((pred (if (listp rm-blacklist) #'member #'rm--string-match))
 216         (out li))
 217     (when rm-blacklist
 218       (setq out
 219             (remove nil
 220                     (mapcar
 221                      (lambda (x) (unless (and (stringp x)
 222                                          (funcall pred x rm-blacklist))
 223                               x))
 224                      out))))
 225     (when rm-whitelist
 226       (setq pred (if (listp rm-whitelist) #'member #'rm--string-match))
 227       (setq out
 228             (remove nil
 229                     (mapcar
 230                      (lambda (x) (unless (and (stringp x)
 231                                          (null (funcall pred x rm-whitelist)))
 232                               x))
 233                      out))))
 234     out))
 235
 236 (defun rm--string-match (string regexp)
 237   "Like `string-match', but arg STRING comes before REGEXP."
 238   (string-match regexp string))
 239
 240 \f
 241 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 242 ;; minor-mode
 243 (defvar rm--mode-line-construct
 244   '(:eval (rm--mode-list-as-string-list))
 245   "Construct used to replace `minor-mode-alist'.")
 246
 247 (defvar rm--warning-absent-element
 248   "Couldn't find %S inside `mode-line-modes'. If you didn't change it yourself, please file a bug report with M-x rm-bug-report"
 249   "Warning message used when something wasn't found.")
 250
 251 (defvar rm--backup-construct nil
 252   "Construct containing `minor-mode-alist' which we removed from the mode-line.")
 253
 254 ;;;###autoload
 255 (define-minor-mode rich-minority-mode nil nil " $"
 256   :global t
 257   (if rich-minority-mode
 258       (let ((place (or (member 'minor-mode-alist mode-line-modes)
 259                        (cl-member-if
 260                         (lambda (x) (and (listp x)
 261                                     (equal (car x) :propertize)
 262                                     (equal (cadr x) '("" minor-mode-alist))))
 263                         mode-line-modes))))
 264         (if place
 265             (progn
 266               (setq rm--backup-construct (car place))
 267               (setcar place rm--mode-line-construct))
 268           (setq rich-minority-mode nil)
 269           (if (member 'sml/pos-id-separator mode-line-format)
 270               (message "You don't need to activate rich-minority-mode if you're using smart-mode-line")
 271             (warn rm--warning-absent-element 'minor-mode-alist))))
 272     (let ((place (member rm--mode-line-construct mode-line-modes)))
 273       (if place
 274           (setcar place rm--backup-construct)
 275         (warn rm--warning-absent-element rm--mode-line-construct)))))
 276
 277 (provide 'rich-minority)
 278
 279 ;;; rich-minority.el ends here
 280
 281 ;; Local Variables:
 282 ;; nameless-current-name: "rm"
 283 ;; End: