Commit | Line | Data |
---|---|---|
e8af40ee | 1 | ;;; cpp.el --- highlight or hide text according to cpp conditionals |
20f5d145 | 2 | |
d7a0267c | 3 | ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007 |
034babe1 | 4 | ;; Free Software Foundation |
20f5d145 | 5 | |
d6d92017 | 6 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
20f5d145 RS |
7 | ;; Keywords: c, faces, tools |
8 | ||
7930d722 | 9 | ;; This file is part of GNU Emacs. |
20f5d145 | 10 | |
7930d722 | 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
20f5d145 | 12 | ;; it under the terms of the GNU General Public License as published by |
1a484753 | 13 | ;; the Free Software Foundation; either version 3, or (at your option) |
20f5d145 | 14 | ;; any later version. |
7930d722 RS |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20f5d145 RS |
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. | |
7930d722 | 20 | |
20f5d145 | 21 | ;; You should have received a copy of the GNU General Public License |
b578f267 | 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
20f5d145 | 25 | |
7930d722 | 26 | ;;; Commentary: |
20f5d145 RS |
27 | |
28 | ;; Parse a text for C preprocessor conditionals, and highlight or hide | |
29 | ;; the text inside the conditionals as you wish. | |
30 | ||
fe441eb7 | 31 | ;; This package is inspired by Jim Coplien's delta editor for SCCS. |
20f5d145 RS |
32 | |
33 | ;;; Todo: | |
34 | ||
35 | ;; Should parse "#if" and "#elif" expressions and merge the faces | |
a1506d29 | 36 | ;; somehow. |
20f5d145 RS |
37 | |
38 | ;; Somehow it is sometimes possible to make changes near a read only | |
39 | ;; area which you can't undo. Their are other strange effects in that | |
40 | ;; area. | |
41 | ||
42 | ;; The Edit buffer should -- optionally -- appear in its own frame. | |
43 | ||
44 | ;; Conditionals seem to be rear-sticky. They shouldn't be. | |
45 | ||
46 | ;; Restore window configurations when exiting CPP Edit buffer. | |
47 | ||
48 | ;;; Code: | |
49 | ||
50 | ;;; Customization: | |
487e6fcb RS |
51 | (defgroup cpp nil |
52 | "Highlight or hide text according to cpp conditionals." | |
8ec3bce0 | 53 | :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) |
2279eb90 | 54 | :group 'c |
487e6fcb RS |
55 | :prefix "cpp-") |
56 | ||
57 | (defcustom cpp-config-file (convert-standard-filename ".cpp.el") | |
58 | "*File name to save cpp configuration." | |
59 | :type 'file | |
60 | :group 'cpp) | |
61 | ||
cf717a0d JL |
62 | (define-widget 'cpp-face 'lazy |
63 | "Either a face or the special symbol 'invisible'." | |
64 | :type '(choice (const invisible) (face))) | |
65 | ||
487e6fcb RS |
66 | (defcustom cpp-known-face 'invisible |
67 | "*Face used for known cpp symbols." | |
cf717a0d | 68 | :type 'cpp-face |
487e6fcb RS |
69 | :group 'cpp) |
70 | ||
71 | (defcustom cpp-unknown-face 'highlight | |
72 | "*Face used for unknown cpp symbols." | |
cf717a0d | 73 | :type 'cpp-face |
487e6fcb RS |
74 | :group 'cpp) |
75 | ||
a1506d29 | 76 | (defcustom cpp-face-type 'light |
20f5d145 RS |
77 | "*Indicate what background face type you prefer. |
78 | Can be either light or dark for color screens, mono for monochrome | |
25ef2b06 EZ |
79 | screens, and none if you don't use a window system and don't have |
80 | a color-capable display." | |
487e6fcb RS |
81 | :options '(light dark mono nil) |
82 | :type 'symbol | |
83 | :group 'cpp) | |
84 | ||
85 | (defcustom cpp-known-writable t | |
86 | "*Non-nil means you are allowed to modify the known conditionals." | |
87 | :type 'boolean | |
88 | :group 'cpp) | |
89 | ||
90 | (defcustom cpp-unknown-writable t | |
91 | "*Non-nil means you are allowed to modify the unknown conditionals." | |
92 | :type 'boolean | |
93 | :group 'cpp) | |
94 | ||
95 | (defcustom cpp-edit-list nil | |
2e922f0b RS |
96 | "Alist of cpp macros and information about how they should be displayed. |
97 | Each entry is a list with the following elements: | |
98 | 0. The name of the macro (a string). | |
99 | 1. Face used for text that is `ifdef' the macro. | |
100 | 2. Face used for text that is `ifndef' the macro. | |
d7e170b3 | 101 | 3. t, nil, or `both' depending on what text may be edited." |
cf717a0d JL |
102 | :type '(repeat (list (string :tag "Macro") |
103 | (cpp-face :tag "True") | |
104 | (cpp-face :tag "False") | |
105 | (choice (const :tag "True branch writable" t) | |
106 | (const :tag "False branch writeable" nil) | |
107 | (const :tag "Both branches writeable" both)))) | |
487e6fcb | 108 | :group 'cpp) |
2e922f0b RS |
109 | |
110 | (defvar cpp-overlay-list nil) | |
111 | ;; List of cpp overlays active in the current buffer. | |
112 | (make-variable-buffer-local 'cpp-overlay-list) | |
113 | ||
114 | (defvar cpp-callback-data) | |
115 | (defvar cpp-state-stack) | |
116 | ||
117 | (defconst cpp-face-type-list | |
118 | '(("light color background" . light) | |
119 | ("dark color background" . dark) | |
120 | ("monochrome" . mono) | |
121 | ("tty" . none)) | |
122 | "Alist of strings and names of the defined face collections.") | |
123 | ||
124 | (defconst cpp-writable-list | |
125 | ;; Names used for the writable property. | |
126 | '(("writable" . t) | |
127 | ("read-only" . nil))) | |
128 | ||
129 | (defvar cpp-button-event nil) | |
130 | ;; This will be t in the callback for `cpp-make-button'. | |
131 | ||
132 | (defvar cpp-edit-buffer nil) | |
133 | ;; Real buffer whose cpp display information we are editing. | |
134 | (make-variable-buffer-local 'cpp-edit-buffer) | |
135 | ||
136 | (defconst cpp-branch-list | |
137 | ;; Alist of branches. | |
138 | '(("false" . nil) | |
139 | ("true" . t) | |
140 | ("both" . both))) | |
141 | ||
487e6fcb | 142 | (defcustom cpp-face-default-list nil |
212a75c4 RS |
143 | "Alist of faces you can choose from for cpp conditionals. |
144 | Each element has the form (STRING . FACE), where STRING | |
145 | serves as a name (for `cpp-highlight-buffer' only) | |
146 | and FACE is either a face (a symbol) | |
147 | or a cons cell (background-color . COLOR)." | |
148 | :type '(repeat (cons string (choice face (cons (const background-color) string)))) | |
487e6fcb | 149 | :group 'cpp) |
2e922f0b | 150 | |
487e6fcb | 151 | (defcustom cpp-face-light-name-list |
2e922f0b RS |
152 | '("light gray" "light blue" "light cyan" "light yellow" "light pink" |
153 | "pale green" "beige" "orange" "magenta" "violet" "medium purple" | |
154 | "turquoise") | |
bb27ac6f | 155 | "Background colors useful with dark foreground colors." |
487e6fcb RS |
156 | :type '(repeat string) |
157 | :group 'cpp) | |
2e922f0b | 158 | |
487e6fcb | 159 | (defcustom cpp-face-dark-name-list |
2e922f0b RS |
160 | '("dim gray" "blue" "cyan" "yellow" "red" |
161 | "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple" | |
162 | "dark turquoise") | |
bb27ac6f | 163 | "Background colors useful with light foreground colors." |
487e6fcb RS |
164 | :type '(repeat string) |
165 | :group 'cpp) | |
166 | ||
167 | (defcustom cpp-face-light-list nil | |
168 | "Alist of names and faces to be used for light backgrounds." | |
0b44343b AS |
169 | :type '(repeat (cons string (choice face |
170 | (cons (const background-color) string)))) | |
487e6fcb RS |
171 | :group 'cpp) |
172 | ||
173 | (defcustom cpp-face-dark-list nil | |
174 | "Alist of names and faces to be used for dark backgrounds." | |
0b44343b AS |
175 | :type '(repeat (cons string (choice face |
176 | (cons (const background-color) string)))) | |
487e6fcb RS |
177 | :group 'cpp) |
178 | ||
179 | (defcustom cpp-face-mono-list | |
180 | '(("bold" . bold) | |
181 | ("bold-italic" . bold-italic) | |
182 | ("italic" . italic) | |
183 | ("underline" . underline)) | |
184 | "Alist of names and faces to be used for monochrome screens." | |
185 | :type '(repeat (cons string face)) | |
186 | :group 'cpp) | |
187 | ||
188 | (defcustom cpp-face-none-list | |
2e922f0b RS |
189 | '(("default" . default) |
190 | ("invisible" . invisible)) | |
487e6fcb | 191 | "Alist of names and faces available even if you don't use a window system." |
6728475c | 192 | :type '(repeat (cons string cpp-face)) |
487e6fcb | 193 | :group 'cpp) |
2e922f0b RS |
194 | |
195 | (defvar cpp-face-all-list | |
196 | (append cpp-face-light-list | |
197 | cpp-face-dark-list | |
198 | cpp-face-mono-list | |
199 | cpp-face-none-list) | |
44fb78c0 | 200 | "All faces used for highlighting text inside cpp conditionals.") |
2e922f0b | 201 | |
20f5d145 RS |
202 | ;;; Parse Buffer: |
203 | ||
204 | (defvar cpp-parse-symbols nil | |
205 | "List of cpp macros used in the local buffer.") | |
206 | (make-variable-buffer-local 'cpp-parse-symbols) | |
207 | ||
208 | (defconst cpp-parse-regexp | |
209 | ;; Regexp matching all tokens needed to find conditionals. | |
210 | (concat | |
211 | "'\\|\"\\|/\\*\\|//\\|" | |
212 | "\\(^[ \t]*#[ \t]*\\(ifdef\\|ifndef\\|if\\|" | |
213 | "elif\\|else\\|endif\\)\\b\\)")) | |
214 | ||
215 | ;;;###autoload | |
daf4206b RS |
216 | (defun cpp-highlight-buffer (arg) |
217 | "Highlight C code according to preprocessor conditionals. | |
218 | This command pops up a buffer which you should edit to specify | |
219 | what kind of highlighting to use, and the criteria for highlighting. | |
f3a69d8f | 220 | A prefix arg suppresses display of that buffer." |
20f5d145 | 221 | (interactive "P") |
212a75c4 RS |
222 | (unless (or (eq t buffer-invisibility-spec) |
223 | (memq 'cpp buffer-invisibility-spec)) | |
73932557 | 224 | (add-to-invisibility-spec 'cpp)) |
20f5d145 RS |
225 | (setq cpp-parse-symbols nil) |
226 | (cpp-parse-reset) | |
227 | (if (null cpp-edit-list) | |
228 | (cpp-edit-load)) | |
2e922f0b | 229 | (let (cpp-state-stack) |
20f5d145 RS |
230 | (save-excursion |
231 | (goto-char (point-min)) | |
232 | (cpp-progress-message "Parsing...") | |
233 | (while (re-search-forward cpp-parse-regexp nil t) | |
234 | (cpp-progress-message "Parsing...%d%%" | |
235 | (/ (* 100 (- (point) (point-min))) (buffer-size))) | |
236 | (let ((match (buffer-substring (match-beginning 0) (match-end 0)))) | |
237 | (cond ((or (string-equal match "'") | |
238 | (string-equal match "\"")) | |
239 | (goto-char (match-beginning 0)) | |
240 | (condition-case nil | |
241 | (forward-sexp) | |
242 | (error (cpp-parse-error | |
243 | "Unterminated string or character")))) | |
244 | ((string-equal match "/*") | |
245 | (or (search-forward "*/" nil t) | |
246 | (error "Unterminated comment"))) | |
247 | ((string-equal match "//") | |
248 | (skip-chars-forward "^\n\r")) | |
249 | (t | |
250 | (end-of-line 1) | |
251 | (let ((from (match-beginning 1)) | |
252 | (to (1+ (point))) | |
253 | (type (buffer-substring (match-beginning 2) | |
254 | (match-end 2))) | |
255 | (expr (buffer-substring (match-end 1) (point)))) | |
256 | (cond ((string-equal type "ifdef") | |
257 | (cpp-parse-open t expr from to)) | |
258 | ((string-equal type "ifndef") | |
259 | (cpp-parse-open nil expr from to)) | |
260 | ((string-equal type "if") | |
261 | (cpp-parse-open t expr from to)) | |
262 | ((string-equal type "elif") | |
263 | (let (cpp-known-face cpp-unknown-face) | |
264 | (cpp-parse-close from to)) | |
265 | (cpp-parse-open t expr from to)) | |
266 | ((string-equal type "else") | |
2e922f0b RS |
267 | (or cpp-state-stack |
268 | (cpp-parse-error "Top level #else")) | |
269 | (let ((entry (list (not (nth 0 (car cpp-state-stack))) | |
270 | (nth 1 (car cpp-state-stack)) | |
20f5d145 RS |
271 | from to))) |
272 | (cpp-parse-close from to) | |
2e922f0b | 273 | (setq cpp-state-stack (cons entry cpp-state-stack)))) |
20f5d145 RS |
274 | ((string-equal type "endif") |
275 | (cpp-parse-close from to)) | |
276 | (t | |
277 | (cpp-parse-error "Parser error")))))))) | |
278 | (message "Parsing...done")) | |
2e922f0b | 279 | (if cpp-state-stack |
20f5d145 | 280 | (save-excursion |
2e922f0b | 281 | (goto-char (nth 3 (car cpp-state-stack))) |
20f5d145 RS |
282 | (cpp-parse-error "Unclosed conditional")))) |
283 | (or arg | |
284 | (null cpp-parse-symbols) | |
285 | (cpp-parse-edit))) | |
286 | ||
287 | (defun cpp-parse-open (branch expr begin end) | |
2e922f0b | 288 | "Push information about conditional-beginning onto `cpp-state-stack'." |
f3a69d8f | 289 | ;; Discard comments within this line. |
20f5d145 RS |
290 | (while (string-match "\\b[ \t]*/\\*.*\\*/[ \t]*\\b" expr) |
291 | (setq expr (concat (substring expr 0 (match-beginning 0)) | |
292 | (substring expr (match-end 0))))) | |
f3a69d8f RS |
293 | ;; If a comment starts on this line and continues past, discard it. |
294 | (if (string-match "\\b[ \t]*/\\*" expr) | |
295 | (setq expr (substring expr 0 (match-beginning 0)))) | |
296 | ;; Delete any C++ comment from the line. | |
20f5d145 RS |
297 | (if (string-match "\\b[ \t]*\\(//.*\\)?$" expr) |
298 | (setq expr (substring expr 0 (match-beginning 0)))) | |
299 | (while (string-match "[ \t]+" expr) | |
300 | (setq expr (concat (substring expr 0 (match-beginning 0)) | |
301 | (substring expr (match-end 0))))) | |
2e922f0b | 302 | (setq cpp-state-stack (cons (list branch expr begin end) cpp-state-stack)) |
20f5d145 RS |
303 | (or (member expr cpp-parse-symbols) |
304 | (setq cpp-parse-symbols | |
305 | (cons expr cpp-parse-symbols))) | |
306 | (if (assoc expr cpp-edit-list) | |
307 | (cpp-make-known-overlay begin end) | |
308 | (cpp-make-unknown-overlay begin end))) | |
309 | ||
310 | (defun cpp-parse-close (from to) | |
2e922f0b RS |
311 | ;; Pop top of cpp-state-stack and create overlay. |
312 | (let ((entry (assoc (nth 1 (car cpp-state-stack)) cpp-edit-list)) | |
313 | (branch (nth 0 (car cpp-state-stack))) | |
314 | (begin (nth 2 (car cpp-state-stack))) | |
315 | (end (nth 3 (car cpp-state-stack)))) | |
316 | (setq cpp-state-stack (cdr cpp-state-stack)) | |
20f5d145 RS |
317 | (if entry |
318 | (let ((face (nth (if branch 1 2) entry)) | |
319 | (read-only (eq (not branch) (nth 3 entry))) | |
2e922f0b | 320 | (priority (length cpp-state-stack)) |
20f5d145 RS |
321 | (overlay (make-overlay end from))) |
322 | (cpp-make-known-overlay from to) | |
323 | (setq cpp-overlay-list (cons overlay cpp-overlay-list)) | |
324 | (if priority (overlay-put overlay 'priority priority)) | |
325 | (cond ((eq face 'invisible) | |
326 | (cpp-make-overlay-hidden overlay)) | |
327 | ((eq face 'default)) | |
328 | (t | |
329 | (overlay-put overlay 'face face))) | |
330 | (if read-only | |
331 | (cpp-make-overlay-read-only overlay) | |
332 | (cpp-make-overlay-sticky overlay))) | |
333 | (cpp-make-unknown-overlay from to)))) | |
334 | ||
335 | (defun cpp-parse-error (error) | |
336 | ;; Error message issued by the cpp parser. | |
8995e09e | 337 | (error "%s at line %d" error (count-lines (point-min) (point)))) |
20f5d145 RS |
338 | |
339 | (defun cpp-parse-reset () | |
340 | "Reset display of cpp conditionals to normal." | |
341 | (interactive) | |
342 | (while cpp-overlay-list | |
343 | (delete-overlay (car cpp-overlay-list)) | |
344 | (setq cpp-overlay-list (cdr cpp-overlay-list)))) | |
345 | ||
346 | ;;;###autoload | |
347 | (defun cpp-parse-edit () | |
348 | "Edit display information for cpp conditionals." | |
349 | (interactive) | |
350 | (or cpp-parse-symbols | |
f3a69d8f | 351 | (cpp-highlight-buffer t)) |
20f5d145 RS |
352 | (let ((buffer (current-buffer))) |
353 | (pop-to-buffer "*CPP Edit*") | |
354 | (cpp-edit-mode) | |
355 | (setq cpp-edit-buffer buffer) | |
356 | (cpp-edit-reset))) | |
357 | ||
358 | ;;; Overlays: | |
359 | ||
20f5d145 RS |
360 | (defun cpp-make-known-overlay (start end) |
361 | ;; Create an overlay for a known cpp command from START to END. | |
362 | (let ((overlay (make-overlay start end))) | |
363 | (if (eq cpp-known-face 'invisible) | |
364 | (cpp-make-overlay-hidden overlay) | |
365 | (or (eq cpp-known-face 'default) | |
366 | (overlay-put overlay 'face cpp-known-face)) | |
367 | (if cpp-known-writable | |
368 | () | |
369 | (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) | |
370 | (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)))) | |
371 | (setq cpp-overlay-list (cons overlay cpp-overlay-list)))) | |
372 | ||
373 | (defun cpp-make-unknown-overlay (start end) | |
374 | ;; Create an overlay for an unknown cpp command from START to END. | |
375 | (let ((overlay (make-overlay start end))) | |
376 | (cond ((eq cpp-unknown-face 'invisible) | |
377 | (cpp-make-overlay-hidden overlay)) | |
378 | ((eq cpp-unknown-face 'default)) | |
a1506d29 | 379 | (t |
20f5d145 RS |
380 | (overlay-put overlay 'face cpp-unknown-face))) |
381 | (if cpp-unknown-writable | |
382 | () | |
383 | (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) | |
384 | (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))) | |
385 | (setq cpp-overlay-list (cons overlay cpp-overlay-list)))) | |
386 | ||
387 | (defun cpp-make-overlay-hidden (overlay) | |
388 | ;; Make overlay hidden and intangible. | |
73932557 | 389 | (overlay-put overlay 'invisible 'cpp) |
dfc4f59b RS |
390 | (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) |
391 | (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))) | |
20f5d145 RS |
392 | |
393 | (defun cpp-make-overlay-read-only (overlay) | |
394 | ;; Make overlay read only. | |
395 | (overlay-put overlay 'modification-hooks '(cpp-signal-read-only)) | |
396 | (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)) | |
397 | (overlay-put overlay 'insert-behind-hooks '(cpp-signal-read-only))) | |
398 | ||
399 | (defun cpp-make-overlay-sticky (overlay) | |
400 | ;; Make OVERLAY grow when you insert text at either end. | |
401 | (overlay-put overlay 'insert-in-front-hooks '(cpp-grow-overlay)) | |
402 | (overlay-put overlay 'insert-behind-hooks '(cpp-grow-overlay))) | |
403 | ||
dfc4f59b | 404 | (defun cpp-signal-read-only (overlay after start end &optional len) |
20f5d145 RS |
405 | ;; Only allow deleting the whole overlay. |
406 | ;; Trying to change a read-only overlay. | |
dfc4f59b RS |
407 | (if (and (not after) |
408 | (or (< (overlay-start overlay) start) | |
409 | (> (overlay-end overlay) end))) | |
20f5d145 RS |
410 | (error "This text is read only"))) |
411 | ||
dfc4f59b | 412 | (defun cpp-grow-overlay (overlay after start end &optional len) |
20f5d145 | 413 | ;; Make OVERLAY grow to contain range START to END. |
dfc4f59b RS |
414 | (if after |
415 | (move-overlay overlay | |
416 | (min start (overlay-start overlay)) | |
417 | (max end (overlay-end overlay))))) | |
20f5d145 RS |
418 | |
419 | ;;; Edit Buffer: | |
420 | ||
20f5d145 RS |
421 | (defvar cpp-edit-map nil) |
422 | ;; Keymap for `cpp-edit-mode'. | |
423 | ||
424 | (if cpp-edit-map | |
425 | () | |
426 | (setq cpp-edit-map (make-keymap)) | |
427 | (suppress-keymap cpp-edit-map) | |
428 | (define-key cpp-edit-map [ down-mouse-2 ] 'cpp-push-button) | |
429 | (define-key cpp-edit-map [ mouse-2 ] 'ignore) | |
430 | (define-key cpp-edit-map " " 'scroll-up) | |
431 | (define-key cpp-edit-map "\C-?" 'scroll-down) | |
432 | (define-key cpp-edit-map [ delete ] 'scroll-down) | |
433 | (define-key cpp-edit-map "\C-c\C-c" 'cpp-edit-apply) | |
434 | (define-key cpp-edit-map "a" 'cpp-edit-apply) | |
435 | (define-key cpp-edit-map "A" 'cpp-edit-apply) | |
436 | (define-key cpp-edit-map "r" 'cpp-edit-reset) | |
437 | (define-key cpp-edit-map "R" 'cpp-edit-reset) | |
438 | (define-key cpp-edit-map "s" 'cpp-edit-save) | |
439 | (define-key cpp-edit-map "S" 'cpp-edit-save) | |
440 | (define-key cpp-edit-map "l" 'cpp-edit-load) | |
441 | (define-key cpp-edit-map "L" 'cpp-edit-load) | |
442 | (define-key cpp-edit-map "h" 'cpp-edit-home) | |
443 | (define-key cpp-edit-map "H" 'cpp-edit-home) | |
444 | (define-key cpp-edit-map "b" 'cpp-edit-background) | |
445 | (define-key cpp-edit-map "B" 'cpp-edit-background) | |
446 | (define-key cpp-edit-map "k" 'cpp-edit-known) | |
447 | (define-key cpp-edit-map "K" 'cpp-edit-known) | |
448 | (define-key cpp-edit-map "u" 'cpp-edit-unknown) | |
449 | (define-key cpp-edit-map "u" 'cpp-edit-unknown) | |
450 | (define-key cpp-edit-map "t" 'cpp-edit-true) | |
451 | (define-key cpp-edit-map "T" 'cpp-edit-true) | |
452 | (define-key cpp-edit-map "f" 'cpp-edit-false) | |
453 | (define-key cpp-edit-map "F" 'cpp-edit-false) | |
454 | (define-key cpp-edit-map "w" 'cpp-edit-write) | |
455 | (define-key cpp-edit-map "W" 'cpp-edit-write) | |
456 | (define-key cpp-edit-map "X" 'cpp-edit-toggle-known) | |
457 | (define-key cpp-edit-map "x" 'cpp-edit-toggle-known) | |
458 | (define-key cpp-edit-map "Y" 'cpp-edit-toggle-unknown) | |
459 | (define-key cpp-edit-map "y" 'cpp-edit-toggle-unknown) | |
460 | (define-key cpp-edit-map "q" 'bury-buffer) | |
461 | (define-key cpp-edit-map "Q" 'bury-buffer)) | |
462 | ||
20f5d145 RS |
463 | (defvar cpp-edit-symbols nil) |
464 | ;; Symbols defined in the edit buffer. | |
465 | (make-variable-buffer-local 'cpp-edit-symbols) | |
466 | ||
467 | (defun cpp-edit-mode () | |
daf4206b | 468 | "Major mode for editing the criteria for highlighting cpp conditionals. |
a1506d29 | 469 | Click on objects to change them. |
20f5d145 RS |
470 | You can also use the keyboard accelerators indicated like this: [K]ey." |
471 | (kill-all-local-variables) | |
472 | (buffer-disable-undo) | |
473 | (auto-save-mode -1) | |
474 | (setq buffer-read-only t) | |
475 | (setq major-mode 'cpp-edit-mode) | |
476 | (setq mode-name "CPP Edit") | |
477 | (use-local-map cpp-edit-map)) | |
478 | ||
479 | (defun cpp-edit-apply () | |
480 | "Apply edited display information to original buffer." | |
481 | (interactive) | |
482 | (cpp-edit-home) | |
f3a69d8f | 483 | (cpp-highlight-buffer t)) |
20f5d145 RS |
484 | |
485 | (defun cpp-edit-reset () | |
486 | "Reset display information from original buffer." | |
487 | (interactive) | |
488 | (let ((buffer (current-buffer)) | |
489 | (buffer-read-only nil) | |
490 | (start (window-start)) | |
491 | (pos (point)) | |
492 | symbols) | |
493 | (set-buffer cpp-edit-buffer) | |
494 | (setq symbols cpp-parse-symbols) | |
495 | (set-buffer buffer) | |
496 | (setq cpp-edit-symbols symbols) | |
497 | (erase-buffer) | |
498 | (insert "CPP Display Information for `") | |
499 | (cpp-make-button (buffer-name cpp-edit-buffer) 'cpp-edit-home) | |
3478257b | 500 | (insert "'\n\nClick mouse-2 on item you want to change or use\n" |
f3a69d8f RS |
501 | "or switch to this buffer and type the keyboard equivalents.\n" |
502 | "Keyboard equivalents are indicated with brackets like [T]his.\n\n") | |
503 | (cpp-make-button "[H]ome (display the C file)" 'cpp-edit-home) | |
504 | (insert " ") | |
505 | (cpp-make-button "[A]pply new settings" 'cpp-edit-apply) | |
506 | (insert "\n") | |
507 | (cpp-make-button "[S]ave settings" 'cpp-edit-save) | |
508 | (insert " ") | |
509 | (cpp-make-button "[L]oad settings" 'cpp-edit-load) | |
510 | (insert "\n\n") | |
511 | ||
20f5d145 RS |
512 | (insert "[B]ackground: ") |
513 | (cpp-make-button (car (rassq cpp-face-type cpp-face-type-list)) | |
514 | 'cpp-edit-background) | |
515 | (insert "\n[K]nown conditionals: ") | |
516 | (cpp-make-button (cpp-face-name cpp-known-face) | |
517 | 'cpp-edit-known nil t) | |
518 | (insert " [X] ") | |
519 | (cpp-make-button (car (rassq cpp-known-writable cpp-writable-list)) | |
520 | 'cpp-edit-toggle-known) | |
521 | (insert "\n[U]nknown conditionals: ") | |
522 | (cpp-make-button (cpp-face-name cpp-unknown-face) | |
523 | 'cpp-edit-unknown nil t) | |
524 | (insert " [Y] ") | |
525 | (cpp-make-button (car (rassq cpp-unknown-writable cpp-writable-list)) | |
526 | 'cpp-edit-toggle-unknown) | |
527 | (insert (format "\n\n\n%39s: %14s %14s %7s\n\n" "Expression" | |
528 | "[T]rue Face" "[F]alse Face" "[W]rite")) | |
9a8ee448 MY |
529 | |
530 | (setq symbols (reverse symbols)) | |
20f5d145 RS |
531 | (while symbols |
532 | (let* ((symbol (car symbols)) | |
533 | (entry (assoc symbol cpp-edit-list)) | |
534 | (true (nth 1 entry)) | |
535 | (false (nth 2 entry)) | |
536 | (write (if entry (nth 3 entry) 'both))) | |
537 | (setq symbols (cdr symbols)) | |
538 | ||
539 | (if (and entry ; Make default entries unknown. | |
540 | (or (null true) (eq true 'default)) | |
541 | (or (null false) (eq false 'default)) | |
542 | (eq write 'both)) | |
543 | (setq cpp-edit-list (delq entry cpp-edit-list) | |
544 | entry nil)) | |
a1506d29 | 545 | |
dfc4f59b | 546 | (if (> (length symbol) 39) |
20f5d145 RS |
547 | (insert (substring symbol 0 39) ": ") |
548 | (insert (format "%39s: " symbol))) | |
549 | ||
550 | (cpp-make-button (cpp-face-name true) | |
551 | 'cpp-edit-true symbol t 14) | |
552 | (insert " ") | |
553 | (cpp-make-button (cpp-face-name false) | |
554 | 'cpp-edit-false symbol t 14) | |
555 | (insert " ") | |
556 | (cpp-make-button (car (rassq write cpp-branch-list)) | |
557 | 'cpp-edit-write symbol nil 6) | |
558 | (insert "\n"))) | |
559 | (insert "\n\n") | |
560 | (set-window-start nil start) | |
561 | (goto-char pos))) | |
562 | ||
563 | (defun cpp-edit-load () | |
564 | "Load cpp configuration." | |
565 | (interactive) | |
e9286904 RS |
566 | (cond ((null init-file-user) |
567 | ;; If -q was specified, don't load any init files. | |
568 | nil) | |
569 | ((file-readable-p cpp-config-file) | |
21590f63 RS |
570 | (load-file cpp-config-file)) |
571 | ((file-readable-p (concat "~/" cpp-config-file)) | |
572 | (load-file cpp-config-file))) | |
fe441eb7 RS |
573 | (if (eq major-mode 'cpp-edit-mode) |
574 | (cpp-edit-reset))) | |
20f5d145 RS |
575 | |
576 | (defun cpp-edit-save () | |
e9286904 | 577 | "Save the current cpp configuration in a file." |
20f5d145 RS |
578 | (interactive) |
579 | (require 'pp) | |
580 | (save-excursion | |
581 | (set-buffer cpp-edit-buffer) | |
21590f63 | 582 | (let ((buffer (find-file-noselect cpp-config-file))) |
20f5d145 RS |
583 | (set-buffer buffer) |
584 | (erase-buffer) | |
585 | (pp (list 'setq 'cpp-known-face | |
586 | (list 'quote cpp-known-face)) buffer) | |
587 | (pp (list 'setq 'cpp-unknown-face | |
588 | (list 'quote cpp-unknown-face)) buffer) | |
589 | (pp (list 'setq 'cpp-face-type | |
590 | (list 'quote cpp-face-type)) buffer) | |
591 | (pp (list 'setq 'cpp-known-writable | |
592 | (list 'quote cpp-known-writable)) buffer) | |
593 | (pp (list 'setq 'cpp-unknown-writable | |
594 | (list 'quote cpp-unknown-writable)) buffer) | |
595 | (pp (list 'setq 'cpp-edit-list | |
596 | (list 'quote cpp-edit-list)) buffer) | |
21590f63 | 597 | (write-file cpp-config-file)))) |
20f5d145 RS |
598 | |
599 | (defun cpp-edit-home () | |
600 | "Switch back to original buffer." | |
601 | (interactive) | |
602 | (if cpp-button-event | |
603 | (read-event)) | |
604 | (pop-to-buffer cpp-edit-buffer)) | |
605 | ||
606 | (defun cpp-edit-background () | |
607 | "Change default face collection." | |
608 | (interactive) | |
609 | (call-interactively 'cpp-choose-default-face) | |
610 | (cpp-edit-reset)) | |
611 | ||
612 | (defun cpp-edit-known () | |
613 | "Select default for known conditionals." | |
614 | (interactive) | |
615 | (setq cpp-known-face (cpp-choose-face "Known face" cpp-known-face)) | |
616 | (cpp-edit-reset)) | |
617 | ||
618 | (defun cpp-edit-unknown () | |
619 | "Select default for unknown conditionals." | |
620 | (interactive) | |
621 | (setq cpp-unknown-face (cpp-choose-face "Unknown face" cpp-unknown-face)) | |
622 | (cpp-edit-reset)) | |
623 | ||
20f5d145 RS |
624 | (defun cpp-edit-toggle-known (arg) |
625 | "Toggle writable status for known conditionals. | |
626 | With optional argument ARG, make them writable iff ARG is positive." | |
627 | (interactive "@P") | |
628 | (if (or (and (null arg) cpp-known-writable) | |
629 | (<= (prefix-numeric-value arg) 0)) | |
630 | (setq cpp-known-writable nil) | |
631 | (setq cpp-known-writable t)) | |
632 | (cpp-edit-reset)) | |
633 | ||
634 | (defun cpp-edit-toggle-unknown (arg) | |
635 | "Toggle writable status for unknown conditionals. | |
636 | With optional argument ARG, make them writable iff ARG is positive." | |
637 | (interactive "@P") | |
638 | (if (or (and (null arg) cpp-unknown-writable) | |
639 | (<= (prefix-numeric-value arg) 0)) | |
640 | (setq cpp-unknown-writable nil) | |
641 | (setq cpp-unknown-writable t)) | |
642 | (cpp-edit-reset)) | |
643 | ||
644 | (defun cpp-edit-true (symbol face) | |
645 | "Select SYMBOL's true FACE used for highlighting taken conditionals." | |
646 | (interactive | |
647 | (let ((symbol (cpp-choose-symbol))) | |
648 | (list symbol | |
649 | (cpp-choose-face "True face" | |
650 | (nth 1 (assoc symbol cpp-edit-list)))))) | |
651 | (setcar (nthcdr 1 (cpp-edit-list-entry-get-or-create symbol)) face) | |
652 | (cpp-edit-reset)) | |
653 | ||
654 | (defun cpp-edit-false (symbol face) | |
655 | "Select SYMBOL's false FACE used for highlighting untaken conditionals." | |
656 | (interactive | |
657 | (let ((symbol (cpp-choose-symbol))) | |
658 | (list symbol | |
a1506d29 | 659 | (cpp-choose-face "False face" |
20f5d145 RS |
660 | (nth 2 (assoc symbol cpp-edit-list)))))) |
661 | (setcar (nthcdr 2 (cpp-edit-list-entry-get-or-create symbol)) face) | |
662 | (cpp-edit-reset)) | |
663 | ||
664 | (defun cpp-edit-write (symbol branch) | |
665 | "Set which branches of SYMBOL should be writable to BRANCH. | |
666 | BRANCH should be either nil (false branch), t (true branch) or 'both." | |
667 | (interactive (list (cpp-choose-symbol) (cpp-choose-branch))) | |
668 | (setcar (nthcdr 3 (cpp-edit-list-entry-get-or-create symbol)) branch) | |
669 | (cpp-edit-reset)) | |
670 | ||
671 | (defun cpp-edit-list-entry-get-or-create (symbol) | |
672 | ;; Return the entry for SYMBOL in `cpp-edit-list'. | |
673 | ;; If it does not exist, create it. | |
674 | (let ((entry (assoc symbol cpp-edit-list))) | |
675 | (or entry | |
676 | (setq entry (list symbol nil nil 'both nil) | |
677 | cpp-edit-list (cons entry cpp-edit-list))) | |
678 | entry)) | |
679 | ||
680 | ;;; Prompts: | |
681 | ||
682 | (defun cpp-choose-symbol () | |
683 | ;; Choose a symbol if called from keyboard, otherwise use the one clicked on. | |
684 | (if cpp-button-event | |
2e922f0b | 685 | cpp-callback-data |
4ead48d7 | 686 | (completing-read "Symbol: " cpp-edit-symbols nil t))) |
20f5d145 | 687 | |
20f5d145 RS |
688 | (defun cpp-choose-branch () |
689 | ;; Choose a branch, either nil, t, or both. | |
690 | (if cpp-button-event | |
691 | (x-popup-menu cpp-button-event | |
692 | (list "Branch" (cons "Branch" cpp-branch-list))) | |
693 | (cdr (assoc (completing-read "Branch: " cpp-branch-list nil t) | |
694 | cpp-branch-list)))) | |
695 | ||
696 | (defun cpp-choose-face (prompt default) | |
275cffa7 | 697 | ;; Choose a face from cpp-face-default-list. |
20f5d145 RS |
698 | ;; PROMPT is what to say to the user. |
699 | ;; DEFAULT is the default face. | |
700 | (or (if cpp-button-event | |
701 | (x-popup-menu cpp-button-event | |
702 | (list prompt (cons prompt cpp-face-default-list))) | |
703 | (let ((name (car (rassq default cpp-face-default-list)))) | |
704 | (cdr (assoc (completing-read (if name | |
705 | (concat prompt | |
706 | " (default " name "): ") | |
707 | (concat prompt ": ")) | |
708 | cpp-face-default-list nil t) | |
709 | cpp-face-all-list)))) | |
710 | default)) | |
711 | ||
20f5d145 RS |
712 | (defun cpp-choose-default-face (type) |
713 | ;; Choose default face list for screen of TYPE. | |
714 | ;; Type must be one of the types defined in `cpp-face-type-list'. | |
715 | (interactive (list (if cpp-button-event | |
716 | (x-popup-menu cpp-button-event | |
717 | (list "Screen type" | |
718 | (cons "Screen type" | |
719 | cpp-face-type-list))) | |
720 | (cdr (assoc (completing-read "Screen type: " | |
721 | cpp-face-type-list | |
722 | nil t) | |
723 | cpp-face-type-list))))) | |
724 | (cond ((null type)) | |
725 | ((eq type 'light) | |
726 | (if cpp-face-light-list | |
727 | () | |
728 | (setq cpp-face-light-list | |
729 | (mapcar 'cpp-create-bg-face cpp-face-light-name-list)) | |
730 | (setq cpp-face-all-list | |
731 | (append cpp-face-all-list cpp-face-light-list))) | |
732 | (setq cpp-face-type 'light) | |
733 | (setq cpp-face-default-list | |
734 | (append cpp-face-light-list cpp-face-none-list))) | |
735 | ((eq type 'dark) | |
736 | (if cpp-face-dark-list | |
737 | () | |
738 | (setq cpp-face-dark-list | |
739 | (mapcar 'cpp-create-bg-face cpp-face-dark-name-list)) | |
740 | (setq cpp-face-all-list | |
741 | (append cpp-face-all-list cpp-face-dark-list))) | |
742 | (setq cpp-face-type 'dark) | |
743 | (setq cpp-face-default-list | |
744 | (append cpp-face-dark-list cpp-face-none-list))) | |
745 | ((eq type 'mono) | |
746 | (setq cpp-face-type 'mono) | |
747 | (setq cpp-face-default-list | |
748 | (append cpp-face-mono-list cpp-face-none-list))) | |
749 | (t | |
750 | (setq cpp-face-type 'none) | |
751 | (setq cpp-face-default-list cpp-face-none-list)))) | |
752 | ||
753 | ;;; Buttons: | |
754 | ||
20f5d145 RS |
755 | (defun cpp-make-button (name callback &optional data face padding) |
756 | ;; Create a button at point. | |
757 | ;; NAME is the name of the button. | |
758 | ;; CALLBACK is the function to call when the button is pushed. | |
2e922f0b RS |
759 | ;; DATA will be made available to CALLBACK |
760 | ;;in the free variable cpp-callback-data. | |
20f5d145 RS |
761 | ;; FACE means that NAME is the name of a face in `cpp-face-all-list'. |
762 | ;; PADDING means NAME will be right justified at that length. | |
763 | (let ((name (format "%s" name)) | |
764 | from to) | |
765 | (cond ((null padding) | |
766 | (setq from (point)) | |
767 | (insert name)) | |
768 | ((> (length name) padding) | |
769 | (setq from (point)) | |
770 | (insert (substring name 0 padding))) | |
771 | (t | |
772 | (insert (make-string (- padding (length name)) ? )) | |
773 | (setq from (point)) | |
774 | (insert name))) | |
775 | (setq to (point)) | |
776 | (setq face | |
777 | (if face | |
778 | (let ((check (cdr (assoc name cpp-face-all-list)))) | |
779 | (if (memq check '(default invisible)) | |
780 | 'bold | |
781 | check)) | |
782 | 'bold)) | |
783 | (add-text-properties from to | |
784 | (append (list 'face face) | |
785 | '(mouse-face highlight) | |
3c0a21c0 | 786 | '(help-echo "mouse-2: change/use this item") |
20f5d145 RS |
787 | (list 'cpp-callback callback) |
788 | (if data (list 'cpp-data data)))))) | |
789 | ||
790 | (defun cpp-push-button (event) | |
791 | ;; Pushed a CPP button. | |
792 | (interactive "@e") | |
793 | (set-buffer (window-buffer (posn-window (event-start event)))) | |
794 | (let ((pos (posn-point (event-start event)))) | |
2e922f0b | 795 | (let ((cpp-callback-data (get-text-property pos 'cpp-data)) |
20f5d145 RS |
796 | (fun (get-text-property pos 'cpp-callback)) |
797 | (cpp-button-event event)) | |
798 | (cond (fun | |
799 | (call-interactively (get-text-property pos 'cpp-callback))) | |
800 | ((lookup-key global-map [ down-mouse-2]) | |
801 | (call-interactively (lookup-key global-map [ down-mouse-2]))))))) | |
802 | ||
803 | ;;; Faces: | |
804 | ||
20f5d145 RS |
805 | (defun cpp-create-bg-face (color) |
806 | ;; Create entry for face with background COLOR. | |
212a75c4 | 807 | (cons color (cons 'background-color color))) |
20f5d145 | 808 | |
25ef2b06 EZ |
809 | (cpp-choose-default-face |
810 | (if (or window-system (display-color-p)) cpp-face-type 'none)) | |
20f5d145 RS |
811 | |
812 | (defun cpp-face-name (face) | |
813 | ;; Return the name of FACE from `cpp-face-all-list'. | |
814 | (let ((entry (rassq (if face face 'default) cpp-face-all-list))) | |
815 | (if entry | |
816 | (car entry) | |
817 | (format "<%s>" face)))) | |
818 | ||
819 | ;;; Utilities: | |
820 | ||
821 | (defvar cpp-progress-time 0) | |
822 | ;; Last time we issued a progress message. | |
823 | ||
824 | (defun cpp-progress-message (&rest args) | |
825 | ;; Report progress at most once a second. Take same ARGS as `message'. | |
826 | (let ((time (nth 1 (current-time)))) | |
827 | (if (= time cpp-progress-time) | |
828 | () | |
829 | (setq cpp-progress-time time) | |
830 | (apply 'message args)))) | |
831 | ||
832 | (provide 'cpp) | |
833 | ||
ab5796a9 | 834 | ;;; arch-tag: fb7d433d-745d-495a-96f0-86908ab63f74 |
20f5d145 | 835 | ;;; cpp.el ends here |