lisp/progmodes/glasses.el

   1 ;;; glasses.el --- make cantReadThis readable
   2
   3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
   4
   5 ;; Author: Milan Zamazal <pdm@freesoft.cz>
   6 ;; Maintainer: Milan Zamazal <pdm@freesoft.cz>
   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., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, 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 and 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 identifiers likeThis readable."
  65   :group 'tools)
  66
  67
  68 (defcustom glasses-separator "_"
  69   "*String to be displayed as a visual separator in unreadable identifiers."
  70   :group 'glasses
  71   :type 'string
  72   :set 'glasses-custom-set
  73   :initialize 'custom-initialize-default)
  74
  75
  76 (defcustom glasses-face nil
  77   "*Face to be put on capitals of an identifier looked through glasses.
  78 If it is nil, no face is placed at the capitalized letter.
  79
  80 For example, you can set `glasses-separator' to an empty string and
  81 `glasses-face' to `bold'.  Then unreadable identifiers will have no separators,
  82 but will have their capitals in bold."
  83   :group 'glasses
  84   :type 'symbol
  85   :set 'glasses-custom-set
  86   :initialize 'custom-initialize-default)
  87
  88
  89 (defcustom glasses-convert-on-write-p nil
  90   "*If non-nil, remove separators when writing glasses buffer to a file.
  91 If you are confused by glasses so much, that you write the separators into code
  92 during coding, set this variable to t.  The separators will be removed on each
  93 file write then.
  94
  95 Note the removal action does not try to be much clever, so it can remove real
  96 separators too."
  97   :group 'glasses
  98   :type 'boolean)
  99
 100
 101 (defun glasses-custom-set (symbol value)
 102   "Set value of the variable SYMBOL to VALUE and update overlay categories.
 103 Used in :set parameter of some customized glasses variables."
 104   (set symbol value)
 105   (glasses-set-overlay-properties))
 106
 107
 108 ;;; Utility functions
 109
 110
 111 (defun glasses-set-overlay-properties ()
 112   "Set properties of glasses overlays.
 113 Consider current setting of user variables."
 114   ;; In-identifier overlay
 115   (put 'glasses 'evaporate t)
 116   (put 'glasses 'before-string glasses-separator)
 117   (put 'glasses 'face glasses-face)
 118   ;; Beg-identifier overlay
 119   (put 'glasses-init 'evaporate t)
 120   (put 'glasses-init 'face glasses-face))
 121
 122 (glasses-set-overlay-properties)
 123
 124
 125 (defun glasses-overlay-p (overlay)
 126   "Return whether OVERLAY is an overlay of glasses mode."
 127   (memq (overlay-get overlay 'category) '(glasses glasses-init)))
 128
 129
 130 (defun glasses-make-overlay (beg end &optional init)
 131   "Create readability overlay over the region from BEG to END.
 132 If INIT is non-nil, put `glasses-init' overlay there."
 133   (let ((overlay (make-overlay beg end)))
 134     (overlay-put overlay 'category (if init 'glasses-init 'glasses))))
 135
 136
 137 (defun glasses-make-readable (beg end)
 138   "Make identifiers in the region from BEG to END readable."
 139   (let ((case-fold-search nil))
 140     (save-excursion
 141       (save-match-data
 142         ;; Face only
 143         (goto-char beg)
 144         (while (re-search-forward
 145                 "\\<\\([A-Z]\\)[a-zA-Z]*\\([a-z][A-Z]\\|[A-Z][a-z]\\)"
 146                 end t)
 147           (glasses-make-overlay (match-beginning 1) (match-end 1) t))
 148         (goto-char beg)
 149         ;; Face + separator
 150         (while (re-search-forward "[a-z]\\([A-Z]\\)\\|[A-Z]\\([A-Z]\\)[a-z]"
 151                                   end t)
 152           (let ((n (if (match-string 1) 1 2)))
 153             (glasses-make-overlay (match-beginning n) (match-end n))
 154             (goto-char (match-beginning n))))))))
 155
 156
 157 (defun glasses-make-unreadable (beg end)
 158   "Return identifiers in the region from BEG to END to their unreadable state."
 159   (dolist (o (overlays-in beg end))
 160     (when (glasses-overlay-p o)
 161       (delete-overlay o))))
 162
 163
 164 (defun glasses-convert-to-unreadable ()
 165   "Convert current buffer to unreadable identifiers and return nil.
 166 This function modifies buffer contents, it removes all the separators,
 167 recognized according to the current value of the variable `glasses-separator'."
 168   (when (and glasses-convert-on-write-p
 169              (not (string= glasses-separator "")))
 170     (let ((case-fold-search nil))
 171       (save-excursion
 172         (goto-char (point-min))
 173         (while (re-search-forward
 174                 "[a-z]\\(_\\)[A-Z]\\|[A-Z]\\(_\\)[A-Z][a-z]" nil t)
 175           (let ((n (if (match-string 1) 1 2)))
 176             (replace-match "" t nil nil n)
 177             (goto-char (match-end n)))))))
 178   ;; nil must be returned to allow use in write file hooks
 179   nil)
 180
 181
 182 (defun glasses-change (beg end old-len)
 183   "After-change function updating glass overlays."
 184   (let ((beg-line (save-excursion (goto-char beg) (line-beginning-position)))
 185         (end-line (save-excursion (goto-char end) (line-end-position))))
 186     (glasses-make-unreadable beg-line end-line)
 187     (glasses-make-readable beg-line end-line)))
 188
 189
 190 ;;; Minor mode definition
 191
 192
 193 (defvar glasses-mode nil
 194   "Mode variable for `glasses-mode'.")
 195 (make-variable-buffer-local 'glasses-mode)
 196
 197 (add-to-list 'minor-mode-alist '(glasses-mode " o^o"))
 198
 199
 200 ;;;###autoload
 201 (defun glasses-mode (arg)
 202   "Minor mode for making identifiers likeThis readable.
 203 When this mode is active, it tries to add virtual separators (like underscores)
 204 at places they belong to."
 205   (interactive "P")
 206   (let ((new-flag (if (null arg)
 207                        (not glasses-mode)
 208                     (> (prefix-numeric-value arg) 0))))
 209     (unless (eq new-flag glasses-mode)
 210       (save-excursion
 211         (save-restriction
 212           (widen)
 213           (if new-flag
 214               (progn
 215                 (glasses-make-readable (point-min) (point-max))
 216                 (make-local-hook 'after-change-functions)
 217                 (add-hook 'after-change-functions 'glasses-change nil t)
 218                 (add-hook 'local-write-file-hooks
 219                           'glasses-convert-to-unreadable nil t))
 220             (glasses-make-unreadable (point-min) (point-max))
 221             (remove-hook 'after-change-functions 'glasses-change t)
 222             (remove-hook 'local-write-file-hooks
 223                          'glasses-convert-to-unreadable t))))
 224       (setq glasses-mode new-flag))))
 225
 226
 227 ;;; Announce
 228
 229 (provide 'glasses)
 230
 231
 232 ;;; glasses.el ends here