|
1 ;;; -*- coding: utf-8 -*- |
|
2 ;; Minor mode for redisplaying parts of the buffer as pretty symbols |
|
3 ;; originally modified from Trent Buck's version at http://paste.lisp.org/display/42335,2/raw |
|
4 ;; Also includes code from `sml-mode' |
|
5 ;; See also http://www.emacswiki.org/cgi-bin/wiki/PrettyLambda |
|
6 ;; written by Arthur Danskin <[email protected]> |
|
7 ;; |
|
8 ;; to install: |
|
9 ;; (require 'pretty-mode) |
|
10 ;; (global-pretty-mode 1) |
|
11 ;; or |
|
12 ;; (add-hook 'my-pretty-language-hook 'turn-on-pretty-mode) |
|
13 |
|
14 |
|
15 (require 'cl) |
|
16 |
|
17 ;; modified from `sml-mode' |
|
18 (defun pretty-font-lock-compose-symbol (alist) |
|
19 "Compose a sequence of ascii chars into a symbol." |
|
20 (let* ((start (match-beginning 0)) |
|
21 (end (match-end 0)) |
|
22 (syntax (char-syntax (char-after start)))) |
|
23 (if (or (if (eq syntax ?w) |
|
24 (or (eq (char-syntax (char-before start)) ?w) |
|
25 (eq (char-syntax (char-after end)) ?w)) |
|
26 (memq (char-syntax (char-before start)) '(?. ?\\))) |
|
27 (memq (get-text-property start 'face) |
|
28 '(font-lock-doc-face font-lock-string-face |
|
29 font-lock-comment-face))) |
|
30 (remove-text-properties start end '(composition)) |
|
31 (compose-region start end (cdr (assoc (match-string 0) alist))) |
|
32 )) |
|
33 nil) |
|
34 |
|
35 (defvar pretty-interaction-mode-alist |
|
36 '((inferior-scheme-mode . scheme-mode) |
|
37 (lisp-interaction-mode . emacs-lisp-mode) |
|
38 (inferior-lisp-mode . lisp-mode) |
|
39 (inferior-ess-mode . ess-mode) |
|
40 (inf-haskell-mode . haskell-mode) |
|
41 (inferior-erlang-mode . erlang-mode) |
|
42 (tuareg-interactive-mode . tuareg-mode) |
|
43 (inferior-python-mode . python-mode) |
|
44 (inferior-octave-mode . octave-mode) |
|
45 (inferior-ruby-mode . ruby-mode)) |
|
46 "Alist mapping from inferior process interaction modes to their |
|
47 corresponding script editing modes.") |
|
48 |
|
49 |
|
50 (defun pretty-font-lock-keywords (alist) |
|
51 "Return a `font-lock-keywords' style entry for replacing |
|
52 regular expressions with symbols. ALIST has the form ((STRING . |
|
53 REPLACE-CHAR) ...)." |
|
54 (when alist |
|
55 `((,(regexp-opt (mapcar 'car alist)) |
|
56 (0 (pretty-font-lock-compose-symbol |
|
57 ',alist)))))) |
|
58 |
|
59 (defun pretty-keywords (&optional mode) |
|
60 "Return the font-lock keywords for MODE, or the current mode if |
|
61 MODE is nil. Return nil if there are no keywords." |
|
62 (let* ((mode (or mode major-mode)) |
|
63 (kwds (cdr-safe |
|
64 (or (assoc mode pretty-patterns) |
|
65 (assoc (cdr-safe |
|
66 (assoc mode pretty-interaction-mode-alist)) |
|
67 pretty-patterns))))) |
|
68 (pretty-font-lock-keywords kwds))) |
|
69 |
|
70 (defgroup pretty nil "Minor mode for replacing text with symbols " |
|
71 :group 'faces) |
|
72 |
|
73 (define-minor-mode pretty-mode |
|
74 "Toggle Pretty minor mode. |
|
75 With arg, turn Pretty minor mode on if arg is positive, off otherwise. |
|
76 |
|
77 Pretty mode builds on `font-lock-mode'. Instead of highlighting |
|
78 keywords, it replaces them with symbols. For example, lambda is |
|
79 displayed as λ in lisp modes." |
|
80 :group 'pretty |
|
81 ; :lighter " λ" |
|
82 (if pretty-mode |
|
83 (progn |
|
84 (font-lock-add-keywords nil (pretty-keywords) t) |
|
85 (font-lock-fontify-buffer)) |
|
86 (font-lock-remove-keywords nil (pretty-keywords)) |
|
87 (remove-text-properties (point-min) (point-max) '(composition nil)))) |
|
88 |
|
89 (defun turn-on-pretty-if-desired () |
|
90 "Turn on `pretty-mode' if the current major mode supports it." |
|
91 (if (pretty-keywords) |
|
92 (pretty-mode 1))) |
|
93 |
|
94 (define-globalized-minor-mode global-pretty-mode |
|
95 pretty-mode turn-on-pretty-if-desired |
|
96 :init-value t) |
|
97 |
|
98 (defun turn-off-pretty-mode () |
|
99 (interactive) |
|
100 (pretty-mode -1)) |
|
101 |
|
102 |
|
103 (defun turn-on-pretty-mode () |
|
104 (interactive) |
|
105 (pretty-mode +1)) |
|
106 |
|
107 (defun pretty-compile-patterns (patterns) |
|
108 "Set pretty patterns in a convenient way. |
|
109 |
|
110 PATTERNS should be of the form ((GLYPH (REGEXP MODE ...) ...) |
|
111 ...). GLYPH should be a character. MODE should be the name of a |
|
112 major mode without the \"-mode\". Returns patterns in the form |
|
113 expected by `pretty-patterns'" |
|
114 (let ((pretty-patterns)) |
|
115 (loop for (glyph . pairs) in patterns do |
|
116 (loop for (regexp . major-modes) in pairs do |
|
117 (loop for mode in major-modes do |
|
118 (let* ((mode (intern (concat (symbol-name mode) |
|
119 "-mode"))) |
|
120 (assoc-pair (assoc mode pretty-patterns)) |
|
121 |
|
122 (entry (cons regexp glyph))) |
|
123 (if assoc-pair |
|
124 (push entry (cdr assoc-pair)) |
|
125 (push (cons mode (list entry)) |
|
126 pretty-patterns)))))) |
|
127 pretty-patterns)) |
|
128 |
|
129 ;;; (setq-default pretty-patterns pretty-patterns-default) |
|
130 (defconst pretty-patterns-default |
|
131 (let* ((lispy '(scheme emacs-lisp lisp)) |
|
132 (mley '(tuareg haskell sml erlang)) |
|
133 (c-like '(c c++ perl sh python java ess ruby)) |
|
134 (all (append lispy mley c-like (list 'octave)))) |
|
135 (pretty-compile-patterns |
|
136 `( |
|
137 (?≠ ("!=" ,@c-like scheme octave) |
|
138 ("<>" tuareg octave) |
|
139 ("~=" octave) |
|
140 ("/=" haskell) |
|
141 ("=/=" erlang)) |
|
142 (?≤ ("<=" ,@all)) |
|
143 (?≤ ("=<" erlang)) |
|
144 (?λ ("fun" erlang)) |
|
145 (?≥ (">=" ,@all)) |
|
146 (?← ("<-" ,@mley ess) |
|
147 ("!" erlang)) |
|
148 (?→ ("->" ,@mley ess c c++ perl)) |
|
149 (?↑ ("\\^" tuareg)) |
|
150 (?⇒ ("=>" sml perl ruby)) |
|
151 ;;; (?∅ ("nil" emacs-lisp ruby) |
|
152 ;;; ("null" scheme java) |
|
153 ;;; ("NULL" c c++) |
|
154 ;;; ("None" python) |
|
155 ;;; ("()" ,@mley)) |
|
156 (?≡ ("==" ,@c-like erlang haskell)) |
|
157 (?∀ ("BOOST_FOREACH" c++)) |
|
158 (?∷ ("::" ,@all)) |
|
159 (?√ ("sqrt" ,@all)) |
|
160 (?∑ ("sum" python)) |
|
161 (?α ("alpha" ,@all)) |
|
162 (?β ("beta" ,@all)) |
|
163 (?γ ("gamma" ,@all)) |
|
164 (?δ ("delta" ,@all)) |
|
165 (?ε ("epsilon" ,@all)) |
|
166 (?ζ ("zeta" ,@all)) |
|
167 (?η ("eta" ,@all)) |
|
168 (?θ ("theta" ,@all)) |
|
169 (?ι ("iota" ,@all)) |
|
170 (?κ ("kappa" ,@all)) |
|
171 (?λ ("lambda" ,@all)) |
|
172 (?μ ("mu" ,@all)) |
|
173 (?ν ("nu" ,@all)) |
|
174 (?ν ("vega" ,@all)) |
|
175 (?ξ ("xi" ,@all)) |
|
176 (?ο ("omicron" ,@all)) |
|
177 (?π ("pi" ,@all)) |
|
178 (?ρ ("rho" ,@all)) |
|
179 (?σ ("sigma" ,@all)) |
|
180 (?τ ("tau" ,@all)) |
|
181 (?υ ("upsilon" ,@all)) |
|
182 (?φ ("phi" ,@all)) |
|
183 (?χ ("chi" ,@all)) |
|
184 (?ψ ("psi" ,@all)) |
|
185 (?ω ("omega" ,@all)) |
|
186 (?² ("**2" python tuareg octave)) |
|
187 (?³ ("**3" python tuareg octave)) |
|
188 (?ⁿ ("**n" python tuareg octave)) |
|
189 (?ₐ ("[a]" ,@c-like)) |
|
190 (?ₓ ("[x]" ,@c-like)) |
|
191 (?₀ ("[0]" ,@c-like) |
|
192 ("/0" erlang)) |
|
193 (?₁ ("[1]" ,@c-like) |
|
194 ("/1" erlang)) |
|
195 (?₂ ("[2]" ,@c-like) |
|
196 ("/2" erlang)) |
|
197 (?₃ ("[3]" ,@c-like) |
|
198 ("/3" erlang)) |
|
199 (?₄ ("[4]" ,@c-like) |
|
200 ("/4" erlang)) |
|
201 (?₅ ("[5]" ,@c-like) |
|
202 ("/5" erlang)) |
|
203 (?₆ ("[6]" ,@c-like) |
|
204 ("/6" erlang)) |
|
205 (?₇ ("[7]" ,@c-like) |
|
206 ("/7" erlang)) |
|
207 (?₈ ("[8]" ,@c-like) |
|
208 ("/8" erlang)) |
|
209 (?₉ ("[9]" ,@c-like) |
|
210 ("/9" erlang)) |
|
211 (?∧ ("\\<And\\>" emacs-lisp lisp python) |
|
212 ("\\<andalso\\>" sml erlang) |
|
213 ("&&" c c++ perl haskell)) |
|
214 (?∨ ("\\<or\\>" emacs-lisp lisp) |
|
215 ("\\<orelse\\>" sml erlang) |
|
216 ("||" c c++ perl haskell erlang)) |
|
217 (?¬ ("!" c c++)) |
|
218 ))) |
|
219 "default value for `pretty-patterns'") |
|
220 |
|
221 ;; TODO fix type |
|
222 (defcustom pretty-patterns pretty-patterns-default |
|
223 "*List of pretty patterns. |
|
224 |
|
225 Should be a list of the form ((MODE ((REGEXP . GLYPH) ...)) ...)" |
|
226 :group 'pretty |
|
227 :type '(alist :key-type variable :value-type (alist :key-type (string) :value-type (character)))) |
|
228 |
|
229 |
|
230 (defun pretty-add-keywords (mode keywords) |
|
231 "Add pretty character KEYWORDS to MODE |
|
232 |
|
233 MODE should be a symbol, the major mode command name, such as |
|
234 `c-mode' or nil. If nil, pretty keywords are added to the current |
|
235 buffer. KEYWORDS should be a list where each element has the |
|
236 form (REGEXP . CHAR). REGEXP will be replaced with CHAR in the |
|
237 relevant buffer(s)." |
|
238 (font-lock-add-keywords |
|
239 mode (mapcar (lambda (kw) `((,(car kw) |
|
240 (0 (prog1 nil |
|
241 (compose-region (match-beginning 0) |
|
242 (match-end 0) |
|
243 ,(cdr kw))))))) |
|
244 keywords))) |
|
245 |
|
246 (defun pretty-regexp (regexp glyph) |
|
247 "Replace REGEXP with GLYPH in buffer." |
|
248 (interactive "MRegexp to replace: |
|
249 MCharacter to replace with: ") |
|
250 (pretty-add-keywords nil `((,regexp . ,(string-to-char glyph)))) |
|
251 (font-lock-fontify-buffer)) |
|
252 |
|
253 |
|
254 |
|
255 |
|
256 (provide 'pretty-mode) |