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