lisp/progmodes/glasses.el

   1 ;;; glasses.el --- make cantReadThis readable
   2
   3 ;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Milan Zamazal <pdm@zamazal.org>
   6 ;; Maintainer: Milan Zamazal <pdm@zamazal.org>
   7 ;; Keywords: tools
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This file defines a minor mode for making unreadableIdentifiersLikeThis
  27 ;; readable.  In some environments, for instance Java, it is common to use such
  28 ;; unreadable identifiers.  It is not good to use underscores in identifiers of
  29 ;; your own project in such an environment to make your sources more readable,
  30 ;; since it introduces undesirable confusion, which is worse than the
  31 ;; unreadability.  Fortunately, you use Emacs for the subproject, so the
  32 ;; problem can be solved some way.
  33 ;;
  34 ;; This file defines the `glasses-mode' minor mode, which displays underscores
  35 ;; between all the pairs of lower and upper English letters.  (This only
  36 ;; displays underscores, the text is not changed actually.)  Alternatively, you
  37 ;; can say you want the capitals in some given face (e.g. bold).
  38 ;;
  39 ;; The mode does something usable, though not perfect.  Improvement suggestions
  40 ;; from Emacs experts are welcome.
  41 ;;
  42 ;; If you like in-identifier separators different from underscores, change the
  43 ;; value of the variable `glasses-separator' appropriately.  See also the
  44 ;; variables `glasses-face' and `glasses-convert-on-write-p'.  You can also use
  45 ;; the command `M-x customize-group RET glasses RET'.
  46 ;;
  47 ;; If you set any of the variables `glasses-separator' or `glasses-face' after
  48 ;; glasses.el is loaded in a different way than through customize, you
  49 ;; should call the function `glasses-set-overlay-properties' afterwards.
  50
  51 ;;; Code:
  52
  53
  54 ;;; User variables
  55
  56
  57 (defgroup glasses nil
  58   "Make unreadable code likeThis(one) readable."
  59   :version "21.1"
  60   :group 'tools)
  61
  62
  63 (defcustom glasses-separator "_"
  64   "String to be displayed as a visual separator in identifiers.
  65 It is used both for adding missing separators and for replacing separators
  66 defined by `glasses-original-separator'.  If you don't want to add missing
  67 separators, set `glasses-separator' to an empty string.  If you don't want to
  68 replace existent separators, set `glasses-original-separator' to an empty
  69 string."
  70   :group 'glasses
  71   :type 'string
  72   :set 'glasses-custom-set
  73   :initialize 'custom-initialize-default)
  74
  75
  76 (defcustom glasses-original-separator "_"
  77   "String to be displayed as `glasses-separator' in separator positions.
  78 For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
  79 underscore separators are displayed as hyphens.
  80 If `glasses-original-separator' is an empty string, no such display change is
  81 performed."
  82   :group 'glasses
  83   :type 'string
  84   :set 'glasses-custom-set
  85   :initialize 'custom-initialize-default
  86   :version "22.1")
  87
  88
  89 (defcustom glasses-face nil
  90   "Face to be put on capitals of an identifier looked through glasses.
  91 If it is nil, no face is placed at the capitalized letter.
  92
  93 For example, you can set `glasses-separator' to an empty string and
  94 `glasses-face' to `bold'.  Then unreadable identifiers will have no separators,
  95 but will have their capitals in bold."
  96   :group 'glasses
  97   :type '(choice (const :tag "None" nil) face)
  98   :set 'glasses-custom-set
  99   :initialize 'custom-initialize-default)
 100
 101
 102 (defcustom glasses-separate-parentheses-p t
 103   "If non-nil, ensure space between an identifier and an opening parenthesis."
 104   :group 'glasses
 105   :type 'boolean)
 106
 107 (defcustom glasses-separate-parentheses-exceptions
 108   '("^#[\t ]*define[\t ]*[A-Za-z0-9_-]* ?($")
 109   "List of regexp that are exceptions for `glasses-separate-parentheses-p'.
 110 They are matched to the current line truncated to the point where the
 111 parenthesis expression starts."
 112   :group 'glasses
 113   :type '(repeat regexp))
 114
 115 (defcustom glasses-separate-capital-groups t
 116   "If non-nil, try to separate groups of capital letters.
 117 When the value is non-nil, HTMLSomething and IPv6 are displayed
 118 as HTML_Something and I_Pv6 respectively.  Set the value to nil
 119 if you prefer to display them unchanged."
 120   :group 'glasses
 121   :type 'boolean
 122   :version "24.1")
 123
 124 (defcustom glasses-uncapitalize-p nil
 125   "If non-nil, downcase embedded capital letters in identifiers.
 126 Only identifiers starting with lower case letters are affected, letters inside
 127 other identifiers are unchanged."
 128   :group 'glasses
 129   :type 'boolean
 130   :set 'glasses-custom-set
 131   :initialize 'custom-initialize-default)
 132
 133
 134 (defcustom glasses-uncapitalize-regexp "[a-z]"
 135   "Regexp matching beginnings of words to be uncapitalized.
 136 Only words starting with this regexp are uncapitalized.
 137 The regexp is case sensitive.
 138 It has any effect only when `glasses-uncapitalize-p' is non-nil."
 139   :group 'glasses
 140   :type 'regexp
 141   :set 'glasses-custom-set
 142   :initialize 'custom-initialize-default)
 143
 144
 145 (defcustom glasses-convert-on-write-p nil
 146   "If non-nil, remove separators when writing glasses buffer to a file.
 147 If you are confused by glasses so much, that you write the separators into code
 148 during coding, set this variable to t.  The separators will be removed on each
 149 file write then.
 150
 151 Note the removal action does not try to be much clever, so it can remove real
 152 separators too."
 153   :group 'glasses
 154   :type 'boolean)
 155
 156
 157 (defun glasses-custom-set (symbol value)
 158   "Set value of the variable SYMBOL to VALUE and update overlay categories.
 159 Used in :set parameter of some customized glasses variables."
 160   (set-default symbol value)
 161   (glasses-set-overlay-properties))
 162
 163
 164 ;;; Utility functions
 165
 166 (defun glasses-parenthesis-exception-p (beg end)
 167   "Tell if (BEG, END) is an exception to `glasses-separate-parentheses-p'.
 168 See `glasses-separate-parentheses-exceptions'."
 169   (save-match-data
 170     (let ((str (buffer-substring beg end)))
 171       (catch 'match
 172         (dolist (re glasses-separate-parentheses-exceptions)
 173           (and (string-match re str) (throw 'match t)))))))
 174
 175 (defun glasses-set-overlay-properties ()
 176   "Set properties of glasses overlays.
 177 Consider current setting of user variables."
 178   ;; In-identifier overlay
 179   (put 'glasses 'evaporate t)
 180   (put 'glasses 'before-string glasses-separator)
 181   (put 'glasses 'face glasses-face)
 182   ;; Beg-identifier overlay
 183   (put 'glasses-init 'evaporate t)
 184   (put 'glasses-init 'face glasses-face)
 185   ;; Parenthesis overlay
 186   (put 'glasses-parenthesis 'evaporate t)
 187   (put 'glasses-parenthesis 'before-string " "))
 188
 189 (glasses-set-overlay-properties)
 190
 191
 192 (defun glasses-overlay-p (overlay)
 193   "Return whether OVERLAY is an overlay of glasses mode."
 194   (memq (overlay-get overlay 'category)
 195         '(glasses glasses-init glasses-parenthesis)))
 196
 197
 198 (defun glasses-make-overlay (beg end &optional category)
 199   "Create and return readability overlay over the region from BEG to END.
 200 CATEGORY is the overlay category.  If it is nil, use the `glasses' category."
 201   (let ((overlay (make-overlay beg end)))
 202     (overlay-put overlay 'category (or category 'glasses))
 203     overlay))
 204
 205
 206 (defun glasses-make-readable (beg end)
 207   "Make identifiers in the region from BEG to END readable."
 208   (let ((case-fold-search nil))
 209     (save-excursion
 210       (save-match-data
 211         ;; Face only
 212         (goto-char beg)
 213         (while (re-search-forward
 214                 "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)"
 215                 end t)
 216           (glasses-make-overlay (match-beginning 1) (match-end 1)
 217                                 'glasses-init))
 218         ;; Face + separator
 219         (goto-char beg)
 220         (while (re-search-forward
 221                 (if glasses-separate-capital-groups
 222                     "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
 223                   "[a-z]\\([A-Z]\\)")
 224                 end t)
 225           (let* ((n (if (match-string 1) 1 2))
 226                  (o (glasses-make-overlay (match-beginning n) (match-end n))))
 227             (goto-char (match-beginning n))
 228             (when (and glasses-uncapitalize-p
 229                        (save-match-data
 230                          (looking-at "[A-Z]\\($\\|[^A-Z]\\)"))
 231                        (save-excursion
 232                          (save-match-data
 233                            (re-search-backward "\\<.")
 234                            (looking-at glasses-uncapitalize-regexp))))
 235               (overlay-put o 'invisible t)
 236               (overlay-put o 'after-string (downcase (match-string n))))))
 237         ;; Separator change
 238         (when (and (not (string= glasses-original-separator glasses-separator))
 239                    (not (string= glasses-original-separator "")))
 240           (goto-char beg)
 241           (let ((original-regexp (regexp-quote glasses-original-separator)))
 242             (while (re-search-forward
 243                     (format "[a-zA-Z0-9]\\(\\(%s\\)+\\)[a-zA-Z0-9]"
 244                             original-regexp)
 245                     end t)
 246               (goto-char (match-beginning 1))
 247               (while (looking-at original-regexp)
 248                 (let ((o (glasses-make-overlay (point) (1+ (point)))))
 249                   ;; `concat' ensures the character properties won't merge
 250                   (overlay-put o 'display (concat glasses-separator)))
 251                 (goto-char (match-end 0))))))
 252         ;; Parentheses
 253         (when glasses-separate-parentheses-p
 254           (goto-char beg)
 255           (while (re-search-forward "[a-zA-Z]_*\\(\(\\)" end t)
 256             (unless (glasses-parenthesis-exception-p (point-at-bol) (match-end 1))
 257               (glasses-make-overlay (match-beginning 1) (match-end 1)
 258                                     'glasses-parenthesis))))))))
 259
 260
 261 (defun glasses-make-unreadable (beg end)
 262   "Return identifiers in the region from BEG to END to their unreadable state."
 263   (dolist (o (overlays-in beg end))
 264     (when (glasses-overlay-p o)
 265       (delete-overlay o))))
 266
 267
 268 (defun glasses-convert-to-unreadable ()
 269   "Convert current buffer to unreadable identifiers and return nil.
 270 This function modifies buffer contents, it removes all the separators,
 271 recognized according to the current value of the variable `glasses-separator'."
 272   (when glasses-convert-on-write-p
 273     (let ((case-fold-search nil)
 274           (separator (regexp-quote glasses-separator)))
 275       (save-excursion
 276         (unless (string= glasses-separator "")
 277           (goto-char (point-min))
 278           (while (re-search-forward
 279                   (format "[a-z]\\(%s\\)[A-Z]\\|[A-Z]\\(%s\\)[A-Z][a-z]"
 280                           separator separator)
 281                   nil t)
 282             (let ((n (if (match-string 1) 1 2)))
 283               (replace-match "" t nil nil n)
 284               (goto-char (match-end n))))
 285           (unless (string= glasses-separator glasses-original-separator)
 286             (goto-char (point-min))
 287             (while (re-search-forward (format "[a-zA-Z0-9]\\(%s+\\)[a-zA-Z0-9]"
 288                                               separator)
 289                                       nil t)
 290               (replace-match glasses-original-separator nil nil nil 1)
 291               (goto-char (match-beginning 1)))))
 292         (when glasses-separate-parentheses-p
 293           (goto-char (point-min))
 294           (while (re-search-forward "[a-zA-Z]_*\\( \\)\(" nil t)
 295             (unless (glasses-parenthesis-exception-p (point-at-bol) (1+ (match-end 1)))
 296               (replace-match "" t nil nil 1)))))))
 297   ;; nil must be returned to allow use in write file hooks
 298   nil)
 299
 300
 301 (defun glasses-change (beg end &optional _old-len)
 302   "After-change function updating glass overlays."
 303   (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
 304         (end-line (save-excursion (goto-char end) (line-end-position))))
 305     (glasses-make-unreadable beg-line end-line)
 306     (glasses-make-readable beg-line end-line)))
 307
 308
 309 ;;; Minor mode definition
 310
 311
 312 ;;;###autoload
 313 (define-minor-mode glasses-mode
 314   "Minor mode for making identifiers likeThis readable.
 315 With a prefix argument ARG, enable the mode if ARG is positive,
 316 and disable it otherwise.  If called from Lisp, enable the mode
 317 if ARG is omitted or nil.  When this mode is active, it tries to
 318 add virtual separators (like underscores) at places they belong to."
 319   :group 'glasses :lighter " o^o"
 320   (save-excursion
 321     (save-restriction
 322       (widen)
 323       ;; We erase all the overlays anyway, to avoid dual sight in some
 324       ;; circumstances
 325       (glasses-make-unreadable (point-min) (point-max))
 326       (if glasses-mode
 327           (progn
 328             (jit-lock-register 'glasses-change)
 329             (add-hook 'local-write-file-hooks
 330                       'glasses-convert-to-unreadable nil t))
 331         (jit-lock-unregister 'glasses-change)
 332         (remove-hook 'local-write-file-hooks
 333                      'glasses-convert-to-unreadable t)))))
 334
 335
 336 ;;; Announce
 337
 338 (provide 'glasses)
 339
 340
 341 ;;; glasses.el ends here