;;; tildify.el --- adding hard spaces into texts ;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Milan Zamazal ;; Michal Nazarewicz ;; Version: 4.6 ;; Keywords: text, TeX, SGML, wp ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This package can be typically used for adding forgotten tildes in TeX ;; sources or adding ` ' sequences in SGML (e.g. HTML) texts. ;; ;; For example, the Czech orthography requires avoiding one letter ;; prepositions at line endings. So they should be connected with the ;; following words by a tilde. Some users forget to do this all the ;; time. The purpose of this program is to check the text and suggest ;; adding of missing tildes on some places. It works in a similar ;; manner to `query-replace-regexp'. ;; ;; The functionality of this program is actually performing query ;; replace on certain regions, but for historical reasons explained ;; above it is called `tildify'. ;; ;; The default variable settings are suited for Czech, so do not try to ;; understand them if you are not familiar with Czech grammar and spelling. ;; ;; The algorithm was inspired by Petr Olšák's program `vlna'. Abilities of ;; `tildify.el' are a little limited; if you have improvement suggestions, let ;; me know. ;;; Code: ;;; *** User configuration variables *** (defgroup tildify nil "Add hard spaces or other text fragments to text buffers." :version "21.1" :group 'wp) (defcustom tildify-pattern-alist '((t "\\([,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(\\w\\|[([{\\]\\|<[a-zA-Z]\\)" 2)) "Alist specifying where to insert hard spaces. Each alist item is of the form (MAJOR-MODE REGEXP NUMBER) or \(MAJOR-MODE . SYMBOL). MAJOR-MODE defines major mode, for which the item applies. It can be either: - a symbol equal to the major mode of the buffer to be fixed - t for default item, this applies to all major modes not defined in another alist item REGEXP is a regular expression matching the part of a text, where a hard space is missing. The regexp is always case sensitive, regardless of the current `case-fold-search' setting. NUMBER defines the number of the REGEXP subexpression which should be replaced by the hard space character. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." :group 'tildify :type '(repeat (cons :tag "Entry for major mode" (choice (const :tag "Default" t) (symbol :tag "Major mode")) (choice (list :tag "Regexp" regexp (integer :tag "Group ")) (symbol :tag "Like other"))))) (defcustom tildify-string-alist '((latex-mode . "~") (tex-mode . latex-mode) (plain-tex-mode . latex-mode) (sgml-mode . " ") (html-mode . sgml-mode) (xml-mode . " ") ; XML does not define   so use numeric reference (nxml-mode . xml-mode) (t . " ")) "Alist specifying what is a hard space in the current major mode. Each alist item is of the form (MAJOR-MODE . STRING) or \(MAJOR-MODE . SYMBOL). MAJOR-MODE defines major mode, for which the item applies. It can be either: - a symbol equal to the major mode of the buffer to be fixed - t for default item, this applies to all major modes not defined in another alist item STRING defines the hard space, which is inserted at places defined by `tildify-pattern-alist'. For example it can be \"~\" for TeX or \" \" for SGML. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." :group 'tildify :type '(repeat (cons :tag "Entry for major mode" (choice (const :tag "Default" t) (symbol :tag "Major mode")) (choice (const :tag "No-break space (U+00A0)" "\u00A0") (string :tag "String ") (symbol :tag "Like other"))))) (defcustom tildify-ignored-environments-alist `((latex-mode ("\\\\\\\\" . "") ; do not remove this (,(eval-when-compile (concat "\\\\begin{\\(" (regexp-opt '("verbatim" "math" "displaymath" "equation" "eqnarray" "eqnarray*")) "}")) "\\\\end{" 1 "}") ("\\\\verb\\*?\\(.\\)" . (1)) ("\\$\\$?" 0) ("\\\\(" . "\\\\)") ("\\\\[[]" . "\\\\[]]") ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "") ("%" . "$")) (plain-tex-mode . latex-mode) (html-mode (,(eval-when-compile (concat "<\\(" (regexp-opt '("pre" "dfn" "code" "samp" "kbd" "var" "PRE" "DFN" "CODE" "SAMP" "KBD" "VAR")) "\\)\\>[^>]*>")) "") ("") ("<" . ">")) (sgml-mode . html-mode) (xml-mode ("") ("<" . ">")) (nxml-mode . html-mode)) "Alist specifying ignored structured text environments. Parts of text defined in this alist are skipped without performing hard space insertion on them. These setting allow skipping text parts like verbatim or math environments in TeX or preformatted text in SGML. Each list element is of the form (MAJOR-MODE (BEG-REGEX . END-REGEX) (BEG-REGEX . END-REGEX) ... ) MAJOR-MODE defines major mode, for which the item applies. It can be either: - a symbol equal to the major mode of the buffer to be fixed - t for default item, this applies to all major modes not defined in another alist item BEG-REGEX is a regexp matching beginning of a text part to be skipped. END-REGEX defines end of the corresponding text part and can be either: - a regexp matching the end of the skipped text part - a list of regexps and numbers, which will compose the ending regexp by concatenating themselves, while replacing the numbers with corresponding subexpressions of BEG-REGEX (this is used to solve cases like \\\\verb in TeX)." :group 'tildify :type '(repeat (cons :tag "Entry for major mode" (choice (const :tag "Default" t) (symbol :tag "Major mode")) (choice (const :tag "None") (repeat :tag "Environments" (cons :tag "Regexp pair" (regexp :tag "Open ") (choice :tag "Close" (regexp :tag "Regexp") (list :tag "Regexp and groups (concatenated)" (choice (regexp :tag "Regexp") (integer :tag "Group ")))))) (symbol :tag "Like other"))))) ;;; *** Interactive functions *** ;;;###autoload (defun tildify-region (beg end) "Add hard spaces in the region between BEG and END. See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. This function performs no refilling of the changed text." (interactive "*r") (let (case-fold-search (count 0) (ask t)) (tildify-foreach-region-outside-env beg end (lambda (beg end) (let ((aux (tildify-tildify beg end ask))) (setq count (+ count (car aux))) (if (not (eq (cdr aux) 'force)) (cdr aux) (setq ask nil) t)))) (message "%d spaces replaced." count))) ;;;###autoload (defun tildify-buffer () "Add hard spaces in the current buffer. See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. This function performs no refilling of the changed text." (interactive "*") (tildify-region (point-min) (point-max))) ;;; *** Auxiliary functions *** (defun tildify-mode-alist (mode-alist &optional mode) "Return alist item for the MODE-ALIST in the current major MODE." (let ((alist (cdr (or (assoc (or mode major-mode) mode-alist) (assoc t mode-alist))))) (if (and alist (symbolp alist)) (tildify-mode-alist mode-alist alist) alist))) (defun tildify-foreach-region-outside-env (beg end callback) "Scan region from BEG to END calling CALLBACK on portions out of environments. Call CALLBACK on each region outside of environment to ignore. CALLBACK will only be called for regions which have intersection with [BEG END]. It must be a function that takes two point arguments specifying the region to operate on. Stop scanning the region as soon as CALLBACK returns nil. Environments to ignore are determined from `tildify-ignored-environments-alist'." (declare (indent 2)) (let* ((pairs (tildify-mode-alist tildify-ignored-environments-alist)) (beg-re (if pairs (mapconcat 'car pairs "\\|") pairs))) (if (not pairs) (funcall callback beg end) (let ((func (lambda (b e) (let ((b (min b beg)) (e (min e beg))) (if (< b e) (funcall callback beg end) t)))) p end-re) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (and (< (setq p (point)) end) (if (not (setq end-re (tildify-find-env beg-re pairs))) (progn (funcall func p end) nil) (funcall func p (match-beginning 0)) (when (< (point) end) (setq p (point)) (if (re-search-forward end-re nil t) t (funcall func p end) nil))))))))))) (defun tildify-find-env (regexp pairs) "Find environment using REGEXP. Return regexp for the end of the environment found in PAIRS or nil if no environment was found." ;; Find environment (when (re-search-forward regexp nil t) ;; Find regexp pair that matched (let ((match (match-string 0))) (save-match-data (while (not (eq (string-match (caar pairs) match) 0)) (setq pairs (cdr pairs))))) ;; Build end-re regexp (let ((expression (cdar pairs))) (if (stringp expression) expression (mapconcat (lambda (el) (if (stringp el) el expression (regexp-quote (match-string el)))) expression ""))))) (defun tildify-tildify (beg end ask) "Add tilde characters in the region between BEG and END. This function does not do any further checking except of for comments and macros. If ASK is nil, perform replace without asking user for confirmation. Returns (count . response) cons where count is number of string replacements done and response is one of symbols: t (all right), nil (quit), force (replace without further questions)." (save-excursion (goto-char beg) (let* ((alist (tildify-mode-alist tildify-pattern-alist)) (regexp (car alist)) (match-number (cadr alist)) (tilde (tildify-mode-alist tildify-string-alist)) (end-marker (copy-marker end)) answer bad-answer replace quit (message-log-max nil) (count 0)) (while (and (not quit) (re-search-forward regexp (marker-position end-marker) t)) (when (or (not ask) (progn (goto-char (match-beginning match-number)) (setq bad-answer t) (while bad-answer (setq bad-answer nil) (message "Replace? (yn!q) ") (setq answer (read-event))) (cond ((or (eq answer ?y) (eq answer ? ) (eq answer 'space)) (setq replace t)) ((eq answer ?n) (setq replace nil)) ((eq answer ?!) (setq replace t ask nil)) ((eq answer ?q) (setq replace nil quit t)) (t (message "Press y, n, !, or q.") (setq bad-answer t))) replace)) (replace-match tilde t t nil match-number) (setq count (1+ count)))) ;; Return value (cons count (cond (quit nil) ((not ask) 'force) (t t)))))) ;;; *** Auto Tildify *** (defcustom auto-tildify-pattern-alist '((t . "[,:;(][ \t]*[a]\\|\\<[AIKOSUVWZikosuvwz]")) "Alist specifying whether to insert hard space at point. Each alist item is of the form (MAJOR-MODE . REGEXP) or \(MAJOR-MODE . SYMBOL). MAJOR-MODE defines major mode, for which the item applies. It can be either: - a symbol equal to the major mode of the buffer to be fixed - t for default item, this applies to all major modes not defined in another alist item REGEXP is a regular expression matching the part of a text that needs a hard space to be inserted instead of a space. The regexp is always case sensitive, regardless of the current `case-fold-search' setting. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." :group 'tildify :type '(repeat (cons (choice (const :tag "Default" t) (symbol :tag "For mode ")) (choice (regexp :tag "Regexp ") (symbol :tag "Like mode"))))) (defcustom auto-tildify-check-envs t "Should `auto-tildify' check if point is inside ignored environment." :group 'tildify :type 'boolean) ;;;###autoload (defun auto-tildify () "Convert space before point into a hard space if the context is right. If * character before point is a space character, * character before that has “w” character syntax (i.e. it's a word constituent), * pattern from `auto-tildify-pattern-alist' matches when `looking-back' (no more than 10 characters) from before the space character, and * `auto-tildify-check-envs' is nil or point is not inside of an environment to ignore replace the space character with a hard space defined in `auto-tildify-string'. Return t if conversion happened, nil otherwise. This function is meant to be used as a `post-self-insert-hook'." (interactive) (let (case-fold-search space pattern) (when (and (> (- (point) (point-min)) 2) (eq (preceding-char) ?\s) (eq (char-syntax (char-before (1- (point)))) ?w) (setq space (tildify-mode-alist tildify-string-alist)) (not (string-equal " " space)) (setq pattern (tildify-mode-alist auto-tildify-pattern-alist)) (save-excursion (goto-char (1- (point))) (looking-back pattern (max (point-min) (- (point) 10)))) (or (not auto-tildify-check-envs) (let (found) (tildify-foreach-region-outside-env (- (point) 2) (1- (point)) (lambda (beg end) (setq found t) nil)) found))) (delete-char -1) (insert space) t))) ;;;###autoload (define-minor-mode auto-tildify-mode "Adds electric behaviour to space character. When space is inserted into a buffer in a position where hard space is required instead, that space character is replaced by a hard space correct for given mode. Converting of the space is done by `auto-tildify'." nil " ~" nil (when (let ((space (tildify-mode-alist tildify-string-alist))) (or (not space) (string-equal " " space))) (message "Hard space for %s is single space character, auto-tildify won't have any effect." major-mode)) (when (not (tildify-mode-alist auto-tildify-pattern-alist)) (message "No auto-pattern defined for %s, auto-tildify won't have any effect." major-mode)) (if auto-tildify-mode (add-hook 'post-self-insert-hook 'auto-tildify nil t) (remove-hook 'post-self-insert-hook 'auto-tildify t))) ;;; *** Announce *** (provide 'tildify) ;; Local variables: ;; coding: utf-8 ;; End: ;;; tildify.el ends here