lisp/textmodes/tildify.el

   1 ;;; tildify.el --- adding hard spaces into texts
   2
   3 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author:     Milan Zamazal <pdm@zamazal.org>
   7 ;; Version:    4.5
   8 ;; Keywords:   text, TeX, SGML, wp
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This package can be typically used for adding forgotten tildes in TeX
  30 ;; sources or adding `&nbsp;' sequences in SGML (e.g. HTML) texts.
  31 ;;
  32 ;; For example, the Czech orthography requires avoiding one letter
  33 ;; prepositions at line endings.  So they should be connected with the
  34 ;; following words by a tilde.  Some users forget to do this all the
  35 ;; time.  The purpose of this program is to check the text and suggest
  36 ;; adding of missing tildes on some places.  It works in a similar
  37 ;; manner to `query-replace-regexp'.
  38 ;;
  39 ;; The functionality of this program is actually performing query
  40 ;; replace on certain regions, but for historical reasons explained
  41 ;; above it is called `tildify'.
  42 ;;
  43 ;; The default variable settings are suited for Czech, so do not try to
  44 ;; understand them if you are not familiar with Czech grammar and spelling.
  45 ;;
  46 ;; The algorithm was inspired by Petr Ol¹ák's program `vlna'.  Abilities of
  47 ;; `tildify.el' are a little limited; if you have improvement suggestions, let
  48 ;; me know.
  49
  50 ;;; Code:
  51
  52
  53 ;;; *** User configuration variables ***
  54
  55
  56 (defgroup tildify nil
  57   "Adding missing hard spaces or other text fragments into texts."
  58   :version "21.1"
  59   :group 'wp)
  60
  61 (defcustom tildify-pattern-alist
  62   '((t "\\([,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(\\w\\|[([{\\]\\|<[a-zA-Z]\\)" 2))
  63   "Alist specifying where to insert hard spaces.
  64
  65 Each alist item is of the form (MAJOR-MODE REGEXP NUMBER) or
  66 \(MAJOR-MODE . SYMBOL).
  67
  68 MAJOR-MODE defines major mode, for which the item applies.  It can be either:
  69 - a symbol equal to the major mode of the buffer to be fixed
  70 - t for default item, this applies to all major modes not defined in another
  71   alist item
  72
  73 REGEXP is a regular expression matching the part of a text, where a hard space
  74 is missing.  The regexp is always case sensitive, regardless of the current
  75 `case-fold-search' setting.
  76
  77 NUMBER defines the number of the REGEXP subexpression which should be replaced
  78 by the hard space character.
  79
  80 The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE.  For this
  81 mode, the item for the mode SYMBOL is looked up in the alist instead."
  82   :group 'tildify
  83   :type '(repeat (choice (list symbol regexp integer) (cons symbol symbol))))
  84
  85 (defcustom tildify-string-alist
  86   '((latex-mode . "~")
  87     (tex-mode . latex-mode)
  88     (plain-tex-mode . latex-mode)
  89     (sgml-mode . "&nbsp;")
  90     (xml-mode . sgml-mode)
  91     (html-mode . sgml-mode)
  92     (t . " "))
  93   "Alist specifying what is a hard space in the current major mode.
  94
  95 Each alist item is of the form (MAJOR-MODE . STRING) or
  96 \(MAJOR-MODE . SYMBOL).
  97
  98 MAJOR-MODE defines major mode, for which the item applies.  It can be either:
  99 - a symbol equal to the major mode of the buffer to be fixed
 100 - t for default item, this applies to all major modes not defined in another
 101   alist item
 102
 103 STRING defines the hard space, which is inserted at places defined by
 104 `tildify-pattern-alist'.  For example it can be \"~\" for TeX or \"&nbsp;\"
 105 for SGML.
 106
 107 The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE.  For this
 108 mode, the item for the mode SYMBOL is looked up in the alist instead."
 109   :group 'tildify
 110   :type '(repeat (cons symbol (choice string symbol))))
 111
 112 (defcustom tildify-ignored-environments-alist
 113   '((latex-mode
 114      ("\\\\\\\\" . "")          ; do not remove this
 115      ("\\\\begin{verbatim}" . "\\\\end{verbatim}")
 116      ("\\\\verb\\*?\\(.\\)" . (1))
 117      ("\\$\\$" . "\\$\\$")
 118      ("\\$" . "\\$")
 119      ("\\\\(" . "\\\\)")
 120      ("\\\\[[]" . "\\\\[]]")
 121      ("\\\\begin{math}" . "\\\\end{math}")
 122      ("\\\\begin{displaymath}" . "\\\\end{displaymath}")
 123      ("\\\\begin{equation}" . "\\\\end{equation}")
 124      ("\\\\begin{eqnarray\\*?}" . "\\\\end{eqnarray\\*?}")
 125      ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "")
 126      ("%" . "$"))
 127     (plain-tex-mode . latex-mode)
 128     (html-mode
 129      ("<pre[^>]*>" . "</pre>")
 130      ("<dfn>" . "</dfn>")
 131      ("<code>" . "</code>")
 132      ("<samp>" . "</samp>")
 133      ("<kbd>" . "</kbd>")
 134      ("<var>" . "</var>")
 135      ("<PRE[^>]*>" . "</PRE>")
 136      ("<DFN>" . "</DFN>")
 137      ("<CODE>" . "</CODE>")
 138      ("<SAMP>" . "</SAMP>")
 139      ("<KBD>" . "</KBD>")
 140      ("<VAR>" . "</VAR>")
 141      ("<! *--" . "-- *>")
 142      ("<" . ">"))
 143     (sgml-mode . html-mode)
 144     (t nil))
 145   "Alist specifying ignored structured text environments.
 146 Parts of text defined in this alist are skipped without performing hard space
 147 insertion on them.  These setting allow skipping text parts like verbatim or
 148 math environments in TeX or preformatted text in SGML.
 149
 150 Each list element is of the form
 151   (MAJOR-MODE (BEG-REGEX . END-REGEX) (BEG-REGEX . END-REGEX) ... )
 152
 153 MAJOR-MODE defines major mode, for which the item applies.  It can be either:
 154 - a symbol equal to the major mode of the buffer to be fixed
 155 - t for default item, this applies to all major modes not defined in another
 156   alist item
 157
 158 BEG-REGEX is a regexp matching beginning of a text part to be skipped.
 159 END-REGEX defines end of the corresponding text part and can be either:
 160 - a regexp matching the end of the skipped text part
 161 - a list of regexps and numbers, which will compose the ending regexp by
 162   concatenating themselves, while replacing the numbers with corresponding
 163   subexpressions of BEG-REGEX (this is used to solve cases like
 164   \\\\verb<character> in TeX)."
 165   :group 'tildify
 166   :type '(repeat (cons symbol (choice symbol (repeat sexp)))))
 167
 168
 169 ;;; *** Internal variables ***
 170
 171 (defvar tildify-count nil
 172   "Counter for replacements.")
 173
 174
 175 ;;; *** Interactive functions ***
 176
 177 ;;;###autoload
 178 (defun tildify-region (beg end)
 179   "Add hard spaces in the region between BEG and END.
 180 See variables `tildify-pattern-alist', `tildify-string-alist', and
 181 `tildify-ignored-environments-alist' for information about configuration
 182 parameters.
 183 This function performs no refilling of the changed text."
 184   (interactive "*r")
 185   (setq tildify-count 0)
 186   (let (a
 187         z
 188         (marker-end (copy-marker end))
 189         end-env
 190         finish
 191         (ask t)
 192         (case-fold-search nil)
 193         (regexp (tildify-build-regexp)) ; beginnings of environments
 194         aux)
 195     (if regexp
 196         ;; Yes, ignored environments exist for the current major mode,
 197         ;; tildify just texts outside them
 198         (save-excursion
 199           (save-restriction
 200             (widen)
 201             (goto-char (point-min))
 202             (while (not finish)
 203               (setq a (point))
 204               (setq end-env (tildify-find-env regexp))
 205               (setq z (copy-marker (if end-env (1- (point)) (point-max))))
 206               (if (>= (marker-position z) beg)
 207                   (progn
 208                     (or (>= a beg) (setq a beg))
 209                     (or (<= (marker-position z) (marker-position marker-end))
 210                         (setq z marker-end))
 211                     (setq aux (tildify-tildify a (marker-position z) ask))
 212                     (if (eq aux 'force)
 213                         (setq ask nil)
 214                       (if (eq aux nil)
 215                           (setq finish t)))))
 216               (if (>= (marker-position z) (marker-position marker-end))
 217                   (setq finish t))
 218               (or (>= (point) (marker-position z))
 219                   (goto-char (marker-position z)))
 220               (if (not finish)
 221                   (if (re-search-forward end-env nil t)
 222                       (if (> (point) (marker-position marker-end))
 223                           (setq finish t))
 224                     (message
 225                      "End of environment not found: %s" end-env)
 226                     (setq finish t))))))
 227       ;; No ignored environments, tildify directly
 228       (tildify-tildify beg end ask)))
 229   (message "%d spaces replaced." tildify-count))
 230
 231 ;;;###autoload
 232 (defun tildify-buffer ()
 233   "Add hard spaces in the current buffer.
 234 See variables `tildify-pattern-alist', `tildify-string-alist', and
 235 `tildify-ignored-environments-alist' for information about configuration
 236 parameters.
 237 This function performs no refilling of the changed text."
 238   (interactive  "*")
 239   (tildify-region (point-min) (point-max)))
 240
 241
 242 ;;; *** Auxiliary functions ***
 243
 244 (defun tildify-build-regexp ()
 245   "Build start of environment regexp."
 246   (let ((alist (tildify-mode-alist tildify-ignored-environments-alist))
 247         regexp)
 248     (when alist
 249       (setq regexp (caar alist))
 250       (setq alist (cdr alist))
 251       (while alist
 252         (setq regexp (concat regexp "\\|" (caar alist)))
 253         (setq alist (cdr alist)))
 254       regexp)))
 255
 256 (defun tildify-mode-alist (mode-alist &optional mode)
 257   "Return alist item for the MODE-ALIST in the current major MODE."
 258   (if (null mode)
 259       (setq mode major-mode))
 260   (let ((alist (cdr (or (assoc mode mode-alist)
 261                         (assoc t mode-alist)))))
 262     (if (and alist
 263              (symbolp alist))
 264         (tildify-mode-alist mode-alist alist)
 265       alist)))
 266
 267 (defun tildify-find-env (regexp)
 268   "Find environment using REGEXP.
 269 Return regexp for the end of the environment or nil if no environment was
 270 found."
 271   ;; Find environment
 272   (if (re-search-forward regexp nil t)
 273       ;; Build end-env regexp
 274       (let ((match (match-string 0))
 275             (alist (tildify-mode-alist tildify-ignored-environments-alist))
 276             expression)
 277         (save-match-data
 278           (while (not (eq (string-match (caar alist) match) 0))
 279             (setq alist (cdr alist))))
 280         (if (stringp (setq expression (cdar alist)))
 281             expression
 282           (let ((result "")
 283                 aux)
 284             (while expression
 285               (setq result (concat result
 286                                    (if (stringp (setq aux (car expression)))
 287                                        expression
 288                                      (regexp-quote (match-string aux)))))
 289               (setq expression (cdr expression)))
 290             result)))
 291     ;; Return nil if not found
 292     nil))
 293
 294 (defun tildify-tildify (beg end ask)
 295   "Add tilde characters in the region between BEG and END.
 296 This function does not do any further checking except of for comments and
 297 macros.
 298
 299 If ASK is nil, perform replace without asking user for confirmation.
 300
 301 Returns one of symbols: t (all right), nil (quit), force (replace without
 302 further questions)."
 303   (save-excursion
 304     (goto-char beg)
 305     (let* ((alist (tildify-mode-alist tildify-pattern-alist))
 306            (regexp (car alist))
 307            (match-number (cadr alist))
 308            (tilde (tildify-mode-alist tildify-string-alist))
 309            (end-marker (copy-marker end))
 310            answer
 311            bad-answer
 312            replace
 313            quit
 314            (message-log-max nil))
 315       (while (and (not quit)
 316                   (re-search-forward regexp (marker-position end-marker) t))
 317         (when (or (not ask)
 318                   (progn
 319                     (goto-char (match-beginning match-number))
 320                     (setq bad-answer t)
 321                     (while bad-answer
 322                       (setq bad-answer nil)
 323                       (message "Replace? (yn!q) ")
 324                       (setq answer (read-event)))
 325                     (cond
 326                      ((or (eq answer ?y) (eq answer ? ) (eq answer 'space))
 327                       (setq replace t))
 328                      ((eq answer ?n)
 329                       (setq replace nil))
 330                      ((eq answer ?!)
 331                       (setq replace t
 332                             ask nil))
 333                      ((eq answer ?q)
 334                       (setq replace nil
 335                             quit t))
 336                      (t
 337                       (message "Press y, n, !, or q.")
 338                       (setq bad-answer t)))
 339                     replace))
 340           (replace-match tilde t t nil match-number)
 341           (setq tildify-count (1+ tildify-count))))
 342       ;; Return value
 343       (cond
 344        (quit nil)
 345        ((not ask) 'force)
 346        (t t)))))
 347
 348
 349 ;;; *** Announce ***
 350
 351 (provide 'tildify)
 352
 353
 354 ;; Local variables:
 355 ;; coding: iso-latin-2
 356 ;; End:
 357
 358 ;;; arch-tag: fc9b05a6-7355-4639-8170-dcf57853ba22
 359 ;;; tildify.el ends here