lisp/textmodes/tildify.el

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