lisp/progmodes/glasses.el

   1 ;;; glasses.el --- make cantReadThis readable
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2005 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 2, or (at your option)
  14 ;; 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This file defines a minor mode for making unreadableIdentifiersLikeThis
  29 ;; readable.  In some environments, for instance Java, it is common to use such
  30 ;; unreadable identifiers.  It is not good to use underscores in identifiers of
  31 ;; your own project in such an environment to make your sources more readable,
  32 ;; since it introduces undesirable confusion, which is worse than the
  33 ;; unreadability.  Fortunately, you use Emacs for the subproject, so the
  34 ;; problem can be solved some way.
  35 ;;
  36 ;; This file defines the `glasses-mode' minor mode, which displays underscores
  37 ;; between all the pairs of lower and upper English letters.  (This only
  38 ;; displays underscores, the text is not changed actually.)  Alternatively, you
  39 ;; can say you want the capitals in some given face (e.g. bold).
  40 ;;
  41 ;; The mode does something usable, though not perfect.  Improvement suggestions
  42 ;; from Emacs experts are welcome.
  43 ;;
  44 ;; If you like in-identifier separators different from underscores, change the
  45 ;; value of the variable `glasses-separator' appropriately.  See also the
  46 ;; variables `glasses-face' and `glasses-convert-on-write-p'.  You can also use
  47 ;; the command `M-x customize-group RET glasses RET'.
  48 ;;
  49 ;; If you set any of the variables `glasses-separator' or `glasses-face' after
  50 ;; glasses.el is loaded in a different way than through customize, you
  51 ;; should call the function `glasses-set-overlay-properties' afterwards.
  52
  53 ;;; Code:
  54
  55
  56 (eval-when-compile
  57   (require 'cl))
  58
  59
  60 ;;; User variables
  61
  62
  63 (defgroup glasses nil
  64   "Make unreadable code likeThis(one) readable."
  65   :version "21.1"
  66   :group 'tools)
  67
  68
  69 (defcustom glasses-separator "_"
  70   "*String to be displayed as a visual separator in unreadable identifiers."
  71   :group 'glasses
  72   :type 'string
  73   :set 'glasses-custom-set
  74   :initialize 'custom-initialize-default)
  75
  76
  77 (defcustom glasses-face nil
  78   "*Face to be put on capitals of an identifier looked through glasses.
  79 If it is nil, no face is placed at the capitalized letter.
  80
  81 For example, you can set `glasses-separator' to an empty string and
  82 `glasses-face' to `bold'.  Then unreadable identifiers will have no separators,
  83 but will have their capitals in bold."
  84   :group 'glasses
  85   :type '(choice face (const nil))
  86   :set 'glasses-custom-set
  87   :initialize 'custom-initialize-default)
  88
  89
  90 (defcustom glasses-separate-parentheses-p t
  91   "*If non-nil, ensure space between an identifier and an opening parenthesis."
  92   :group 'glasses
  93   :type 'boolean)
  94
  95
  96 (defcustom glasses-uncapitalize-p nil
  97   "*If non-nil, downcase embedded capital letters in identifiers.
  98 Only identifiers starting with lower case letters are affected, letters inside
  99 other identifiers are unchanged."
 100   :group 'glasses
 101   :type 'boolean
 102   :set 'glasses-custom-set
 103   :initialize 'custom-initialize-default)
 104
 105
 106 (defcustom glasses-uncapitalize-regexp "[a-z]"
 107   "*Regexp matching beginnings of words to be uncapitalized.
 108 Only words starting with this regexp are uncapitalized.
 109 The regexp is case sensitive.
 110 It has any effect only when `glasses-uncapitalize-p' is non-nil."
 111   :group 'glasses
 112   :type 'regexp
 113   :set 'glasses-custom-set
 114   :initialize 'custom-initialize-default)
 115
 116
 117 (defcustom glasses-convert-on-write-p nil
 118   "*If non-nil, remove separators when writing glasses buffer to a file.
 119 If you are confused by glasses so much, that you write the separators into code
 120 during coding, set this variable to t.  The separators will be removed on each
 121 file write then.
 122
 123 Note the removal action does not try to be much clever, so it can remove real
 124 separators too."
 125   :group 'glasses
 126   :type 'boolean)
 127
 128
 129 (defun glasses-custom-set (symbol value)
 130   "Set value of the variable SYMBOL to VALUE and update overlay categories.
 131 Used in :set parameter of some customized glasses variables."
 132   (set-default symbol value)
 133   (glasses-set-overlay-properties))
 134
 135
 136 ;;; Utility functions
 137
 138
 139 (defun glasses-set-overlay-properties ()
 140   "Set properties of glasses overlays.
 141 Consider current setting of user variables."
 142   ;; In-identifier overlay
 143   (put 'glasses 'evaporate t)
 144   (put 'glasses 'before-string glasses-separator)
 145   (put 'glasses 'face glasses-face)
 146   ;; Beg-identifier overlay
 147   (put 'glasses-init 'evaporate t)
 148   (put 'glasses-init 'face glasses-face)
 149   ;; Parenthesis overlay
 150   (put 'glasses-parenthesis 'evaporate t)
 151   (put 'glasses-parenthesis 'before-string " "))
 152
 153 (glasses-set-overlay-properties)
 154
 155
 156 (defun glasses-overlay-p (overlay)
 157   "Return whether OVERLAY is an overlay of glasses mode."
 158   (memq (overlay-get overlay 'category)
 159         '(glasses glasses-init glasses-parenthesis)))
 160
 161
 162 (defun glasses-make-overlay (beg end &optional category)
 163   "Create and return readability overlay over the region from BEG to END.
 164 CATEGORY is the overlay category.  If it is nil, use the `glasses' category."
 165   (let ((overlay (make-overlay beg end)))
 166     (overlay-put overlay 'category (or category 'glasses))
 167     overlay))
 168
 169
 170 (defun glasses-make-readable (beg end)
 171   "Make identifiers in the region from BEG to END readable."
 172   (let ((case-fold-search nil))
 173     (save-excursion
 174       (save-match-data
 175         ;; Face only
 176         (goto-char beg)
 177         (while (re-search-forward
 178                 "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)"
 179                 end t)
 180           (glasses-make-overlay (match-beginning 1) (match-end 1)
 181                                 'glasses-init))
 182         ;; Face + separator
 183         (goto-char beg)
 184         (while (re-search-forward "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
 185                                   end t)
 186           (let* ((n (if (match-string 1) 1 2))
 187                  (o (glasses-make-overlay (match-beginning n) (match-end n))))
 188             (goto-char (match-beginning n))
 189             (when (and glasses-uncapitalize-p
 190                        (save-match-data
 191                          (looking-at "[A-Z]\\($\\|[^A-Z]\\)"))
 192                        (save-excursion
 193                          (save-match-data
 194                            (re-search-backward "\\<.")
 195                            (looking-at glasses-uncapitalize-regexp))))
 196               (overlay-put o 'invisible t)
 197               (overlay-put o 'after-string (downcase (match-string n))))))
 198         ;; Separator change
 199         (unless (string= glasses-separator "_")
 200           (goto-char beg)
 201           (while (re-search-forward "[a-zA-Z0-9]\\(_+\\)[a-zA-Z0-9]" end t)
 202             (goto-char (match-beginning 1))
 203             (while (eql (char-after) ?\_)
 204               (let ((o (glasses-make-overlay (point) (1+ (point)))))
 205                 ;; `concat' ensures the character properties won't merge
 206                 (overlay-put o 'display (concat glasses-separator)))
 207               (forward-char))))
 208         ;; Parentheses
 209         (when glasses-separate-parentheses-p
 210           (goto-char beg)
 211           (while (re-search-forward "[a-zA-Z]_*\\(\(\\)" end t)
 212             (glasses-make-overlay (match-beginning 1) (match-end 1)
 213                                   'glasses-parenthesis)))))))
 214
 215
 216 (defun glasses-make-unreadable (beg end)
 217   "Return identifiers in the region from BEG to END to their unreadable state."
 218   (dolist (o (overlays-in beg end))
 219     (when (glasses-overlay-p o)
 220       (delete-overlay o))))
 221
 222
 223 (defun glasses-convert-to-unreadable ()
 224   "Convert current buffer to unreadable identifiers and return nil.
 225 This function modifies buffer contents, it removes all the separators,
 226 recognized according to the current value of the variable `glasses-separator'."
 227   (when (and glasses-convert-on-write-p
 228              (not (string= glasses-separator "")))
 229     (let ((case-fold-search nil)
 230           (separator (regexp-quote glasses-separator)))
 231       (save-excursion
 232         (goto-char (point-min))
 233         (while (re-search-forward
 234                 (format "[a-z]\\(%s\\)[A-Z]\\|[A-Z]\\(%s\\)[A-Z][a-z]"
 235                         separator separator)
 236                 nil t)
 237           (let ((n (if (match-string 1) 1 2)))
 238             (replace-match "" t nil nil n)
 239             (goto-char (match-end n))))
 240         (unless (string= glasses-separator "_")
 241           (goto-char (point-min))
 242           (while (re-search-forward (format "[a-zA-Z0-9]\\(%s+\\)[a-zA-Z0-9]"
 243                                             separator)
 244                                     nil t)
 245             (replace-match "_" nil nil nil 1)
 246             (goto-char (match-beginning 1))))
 247         (when glasses-separate-parentheses-p
 248           (goto-char (point-min))
 249           (while (re-search-forward "[a-zA-Z]_*\\( \\)\(" nil t)
 250             (replace-match "" t nil nil 1))))))
 251   ;; nil must be returned to allow use in write file hooks
 252   nil)
 253
 254
 255 (defun glasses-change (beg end &optional old-len)
 256   "After-change function updating glass overlays."
 257   (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
 258         (end-line (save-excursion (goto-char end) (line-end-position))))
 259     (glasses-make-unreadable beg-line end-line)
 260     (glasses-make-readable beg-line end-line)))
 261
 262
 263 ;;; Minor mode definition
 264
 265
 266 ;;;###autoload
 267 (define-minor-mode glasses-mode
 268   "Minor mode for making identifiers likeThis readable.
 269 When this mode is active, it tries to add virtual separators (like underscores)
 270 at places they belong to."
 271   :group 'glasses :lighter " o^o"
 272   (save-excursion
 273     (save-restriction
 274       (widen)
 275       ;; We erase all the overlays anyway, to avoid dual sight in some
 276       ;; circumstances
 277       (glasses-make-unreadable (point-min) (point-max))
 278       (if glasses-mode
 279           (progn
 280             (jit-lock-register 'glasses-change)
 281             (add-hook 'local-write-file-hooks
 282                       'glasses-convert-to-unreadable nil t))
 283         (jit-lock-unregister 'glasses-change)
 284         (remove-hook 'local-write-file-hooks
 285                      'glasses-convert-to-unreadable t)))))
 286
 287
 288 ;;; Announce
 289
 290 (provide 'glasses)
 291
 292
 293 ;;; arch-tag: a3515167-c89e-484f-90a1-d85143e52b12
 294 ;;; glasses.el ends here