nxhtml/util/markchars.el

   1 ;;; markchars.el --- Mark chars fitting certain characteristics
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2010-03-22 Mon
   5 ;; Version:
   6 ;; Last-Updated: 2010-03-25 Thu
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; Features that might be required by this library:
  12 ;;
  13 ;;   Required feature `markchars' was not provided.
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; Mark special chars, by default non-ascii, non-IDN chars. See
  20 ;; `markchars-mode'.
  21 ;;
  22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23 ;;
  24 ;;; Change log:
  25 ;;
  26 ;;
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;;
  29 ;; This program is free software; you can redistribute it and/or
  30 ;; modify it under the terms of the GNU General Public License as
  31 ;; published by the Free Software Foundation; either version 3, or
  32 ;; (at your option) any later version.
  33 ;;
  34 ;; This program is distributed in the hope that it will be useful,
  35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  37 ;; General Public License for more details.
  38 ;;
  39 ;; You should have received a copy of the GNU General Public License
  40 ;; along with this program; see the file COPYING.  If not, write to
  41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  42 ;; Floor, Boston, MA 02110-1301, USA.
  43 ;;
  44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  45 ;;
  46 ;;; Code:
  47
  48 (require 'idn)
  49
  50 ;;;###autoload
  51 (defgroup markchars nil
  52   "Customization group for `markchars-mode'."
  53   :group 'convenience)
  54
  55 (defface markchars-light
  56   '((t (:underline "light blue")))
  57   "Light face for `markchars-mode' char marking."
  58   :group 'markchars)
  59
  60 (defface markchars-heavy
  61   '((t (:underline "magenta")))
  62   "Heavy face for `markchars-mode' char marking."
  63   :group 'markchars)
  64
  65 (defcustom markchars-face 'markchars-heavy
  66   "Pointer to face used for marking chars."
  67   :type 'face
  68   :group 'markchars)
  69
  70 ;; (markchars-nonidn-fun (point-max))
  71 ;; åäö
  72 ;; character: å (229, #o345, #xe5)
  73 ;; (idn-is-recommended 229) => t
  74 ;; 152F ;       00B7 0034 ;     SL      # ( ᔯ → ·4 ) CANADIAN SYLLABICS YWE → MIDDLE DOT, DIGIT FOUR     # {source:835} ᐧ4 {[source:696]}
  75
  76 (defun markchars-nonidn-fun (bound)
  77   "Font lock matcher for non-IDN, non-ascii chars."
  78   (let* ((beg (catch 'beg
  79                (while (< (point) bound)
  80                  (let ((char (char-after)))
  81                    (unless (or (< char 256)
  82                                (idn-is-recommended char))
  83                      (throw 'beg (point)))
  84                    (forward-char)))))
  85          (end (when beg
  86                 (catch 'end
  87                   (while (< (point) bound)
  88                     (let ((char (char-after (point))))
  89                       (when (or (< char 256)
  90                                 (idn-is-recommended char))
  91                         (throw 'end (point)))
  92                       (forward-char)))))))
  93     (when beg
  94       (setq end (or end bound))
  95       (set-match-data (list (copy-marker beg) (copy-marker end)))
  96       t)))
  97
  98 (defcustom markchars-keywords (or (when (fboundp 'idn-is-recommended) 'markchars-nonidn-fun)
  99                                   "[[:nonascii:]]+")
 100   "Regexp or function for font lock to use for characters to mark.
 101 By default it matches non-IDN, non-ascii chars."
 102   :type '(choice (const :tag "Non-ascii chars" "[[:nonascii:]]+")
 103                  (const :tag "Non IDN chars (Unicode.org tr39 suggestions)" markchars-nonidn-fun))
 104   :group 'markchars)
 105
 106 (defvar markchars-used-keywords nil
 107   "Keywords currently used for font lock.")
 108 (put 'markchars-used-keywords 'permanent-local t)
 109
 110 (defun markchars-set-keywords ()
 111   "Set `markchars-used-keywords' from options."
 112   (set (make-local-variable 'markchars-used-keywords)
 113        (list
 114         (list markchars-keywords
 115               (list 0 '(put-text-property (match-beginning 0) (match-end 0)
 116                                           'face markchars-face))))))
 117
 118 ;;;###autoload
 119 (define-minor-mode markchars-mode
 120   "Mark special characters.
 121 Which characters to mark are defined by `markchars-keywords'.
 122
 123 The default is to mark non-IDN, non-ascii chars with a magenta
 124 underline.
 125
 126 For information about IDN chars see `idn-is-recommended'.
 127
 128 If you change anything in the customization group `markchars' you
 129 must restart this minor mode for the changes to take effect."
 130   :group 'markchars
 131   :lighter " ø"
 132   (if markchars-mode
 133       (progn
 134         (markchars-set-keywords)
 135         (font-lock-add-keywords nil markchars-used-keywords))
 136     (font-lock-remove-keywords nil markchars-used-keywords))
 137   ;; Fix-me: Something like mumamo-mark-for-refontification should be in Emacs.
 138   (if (fboundp 'mumamo-mark-for-refontification)
 139       (save-restriction
 140         (widen)
 141         (mumamo-mark-for-refontification (point-min) (point-max)))
 142     (font-lock-fontify-buffer)))
 143
 144 ;;;###autoload
 145 (define-globalized-minor-mode markchars-global-mode markchars-mode
 146   (lambda () (markchars-mode 1))
 147   :group 'markchars)
 148
 149 (provide 'markchars)
 150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 151 ;;; markchars.el ends here