lisp/progmodes/glasses.el

   1 ;;; glasses.el --- make cantReadThis readable
   2
   3 ;; Copyright (C) 1999-2012  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 (eval-when-compile
  55   (require 'cl))
  56
  57
  58 ;;; User variables
  59
  60
  61 (defgroup glasses nil
  62   "Make unreadable code likeThis(one) readable."
  63   :version "21.1"
  64   :group 'tools)
  65
  66
  67 (defcustom glasses-separator "_"
  68   "String to be displayed as a visual separator in identifiers.
  69 It is used both for adding missing separators and for replacing separators
  70 defined by `glasses-original-separator'.  If you don't want to add missing
  71 separators, set `glasses-separator' to an empty string.  If you don't want to
  72 replace existent separators, set `glasses-original-separator' to an empty
  73 string."
  74   :group 'glasses
  75   :type 'string
  76   :set 'glasses-custom-set
  77   :initialize 'custom-initialize-default)
  78
  79
  80 (defcustom glasses-original-separator "_"
  81   "*String to be displayed as `glasses-separator' in separator positions.
  82 For instance, if you set it to \"_\" and set `glasses-separator' to \"-\",
  83 underscore separators are displayed as hyphens.
  84 If `glasses-original-separator' is an empty string, no such display change is
  85 performed."
  86   :group 'glasses
  87   :type 'string
  88   :set 'glasses-custom-set
  89   :initialize 'custom-initialize-default
  90   :version "22.1")
  91
  92
  93 (defcustom glasses-face nil
  94   "Face to be put on capitals of an identifier looked through glasses.
  95 If it is nil, no face is placed at the capitalized letter.
  96
  97 For example, you can set `glasses-separator' to an empty string and
  98 `glasses-face' to `bold'.  Then unreadable identifiers will have no separators,
  99 but will have their capitals in bold."
 100   :group 'glasses
 101   :type '(choice (const :tag "None" nil) face)
 102   :set 'glasses-custom-set
 103   :initialize 'custom-initialize-default)
 104
 105
 106 (defcustom glasses-separate-parentheses-p t
 107   "If non-nil, ensure space between an identifier and an opening parenthesis."
 108   :group 'glasses
 109   :type 'boolean)
 110
 111 (defcustom glasses-separate-parentheses-exceptions
 112   '("^#[\t ]*define[\t ]*[A-Za-z0-9_-]* ?($")
 113   "List of regexp that are exceptions for `glasses-separate-parentheses-p'.
 114 They are matched to the current line truncated to the point where the
 115 parenthesis expression starts."
 116   :group 'glasses
 117   :type '(repeat regexp))
 118
 119 (defcustom glasses-separate-capital-groups t
 120   "If non-nil, try to separate groups of capital letters.
 121 When the value is non-nil, HTMLSomething and IPv6 are displayed
 122 as HTML_Something and I_Pv6 respectively.  Set the value to nil
 123 if you prefer to display them unchanged."
 124   :group 'glasses
 125   :type 'boolean
 126   :version "24.1")
 127
 128 (defcustom glasses-uncapitalize-p nil
 129   "If non-nil, downcase embedded capital letters in identifiers.
 130 Only identifiers starting with lower case letters are affected, letters inside
 131 other identifiers are unchanged."
 132   :group 'glasses
 133   :type 'boolean
 134   :set 'glasses-custom-set
 135   :initialize 'custom-initialize-default)
 136
 137
 138 (defcustom glasses-uncapitalize-regexp "[a-z]"
 139   "Regexp matching beginnings of words to be uncapitalized.
 140 Only words starting with this regexp are uncapitalized.
 141 The regexp is case sensitive.
 142 It has any effect only when `glasses-uncapitalize-p' is non-nil."
 143   :group 'glasses
 144   :type 'regexp
 145   :set 'glasses-custom-set
 146   :initialize 'custom-initialize-default)
 147
 148
 149 (defcustom glasses-convert-on-write-p nil
 150   "If non-nil, remove separators when writing glasses buffer to a file.
 151 If you are confused by glasses so much, that you write the separators into code
 152 during coding, set this variable to t.  The separators will be removed on each
 153 file write then.
 154
 155 Note the removal action does not try to be much clever, so it can remove real
 156 separators too."
 157   :group 'glasses
 158   :type 'boolean)
 159
 160
 161 (defun glasses-custom-set (symbol value)
 162   "Set value of the variable SYMBOL to VALUE and update overlay categories.
 163 Used in :set parameter of some customized glasses variables."
 164   (set-default symbol value)
 165   (glasses-set-overlay-properties))
 166
 167
 168 ;;; Utility functions
 169
 170 (defun glasses-parenthesis-exception-p (beg end)
 171   "Tell if (BEG, END) is an exception to `glasses-separate-parentheses-p'.
 172 See `glasses-separate-parentheses-exceptions'."
 173   (save-match-data
 174     (let ((str (buffer-substring beg end)))
 175       (catch 'match
 176         (dolist (re glasses-separate-parentheses-exceptions)
 177           (and (string-match re str) (throw 'match t)))))))
 178
 179 (defun glasses-set-overlay-properties ()
 180   "Set properties of glasses overlays.
 181 Consider current setting of user variables."
 182   ;; In-identifier overlay
 183   (put 'glasses 'evaporate t)
 184   (put 'glasses 'before-string glasses-separator)
 185   (put 'glasses 'face glasses-face)
 186   ;; Beg-identifier overlay
 187   (put 'glasses-init 'evaporate t)
 188   (put 'glasses-init 'face glasses-face)
 189   ;; Parenthesis overlay
 190   (put 'glasses-parenthesis 'evaporate t)
 191   (put 'glasses-parenthesis 'before-string " "))
 192
 193 (glasses-set-overlay-properties)
 194
 195
 196 (defun glasses-overlay-p (overlay)
 197   "Return whether OVERLAY is an overlay of glasses mode."
 198   (memq (overlay-get overlay 'category)
 199         '(glasses glasses-init glasses-parenthesis)))
 200
 201
 202 (defun glasses-make-overlay (beg end &optional category)
 203   "Create and return readability overlay over the region from BEG to END.
 204 CATEGORY is the overlay category.  If it is nil, use the `glasses' category."
 205   (let ((overlay (make-overlay beg end)))
 206     (overlay-put overlay 'category (or category 'glasses))
 207     overlay))
 208
 209
 210 (defun glasses-make-readable (beg end)
 211   "Make identifiers in the region from BEG to END readable."
 212   (let ((case-fold-search nil))
 213     (save-excursion
 214       (save-match-data
 215         ;; Face only
 216         (goto-char beg)
 217         (while (re-search-forward
 218                 "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)"
 219                 end t)
 220           (glasses-make-overlay (match-beginning 1) (match-end 1)
 221                                 'glasses-init))
 222         ;; Face + separator
 223         (goto-char beg)
 224         (while (re-search-forward
 225                 (if glasses-separate-capital-groups
 226                     "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
 227                   "[a-z]\\([A-Z]\\)")
 228                 end t)
 229           (let* ((n (if (match-string 1) 1 2))
 230                  (o (glasses-make-overlay (match-beginning n) (match-end n))))
 231             (goto-char (match-beginning n))
 232             (when (and glasses-uncapitalize-p
 233                        (save-match-data
 234                          (looking-at "[A-Z]\\($\\|[^A-Z]\\)"))
 235                        (save-excursion
 236                          (save-match-data
 237                            (re-search-backward "\\<.")
 238                            (looking-at glasses-uncapitalize-regexp))))
 239               (overlay-put o 'invisible t)
 240               (overlay-put o 'after-string (downcase (match-string n))))))
 241         ;; Separator change
 242         (when (and (not (string= glasses-original-separator glasses-separator))
 243                    (not (string= glasses-original-separator "")))
 244           (goto-char beg)
 245           (let ((original-regexp (regexp-quote glasses-original-separator)))
 246             (while (re-search-forward
 247                     (format "[a-zA-Z0-9]\\(\\(%s\\)+\\)[a-zA-Z0-9]"
 248                             original-regexp)
 249                     end t)
 250               (goto-char (match-beginning 1))
 251               (while (looking-at original-regexp)
 252                 (let ((o (glasses-make-overlay (point) (1+ (point)))))
 253                   ;; `concat' ensures the character properties won't merge
 254                   (overlay-put o 'display (concat glasses-separator)))
 255                 (goto-char (match-end 0))))))
 256         ;; Parentheses
 257         (when glasses-separate-parentheses-p
 258           (goto-char beg)
 259           (while (re-search-forward "[a-zA-Z]_*\\(\(\\)" end t)
 260             (unless (glasses-parenthesis-exception-p (point-at-bol) (match-end 1))
 261               (glasses-make-overlay (match-beginning 1) (match-end 1)
 262                                     'glasses-parenthesis))))))))
 263
 264
 265 (defun glasses-make-unreadable (beg end)
 266   "Return identifiers in the region from BEG to END to their unreadable state."
 267   (dolist (o (overlays-in beg end))
 268     (when (glasses-overlay-p o)
 269       (delete-overlay o))))
 270
 271
 272 (defun glasses-convert-to-unreadable ()
 273   "Convert current buffer to unreadable identifiers and return nil.
 274 This function modifies buffer contents, it removes all the separators,
 275 recognized according to the current value of the variable `glasses-separator'."
 276   (when glasses-convert-on-write-p
 277     (let ((case-fold-search nil)
 278           (separator (regexp-quote glasses-separator)))
 279       (save-excursion
 280         (unless (string= glasses-separator "")
 281           (goto-char (point-min))
 282           (while (re-search-forward
 283                   (format "[a-z]\\(%s\\)[A-Z]\\|[A-Z]\\(%s\\)[A-Z][a-z]"
 284                           separator separator)
 285                   nil t)
 286             (let ((n (if (match-string 1) 1 2)))
 287               (replace-match "" t nil nil n)
 288               (goto-char (match-end n))))
 289           (unless (string= glasses-separator glasses-original-separator)
 290             (goto-char (point-min))
 291             (while (re-search-forward (format "[a-zA-Z0-9]\\(%s+\\)[a-zA-Z0-9]"
 292                                               separator)
 293                                       nil t)
 294               (replace-match glasses-original-separator nil nil nil 1)
 295               (goto-char (match-beginning 1)))))
 296         (when glasses-separate-parentheses-p
 297           (goto-char (point-min))
 298           (while (re-search-forward "[a-zA-Z]_*\\( \\)\(" nil t)
 299             (unless (glasses-parenthesis-exception-p (point-at-bol) (1+ (match-end 1)))
 300               (replace-match "" t nil nil 1)))))))
 301   ;; nil must be returned to allow use in write file hooks
 302   nil)
 303
 304
 305 (defun glasses-change (beg end &optional _old-len)
 306   "After-change function updating glass overlays."
 307   (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
 308         (end-line (save-excursion (goto-char end) (line-end-position))))
 309     (glasses-make-unreadable beg-line end-line)
 310     (glasses-make-readable beg-line end-line)))
 311
 312
 313 ;;; Minor mode definition
 314
 315
 316 ;;;###autoload
 317 (define-minor-mode glasses-mode
 318   "Minor mode for making identifiers likeThis readable.
 319 When this mode is active, it tries to add virtual separators (like underscores)
 320 at places they belong to."
 321   :group 'glasses :lighter " o^o"
 322   (save-excursion
 323     (save-restriction
 324       (widen)
 325       ;; We erase all the overlays anyway, to avoid dual sight in some
 326       ;; circumstances
 327       (glasses-make-unreadable (point-min) (point-max))
 328       (if glasses-mode
 329           (progn
 330             (jit-lock-register 'glasses-change)
 331             (add-hook 'local-write-file-hooks
 332                       'glasses-convert-to-unreadable nil t))
 333         (jit-lock-unregister 'glasses-change)
 334         (remove-hook 'local-write-file-hooks
 335                      'glasses-convert-to-unreadable t)))))
 336
 337
 338 ;;; Announce
 339
 340 (provide 'glasses)
 341
 342
 343 ;;; glasses.el ends here