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