Fix default-directory in changeset diffs after vc-print-log
[emacs.git] / lisp / progmodes / hideif.el
bloba9376ff6101a95c2ffc5b7b037a64f088472996d
1 ;;; hideif.el --- hides selected code within ifdef -*- lexical-binding:t -*-
3 ;; Copyright (C) 1988, 1994, 2001-2015 Free Software Foundation, Inc.
5 ;; Author: Brian Marick
6 ;; Daniel LaLiberte <liberte@holonexus.org>
7 ;; Maintainer: Luke Lee <luke.yx.lee@gmail.com>
8 ;; Keywords: c, outlines
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; To initialize, toggle the hide-ifdef minor mode with
29 ;; M-x hide-ifdef-mode
31 ;; This will set up key bindings and call hide-ifdef-mode-hook if it
32 ;; has a value. To explicitly hide ifdefs using a buffer-local
33 ;; define list (default empty), type
35 ;; M-x hide-ifdefs or C-c @ h
37 ;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't
38 ;; pass through. Support complete C/C++ expression and precedence.
39 ;; It will automatically scan for new #define symbols and macros on the way
40 ;; parsing.
42 ;; The hidden code is marked by ellipses (...). Be
43 ;; cautious when editing near ellipses, since the hidden text is
44 ;; still in the buffer, and you can move the point into it and modify
45 ;; text unawares.
46 ;; You can make your buffer read-only while hide-ifdef-hiding by setting
47 ;; hide-ifdef-read-only to a non-nil value. You can toggle this
48 ;; variable with hide-ifdef-toggle-read-only (C-c @ C-q).
50 ;; You can undo the effect of hide-ifdefs by typing
52 ;; M-x show-ifdefs or C-c @ s
54 ;; Use M-x hide-ifdef-define (C-c @ d) to define a symbol.
55 ;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol.
57 ;; If you define or undefine a symbol while hide-ifdef-mode is in effect,
58 ;; the display will be updated. Only the define list for the current
59 ;; buffer will be affected. You can save changes to the local define
60 ;; list with hide-ifdef-set-define-alist. This adds entries
61 ;; to hide-ifdef-define-alist.
63 ;; If you have defined a hide-ifdef-mode-hook, you can set
64 ;; up a list of symbols that may be used by hide-ifdefs as in the
65 ;; following example:
67 ;; (add-hook 'hide-ifdef-mode-hook
68 ;; (lambda ()
69 ;; (unless hide-ifdef-define-alist
70 ;; (setq hide-ifdef-define-alist
71 ;; '((list1 ONE TWO)
72 ;; (list2 TWO THREE))))
73 ;; (hide-ifdef-use-define-alist 'list2))) ; use list2 by default
75 ;; You can call hide-ifdef-use-define-alist (C-c @ U) at any time to specify
76 ;; another list to use.
78 ;; To cause ifdefs to be hidden as soon as hide-ifdef-mode is called,
79 ;; set hide-ifdef-initially to non-nil.
81 ;; If you set hide-ifdef-lines to t, hide-ifdefs hides all the #ifdef lines.
82 ;; In the absence of highlighting, that might be a bad idea. If you set
83 ;; hide-ifdef-lines to nil (the default), the surrounding preprocessor
84 ;; lines will be displayed. That can be confusing in its own
85 ;; right. Other variations on display are possible, but not much
86 ;; better.
88 ;; You can explicitly hide or show individual ifdef blocks irrespective
89 ;; of the define list by using hide-ifdef-block and show-ifdef-block.
91 ;; You can move the point between ifdefs with forward-ifdef, backward-ifdef,
92 ;; up-ifdef, down-ifdef, next-ifdef, and previous-ifdef.
94 ;; If you have minor-mode-alist in your mode line (the default) two labels
95 ;; may appear. "Ifdef" will appear when hide-ifdef-mode is active. "Hiding"
96 ;; will appear when text may be hidden ("hide-ifdef-hiding" is non-nil).
98 ;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL.
99 ;; Extensively modified by Daniel LaLiberte (while at Gould).
101 ;; Extensively modified by Luke Lee in 2013 to support complete C expression
102 ;; evaluation and argumented macro expansion.
104 ;;; Code:
106 (require 'cc-mode)
107 (require 'cl-lib)
109 (defgroup hide-ifdef nil
110 "Hide selected code within `ifdef'."
111 :group 'c)
113 (defcustom hide-ifdef-initially nil
114 "Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
115 :type 'boolean
116 :group 'hide-ifdef)
118 (defcustom hide-ifdef-read-only nil
119 "Set to non-nil if you want buffer to be read-only while hiding text."
120 :type 'boolean
121 :group 'hide-ifdef)
123 (defcustom hide-ifdef-lines nil
124 "Non-nil means hide the #ifX, #else, and #endif lines."
125 :type 'boolean
126 :group 'hide-ifdef)
128 (defcustom hide-ifdef-shadow nil
129 "Non-nil means shadow text instead of hiding it."
130 :type 'boolean
131 :group 'hide-ifdef
132 :version "23.1")
134 (defface hide-ifdef-shadow '((t (:inherit shadow)))
135 "Face for shadowing ifdef blocks."
136 :group 'hide-ifdef
137 :version "23.1")
139 (defcustom hide-ifdef-exclude-define-regexp nil
140 "Ignore #define names if those names match this exclusion pattern."
141 :type 'string
142 :version "25.1")
144 (defcustom hide-ifdef-expand-reinclusion-protection t
145 "Non-nil means don't hide an entire header file enclosed by #ifndef...#endif.
146 Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion:
148 ----- beginning of file -----
149 #ifndef _XXX_HEADER_FILE_INCLUDED_
150 #define _XXX_HEADER_FILE_INCLUDED_
153 xxx...
154 #endif
155 ----- end of file -----
157 The first time we visit such a file, _XXX_HEADER_FILE_INCLUDED_ is
158 undefined, and so nothing is hidden. The next time we visit it, everything will
159 be hidden.
161 This behavior is generally undesirable. If this option is non-nil, the outermost
162 #if is always visible."
163 :type 'boolean
164 :version "25.1")
166 (defcustom hide-ifdef-header-regexp
167 "\\.h\\(h\\|xx\\|pp\\)?\\'"
168 "C/C++ header file name patterns to determine if current buffer is a header.
169 Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
170 :type 'string
171 :group 'hide-ifdef
172 :version "25.1")
174 (defvar hide-ifdef-mode-submap
175 ;; Set up the submap that goes after the prefix key.
176 (let ((map (make-sparse-keymap)))
177 (define-key map "d" 'hide-ifdef-define)
178 (define-key map "u" 'hide-ifdef-undef)
179 (define-key map "D" 'hide-ifdef-set-define-alist)
180 (define-key map "U" 'hide-ifdef-use-define-alist)
182 (define-key map "h" 'hide-ifdefs)
183 (define-key map "s" 'show-ifdefs)
184 (define-key map "\C-d" 'hide-ifdef-block)
185 (define-key map "\C-s" 'show-ifdef-block)
186 (define-key map "e" 'hif-evaluate-macro)
187 (define-key map "C" 'hif-clear-all-ifdef-defined)
189 (define-key map "\C-q" 'hide-ifdef-toggle-read-only)
190 (define-key map "\C-w" 'hide-ifdef-toggle-shadowing)
191 (substitute-key-definition
192 'read-only-mode 'hide-ifdef-toggle-outside-read-only map)
193 ;; `toggle-read-only' is obsoleted by `read-only-mode'.
194 (substitute-key-definition
195 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map)
196 map)
197 "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
199 (defconst hide-ifdef-mode-prefix-key "\C-c@"
200 "Prefix key for all Hide-Ifdef mode commands.")
202 (defvar hide-ifdef-mode-map
203 ;; Set up the mode's main map, which leads via the prefix key to the submap.
204 (let ((map (make-sparse-keymap)))
205 (define-key map hide-ifdef-mode-prefix-key hide-ifdef-mode-submap)
206 map)
207 "Keymap used with `hide-ifdef-mode'.")
209 (easy-menu-define hide-ifdef-mode-menu hide-ifdef-mode-map
210 "Menu for `hide-ifdef-mode'."
211 '("Hide-Ifdef"
212 ["Hide some ifdefs" hide-ifdefs
213 :help "Hide the contents of some #ifdefs"]
214 ["Show all ifdefs" show-ifdefs
215 :help "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs"]
216 ["Hide ifdef block" hide-ifdef-block
217 :help "Hide the ifdef block (true or false part) enclosing or before the cursor"]
218 ["Show ifdef block" show-ifdef-block
219 :help "Show the ifdef block (true or false part) enclosing or before the cursor"]
220 ["Define a variable..." hide-ifdef-define
221 :help "Define a VAR so that #ifdef VAR would be included"]
222 ["Undefine a variable..." hide-ifdef-undef
223 :help "Undefine a VAR so that #ifdef VAR would not be included"]
224 ["Define an alist..." hide-ifdef-set-define-alist
225 :help "Set the association for NAME to `hide-ifdef-env'"]
226 ["Use an alist..." hide-ifdef-use-define-alist
227 :help "Set `hide-ifdef-env' to the define list specified by NAME"]
228 ["Toggle read only" hide-ifdef-toggle-read-only
229 :style toggle :selected hide-ifdef-read-only
230 :help "Buffer should be read-only while hiding text"]
231 ["Toggle shadowing" hide-ifdef-toggle-shadowing
232 :style toggle :selected hide-ifdef-shadow
233 :help "Text should be shadowed instead of hidden"]))
235 (defvar hide-ifdef-hiding nil
236 "Non-nil when text may be hidden.")
238 (or (assq 'hide-ifdef-hiding minor-mode-alist)
239 (setq minor-mode-alist
240 (cons '(hide-ifdef-hiding " Hiding")
241 minor-mode-alist)))
243 ;; Fix c-mode syntax table so we can recognize whole symbols.
244 (defvar hide-ifdef-syntax-table
245 (let ((st (copy-syntax-table c-mode-syntax-table)))
246 (modify-syntax-entry ?_ "w" st)
247 (modify-syntax-entry ?& "." st)
248 (modify-syntax-entry ?\| "." st)
250 "Syntax table used for tokenizing #if expressions.")
252 (defvar hide-ifdef-env nil
253 "An alist of defined symbols and their values.")
255 (defvar hide-ifdef-env-backup nil
256 "This variable is a backup of the previously cleared `hide-ifdef-env'.
257 This backup prevents any accidental clearance of `hide-fidef-env' by
258 `hif-clear-all-ifdef-defined'.")
260 (defvar hif-outside-read-only nil
261 "Internal variable. Saves the value of `buffer-read-only' while hiding.")
263 ;;;###autoload
264 (define-minor-mode hide-ifdef-mode
265 "Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode).
266 With a prefix argument ARG, enable Hide-Ifdef mode if ARG is
267 positive, and disable it otherwise. If called from Lisp, enable
268 the mode if ARG is omitted or nil.
270 Hide-Ifdef mode is a buffer-local minor mode for use with C and
271 C-like major modes. When enabled, code within #ifdef constructs
272 that the C preprocessor would eliminate may be hidden from view.
273 Several variables affect how the hiding is done:
275 `hide-ifdef-env'
276 An association list of defined and undefined symbols for the
277 current project. Initially, the global value of `hide-ifdef-env'
278 is used. This variable was a buffer-local variable, which limits
279 hideif to parse only one C/C++ file at a time. We've extended
280 hideif to support parsing a C/C++ project containing multiple C/C++
281 source files opened simultaneously in different buffers. Therefore
282 `hide-ifdef-env' can no longer be buffer local but must be global.
284 `hide-ifdef-define-alist'
285 An association list of defined symbol lists.
286 Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env'
287 and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env'
288 from one of the lists in `hide-ifdef-define-alist'.
290 `hide-ifdef-lines'
291 Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
292 #endif lines when hiding.
294 `hide-ifdef-initially'
295 Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
296 is activated.
298 `hide-ifdef-read-only'
299 Set to non-nil if you want to make buffers read only while hiding.
300 After `show-ifdefs', read-only status is restored to previous value.
302 \\{hide-ifdef-mode-map}"
303 :group 'hide-ifdef :lighter " Ifdef"
304 (if hide-ifdef-mode
305 (progn
306 ;; inherit global values
308 ;; `hide-ifdef-env' is now a global variable.
309 ;; We can still simulate the behavior of older hideif versions (i.e.
310 ;; `hide-ifdef-env' being buffer local) by clearing this variable
311 ;; (C-c @ C) everytime before hiding current buffer.
312 ;; (set (make-local-variable 'hide-ifdef-env)
313 ;; (default-value 'hide-ifdef-env))
314 (set 'hide-ifdef-env (default-value 'hide-ifdef-env))
315 ;; Some C/C++ headers might have other ways to prevent reinclusion and
316 ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil.
317 (set (make-local-variable 'hide-ifdef-expand-reinclusion-protection)
318 (default-value 'hide-ifdef-expand-reinclusion-protection))
319 (set (make-local-variable 'hide-ifdef-hiding)
320 (default-value 'hide-ifdef-hiding))
321 (set (make-local-variable 'hif-outside-read-only) buffer-read-only)
322 (set (make-local-variable 'line-move-ignore-invisible) t)
323 (add-hook 'change-major-mode-hook
324 (lambda () (hide-ifdef-mode -1)) nil t)
326 (add-to-invisibility-spec '(hide-ifdef . t))
328 (if hide-ifdef-initially
329 (hide-ifdefs)
330 (show-ifdefs)))
331 ;; else end hide-ifdef-mode
332 (kill-local-variable 'line-move-ignore-invisible)
333 (remove-from-invisibility-spec '(hide-ifdef . t))
334 (when hide-ifdef-hiding
335 (show-ifdefs))))
337 (defun hif-clear-all-ifdef-defined ()
338 "Clears all symbols defined in `hide-ifdef-env'.
339 It will backup this variable to `hide-ifdef-env-backup' before clearing to
340 prevent accidental clearance."
341 (interactive)
342 (when (y-or-n-p "Clear all #defined symbols? ")
343 (setq hide-ifdef-env-backup hide-ifdef-env)
344 (setq hide-ifdef-env nil)))
346 (defun hif-show-all ()
347 "Show all of the text in the current buffer."
348 (interactive)
349 (hif-show-ifdef-region (point-min) (point-max)))
351 ;; By putting this on after-revert-hook, we arrange that it only
352 ;; does anything when revert-buffer avoids turning off the mode.
353 ;; (That can happen in VC.)
354 (defun hif-after-revert-function ()
355 (and hide-ifdef-mode hide-ifdef-hiding
356 (hide-ifdefs t)))
357 (add-hook 'after-revert-hook 'hif-after-revert-function)
359 (defun hif-end-of-line ()
360 (end-of-line)
361 (while (= (logand 1 (skip-chars-backward "\\\\")) 1)
362 (end-of-line 2)))
364 (defun hif-merge-ifdef-region (start end)
365 "This function merges nearby ifdef regions to form a bigger overlay.
366 The region is defined by START and END. This will decrease the number of
367 overlays created."
368 ;; Generally there is no need to call itself recursively since there should
369 ;; originally exists no un-merged regions; however, if a part of the file is
370 ;; hidden with `hide-ifdef-lines' equals to nil while another part with 't,
371 ;; this case happens.
372 ;; TODO: Should we merge? or just create a container overlay? -- this can
373 ;; prevent `hideif-show-ifdef' expanding too many hidden contents since there
374 ;; is only a big overlay exists there without any smaller overlays.
375 (save-restriction
376 (widen) ; Otherwise `point-min' and `point-max' will be restricted and thus
377 ; fail to find neighbor overlays
378 (let ((begovrs (overlays-in
379 (max (- start 2) (point-min))
380 (max (- start 1) (point-min))))
381 (endovrs (overlays-in
382 (min (+ end 1) (point-max))
383 (min (+ end 2) (point-max))))
384 (ob nil)
385 (oe nil)
386 b e)
387 ;; Merge overlays before START
388 (dolist (o begovrs)
389 (when (overlay-get o 'hide-ifdef)
390 (setq b (min start (overlay-start o))
391 e (max end (overlay-end o)))
392 (move-overlay o b e)
393 (hif-merge-ifdef-region b e)
394 (setq ob o)))
395 ;; Merge overlays after END
396 (dolist (o endovrs)
397 (when (overlay-get o 'hide-ifdef)
398 (setq b (min start (overlay-start o))
399 e (max end (overlay-end o)))
400 (move-overlay o b e)
401 (hif-merge-ifdef-region b e)
402 (setf oe o)))
403 ;; If both START and END merging happens, merge into bigger one
404 (when (and ob oe)
405 (let ((b (min (overlay-start ob) (overlay-start oe)))
406 (e (max (overlay-end ob) (overlay-end oe))))
407 (delete-overlay oe)
408 (move-overlay ob b e)
409 (hif-merge-ifdef-region b e)))
410 (or ob oe))))
412 (defun hide-ifdef-region-internal (start end)
413 (unless (hif-merge-ifdef-region start end)
414 (let ((o (make-overlay start end)))
415 (overlay-put o 'hide-ifdef t)
416 (if hide-ifdef-shadow
417 (overlay-put o 'face 'hide-ifdef-shadow)
418 (overlay-put o 'invisible 'hide-ifdef)))))
420 (defun hide-ifdef-region (start end)
421 "START is the start of a #if, #elif, or #else form. END is the ending part.
422 Everything including these lines is made invisible."
423 (save-excursion
424 (goto-char start) (hif-end-of-line) (setq start (point))
425 (goto-char end) (hif-end-of-line) (setq end (point))
426 (hide-ifdef-region-internal start end)))
428 (defun hif-show-ifdef-region (start end)
429 "Everything between START and END is made visible."
430 (let ((onum (length (overlays-in start end))))
431 (remove-overlays start end 'hide-ifdef t)
432 (/= onum (length (overlays-in start end)))))
435 ;;===%%SF%% evaluation (Start) ===
437 ;; It is not useful to set this to anything but `eval'.
438 ;; In fact, the variable might as well be eliminated.
439 (defvar hide-ifdef-evaluator 'eval
440 "The function to use to evaluate a form.
441 The evaluator is given a canonical form and returns t if text under
442 that form should be displayed.")
444 (defvar hif-undefined-symbol nil
445 "...is by default considered to be false.")
448 (defun hif-set-var (var value)
449 "Prepend (VAR VALUE) pair to `hide-ifdef-env'."
450 (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
452 (declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var))
453 (declare-function semantic-c-hideif-defined "semantic/bovine/c" (var))
455 (defun hif-lookup (var)
456 (or (when (bound-and-true-p semantic-c-takeover-hideif)
457 (semantic-c-hideif-lookup var))
458 (let ((val (assoc var hide-ifdef-env)))
459 (if val
460 (cdr val)
461 hif-undefined-symbol))))
463 (defun hif-defined (var)
464 (cond
465 ((bound-and-true-p semantic-c-takeover-hideif)
466 (semantic-c-hideif-defined var))
467 ((assoc var hide-ifdef-env) 1)
468 (t 0)))
470 ;;===%%SF%% evaluation (End) ===
474 ;;===%%SF%% parsing (Start) ===
475 ;;; The code that understands what ifs and ifdef in files look like.
477 (defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
478 (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def"))
479 (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
480 (defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
481 (defconst hif-elif-regexp (concat hif-cpp-prefix "elif"))
482 (defconst hif-else-regexp (concat hif-cpp-prefix "else"))
483 (defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
484 (defconst hif-ifx-else-endif-regexp
485 (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|"
486 hif-endif-regexp))
487 (defconst hif-macro-expr-prefix-regexp
488 (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+"))
490 (defconst hif-white-regexp "[ \t]*")
491 (defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)"))
492 (defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*"))
493 (defconst hif-macroref-regexp
494 (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp
495 "\\("
496 "(" hif-white-regexp
497 "\\(" hif-id-regexp "\\)?" hif-white-regexp
498 "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*"
499 "\\(\\.\\.\\.\\)?" hif-white-regexp
501 "\\)?" ))
503 ;; Store the current token and the whole token list during parsing.
504 ;; Bound dynamically.
505 (defvar hif-token)
506 (defvar hif-token-list)
508 (defconst hif-token-alist
509 '(("||" . hif-or)
510 ("&&" . hif-and)
511 ("|" . hif-logior)
512 ("^" . hif-logxor)
513 ("&" . hif-logand)
514 ("<<" . hif-shiftleft)
515 (">>" . hif-shiftright)
516 ("==" . hif-equal)
517 ;; Note: we include tokens like `=' which aren't supported by CPP's
518 ;; expression syntax, because they are still relevant for the tokenizer,
519 ;; especially in conjunction with ##.
520 ("=" . hif-assign)
521 ("!=" . hif-notequal)
522 ("##" . hif-token-concat)
523 ("!" . hif-not)
524 ("~" . hif-lognot)
525 ("(" . hif-lparen)
526 (")" . hif-rparen)
527 (">" . hif-greater)
528 ("<" . hif-less)
529 (">=" . hif-greater-equal)
530 ("<=" . hif-less-equal)
531 ("+" . hif-plus)
532 ("-" . hif-minus)
533 ("*" . hif-multiply)
534 ("/" . hif-divide)
535 ("%" . hif-modulo)
536 ("?" . hif-conditional)
537 (":" . hif-colon)
538 ("," . hif-comma)
539 ("#" . hif-stringify)
540 ("..." . hif-etc)))
542 (defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
544 (defconst hif-token-regexp
545 (concat (regexp-opt (mapcar 'car hif-token-alist))
546 "\\|0x[0-9a-fA-F]+\\.?[0-9a-fA-F]*"
547 "\\|[0-9]+\\.?[0-9]*" ;; decimal/octal
548 "\\|\\w+"))
550 (defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)")
552 (defun hif-string-to-number (string &optional base)
553 "Like `string-to-number', but it understands non-decimal floats."
554 (if (or (not base) (= base 10))
555 (string-to-number string base)
556 (let* ((parts (split-string string "\\." t "[ \t]+"))
557 (frac (cadr parts))
558 (fraclen (length frac))
559 (quot (expt (if (zerop fraclen)
560 base
561 (* base 1.0)) fraclen)))
562 (/ (string-to-number (concat (car parts) frac) base) quot))))
564 ;; The dynamic binding variable `hif-simple-token-only' is shared only by
565 ;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize'
566 ;; from returning one more value to indicate a simple token is scanned. This help
567 ;; speeding up macro evaluation on those very simple cases like integers or
568 ;; literals.
569 ;; Check the long comments before `hif-find-define' for more details. [lukelee]
570 (defvar hif-simple-token-only)
572 (defun hif-tokenize (start end)
573 "Separate string between START and END into a list of tokens."
574 (let ((token-list nil))
575 (setq hif-simple-token-only t)
576 (with-syntax-table hide-ifdef-syntax-table
577 (save-excursion
578 (goto-char start)
579 (while (progn (forward-comment (point-max)) (< (point) end))
580 ;; (message "expr-start = %d" expr-start) (sit-for 1)
581 (cond
582 ((looking-at "\\\\\n")
583 (forward-char 2))
585 ((looking-at hif-string-literal-regexp)
586 (push (substring-no-properties (match-string 1)) token-list)
587 (goto-char (match-end 0)))
589 ((looking-at hif-token-regexp)
590 (let ((token (buffer-substring-no-properties
591 (point) (match-end 0))))
592 (goto-char (match-end 0))
593 ;; (message "token: %s" token) (sit-for 1)
594 (push
595 (or (cdr (assoc token hif-token-alist))
596 (if (string-equal token "defined") 'hif-defined)
597 ;; TODO:
598 ;; 1. postfix 'l', 'll', 'ul' and 'ull'
599 ;; 2. floating number formats (like 1.23e4)
600 ;; 3. 098 is interpreted as octal conversion error
601 (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)"
602 token)
603 (hif-string-to-number (match-string 1 token) 16)) ;; hex
604 (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token)
605 (hif-string-to-number token 8)) ;; octal
606 (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'"
607 token)
608 (string-to-number token)) ;; decimal
609 (prog1 (intern token)
610 (setq hif-simple-token-only nil)))
611 token-list)))
613 ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in
614 (forward-char 1)) ; the source code. Let's not get stuck here.
615 (t (error "Bad #if expression: %s" (buffer-string)))))))
617 (nreverse token-list)))
619 ;;------------------------------------------------------------------------
620 ;; Translate C preprocessor #if expressions using recursive descent.
621 ;; This parser was limited to the operators &&, ||, !, and "defined".
622 ;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94
624 ;; Implement the C language operator precedence table. Add all those
625 ;; missing operators that could be used in macros. Luke Lee 2013-09-04
627 ;; | Operator Type | Operator | Associativity |
628 ;; +----------------------+-----------------------------+---------------+
629 ;; | Primary Expression | () [] . -> expr++ expr-- | left-to-right |
630 ;; | Unary Operators | * & + - ! ~ ++expr --expr | right-to-left |
631 ;; | | (typecast) sizeof | |
632 ;; | Binary Operators | * / % | left-to-right |
633 ;; | | + - | |
634 ;; | | >> << | |
635 ;; | | < > <= >= | |
636 ;; | | == != | |
637 ;; | | & | |
638 ;; | | ^ | |
639 ;; | | | | |
640 ;; | | && | |
641 ;; | | || | |
642 ;; | Ternary Operator | ?: | right-to-left |
643 ;; x| Assignment Operators | = += -= *= /= %= >>= <<= &= | right-to-left |
644 ;; | | ^= = | |
645 ;; | Comma | , | left-to-right |
647 (defsubst hif-nexttoken ()
648 "Pop the next token from token-list into the let variable `hif-token'."
649 (setq hif-token (pop hif-token-list)))
651 (defsubst hif-if-valid-identifier-p (id)
652 (not (or (numberp id)
653 (stringp id))))
655 (defun hif-define-operator (tokens)
656 "`Upgrade' hif-define xxx to '(hif-define xxx)' so it won't be substituted."
657 (let ((result nil)
658 (tok nil))
659 (while (setq tok (pop tokens))
660 (push
661 (if (eq tok 'hif-defined)
662 (progn
663 (setq tok (cadr tokens))
664 (if (eq (car tokens) 'hif-lparen)
665 (if (and (hif-if-valid-identifier-p tok)
666 (eq (nth 2 tokens) 'hif-rparen))
667 (setq tokens (cl-cdddr tokens))
668 (error "#define followed by non-identifier: %S" tok))
669 (setq tok (car tokens)
670 tokens (cdr tokens))
671 (unless (hif-if-valid-identifier-p tok)
672 (error "#define followed by non-identifier: %S" tok)))
673 (list 'hif-defined 'hif-lparen tok 'hif-rparen))
674 tok)
675 result))
676 (nreverse result)))
678 (defun hif-flatten (l)
679 "Flatten a tree."
680 (apply #'nconc
681 (mapcar (lambda (x) (if (listp x)
682 (hif-flatten x)
683 (list x))) l)))
685 (defun hif-expand-token-list (tokens &optional macroname expand_list)
686 "Perform expansion on TOKENS till everything expanded.
687 Self-reference (directly or indirectly) tokens are not expanded.
688 EXPAND_LIST is the list of macro names currently being expanded, used for
689 detecting self-reference."
690 (catch 'self-referencing
691 (let ((expanded nil)
692 (remains (hif-define-operator
693 (hif-token-concatenation
694 (hif-token-stringification tokens))))
695 tok rep)
696 (if macroname
697 (setq expand_list (cons macroname expand_list)))
698 ;; Expanding all tokens till list exhausted
699 (while (setq tok (pop remains))
700 (if (memq tok expand_list)
701 ;; For self-referencing tokens, don't expand it
702 (throw 'self-referencing tokens))
703 (push
704 (cond
705 ((or (memq tok hif-valid-token-list)
706 (numberp tok)
707 (stringp tok))
708 tok)
710 ((setq rep (hif-lookup tok))
711 (if (and (listp rep)
712 (eq (car rep) 'hif-define-macro)) ; A defined macro
713 ;; Recursively expand it
714 (if (cadr rep) ; Argument list is not nil
715 (if (not (eq (car remains) 'hif-lparen))
716 ;; No argument, no invocation
718 ;; Argumented macro, get arguments and invoke it.
719 ;; Dynamically bind hif-token-list and hif-token
720 ;; for hif-macro-supply-arguments
721 (let* ((hif-token-list (cdr remains))
722 (hif-token nil)
723 (parmlist (mapcar #'hif-expand-token-list
724 (hif-get-argument-list)))
725 (result
726 (hif-expand-token-list
727 (hif-macro-supply-arguments tok parmlist)
728 tok expand_list)))
729 (setq remains (cons hif-token hif-token-list))
730 result))
731 ;; Argument list is nil, direct expansion
732 (setq rep (hif-expand-token-list
733 (nth 2 rep) ; Macro's token list
734 tok expand_list))
735 ;; Replace all remaining references immediately
736 (setq remains (cl-substitute tok rep remains))
737 rep)
738 ;; Lookup tok returns an atom
739 rep))
741 ;;[2013-10-22 16:06:12 +0800] Must keep the token, removing
742 ;; this token might results in an incomplete expression that
743 ;; cannot be parsed further.
744 ;;((= 1 (hif-defined tok)) ; defined (hif-defined tok)=1,
745 ;; ;;but empty (hif-lookup tok)=nil, thus remove this token
746 ;; (setq remains (delete tok remains))
747 ;; nil)
749 (t ; Usual IDs
750 tok))
752 expanded))
754 (hif-flatten (nreverse expanded)))))
756 (defun hif-parse-exp (token-list &optional macroname)
757 "Parse the TOKEN-LIST.
758 Return translated list in prefix form. MACRONAME is applied when invoking
759 macros to prevent self-reference."
760 (let ((hif-token-list (hif-expand-token-list token-list macroname)))
761 (hif-nexttoken)
762 (prog1
763 (and hif-token
764 (hif-exprlist))
765 (if hif-token ; is there still a token?
766 (error "Error: unexpected token: %s" hif-token)))))
768 (defun hif-exprlist ()
769 "Parse an exprlist: expr { ',' expr}."
770 (let ((result (hif-expr)))
771 (if (eq hif-token 'hif-comma)
772 (let ((temp (list result)))
773 (while
774 (progn
775 (hif-nexttoken)
776 (push (hif-expr) temp)
777 (eq hif-token 'hif-comma)))
778 (cons 'hif-comma (nreverse temp)))
779 result)))
781 (defun hif-expr ()
782 "Parse an expression as found in #if.
783 expr : or-expr | or-expr '?' expr ':' expr."
784 (let ((result (hif-or-expr))
785 middle)
786 (while (eq hif-token 'hif-conditional)
787 (hif-nexttoken)
788 (setq middle (hif-expr))
789 (if (eq hif-token 'hif-colon)
790 (progn
791 (hif-nexttoken)
792 (setq result (list 'hif-conditional result middle (hif-expr))))
793 (error "Error: unexpected token: %s" hif-token)))
794 result))
796 (defun hif-or-expr ()
797 "Parse an or-expr : and-expr | or-expr '||' and-expr."
798 (let ((result (hif-and-expr)))
799 (while (eq hif-token 'hif-or)
800 (hif-nexttoken)
801 (setq result (list 'hif-or result (hif-and-expr))))
802 result))
804 (defun hif-and-expr ()
805 "Parse an and-expr : logior-expr | and-expr '&&' logior-expr."
806 (let ((result (hif-logior-expr)))
807 (while (eq hif-token 'hif-and)
808 (hif-nexttoken)
809 (setq result (list 'hif-and result (hif-logior-expr))))
810 result))
812 (defun hif-logior-expr ()
813 "Parse a logor-expr : logxor-expr | logor-expr '|' logxor-expr."
814 (let ((result (hif-logxor-expr)))
815 (while (eq hif-token 'hif-logior)
816 (hif-nexttoken)
817 (setq result (list 'hif-logior result (hif-logxor-expr))))
818 result))
820 (defun hif-logxor-expr ()
821 "Parse a logxor-expr : logand-expr | logxor-expr '^' logand-expr."
822 (let ((result (hif-logand-expr)))
823 (while (eq hif-token 'hif-logxor)
824 (hif-nexttoken)
825 (setq result (list 'hif-logxor result (hif-logand-expr))))
826 result))
828 (defun hif-logand-expr ()
829 "Parse a logand-expr : eq-expr | logand-expr '&' eq-expr."
830 (let ((result (hif-eq-expr)))
831 (while (eq hif-token 'hif-logand)
832 (hif-nexttoken)
833 (setq result (list 'hif-logand result (hif-eq-expr))))
834 result))
836 (defun hif-eq-expr ()
837 "Parse an eq-expr : comp | eq-expr `=='|`!=' comp."
838 (let ((result (hif-comp-expr))
839 (eq-token nil))
840 (while (memq hif-token '(hif-equal hif-notequal))
841 (setq eq-token hif-token)
842 (hif-nexttoken)
843 (setq result (list eq-token result (hif-comp-expr))))
844 result))
846 (defun hif-comp-expr ()
847 "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift."
848 (let ((result (hif-logshift-expr))
849 (comp-token nil))
850 (while (memq hif-token '(hif-greater hif-less hif-greater-equal
851 hif-less-equal))
852 (setq comp-token hif-token)
853 (hif-nexttoken)
854 (setq result (list comp-token result (hif-logshift-expr))))
855 result))
857 (defun hif-logshift-expr ()
858 "Parse a logshift : math | logshift `<<'|`>>' math."
859 (let ((result (hif-math))
860 (shift-token nil))
861 (while (memq hif-token '(hif-shiftleft hif-shiftright))
862 (setq shift-token hif-token)
863 (hif-nexttoken)
864 (setq result (list shift-token result (hif-math))))
865 result))
867 (defun hif-math ()
868 "Parse an expression with + or -.
869 math : muldiv | math '+|-' muldiv."
870 (let ((result (hif-muldiv-expr))
871 (math-op nil))
872 (while (memq hif-token '(hif-plus hif-minus))
873 (setq math-op hif-token)
874 (hif-nexttoken)
875 (setq result (list math-op result (hif-muldiv-expr))))
876 result))
878 (defun hif-muldiv-expr ()
879 "Parse an expression with *,/,%.
880 muldiv : factor | muldiv '*|/|%' factor."
881 (let ((result (hif-factor))
882 (math-op nil))
883 (while (memq hif-token '(hif-multiply hif-divide hif-modulo))
884 (setq math-op hif-token)
885 (hif-nexttoken)
886 (setq result (list math-op result (hif-factor))))
887 result))
889 (defun hif-factor ()
890 "Parse a factor.
891 factor : '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' |
892 'id(parmlist)' | strings | id."
893 (cond
894 ((eq hif-token 'hif-not)
895 (hif-nexttoken)
896 (list 'hif-not (hif-factor)))
898 ((eq hif-token 'hif-lognot)
899 (hif-nexttoken)
900 (list 'hif-lognot (hif-factor)))
902 ((eq hif-token 'hif-lparen)
903 (hif-nexttoken)
904 (let ((result (hif-exprlist)))
905 (if (not (eq hif-token 'hif-rparen))
906 (error "Bad token in parenthesized expression: %s" hif-token)
907 (hif-nexttoken)
908 result)))
910 ((eq hif-token 'hif-defined)
911 (hif-nexttoken)
912 (let ((paren (when (eq hif-token 'hif-lparen) (hif-nexttoken) t))
913 (ident hif-token))
914 (if (memq hif-token '(or and not hif-defined hif-lparen hif-rparen))
915 (error "Error: unexpected token: %s" hif-token))
916 (when paren
917 (hif-nexttoken)
918 (unless (eq hif-token 'hif-rparen)
919 (error "Error: expected \")\" after identifier")))
920 (hif-nexttoken)
921 `(hif-defined (quote ,ident))))
923 ((numberp hif-token)
924 (prog1 hif-token (hif-nexttoken)))
925 ((stringp hif-token)
926 (hif-string-concatenation))
928 ;; Unary plus/minus.
929 ((memq hif-token '(hif-minus hif-plus))
930 (list (prog1 hif-token (hif-nexttoken)) 0 (hif-factor)))
932 (t ; identifier
933 (let ((ident hif-token))
934 (hif-nexttoken)
935 (if (eq hif-token 'hif-lparen)
936 (hif-place-macro-invocation ident)
937 `(hif-lookup (quote ,ident)))))))
939 (defun hif-get-argument-list ()
940 (let ((nest 0)
941 (parmlist nil) ; A "token" list of parameters, will later be parsed
942 (parm nil))
944 (while (or (not (eq (hif-nexttoken) 'hif-rparen))
945 (/= nest 0))
946 (if (eq (car (last parm)) 'hif-comma)
947 (setq parm nil))
948 (cond
949 ((eq hif-token 'hif-lparen)
950 (setq nest (1+ nest)))
951 ((eq hif-token 'hif-rparen)
952 (setq nest (1- nest)))
953 ((and (eq hif-token 'hif-comma)
954 (= nest 0))
955 (push (nreverse parm) parmlist)
956 (setq parm nil)))
957 (push hif-token parm))
959 (push (nreverse parm) parmlist) ; Okay even if PARM is nil
960 (hif-nexttoken) ; Drop the `hif-rparen', get next token
961 (nreverse parmlist)))
963 (defun hif-place-macro-invocation (ident)
964 (let ((parmlist (hif-get-argument-list)))
965 `(hif-invoke (quote ,ident) (quote ,parmlist))))
967 (defun hif-string-concatenation ()
968 "Parse concatenated strings: string | strings string."
969 (let ((result (substring-no-properties hif-token)))
970 (while (stringp (hif-nexttoken))
971 (setq result (concat
972 (substring result 0 -1) ; remove trailing '"'
973 (substring hif-token 1)))) ; remove leading '"'
974 result))
976 (defun hif-define-macro (_parmlist _token-body)
977 "A marker for defined macro with arguments.
978 This macro cannot be evaluated alone without parameters input."
979 ;;TODO: input arguments at run time, use minibuffer to query all arguments
980 (error
981 "Argumented macro cannot be evaluated without passing any parameter"))
983 (defun hif-stringify (a)
984 "Stringify a number, string or symbol."
985 (cond
986 ((numberp a)
987 (number-to-string a))
988 ((atom a)
989 (symbol-name a))
990 ((stringp a)
991 (concat "\"" a "\""))
993 (error "Invalid token to stringify"))))
995 (defun intern-safe (str)
996 (if (stringp str)
997 (intern str)))
999 (defun hif-token-concat (a b)
1000 "Concatenate two tokens into a longer token.
1001 Currently support only simple token concatenation. Also support weird (but
1002 valid) token concatenation like '>' ## '>' becomes '>>'. Here we take care only
1003 those that can be evaluated during preprocessing time and ignore all those that
1004 can only be evaluated at C(++) runtime (like '++', '--' and '+='...)."
1005 (if (or (memq a hif-valid-token-list)
1006 (memq b hif-valid-token-list))
1007 (let* ((ra (car (rassq a hif-token-alist)))
1008 (rb (car (rassq b hif-token-alist)))
1009 (result (and ra rb
1010 (cdr (assoc (concat ra rb) hif-token-alist)))))
1011 (or result
1012 ;;(error "Invalid token to concatenate")
1013 (error "Concatenating \"%s\" and \"%s\" does not give a valid \
1014 preprocessing token"
1015 (or ra (symbol-name a))
1016 (or rb (symbol-name b)))))
1017 (intern-safe (concat (hif-stringify a)
1018 (hif-stringify b)))))
1020 (defun hif-mathify (val)
1021 "Treat VAL as a number: if it's t or nil, use 1 or 0."
1022 (cond ((eq val t) 1)
1023 ((null val) 0)
1024 (t val)))
1026 (defun hif-conditional (a b c)
1027 (if (not (zerop (hif-mathify a))) (hif-mathify b) (hif-mathify c)))
1028 (defun hif-and (a b)
1029 (and (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b)))))
1030 (defun hif-or (a b)
1031 (or (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b)))))
1032 (defun hif-not (a)
1033 (zerop (hif-mathify a)))
1034 (defun hif-lognot (a)
1035 (lognot (hif-mathify a)))
1037 (defmacro hif-mathify-binop (fun)
1038 `(lambda (a b)
1039 ,(format "Like `%s' but treat t and nil as 1 and 0." fun)
1040 (,fun (hif-mathify a) (hif-mathify b))))
1042 (defun hif-shiftleft (a b)
1043 (setq a (hif-mathify a))
1044 (setq b (hif-mathify b))
1045 (if (< a 0)
1046 (ash a b)
1047 (lsh a b)))
1049 (defun hif-shiftright (a b)
1050 (setq a (hif-mathify a))
1051 (setq b (hif-mathify b))
1052 (if (< a 0)
1053 (ash a (- b))
1054 (lsh a (- b))))
1057 (defalias 'hif-multiply (hif-mathify-binop *))
1058 (defalias 'hif-divide (hif-mathify-binop /))
1059 (defalias 'hif-modulo (hif-mathify-binop %))
1060 (defalias 'hif-plus (hif-mathify-binop +))
1061 (defalias 'hif-minus (hif-mathify-binop -))
1062 (defalias 'hif-equal (hif-mathify-binop =))
1063 (defalias 'hif-notequal (hif-mathify-binop /=))
1064 (defalias 'hif-greater (hif-mathify-binop >))
1065 (defalias 'hif-less (hif-mathify-binop <))
1066 (defalias 'hif-greater-equal (hif-mathify-binop >=))
1067 (defalias 'hif-less-equal (hif-mathify-binop <=))
1068 (defalias 'hif-logior (hif-mathify-binop logior))
1069 (defalias 'hif-logxor (hif-mathify-binop logxor))
1070 (defalias 'hif-logand (hif-mathify-binop logand))
1073 (defun hif-comma (&rest expr)
1074 "Evaluate a list of EXPR, return the result of the last item."
1075 (let ((result nil))
1076 (dolist (e expr)
1077 (ignore-errors
1078 (setq result (funcall hide-ifdef-evaluator e))))
1079 result))
1081 (defun hif-token-stringification (l)
1082 "Scan token list for `hif-stringify' ('#') token and stringify the next token."
1083 (let (result)
1084 (while l
1085 (push (if (eq (car l) 'hif-stringify)
1086 (prog1
1087 (if (cadr l)
1088 (hif-stringify (cadr l))
1089 (error "No token to stringify"))
1090 (setq l (cdr l)))
1091 (car l))
1092 result)
1093 (setq l (cdr l)))
1094 (nreverse result)))
1096 (defun hif-token-concatenation (l)
1097 "Scan token list for `hif-token-concat' ('##') token and concatenate two tokens."
1098 (let ((prev nil)
1099 result)
1100 (while l
1101 (while (eq (car l) 'hif-token-concat)
1102 (unless prev
1103 (error "No token before ## to concatenate"))
1104 (unless (cdr l)
1105 (error "No token after ## to concatenate"))
1106 (setq prev (hif-token-concat prev (cadr l)))
1107 (setq l (cddr l)))
1108 (if prev
1109 (setq result (append result (list prev))))
1110 (setq prev (car l)
1111 l (cdr l)))
1112 (if prev
1113 (append result (list prev))
1114 result)))
1116 (defun hif-delimit (lis atom)
1117 (nconc (cl-mapcan (lambda (l) (list l atom))
1118 (butlast lis))
1119 (last lis)))
1121 ;; Perform token replacement:
1122 (defun hif-macro-supply-arguments (macro-name actual-parms)
1123 "Expand a macro call, replace ACTUAL-PARMS in the macro body."
1124 (let* ((SA (assoc macro-name hide-ifdef-env))
1125 (macro (and SA
1126 (cdr SA)
1127 (eq (cadr SA) 'hif-define-macro)
1128 (cddr SA)))
1129 (formal-parms (and macro (car macro)))
1130 (macro-body (and macro (cadr macro)))
1131 actual-count
1132 formal-count
1133 formal
1134 etc)
1136 (when (and actual-parms formal-parms macro-body)
1137 ;; For each actual parameter, evaluate each one and associate it
1138 ;; with an actual parameter, put it into local table and finally
1139 ;; evaluate the macro body.
1140 (if (setq etc (eq (car formal-parms) 'hif-etc))
1141 ;; Take care of `hif-etc' first. Prefix `hif-comma' back if needed.
1142 (setq formal-parms (cdr formal-parms)))
1143 (setq formal-count (length formal-parms)
1144 actual-count (length actual-parms))
1146 (if (> formal-count actual-count)
1147 (error "Too few parameters for macro %S" macro-name)
1148 (if (< formal-count actual-count)
1149 (or etc
1150 (error "Too many parameters for macro %S" macro-name))))
1152 ;; Perform token replacement on the MACRO-BODY with the parameters
1153 (while (setq formal (pop formal-parms))
1154 ;; Prevent repetitive substitution, thus cannot use `subst'
1155 ;; for example:
1156 ;; #define mac(a,b) (a+b)
1157 ;; #define testmac mac(b,y)
1158 ;; testmac should expand to (b+y): replace of argument a and b
1159 ;; occurs simultaneously, not sequentially. If sequentially,
1160 ;; according to the argument order, it will become:
1161 ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b)
1162 ;; becomes (b+b)
1163 ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b)
1164 ;; becomes (y+y).
1165 (setq macro-body
1166 ;; Unlike `subst', `substitute' replace only the top level
1167 ;; instead of the whole tree; more importantly, it's not
1168 ;; destructive.
1169 (cl-substitute (if (and etc (null formal-parms))
1170 (hif-delimit actual-parms 'hif-comma)
1171 (car actual-parms))
1172 formal macro-body))
1173 (setq actual-parms (cdr actual-parms)))
1175 ;; Replacement completed, flatten the whole token list
1176 (setq macro-body (hif-flatten macro-body))
1178 ;; Stringification and token concatenation happens here
1179 (hif-token-concatenation (hif-token-stringification macro-body)))))
1181 (defun hif-invoke (macro-name actual-parms)
1182 "Invoke a macro by expanding it, reparse macro-body and finally invoke it."
1183 ;; Reparse the macro body and evaluate it
1184 (funcall hide-ifdef-evaluator
1185 (hif-parse-exp
1186 (hif-macro-supply-arguments macro-name actual-parms)
1187 macro-name)))
1189 ;;;----------- end of parser -----------------------
1192 (defun hif-canonicalize-tokens (regexp) ; For debugging
1193 "Return the expanded result of the scanned tokens."
1194 (save-excursion
1195 (re-search-forward regexp)
1196 (let* ((curr-regexp (match-string 0))
1197 (defined (string-match hif-ifxdef-regexp curr-regexp))
1198 (negate (and defined
1199 (string= (match-string 2 curr-regexp) "n")))
1200 (hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize'
1201 (tokens (hif-tokenize (point)
1202 (progn (hif-end-of-line) (point)))))
1203 (if defined
1204 (setq tokens (list 'hif-defined tokens)))
1205 (if negate
1206 (setq tokens (list 'hif-not tokens)))
1207 tokens)))
1209 (defun hif-canonicalize (regexp)
1210 "Return a Lisp expression for its condition by scanning current buffer.
1211 Do this when cursor is at the beginning of `regexp' (i.e. #ifX)."
1212 (let ((case-fold-search nil))
1213 (save-excursion
1214 (re-search-forward regexp)
1215 (let* ((curr-regexp (match-string 0))
1216 (defined (string-match hif-ifxdef-regexp curr-regexp))
1217 (negate (and defined
1218 (string= (match-string 2 curr-regexp) "n")))
1219 (hif-simple-token-only nil) ; Dynamic binding for `hif-tokenize'
1220 (tokens (hif-tokenize (point)
1221 (progn (hif-end-of-line) (point)))))
1222 (if defined
1223 (setq tokens (list 'hif-defined tokens)))
1224 (if negate
1225 (setq tokens (list 'hif-not tokens)))
1226 (hif-parse-exp tokens)))))
1228 (defun hif-find-any-ifX ()
1229 "Move to next #if..., or #ifndef, at point or after."
1230 ;; (message "find ifX at %d" (point))
1231 (prog1
1232 (re-search-forward hif-ifx-regexp (point-max) t)
1233 (beginning-of-line)))
1236 (defun hif-find-next-relevant ()
1237 "Move to next #if..., #elif..., #else, or #endif, after the current line."
1238 ;; (message "hif-find-next-relevant at %d" (point))
1239 (end-of-line)
1240 ;; Avoid infinite recursion by only going to line-beginning if match found
1241 (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t)
1242 (beginning-of-line)))
1244 (defun hif-find-previous-relevant ()
1245 "Move to previous #if..., #else, or #endif, before the current line."
1246 ;; (message "hif-find-previous-relevant at %d" (point))
1247 (beginning-of-line)
1248 ;; Avoid infinite recursion by only going to line-beginning if match found
1249 (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t)
1250 (beginning-of-line)))
1253 (defun hif-looking-at-ifX ()
1254 (looking-at hif-ifx-regexp)) ; Should eventually see #if
1255 (defun hif-looking-at-endif ()
1256 (looking-at hif-endif-regexp))
1257 (defun hif-looking-at-else ()
1258 (looking-at hif-else-regexp))
1260 (defun hif-looking-at-elif ()
1261 (looking-at hif-elif-regexp))
1264 (defun hif-ifdef-to-endif ()
1265 "If positioned at #ifX, #elif, or #else form, skip to corresponding #endif."
1266 ;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1)
1267 (hif-find-next-relevant)
1268 (cond ((hif-looking-at-ifX)
1269 (hif-ifdef-to-endif) ; Find endif of nested if
1270 (hif-ifdef-to-endif)) ; Find outer endif or else
1271 ((hif-looking-at-elif)
1272 (hif-ifdef-to-endif))
1273 ((hif-looking-at-else)
1274 (hif-ifdef-to-endif)) ; Find endif following else
1275 ((hif-looking-at-endif)
1276 'done)
1278 (error "Mismatched #ifdef #endif pair"))))
1281 (defun hif-endif-to-ifdef ()
1282 "If positioned at #endif form, skip backward to corresponding #ifX."
1283 ;; (message "hif-endif-to-ifdef at %d" (point))
1284 (let ((start (point)))
1285 (hif-find-previous-relevant)
1286 (if (= start (point))
1287 (error "Mismatched #ifdef #endif pair")))
1288 (cond ((hif-looking-at-endif)
1289 (hif-endif-to-ifdef) ; Find beginning of nested if
1290 (hif-endif-to-ifdef)) ; Find beginning of outer if or else
1291 ((hif-looking-at-elif)
1292 (hif-endif-to-ifdef))
1293 ((hif-looking-at-else)
1294 (hif-endif-to-ifdef))
1295 ((hif-looking-at-ifX)
1296 'done)
1298 (error "Mismatched #endif")))) ; never gets here
1301 (defun forward-ifdef (&optional arg)
1302 "Move point to beginning of line of the next ifdef-endif.
1303 With argument, do this that many times."
1304 (interactive "p")
1305 (or arg (setq arg 1))
1306 (if (< arg 0) (backward-ifdef (- arg))
1307 (while (< 0 arg)
1308 (setq arg (- arg))
1309 (let ((start (point)))
1310 (unless (hif-looking-at-ifX)
1311 (hif-find-next-relevant))
1312 (if (hif-looking-at-ifX)
1313 (hif-ifdef-to-endif)
1314 (goto-char start)
1315 (error "No following #ifdef"))))))
1318 (defun backward-ifdef (&optional arg)
1319 "Move point to beginning of the previous ifdef-endif.
1320 With argument, do this that many times."
1321 (interactive "p")
1322 (or arg (setq arg 1))
1323 (if (< arg 0) (forward-ifdef (- arg))
1324 (while (< 0 arg)
1325 (setq arg (1- arg))
1326 (beginning-of-line)
1327 (let ((start (point)))
1328 (unless (hif-looking-at-endif)
1329 (hif-find-previous-relevant))
1330 (if (hif-looking-at-endif)
1331 (hif-endif-to-ifdef)
1332 (goto-char start)
1333 (error "No previous #ifdef"))))))
1336 (defun down-ifdef ()
1337 "Move point to beginning of nested ifdef or else-part."
1338 (interactive)
1339 (let ((start (point)))
1340 (hif-find-next-relevant)
1341 (if (or (hif-looking-at-ifX) (hif-looking-at-else))
1343 (goto-char start)
1344 (error "No following #ifdef"))))
1347 (defun up-ifdef ()
1348 "Move point to beginning of enclosing ifdef or else-part."
1349 (interactive)
1350 (beginning-of-line)
1351 (let ((start (point)))
1352 (unless (hif-looking-at-endif)
1353 (hif-find-previous-relevant))
1354 (if (hif-looking-at-endif)
1355 (hif-endif-to-ifdef))
1356 (if (= start (point))
1357 (error "No previous #ifdef"))))
1359 (defun next-ifdef (&optional arg)
1360 "Move to the beginning of the next #ifX, #else, or #endif.
1361 With argument, do this that many times."
1362 (interactive "p")
1363 (or arg (setq arg 1))
1364 (if (< arg 0) (previous-ifdef (- arg))
1365 (while (< 0 arg)
1366 (setq arg (1- arg))
1367 (hif-find-next-relevant)
1368 (when (eolp)
1369 (beginning-of-line)
1370 (error "No following #ifdefs, #elses, or #endifs")))))
1372 (defun previous-ifdef (&optional arg)
1373 "Move to the beginning of the previous #ifX, #else, or #endif.
1374 With argument, do this that many times."
1375 (interactive "p")
1376 (or arg (setq arg 1))
1377 (if (< arg 0) (next-ifdef (- arg))
1378 (while (< 0 arg)
1379 (setq arg (1- arg))
1380 (let ((start (point)))
1381 (hif-find-previous-relevant)
1382 (if (= start (point))
1383 (error "No previous #ifdefs, #elses, or #endifs"))))))
1386 ;;===%%SF%% parsing (End) ===
1389 ;;===%%SF%% hide-ifdef-hiding (Start) ===
1392 ;; A range is a structure with four components:
1393 ;; START The start of the range. (beginning of line)
1394 ;; ELSE The else marker (beginning of line)
1395 ;; END The end of the range. (beginning of line)
1396 ;; ELIF A sequence of #elif markers (beginning of line)
1398 (defsubst hif-make-range (start end &optional else elif)
1399 (list start else end elif))
1401 (defsubst hif-range-start (range) (elt range 0))
1402 (defsubst hif-range-else (range) (elt range 1))
1403 (defsubst hif-range-end (range) (elt range 2))
1404 (defsubst hif-range-elif (range) (elt range 3))
1407 ;; Find-Range
1408 ;; The workhorse, it delimits the #if region. Reasonably simple:
1409 ;; Skip until an #else or #endif is found, remembering positions. If
1410 ;; an #else was found, skip some more, looking for the true #endif.
1412 (defun hif-find-range ()
1413 "Return a Range structure describing the current #if region.
1414 Point is left unchanged."
1415 ;; (message "hif-find-range at %d" (point))
1416 (save-excursion
1417 (beginning-of-line)
1418 (let ((start (point))
1419 (elif nil)
1420 (else nil)
1421 (end nil))
1422 ;; Part one. Look for either #elif, #else or #endif.
1423 ;; This loop-and-a-half dedicated to E. Dijkstra.
1424 (while (and (not else) (not end))
1425 (while (progn
1426 (hif-find-next-relevant)
1427 (hif-looking-at-ifX)) ; Skip nested ifdef
1428 (hif-ifdef-to-endif))
1429 ;; Found either a #else, #elif, or an #endif.
1430 (cond ((hif-looking-at-elif)
1431 (setq elif (nconc elif (list (point)))))
1432 ((hif-looking-at-else)
1433 (setq else (point)))
1435 (setq end (point)))))
1436 ;; If found #else, look for #endif.
1437 (when else
1438 (while (progn
1439 (hif-find-next-relevant)
1440 (hif-looking-at-ifX)) ; Skip nested ifdef
1441 (hif-ifdef-to-endif))
1442 (if (hif-looking-at-else)
1443 (error "Found two elses in a row? Broken!"))
1444 (setq end (point))) ; (line-end-position)
1445 (hif-make-range start end else elif))))
1448 ;; A bit slimy.
1450 (defun hif-hide-line (point)
1451 "Hide the line containing point.
1452 Does nothing if `hide-ifdef-lines' is nil."
1453 (when hide-ifdef-lines
1454 (save-excursion
1455 (goto-char point)
1456 (hide-ifdef-region-internal
1457 (line-beginning-position) (progn (hif-end-of-line) (point))))))
1460 ;; Hif-Possibly-Hide
1461 ;; There are four cases. The #ifX expression is "taken" if it
1462 ;; the hide-ifdef-evaluator returns T. Presumably, this means the code
1463 ;; inside the #ifdef would be included when the program was
1464 ;; compiled.
1466 ;; Case 1: #ifX taken, and there's an #else.
1467 ;; The #else part must be hidden. The #if (then) part must be
1468 ;; processed for nested #ifX's.
1469 ;; Case 2: #ifX taken, and there's no #else.
1470 ;; The #if part must be processed for nested #ifX's.
1471 ;; Case 3: #ifX not taken, and there's an #elif
1472 ;; The #if part must be hidden, and then evaluate
1473 ;; the #elif condition like a new #ifX.
1474 ;; Case 4: #ifX not taken, and there's just an #else.
1475 ;; The #if part must be hidden. The #else part must be processed
1476 ;; for nested #ifs.
1477 ;; Case 5: #ifX not taken, and there's no #else.
1478 ;; The #ifX part must be hidden.
1480 ;; Further processing is done by narrowing to the relevant region
1481 ;; and just recursively calling hide-ifdef-guts.
1483 ;; When hif-possibly-hide returns, point is at the end of the
1484 ;; possibly-hidden range.
1486 (defvar hif-recurse-level 0)
1488 (defun hif-recurse-on (start end &optional dont-go-eol)
1489 "Call `hide-ifdef-guts' after narrowing to end of START line and END line."
1490 (save-excursion
1491 (save-restriction
1492 (goto-char start)
1493 (unless dont-go-eol
1494 (end-of-line))
1495 (narrow-to-region (point) end)
1496 (let ((hif-recurse-level (1+ hif-recurse-level)))
1497 (hide-ifdef-guts)))))
1499 (defun hif-possibly-hide (expand-reinclusion)
1500 "Called at #ifX expression, this hides those parts that should be hidden.
1501 It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag
1502 indicating that we should expand the #ifdef even if it should be hidden.
1503 Refer to `hide-ifdef-expand-reinclusion-protection' for more details."
1504 ;; (message "hif-possibly-hide") (sit-for 1)
1505 (let* ((case-fold-search nil)
1506 (test (hif-canonicalize hif-ifx-regexp))
1507 (range (hif-find-range))
1508 (elifs (hif-range-elif range))
1509 (if-part t) ; Everytime we start from if-part
1510 (complete nil))
1511 ;; (message "test = %s" test) (sit-for 1)
1513 (hif-hide-line (hif-range-end range))
1514 (while (not complete)
1515 (if (and (not (and expand-reinclusion if-part))
1516 (hif-not (funcall hide-ifdef-evaluator test)))
1517 ;; ifX/elif is FALSE
1518 (if elifs
1519 ;; Case 3 - Hide the #ifX and eval #elif
1520 (let ((newstart (car elifs)))
1521 (hif-hide-line (hif-range-start range))
1522 (hide-ifdef-region (hif-range-start range)
1523 (1- newstart))
1524 (setcar range newstart)
1525 (goto-char newstart)
1526 (setq elifs (cdr elifs))
1527 (setq test (hif-canonicalize hif-elif-regexp)))
1529 ;; Check for #else
1530 (cond ((hif-range-else range)
1531 ;; Case 4 - #else block visible
1532 (hif-hide-line (hif-range-else range))
1533 (hide-ifdef-region (hif-range-start range)
1534 (1- (hif-range-else range)))
1535 (hif-recurse-on (hif-range-else range)
1536 (hif-range-end range)))
1538 ;; Case 5 - No #else block, hide #ifX
1539 (hide-ifdef-region (point)
1540 (1- (hif-range-end range)))))
1541 (setq complete t))
1543 ;; ifX/elif is TRUE
1544 (cond (elifs
1545 ;; Luke fix: distinguish from #elif..#elif to #elif..#else
1546 (let ((elif (car elifs)))
1547 ;; hide all elifs
1548 (hif-hide-line elif)
1549 (hide-ifdef-region elif (1- (hif-range-end range)))
1550 (hif-recurse-on (hif-range-start range)
1551 elif)))
1552 ((hif-range-else range)
1553 ;; Case 1 - Hide #elif and #else blocks, recurse #ifX
1554 (hif-hide-line (hif-range-else range))
1555 (hide-ifdef-region (hif-range-else range)
1556 (1- (hif-range-end range)))
1557 (hif-recurse-on (hif-range-start range)
1558 (hif-range-else range)))
1560 ;; Case 2 - No #else, just recurse #ifX
1561 (hif-recurse-on (hif-range-start range)
1562 (hif-range-end range))))
1563 (setq complete t))
1564 (setq if-part nil))
1566 ;; complete = t
1567 (hif-hide-line (hif-range-start range)) ; Always hide start.
1568 (goto-char (hif-range-end range))
1569 (end-of-line)))
1571 (defun hif-evaluate-region (start end)
1572 (let* ((tokens (ignore-errors ; Prevent C statement things like
1573 ; 'do { ... } while (0)'
1574 (hif-tokenize start end)))
1575 (expr (and tokens
1576 (condition-case nil
1577 (hif-parse-exp tokens)
1578 (error
1579 tokens))))
1580 (result (funcall hide-ifdef-evaluator expr)))
1581 result))
1583 (defun hif-evaluate-macro (rstart rend)
1584 "Evaluate the macro expansion result for a region.
1585 If no region active, find the current #ifdefs and evaluate the result.
1586 Currently it supports only math calculations, strings or argumented macros can
1587 not be expanded."
1588 (interactive "r")
1589 (let ((case-fold-search nil))
1590 (save-excursion
1591 (unless mark-active
1592 (setq rstart nil rend nil)
1593 (beginning-of-line)
1594 (when (and (re-search-forward hif-macro-expr-prefix-regexp nil t)
1595 (string= "define" (match-string 2)))
1596 (re-search-forward hif-macroref-regexp nil t)))
1597 (let* ((start (or rstart (point)))
1598 (end (or rend (progn (hif-end-of-line) (point))))
1599 (defined nil)
1600 (simple 't)
1601 (tokens (ignore-errors ; Prevent C statement things like
1602 ; 'do { ... } while (0)'
1603 (hif-tokenize start end)))
1604 (expr (or (and (<= (length tokens) 1) ; Simple token
1605 (setq defined (assoc (car tokens) hide-ifdef-env))
1606 (setq simple (atom (hif-lookup (car tokens))))
1607 (hif-lookup (car tokens)))
1608 (and tokens
1609 (condition-case nil
1610 (hif-parse-exp tokens)
1611 (error
1612 nil)))))
1613 (result (funcall hide-ifdef-evaluator expr))
1614 (exprstring (replace-regexp-in-string
1615 ;; Trim off leading/trailing whites
1616 "^[ \t]*\\([^ \t]+\\)[ \t]*" "\\1"
1617 (replace-regexp-in-string
1618 "\\(//.*\\)" "" ; Trim off end-of-line comments
1619 (buffer-substring-no-properties start end)))))
1620 (cond
1621 ((and (<= (length tokens) 1) simple) ; Simple token
1622 (if defined
1623 (message "%S <= `%s'" result exprstring)
1624 (message "`%s' is not defined" exprstring)))
1625 ((integerp result)
1626 (if (or (= 0 result) (= 1 result))
1627 (message "%S <= `%s'" result exprstring)
1628 (message "%S (0x%x) <= `%s'" result result exprstring)))
1629 ((null result) (message "%S <= `%s'" 'false exprstring))
1630 ((eq t result) (message "%S <= `%s'" 'true exprstring))
1631 (t (message "%S <= `%s'" result exprstring)))
1632 result))))
1634 (defun hif-parse-macro-arglist (str)
1635 "Parse argument list formatted as '( arg1 [ , argn] [...] )'.
1636 The '...' is also included. Return a list of the arguments, if '...' exists the
1637 first arg will be `hif-etc'."
1638 (let* ((hif-simple-token-only nil) ; Dynamic binding var for `hif-tokenize'
1639 (tokenlist
1640 (cdr (hif-tokenize
1641 (- (point) (length str)) (point)))) ; Remove `hif-lparen'
1642 etc result token)
1643 (while (not (eq (setq token (pop tokenlist)) 'hif-rparen))
1644 (cond
1645 ((eq token 'hif-etc)
1646 (setq etc t))
1647 ((eq token 'hif-comma)
1650 (push token result))))
1651 (if etc
1652 (cons 'hif-etc (nreverse result))
1653 (nreverse result))))
1655 ;; The original version of hideif evaluates the macro early and store the
1656 ;; final values for the defined macro into the symbol database (aka
1657 ;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed
1658 ;; tree -> [value]". (The square bracket refers to what's stored in in our
1659 ;; `hide-ifdef-env'.)
1661 ;; This forbids the evaluation of an argumented macro since the parameters
1662 ;; are applied at run time. In order to support argumented macro I then
1663 ;; postponed the evaluation process one stage and store the "parsed tree"
1664 ;; into symbol database. The evaluation process was then "strings -> tokens
1665 ;; -> [parsed tree] -> value". Hideif therefore run slower since it need to
1666 ;; evaluate the parsed tree everytime when trying to expand the symbol. These
1667 ;; temporarily code changes are obsolete and not in Emacs source repository.
1669 ;; Furthermore, CPP did allow partial expression to be defined in several
1670 ;; macros and later got concatenated into a complete expression and then
1671 ;; evaluate it. In order to match this behavior I had to postpone one stage
1672 ;; further, otherwise those partial expression will be fail on parsing and
1673 ;; we'll miss all macros that reference it. The evaluation process thus
1674 ;; became "strings -> [tokens] -> parsed tree -> value." This degraded the
1675 ;; performance since we need to parse tokens and evaluate them everytime
1676 ;; when that symbol is referenced.
1678 ;; In real cases I found a lot portion of macros are "simple macros" that
1679 ;; expand to literals like integers or other symbols. In order to enhance
1680 ;; the performance I use this `hif-simple-token-only' to notify my code and
1681 ;; save the final [value] into symbol database. [lukelee]
1683 (defun hif-find-define (&optional min max)
1684 "Parse texts and retrieve all defines within the region MIN and MAX."
1685 (interactive)
1686 (and min (goto-char min))
1687 (and (re-search-forward hif-define-regexp max t)
1689 (let* ((defining (string= "define" (match-string 2)))
1690 (name (and (re-search-forward hif-macroref-regexp max t)
1691 (match-string 1)))
1692 (parmlist (and (match-string 3) ; First arg id found
1693 (hif-parse-macro-arglist (match-string 2)))))
1694 (if defining
1695 ;; Ignore name (still need to return 't), or define the name
1696 (or (and hide-ifdef-exclude-define-regexp
1697 (string-match hide-ifdef-exclude-define-regexp
1698 name))
1700 (let* ((start (point))
1701 (end (progn (hif-end-of-line) (point)))
1702 (hif-simple-token-only nil) ; Dynamic binding
1703 (tokens
1704 (and name
1705 ;; `hif-simple-token-only' is set/clear
1706 ;; only in this block
1707 (condition-case nil
1708 ;; Prevent C statements like
1709 ;; 'do { ... } while (0)'
1710 (hif-tokenize start end)
1711 (error
1712 ;; We can't just return nil here since
1713 ;; this will stop hideif from searching
1714 ;; for more #defines.
1715 (setq hif-simple-token-only t)
1716 (buffer-substring-no-properties
1717 start end)))))
1718 ;; For simple tokens we save only the parsed result;
1719 ;; otherwise we save the tokens and parse it after
1720 ;; parameter replacement
1721 (expr (and tokens
1722 ;; `hif-simple-token-only' is checked only
1723 ;; here.
1724 (or (and hif-simple-token-only
1725 (listp tokens)
1726 (= (length tokens) 1)
1727 (hif-parse-exp tokens))
1728 `(hif-define-macro ,parmlist
1729 ,tokens))))
1730 (SA (and name
1731 (assoc (intern name) hide-ifdef-env))))
1732 (and name
1733 (if SA
1734 (or (setcdr SA expr) t)
1735 ;; Lazy evaluation, eval only if hif-lookup find it.
1736 ;; Define it anyway, even if nil it's still in list
1737 ;; and therefore considered defined.
1738 (push (cons (intern name) expr) hide-ifdef-env)))))
1739 ;; #undef
1740 (and name
1741 (hif-undefine-symbol (intern name))))))
1745 (defun hif-add-new-defines (&optional min max)
1746 "Scan and add all #define macros between MIN and MAX."
1747 (interactive)
1748 (save-excursion
1749 (save-restriction
1750 ;; (mark-region min max) ;; for debugging
1751 (while (hif-find-define min max)
1752 (setf min (point)))
1753 (if max (goto-char max)
1754 (goto-char (point-max))))))
1756 (defun hide-ifdef-guts ()
1757 "Does most of the work of `hide-ifdefs'.
1758 It does not do the work that's pointless to redo on a recursive entry."
1759 ;; (message "hide-ifdef-guts")
1760 (save-excursion
1761 (let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp'
1762 (expand-header (and hide-ifdef-expand-reinclusion-protection
1763 (string-match hide-ifdef-header-regexp
1764 (buffer-file-name))
1765 (zerop hif-recurse-level)))
1766 (case-fold-search nil)
1767 min max)
1768 (goto-char (point-min))
1769 (setf min (point))
1770 (cl-loop do
1771 (setf max (hif-find-any-ifX))
1772 (hif-add-new-defines min max)
1773 (if max
1774 (hif-possibly-hide expand-header))
1775 (setf min (point))
1776 while max))))
1778 ;;===%%SF%% hide-ifdef-hiding (End) ===
1781 ;;===%%SF%% exports (Start) ===
1783 (defun hide-ifdef-toggle-read-only ()
1784 "Toggle `hide-ifdef-read-only'."
1785 (interactive)
1786 (setq hide-ifdef-read-only (not hide-ifdef-read-only))
1787 (message "Hide-Read-Only %s"
1788 (if hide-ifdef-read-only "ON" "OFF"))
1789 (if hide-ifdef-hiding
1790 (setq buffer-read-only (or hide-ifdef-read-only
1791 hif-outside-read-only)))
1792 (force-mode-line-update))
1794 (defun hide-ifdef-toggle-outside-read-only ()
1795 "Replacement for `read-only-mode' within Hide-Ifdef mode."
1796 (interactive)
1797 (setq hif-outside-read-only (not hif-outside-read-only))
1798 (message "Read only %s"
1799 (if hif-outside-read-only "ON" "OFF"))
1800 (setq buffer-read-only
1801 (or (and hide-ifdef-hiding hide-ifdef-read-only)
1802 hif-outside-read-only))
1803 (force-mode-line-update))
1805 (defun hide-ifdef-toggle-shadowing ()
1806 "Toggle shadowing."
1807 (interactive)
1808 (set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow))
1809 (message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF"))
1810 (save-restriction
1811 (widen)
1812 (dolist (overlay (overlays-in (point-min) (point-max)))
1813 (when (overlay-get overlay 'hide-ifdef)
1814 (if hide-ifdef-shadow
1815 (progn
1816 (overlay-put overlay 'invisible nil)
1817 (overlay-put overlay 'face 'hide-ifdef-shadow))
1818 (overlay-put overlay 'face nil)
1819 (overlay-put overlay 'invisible 'hide-ifdef))))))
1821 (defun hide-ifdef-define (var &optional val)
1822 "Define a VAR to VAL (default 1) in `hide-ifdef-env'.
1823 This allows #ifdef VAR to be hidden."
1824 (interactive
1825 (let* ((default (save-excursion
1826 (beginning-of-line)
1827 (cond ((looking-at hif-ifx-else-endif-regexp)
1828 (forward-word 2)
1829 (current-word 'strict))
1831 nil))))
1832 (var (read-minibuffer "Define what? " default))
1833 (val (read-from-minibuffer (format "Set %s to? (default 1): " var)
1834 nil nil t nil "1")))
1835 (list var val)))
1836 (hif-set-var var (or val 1))
1837 (message "%s set to %s" var (or val 1))
1838 (sleep-for 1)
1839 (if hide-ifdef-hiding (hide-ifdefs)))
1841 (defun hif-undefine-symbol (var)
1842 (setq hide-ifdef-env
1843 (delete (assoc var hide-ifdef-env) hide-ifdef-env)))
1845 (defun hide-ifdef-undef (start end)
1846 "Undefine a VAR so that #ifdef VAR would not be included."
1847 (interactive "r")
1848 (let* ((symstr
1849 (or (and mark-active
1850 (buffer-substring-no-properties start end))
1851 (read-string "Undefine what? " (current-word))))
1852 (sym (and symstr
1853 (intern symstr))))
1854 (if (zerop (hif-defined sym))
1855 (message "`%s' not defined, no need to undefine it" symstr)
1856 (hif-undefine-symbol sym)
1857 (if hide-ifdef-hiding (hide-ifdefs))
1858 (message "`%S' undefined" sym))))
1860 (defun hide-ifdefs (&optional nomsg)
1861 "Hide the contents of some #ifdefs.
1862 Assume that defined symbols have been added to `hide-ifdef-env'.
1863 The text hidden is the text that would not be included by the C
1864 preprocessor if it were given the file with those symbols defined.
1865 With prefix command presents it will also hide the #ifdefs themselves.
1867 Turn off hiding by calling `show-ifdefs'."
1869 (interactive)
1870 (let ((hide-ifdef-lines current-prefix-arg))
1871 (or nomsg
1872 (message "Hiding..."))
1873 (setq hif-outside-read-only buffer-read-only)
1874 (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode
1875 (if hide-ifdef-hiding
1876 (show-ifdefs)) ; Otherwise, deep confusion.
1877 (setq hide-ifdef-hiding t)
1878 (hide-ifdef-guts)
1879 (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
1880 (or nomsg
1881 (message "Hiding done"))))
1884 (defun show-ifdefs ()
1885 "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs."
1886 (interactive)
1887 (setq buffer-read-only hif-outside-read-only)
1888 (hif-show-all)
1889 (setq hide-ifdef-hiding nil))
1892 (defun hif-find-ifdef-block ()
1893 "Utility to hide and show ifdef block.
1894 Return as (TOP . BOTTOM) the extent of ifdef block."
1895 (let (max-bottom)
1896 (cons (save-excursion
1897 (beginning-of-line)
1898 (unless (or (hif-looking-at-else) (hif-looking-at-ifX))
1899 (up-ifdef))
1900 (prog1 (point)
1901 (hif-ifdef-to-endif)
1902 (setq max-bottom (1- (point)))))
1903 (save-excursion
1904 (beginning-of-line)
1905 (unless (hif-looking-at-endif)
1906 (hif-find-next-relevant))
1907 (while (hif-looking-at-ifX)
1908 (hif-ifdef-to-endif)
1909 (hif-find-next-relevant))
1910 (min max-bottom (1- (point)))))))
1913 (defun hide-ifdef-block (&optional arg start end)
1914 "Hide the ifdef block (true or false part) enclosing or before the cursor.
1915 With optional prefix argument ARG, also hide the #ifdefs themselves."
1916 (interactive "P\nr")
1917 (let ((hide-ifdef-lines arg))
1918 (if mark-active
1919 (let ((hif-recurse-level (1+ hif-recurse-level)))
1920 (hif-recurse-on start end t)
1921 (setq mark-active nil))
1922 (unless hide-ifdef-mode (hide-ifdef-mode 1))
1923 (let ((top-bottom (hif-find-ifdef-block)))
1924 (hide-ifdef-region (car top-bottom) (cdr top-bottom))
1925 (when hide-ifdef-lines
1926 (hif-hide-line (car top-bottom))
1927 (hif-hide-line (1+ (cdr top-bottom))))
1928 (setq hide-ifdef-hiding t))
1929 (setq buffer-read-only
1930 (or hide-ifdef-read-only hif-outside-read-only)))))
1932 (defun show-ifdef-block (&optional start end)
1933 "Show the ifdef block (true or false part) enclosing or before the cursor."
1934 (interactive "r")
1935 (if mark-active
1936 (progn
1937 (dolist (o (overlays-in start end))
1938 (if (overlay-get o 'hide-ifdef)
1939 (delete-overlay o)))
1940 (setq mark-active nil))
1941 (let ((top-bottom (condition-case nil
1942 (hif-find-ifdef-block)
1943 (error
1944 nil)))
1945 (ovrs (overlays-in (max (point-min) (1- (point)))
1946 (min (point-max) (1+ (point)))))
1947 (del nil))
1948 (if top-bottom
1949 (if hide-ifdef-lines
1950 (hif-show-ifdef-region
1951 (save-excursion
1952 (goto-char (car top-bottom)) (line-beginning-position))
1953 (save-excursion
1954 (goto-char (1+ (cdr top-bottom)))
1955 (hif-end-of-line) (point)))
1956 (setf del (hif-show-ifdef-region
1957 (1- (car top-bottom)) (cdr top-bottom)))))
1958 (if (not (and top-bottom
1959 del))
1960 (dolist (o ovrs)
1961 ;;(dolist (o (overlays-in (1- (point)) (1+ (point))))
1962 ;; (if (overlay-get o 'hide-ifdef) (message "%S" o)))
1963 (if (overlay-get o 'hide-ifdef)
1964 (delete-overlay o)))))))
1967 ;;; definition alist support
1969 (defvar hide-ifdef-define-alist nil
1970 "A global assoc list of pre-defined symbol lists.")
1972 (defun hif-compress-define-list (env)
1973 "Compress the define list ENV into a list of defined symbols only."
1974 (let ((new-defs nil))
1975 (dolist (def env new-defs)
1976 (if (hif-lookup (car def)) (push (car def) new-defs)))))
1978 (defun hide-ifdef-set-define-alist (name)
1979 "Set the association for NAME to `hide-ifdef-env'."
1980 (interactive "SSet define list: ")
1981 (push (cons name (hif-compress-define-list hide-ifdef-env))
1982 hide-ifdef-define-alist))
1984 (defun hide-ifdef-use-define-alist (name)
1985 "Set `hide-ifdef-env' to the define list specified by NAME."
1986 (interactive
1987 (list (completing-read "Use define list: "
1988 (mapcar (lambda (x) (symbol-name (car x)))
1989 hide-ifdef-define-alist)
1990 nil t)))
1991 (if (stringp name) (setq name (intern name)))
1992 (let ((define-list (assoc name hide-ifdef-define-alist)))
1993 (if define-list
1994 (setq hide-ifdef-env
1995 (mapcar (lambda (arg) (cons arg t))
1996 (cdr define-list)))
1997 (error "No define list for %s" name))
1998 (if hide-ifdef-hiding (hide-ifdefs))))
2000 (provide 'hideif)
2002 ;;; hideif.el ends here