1 ;;; markchars.el --- Mark chars fitting certain characteristics
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2010-03-22 Mon
6 ;; Last-Updated: 2010-03-25 Thu
11 ;; Features that might be required by this library:
13 ;; Required feature `markchars' was not provided.
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 ;; Mark special chars, by default non-ascii, non-IDN chars. See
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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.
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.
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.
44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 (defgroup markchars nil
52 "Customization group for `markchars-mode'."
55 (defface markchars-light
56 '((t (:underline "light blue")))
57 "Light face for `markchars-mode' char marking."
60 (defface markchars-heavy
61 '((t (:underline "magenta")))
62 "Heavy face for `markchars-mode' char marking."
65 (defcustom markchars-face 'markchars-heavy
66 "Pointer to face used for marking chars."
70 ;; (markchars-nonidn-fun (point-max))
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]}
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))
87 (while (< (point) bound)
88 (let ((char (char-after (point))))
89 (when (or (< char 256)
90 (idn-is-recommended char))
94 (setq end (or end bound))
95 (set-match-data (list (copy-marker beg) (copy-marker end)))
98 (defcustom markchars-keywords (or (when (fboundp 'idn-is-recommended) 'markchars-nonidn-fun)
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))
106 (defvar markchars-used-keywords nil
107 "Keywords currently used for font lock.")
108 (put 'markchars-used-keywords 'permanent-local t)
110 (defun markchars-set-keywords ()
111 "Set `markchars-used-keywords' from options."
112 (set (make-local-variable 'markchars-used-keywords)
114 (list markchars-keywords
115 (list 0 '(put-text-property (match-beginning 0) (match-end 0)
116 'face markchars-face))))))
119 (define-minor-mode markchars-mode
120 "Mark special characters.
121 Which characters to mark are defined by `markchars-keywords'.
123 The default is to mark non-IDN, non-ascii chars with a magenta
126 For information about IDN chars see `idn-is-recommended'.
128 If you change anything in the customization group `markchars' you
129 must restart this minor mode for the changes to take effect."
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)
141 (mumamo-mark-for-refontification (point-min) (point-max)))
142 (font-lock-fontify-buffer)))
145 (define-globalized-minor-mode markchars-global-mode markchars-mode
146 (lambda () (markchars-mode 1))
150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
151 ;;; markchars.el ends here