mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-25 10:47:00 +00:00
6b13eef029
initial version of the file).
1030 lines
34 KiB
EmacsLisp
1030 lines
34 KiB
EmacsLisp
;;; hideif.el --- hides selected code within ifdef
|
|
|
|
;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
|
|
;; 2008, 2009 Free Software Foundation, Inc.
|
|
|
|
;; Author: Brian Marick
|
|
;; Daniel LaLiberte <liberte@holonexus.org>
|
|
;; Maintainer: FSF
|
|
;; Keywords: c, outlines
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; To initialize, toggle the hide-ifdef minor mode with
|
|
;;
|
|
;; M-x hide-ifdef-mode
|
|
;;
|
|
;; This will set up key bindings and call hide-ifdef-mode-hook if it
|
|
;; has a value. To explicitly hide ifdefs using a buffer-local
|
|
;; define list (default empty), type
|
|
;;
|
|
;; M-x hide-ifdefs or C-c @ h
|
|
;;
|
|
;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't
|
|
;; pass through. The support of constant expressions in #if lines is
|
|
;; limited to identifiers, parens, and the operators: &&, ||, !, and
|
|
;; "defined". Please extend this.
|
|
;;
|
|
;; The hidden code is marked by ellipses (...). Be
|
|
;; cautious when editing near ellipses, since the hidden text is
|
|
;; still in the buffer, and you can move the point into it and modify
|
|
;; text unawares.
|
|
;; You can make your buffer read-only while hide-ifdef-hiding by setting
|
|
;; hide-ifdef-read-only to a non-nil value. You can toggle this
|
|
;; variable with hide-ifdef-toggle-read-only (C-c @ C-q).
|
|
;;
|
|
;; You can undo the effect of hide-ifdefs by typing
|
|
;;
|
|
;; M-x show-ifdefs or C-c @ s
|
|
;;
|
|
;; Use M-x hide-ifdef-define (C-c @ d) to define a symbol.
|
|
;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol.
|
|
;;
|
|
;; If you define or undefine a symbol while hide-ifdef-mode is in effect,
|
|
;; the display will be updated. Only the define list for the current
|
|
;; buffer will be affected. You can save changes to the local define
|
|
;; list with hide-ifdef-set-define-alist. This adds entries
|
|
;; to hide-ifdef-define-alist.
|
|
;;
|
|
;; If you have defined a hide-ifdef-mode-hook, you can set
|
|
;; up a list of symbols that may be used by hide-ifdefs as in the
|
|
;; following example:
|
|
;;
|
|
;; (add-hook 'hide-ifdef-mode-hook
|
|
;; (lambda ()
|
|
;; (unless hide-ifdef-define-alist
|
|
;; (setq hide-ifdef-define-alist
|
|
;; '((list1 ONE TWO)
|
|
;; (list2 TWO THREE))))
|
|
;; (hide-ifdef-use-define-alist 'list2))) ; use list2 by default
|
|
;;
|
|
;; You can call hide-ifdef-use-define-alist (C-c @ U) at any time to specify
|
|
;; another list to use.
|
|
;;
|
|
;; To cause ifdefs to be hidden as soon as hide-ifdef-mode is called,
|
|
;; set hide-ifdef-initially to non-nil.
|
|
;;
|
|
;; If you set hide-ifdef-lines to t, hide-ifdefs hides all the #ifdef lines.
|
|
;; In the absence of highlighting, that might be a bad idea. If you set
|
|
;; hide-ifdef-lines to nil (the default), the surrounding preprocessor
|
|
;; lines will be displayed. That can be confusing in its own
|
|
;; right. Other variations on display are possible, but not much
|
|
;; better.
|
|
;;
|
|
;; You can explicitly hide or show individual ifdef blocks irrespective
|
|
;; of the define list by using hide-ifdef-block and show-ifdef-block.
|
|
;;
|
|
;; You can move the point between ifdefs with forward-ifdef, backward-ifdef,
|
|
;; up-ifdef, down-ifdef, next-ifdef, and previous-ifdef.
|
|
;;
|
|
;; If you have minor-mode-alist in your mode line (the default) two labels
|
|
;; may appear. "Ifdef" will appear when hide-ifdef-mode is active. "Hiding"
|
|
;; will appear when text may be hidden ("hide-ifdef-hiding" is non-nil).
|
|
;;
|
|
;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL.
|
|
;; Extensively modified by Daniel LaLiberte (while at Gould).
|
|
|
|
;;; Code:
|
|
|
|
(require 'cc-mode)
|
|
|
|
(defgroup hide-ifdef nil
|
|
"Hide selected code within `ifdef'."
|
|
:group 'c)
|
|
|
|
(defcustom hide-ifdef-initially nil
|
|
"Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
|
|
:type 'boolean
|
|
:group 'hide-ifdef)
|
|
|
|
(defcustom hide-ifdef-read-only nil
|
|
"Set to non-nil if you want buffer to be read-only while hiding text."
|
|
:type 'boolean
|
|
:group 'hide-ifdef)
|
|
|
|
(defcustom hide-ifdef-lines nil
|
|
"Non-nil means hide the #ifX, #else, and #endif lines."
|
|
:type 'boolean
|
|
:group 'hide-ifdef)
|
|
|
|
(defcustom hide-ifdef-shadow nil
|
|
"Non-nil means shadow text instead of hiding it."
|
|
:type 'boolean
|
|
:group 'hide-ifdef
|
|
:version "23.1")
|
|
|
|
(defface hide-ifdef-shadow '((t (:inherit shadow)))
|
|
"Face for shadowing ifdef blocks."
|
|
:group 'hide-ifdef
|
|
:version "23.1")
|
|
|
|
|
|
(defvar hide-ifdef-mode-submap
|
|
;; Set up the submap that goes after the prefix key.
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map "d" 'hide-ifdef-define)
|
|
(define-key map "u" 'hide-ifdef-undef)
|
|
(define-key map "D" 'hide-ifdef-set-define-alist)
|
|
(define-key map "U" 'hide-ifdef-use-define-alist)
|
|
|
|
(define-key map "h" 'hide-ifdefs)
|
|
(define-key map "s" 'show-ifdefs)
|
|
(define-key map "\C-d" 'hide-ifdef-block)
|
|
(define-key map "\C-s" 'show-ifdef-block)
|
|
|
|
(define-key map "\C-q" 'hide-ifdef-toggle-read-only)
|
|
(define-key map "\C-w" 'hide-ifdef-toggle-shadowing)
|
|
(substitute-key-definition
|
|
'toggle-read-only 'hide-ifdef-toggle-outside-read-only map)
|
|
map)
|
|
"Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
|
|
|
|
(defconst hide-ifdef-mode-prefix-key "\C-c@"
|
|
"Prefix key for all Hide-Ifdef mode commands.")
|
|
|
|
(defvar hide-ifdef-mode-map
|
|
;; Set up the mode's main map, which leads via the prefix key to the submap.
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map hide-ifdef-mode-prefix-key hide-ifdef-mode-submap)
|
|
map)
|
|
"Keymap used with `hide-ifdef-mode'.")
|
|
|
|
(easy-menu-define hide-ifdef-mode-menu hide-ifdef-mode-map
|
|
"Menu for `hide-ifdef-mode'."
|
|
'("Hide-Ifdef"
|
|
["Hide some ifdefs" hide-ifdefs
|
|
:help "Hide the contents of some #ifdefs"]
|
|
["Show all ifdefs" show-ifdefs
|
|
:help "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs"]
|
|
["Hide ifdef block" hide-ifdef-block
|
|
:help "Hide the ifdef block (true or false part) enclosing or before the cursor"]
|
|
["Show ifdef block" show-ifdef-block
|
|
:help "Show the ifdef block (true or false part) enclosing or before the cursor"]
|
|
["Define a variable..." hide-ifdef-define
|
|
:help "Define a VAR so that #ifdef VAR would be included"]
|
|
["Undefine a variable..." hide-ifdef-undef
|
|
:help "Undefine a VAR so that #ifdef VAR would not be included"]
|
|
["Define an alist..." hide-ifdef-set-define-alist
|
|
:help "Set the association for NAME to `hide-ifdef-env'"]
|
|
["Use an alist..." hide-ifdef-use-define-alist
|
|
:help "Set `hide-ifdef-env' to the define list specified by NAME"]
|
|
["Toggle read only" hide-ifdef-toggle-read-only
|
|
:style toggle :selected hide-ifdef-read-only
|
|
:help "Buffer should be read-only while hiding text"]
|
|
["Toggle shadowing" hide-ifdef-toggle-shadowing
|
|
:style toggle :selected hide-ifdef-shadow
|
|
:help "Text should be shadowed instead of hidden"]))
|
|
|
|
(defvar hide-ifdef-hiding nil
|
|
"Non-nil when text may be hidden.")
|
|
|
|
(or (assq 'hide-ifdef-hiding minor-mode-alist)
|
|
(setq minor-mode-alist
|
|
(cons '(hide-ifdef-hiding " Hiding")
|
|
minor-mode-alist)))
|
|
|
|
;; fix c-mode syntax table so we can recognize whole symbols.
|
|
(defvar hide-ifdef-syntax-table
|
|
(let ((st (copy-syntax-table c-mode-syntax-table)))
|
|
(modify-syntax-entry ?_ "w" st)
|
|
(modify-syntax-entry ?& "." st)
|
|
(modify-syntax-entry ?\| "." st)
|
|
st)
|
|
"Syntax table used for tokenizing #if expressions.")
|
|
|
|
(defvar hide-ifdef-env nil
|
|
"An alist of defined symbols and their values.")
|
|
|
|
(defvar hif-outside-read-only nil
|
|
"Internal variable. Saves the value of `buffer-read-only' while hiding.")
|
|
|
|
;;;###autoload
|
|
(define-minor-mode hide-ifdef-mode
|
|
"Toggle Hide-Ifdef mode. This is a minor mode, albeit a large one.
|
|
With ARG, turn Hide-Ifdef mode on if arg is positive, off otherwise.
|
|
In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor
|
|
would eliminate may be hidden from view. Several variables affect
|
|
how the hiding is done:
|
|
|
|
`hide-ifdef-env'
|
|
An association list of defined and undefined symbols for the
|
|
current buffer. Initially, the global value of `hide-ifdef-env'
|
|
is used.
|
|
|
|
`hide-ifdef-define-alist'
|
|
An association list of defined symbol lists.
|
|
Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env'
|
|
and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env'
|
|
from one of the lists in `hide-ifdef-define-alist'.
|
|
|
|
`hide-ifdef-lines'
|
|
Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
|
|
#endif lines when hiding.
|
|
|
|
`hide-ifdef-initially'
|
|
Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
|
|
is activated.
|
|
|
|
`hide-ifdef-read-only'
|
|
Set to non-nil if you want to make buffers read only while hiding.
|
|
After `show-ifdefs', read-only status is restored to previous value.
|
|
|
|
\\{hide-ifdef-mode-map}"
|
|
:group 'hide-ifdef :lighter " Ifdef"
|
|
(if hide-ifdef-mode
|
|
(progn
|
|
;; inherit global values
|
|
(set (make-local-variable 'hide-ifdef-env)
|
|
(default-value 'hide-ifdef-env))
|
|
(set (make-local-variable 'hide-ifdef-hiding)
|
|
(default-value 'hide-ifdef-hiding))
|
|
(set (make-local-variable 'hif-outside-read-only) buffer-read-only)
|
|
(set (make-local-variable 'line-move-ignore-invisible) t)
|
|
(add-hook 'change-major-mode-hook
|
|
(lambda () (hide-ifdef-mode -1)) nil t)
|
|
|
|
(add-to-invisibility-spec '(hide-ifdef . t))
|
|
|
|
(if hide-ifdef-initially
|
|
(hide-ifdefs)
|
|
(show-ifdefs)))
|
|
;; else end hide-ifdef-mode
|
|
(kill-local-variable 'line-move-ignore-invisible)
|
|
(remove-from-invisibility-spec '(hide-ifdef . t))
|
|
(when hide-ifdef-hiding
|
|
(show-ifdefs))))
|
|
|
|
|
|
(defun hif-show-all ()
|
|
"Show all of the text in the current buffer."
|
|
(interactive)
|
|
(hif-show-ifdef-region (point-min) (point-max)))
|
|
|
|
;; By putting this on after-revert-hook, we arrange that it only
|
|
;; does anything when revert-buffer avoids turning off the mode.
|
|
;; (That can happen in VC.)
|
|
(defun hif-after-revert-function ()
|
|
(and hide-ifdef-mode hide-ifdef-hiding
|
|
(hide-ifdefs t)))
|
|
(add-hook 'after-revert-hook 'hif-after-revert-function)
|
|
|
|
(defun hif-end-of-line ()
|
|
(end-of-line)
|
|
(while (= (logand 1 (skip-chars-backward "\\\\")) 1)
|
|
(end-of-line 2)))
|
|
|
|
(defun hide-ifdef-region-internal (start end)
|
|
(remove-overlays start end 'hide-ifdef t)
|
|
(let ((o (make-overlay start end)))
|
|
(overlay-put o 'hide-ifdef t)
|
|
(if hide-ifdef-shadow
|
|
(overlay-put o 'face 'hide-ifdef-shadow)
|
|
(overlay-put o 'invisible 'hide-ifdef))))
|
|
|
|
(defun hide-ifdef-region (start end)
|
|
"START is the start of a #if or #else form. END is the ending part.
|
|
Everything including these lines is made invisible."
|
|
(save-excursion
|
|
(goto-char start) (hif-end-of-line) (setq start (point))
|
|
(goto-char end) (hif-end-of-line) (setq end (point))
|
|
(hide-ifdef-region-internal start end)))
|
|
|
|
(defun hif-show-ifdef-region (start end)
|
|
"Everything between START and END is made visible."
|
|
(remove-overlays start end 'hide-ifdef t))
|
|
|
|
|
|
;;===%%SF%% evaluation (Start) ===
|
|
|
|
;; It is not useful to set this to anything but `eval'.
|
|
;; In fact, the variable might as well be eliminated.
|
|
(defvar hide-ifdef-evaluator 'eval
|
|
"The function to use to evaluate a form.
|
|
The evaluator is given a canonical form and returns t if text under
|
|
that form should be displayed.")
|
|
|
|
(defvar hif-undefined-symbol nil
|
|
"...is by default considered to be false.")
|
|
|
|
|
|
(defun hif-set-var (var value)
|
|
"Prepend (var value) pair to hide-ifdef-env."
|
|
(setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
|
|
|
|
|
|
(defun hif-lookup (var)
|
|
;; (message "hif-lookup %s" var)
|
|
(let ((val (assoc var hide-ifdef-env)))
|
|
(if val
|
|
(cdr val)
|
|
hif-undefined-symbol)))
|
|
|
|
(defun hif-defined (var)
|
|
(if (assoc var hide-ifdef-env) 1 0))
|
|
|
|
;;===%%SF%% evaluation (End) ===
|
|
|
|
|
|
|
|
;;===%%SF%% parsing (Start) ===
|
|
;;; The code that understands what ifs and ifdef in files look like.
|
|
|
|
(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
|
|
(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
|
|
(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
|
|
(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
|
|
(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
|
|
(defconst hif-ifx-else-endif-regexp
|
|
(concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp))
|
|
|
|
;; Used to store the current token and the whole token list during parsing.
|
|
;; Only bound dynamically.
|
|
(defvar hif-token)
|
|
(defvar hif-token-list)
|
|
|
|
(defconst hif-token-alist
|
|
'(("||" . or)
|
|
("&&" . and)
|
|
("|" . hif-logior)
|
|
("&" . hif-logand)
|
|
("==" . equal)
|
|
("!=" . hif-notequal)
|
|
("!" . not)
|
|
("(" . lparen)
|
|
(")" . rparen)
|
|
(">" . hif-greater)
|
|
("<" . hif-less)
|
|
(">=" . hif-greater-equal)
|
|
("<=" . hif-less-equal)
|
|
("+" . hif-plus)
|
|
("-" . hif-minus)
|
|
("?" . hif-conditional)
|
|
(":" . hif-colon)))
|
|
|
|
(defconst hif-token-regexp
|
|
(concat (regexp-opt (mapcar 'car hif-token-alist)) "\\|\\w+"))
|
|
|
|
(defun hif-tokenize (start end)
|
|
"Separate string between START and END into a list of tokens."
|
|
(let ((token-list nil))
|
|
(with-syntax-table hide-ifdef-syntax-table
|
|
(save-excursion
|
|
(goto-char start)
|
|
(while (progn (forward-comment (point-max)) (< (point) end))
|
|
;; (message "expr-start = %d" expr-start) (sit-for 1)
|
|
(cond
|
|
((looking-at "\\\\\n")
|
|
(forward-char 2))
|
|
|
|
((looking-at hif-token-regexp)
|
|
(let ((token (buffer-substring (point) (match-end 0))))
|
|
(goto-char (match-end 0))
|
|
;; (message "token: %s" token) (sit-for 1)
|
|
(push (or (cdr (assoc token hif-token-alist))
|
|
(if (string-equal token "defined") 'hif-defined)
|
|
(if (string-match "\\`[0-9]*\\'" token)
|
|
(string-to-number token))
|
|
(intern token))
|
|
token-list)))
|
|
(t (error "Bad #if expression: %s" (buffer-string)))))))
|
|
(nreverse token-list)))
|
|
|
|
;;;-----------------------------------------------------------------
|
|
;;; Translate C preprocessor #if expressions using recursive descent.
|
|
;;; This parser is limited to the operators &&, ||, !, and "defined".
|
|
;;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94
|
|
|
|
(defsubst hif-nexttoken ()
|
|
"Pop the next token from token-list into the let variable \"hif-token\"."
|
|
(setq hif-token (pop hif-token-list)))
|
|
|
|
(defun hif-parse-if-exp (hif-token-list)
|
|
"Parse the TOKEN-LIST. Return translated list in prefix form."
|
|
(hif-nexttoken)
|
|
(prog1
|
|
(hif-expr)
|
|
(if hif-token ; is there still a token?
|
|
(error "Error: unexpected token: %s" hif-token))))
|
|
|
|
(defun hif-expr ()
|
|
"Parse an expression as found in #if.
|
|
expr : or-expr | or-expr '?' expr ':' expr."
|
|
(let ((result (hif-or-expr))
|
|
middle)
|
|
(while (eq hif-token 'hif-conditional)
|
|
(hif-nexttoken)
|
|
(setq middle (hif-expr))
|
|
(if (eq hif-token 'hif-colon)
|
|
(progn
|
|
(hif-nexttoken)
|
|
(setq result (list 'hif-conditional result middle (hif-expr))))
|
|
(error "Error: unexpected token: %s" hif-token)))
|
|
result))
|
|
|
|
(defun hif-or-expr ()
|
|
"Parse n or-expr : and-expr | or-expr '||' and-expr."
|
|
(let ((result (hif-and-expr)))
|
|
(while (eq hif-token 'or)
|
|
(hif-nexttoken)
|
|
(setq result (list 'hif-or result (hif-and-expr))))
|
|
result))
|
|
|
|
(defun hif-and-expr ()
|
|
"Parse an and-expr : eq-expr | and-expr '&&' eq-expr."
|
|
(let ((result (hif-eq-expr)))
|
|
(while (eq hif-token 'and)
|
|
(hif-nexttoken)
|
|
(setq result (list 'hif-and result (hif-eq-expr))))
|
|
result))
|
|
|
|
(defun hif-eq-expr ()
|
|
"Parse an eq-expr : math | eq-expr `=='|`!='|`<'|`>'|`>='|`<=' math."
|
|
(let ((result (hif-math))
|
|
(eq-token nil))
|
|
(while (memq hif-token '(equal hif-notequal hif-greater hif-less
|
|
hif-greater-equal hif-less-equal))
|
|
(setq eq-token hif-token)
|
|
(hif-nexttoken)
|
|
(setq result (list eq-token result (hif-math))))
|
|
result))
|
|
|
|
(defun hif-math ()
|
|
"Parse an expression with + or - and simpler things.
|
|
math : factor | math '+|-' factor."
|
|
(let ((result (hif-factor))
|
|
(math-op nil))
|
|
(while (memq hif-token '(hif-plus hif-minus hif-logior hif-logand))
|
|
(setq math-op hif-token)
|
|
(hif-nexttoken)
|
|
(setq result (list math-op result (hif-factor))))
|
|
result))
|
|
|
|
(defun hif-factor ()
|
|
"Parse a factor: '!' factor | '(' expr ')' | 'defined(' id ')' | id."
|
|
(cond
|
|
((eq hif-token 'not)
|
|
(hif-nexttoken)
|
|
(list 'hif-not (hif-factor)))
|
|
|
|
((eq hif-token 'lparen)
|
|
(hif-nexttoken)
|
|
(let ((result (hif-expr)))
|
|
(if (not (eq hif-token 'rparen))
|
|
(error "Bad token in parenthesized expression: %s" hif-token)
|
|
(hif-nexttoken)
|
|
result)))
|
|
|
|
((eq hif-token 'hif-defined)
|
|
(hif-nexttoken)
|
|
(let ((paren (when (eq hif-token 'lparen) (hif-nexttoken) t))
|
|
(ident hif-token))
|
|
(if (memq hif-token '(or and not hif-defined lparen rparen))
|
|
(error "Error: unexpected token: %s" hif-token))
|
|
(when paren
|
|
(hif-nexttoken)
|
|
(unless (eq hif-token 'rparen)
|
|
(error "Error: expected \")\" after identifier")))
|
|
(hif-nexttoken)
|
|
`(hif-defined (quote ,ident))))
|
|
|
|
((numberp hif-token)
|
|
(prog1 hif-token (hif-nexttoken)))
|
|
|
|
;; Unary plus/minus.
|
|
((memq hif-token '(hif-minus hif-plus))
|
|
(list (prog1 hif-token (hif-nexttoken)) 0 (hif-factor)))
|
|
|
|
(t ; identifier
|
|
(let ((ident hif-token))
|
|
(if (memq ident '(or and))
|
|
(error "Error: missing identifier"))
|
|
(hif-nexttoken)
|
|
`(hif-lookup (quote ,ident))))))
|
|
|
|
(defun hif-mathify (val)
|
|
"Treat VAL as a number: if it's t or nil, use 1 or 0."
|
|
(cond ((eq val t) 1)
|
|
((null val) 0)
|
|
(t val)))
|
|
|
|
(defun hif-conditional (a b c)
|
|
(if (not (zerop (hif-mathify a))) (hif-mathify b) (hif-mathify c)))
|
|
(defun hif-and (a b)
|
|
(and (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b)))))
|
|
(defun hif-or (a b)
|
|
(or (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b)))))
|
|
(defun hif-not (a)
|
|
(zerop (hif-mathify a)))
|
|
|
|
(defmacro hif-mathify-binop (fun)
|
|
`(lambda (a b)
|
|
,(format "Like `%s' but treat t and nil as 1 and 0." fun)
|
|
(,fun (hif-mathify a) (hif-mathify b))))
|
|
|
|
(defalias 'hif-plus (hif-mathify-binop +))
|
|
(defalias 'hif-minus (hif-mathify-binop -))
|
|
(defalias 'hif-notequal (hif-mathify-binop /=))
|
|
(defalias 'hif-greater (hif-mathify-binop >))
|
|
(defalias 'hif-less (hif-mathify-binop <))
|
|
(defalias 'hif-greater-equal (hif-mathify-binop >=))
|
|
(defalias 'hif-less-equal (hif-mathify-binop <=))
|
|
(defalias 'hif-logior (hif-mathify-binop logior))
|
|
(defalias 'hif-logand (hif-mathify-binop logand))
|
|
|
|
;;;----------- end of parser -----------------------
|
|
|
|
|
|
(defun hif-canonicalize ()
|
|
"When at beginning of #ifX, return a Lisp expression for its condition."
|
|
(save-excursion
|
|
(let ((negate (looking-at hif-ifndef-regexp)))
|
|
(re-search-forward hif-ifx-regexp)
|
|
(let* ((tokens (hif-tokenize (point)
|
|
(progn (hif-end-of-line) (point))))
|
|
(expr (hif-parse-if-exp tokens)))
|
|
;; (message "hif-canonicalized: %s" expr)
|
|
(if negate
|
|
(list 'hif-not expr)
|
|
expr)))))
|
|
|
|
|
|
(defun hif-find-any-ifX ()
|
|
"Move to next #if..., or #ifndef, at point or after."
|
|
;; (message "find ifX at %d" (point))
|
|
(prog1
|
|
(re-search-forward hif-ifx-regexp (point-max) t)
|
|
(beginning-of-line)))
|
|
|
|
|
|
(defun hif-find-next-relevant ()
|
|
"Move to next #if..., #else, or #endif, after the current line."
|
|
;; (message "hif-find-next-relevant at %d" (point))
|
|
(end-of-line)
|
|
;; avoid infinite recursion by only going to beginning of line if match found
|
|
(if (re-search-forward hif-ifx-else-endif-regexp (point-max) t)
|
|
(beginning-of-line)))
|
|
|
|
(defun hif-find-previous-relevant ()
|
|
"Move to previous #if..., #else, or #endif, before the current line."
|
|
;; (message "hif-find-previous-relevant at %d" (point))
|
|
(beginning-of-line)
|
|
;; avoid infinite recursion by only going to beginning of line if match found
|
|
(if (re-search-backward hif-ifx-else-endif-regexp (point-min) t)
|
|
(beginning-of-line)))
|
|
|
|
|
|
(defun hif-looking-at-ifX () ;; Should eventually see #if
|
|
(looking-at hif-ifx-regexp))
|
|
(defun hif-looking-at-endif ()
|
|
(looking-at hif-endif-regexp))
|
|
(defun hif-looking-at-else ()
|
|
(looking-at hif-else-regexp))
|
|
|
|
|
|
|
|
(defun hif-ifdef-to-endif ()
|
|
"If positioned at #ifX or #else form, skip to corresponding #endif."
|
|
;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1)
|
|
(hif-find-next-relevant)
|
|
(cond ((hif-looking-at-ifX)
|
|
(hif-ifdef-to-endif) ; find endif of nested if
|
|
(hif-ifdef-to-endif)) ; find outer endif or else
|
|
((hif-looking-at-else)
|
|
(hif-ifdef-to-endif)) ; find endif following else
|
|
((hif-looking-at-endif)
|
|
'done)
|
|
(t
|
|
(error "Mismatched #ifdef #endif pair"))))
|
|
|
|
|
|
(defun hif-endif-to-ifdef ()
|
|
"If positioned at #endif form, skip backward to corresponding #ifX."
|
|
;; (message "hif-endif-to-ifdef at %d" (point))
|
|
(let ((start (point)))
|
|
(hif-find-previous-relevant)
|
|
(if (= start (point))
|
|
(error "Mismatched #ifdef #endif pair")))
|
|
(cond ((hif-looking-at-endif)
|
|
(hif-endif-to-ifdef) ; find beginning of nested if
|
|
(hif-endif-to-ifdef)) ; find beginning of outer if or else
|
|
((hif-looking-at-else)
|
|
(hif-endif-to-ifdef))
|
|
((hif-looking-at-ifX)
|
|
'done)
|
|
(t))) ; never gets here
|
|
|
|
|
|
(defun forward-ifdef (&optional arg)
|
|
"Move point to beginning of line of the next ifdef-endif.
|
|
With argument, do this that many times."
|
|
(interactive "p")
|
|
(or arg (setq arg 1))
|
|
(if (< arg 0) (backward-ifdef (- arg))
|
|
(while (< 0 arg)
|
|
(setq arg (- arg))
|
|
(let ((start (point)))
|
|
(unless (hif-looking-at-ifX)
|
|
(hif-find-next-relevant))
|
|
(if (hif-looking-at-ifX)
|
|
(hif-ifdef-to-endif)
|
|
(goto-char start)
|
|
(error "No following #ifdef"))))))
|
|
|
|
|
|
(defun backward-ifdef (&optional arg)
|
|
"Move point to beginning of the previous ifdef-endif.
|
|
With argument, do this that many times."
|
|
(interactive "p")
|
|
(or arg (setq arg 1))
|
|
(if (< arg 0) (forward-ifdef (- arg))
|
|
(while (< 0 arg)
|
|
(setq arg (1- arg))
|
|
(beginning-of-line)
|
|
(let ((start (point)))
|
|
(unless (hif-looking-at-endif)
|
|
(hif-find-previous-relevant))
|
|
(if (hif-looking-at-endif)
|
|
(hif-endif-to-ifdef)
|
|
(goto-char start)
|
|
(error "No previous #ifdef"))))))
|
|
|
|
|
|
(defun down-ifdef ()
|
|
"Move point to beginning of nested ifdef or else-part."
|
|
(interactive)
|
|
(let ((start (point)))
|
|
(hif-find-next-relevant)
|
|
(if (or (hif-looking-at-ifX) (hif-looking-at-else))
|
|
()
|
|
(goto-char start)
|
|
(error "No following #ifdef"))))
|
|
|
|
|
|
(defun up-ifdef ()
|
|
"Move point to beginning of enclosing ifdef or else-part."
|
|
(interactive)
|
|
(beginning-of-line)
|
|
(let ((start (point)))
|
|
(unless (hif-looking-at-endif)
|
|
(hif-find-previous-relevant))
|
|
(if (hif-looking-at-endif)
|
|
(hif-endif-to-ifdef))
|
|
(if (= start (point))
|
|
(error "No previous #ifdef"))))
|
|
|
|
(defun next-ifdef (&optional arg)
|
|
"Move to the beginning of the next #ifX, #else, or #endif.
|
|
With argument, do this that many times."
|
|
(interactive "p")
|
|
(or arg (setq arg 1))
|
|
(if (< arg 0) (previous-ifdef (- arg))
|
|
(while (< 0 arg)
|
|
(setq arg (1- arg))
|
|
(hif-find-next-relevant)
|
|
(when (eolp)
|
|
(beginning-of-line)
|
|
(error "No following #ifdefs, #elses, or #endifs")))))
|
|
|
|
(defun previous-ifdef (&optional arg)
|
|
"Move to the beginning of the previous #ifX, #else, or #endif.
|
|
With argument, do this that many times."
|
|
(interactive "p")
|
|
(or arg (setq arg 1))
|
|
(if (< arg 0) (next-ifdef (- arg))
|
|
(while (< 0 arg)
|
|
(setq arg (1- arg))
|
|
(let ((start (point)))
|
|
(hif-find-previous-relevant)
|
|
(if (= start (point))
|
|
(error "No previous #ifdefs, #elses, or #endifs"))))))
|
|
|
|
|
|
;;===%%SF%% parsing (End) ===
|
|
|
|
|
|
;;===%%SF%% hide-ifdef-hiding (Start) ===
|
|
|
|
|
|
;;; A range is a structure with four components:
|
|
;;; ELSE-P True if there was an else clause for the ifdef.
|
|
;;; START The start of the range. (beginning of line)
|
|
;;; ELSE The else marker (beginning of line)
|
|
;;; Only valid if ELSE-P is true.
|
|
;;; END The end of the range. (beginning of line)
|
|
|
|
(defsubst hif-make-range (start end &optional else)
|
|
(list start else end))
|
|
|
|
(defsubst hif-range-start (range) (elt range 0))
|
|
(defsubst hif-range-else (range) (elt range 1))
|
|
(defsubst hif-range-end (range) (elt range 2))
|
|
|
|
|
|
|
|
;;; Find-Range
|
|
;;; The workhorse, it delimits the #if region. Reasonably simple:
|
|
;;; Skip until an #else or #endif is found, remembering positions. If
|
|
;;; an #else was found, skip some more, looking for the true #endif.
|
|
|
|
(defun hif-find-range ()
|
|
"Return a Range structure describing the current #if region.
|
|
Point is left unchanged."
|
|
;; (message "hif-find-range at %d" (point))
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(let ((start (point))
|
|
(else nil)
|
|
(end nil))
|
|
;; Part one. Look for either #endif or #else.
|
|
;; This loop-and-a-half dedicated to E. Dijkstra.
|
|
(while (progn
|
|
(hif-find-next-relevant)
|
|
(hif-looking-at-ifX)) ; Skip nested ifdef
|
|
(hif-ifdef-to-endif))
|
|
;; Found either a #else or an #endif.
|
|
(cond ((hif-looking-at-else)
|
|
(setq else (point)))
|
|
(t
|
|
(setq end (point)))) ; (save-excursion (end-of-line) (point))
|
|
;; If found #else, look for #endif.
|
|
(when else
|
|
(while (progn
|
|
(hif-find-next-relevant)
|
|
(hif-looking-at-ifX)) ; Skip nested ifdef
|
|
(hif-ifdef-to-endif))
|
|
(if (hif-looking-at-else)
|
|
(error "Found two elses in a row? Broken!"))
|
|
(setq end (point))) ; (save-excursion (end-of-line) (point))
|
|
(hif-make-range start end else))))
|
|
|
|
|
|
;;; A bit slimy.
|
|
|
|
(defun hif-hide-line (point)
|
|
"Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil."
|
|
(when hide-ifdef-lines
|
|
(save-excursion
|
|
(goto-char point)
|
|
(hide-ifdef-region-internal
|
|
(line-beginning-position) (progn (hif-end-of-line) (point))))))
|
|
|
|
|
|
;;; Hif-Possibly-Hide
|
|
;;; There are four cases. The #ifX expression is "taken" if it
|
|
;;; the hide-ifdef-evaluator returns T. Presumably, this means the code
|
|
;;; inside the #ifdef would be included when the program was
|
|
;;; compiled.
|
|
;;;
|
|
;;; Case 1: #ifX taken, and there's an #else.
|
|
;;; The #else part must be hidden. The #if (then) part must be
|
|
;;; processed for nested #ifX's.
|
|
;;; Case 2: #ifX taken, and there's no #else.
|
|
;;; The #if part must be processed for nested #ifX's.
|
|
;;; Case 3: #ifX not taken, and there's an #else.
|
|
;;; The #if part must be hidden. The #else part must be processed
|
|
;;; for nested #ifs.
|
|
;;; Case 4: #ifX not taken, and there's no #else.
|
|
;;; The #ifX part must be hidden.
|
|
;;;
|
|
;;; Further processing is done by narrowing to the relevant region
|
|
;;; and just recursively calling hide-ifdef-guts.
|
|
;;;
|
|
;;; When hif-possibly-hide returns, point is at the end of the
|
|
;;; possibly-hidden range.
|
|
|
|
(defun hif-recurse-on (start end)
|
|
"Call `hide-ifdef-guts' after narrowing to end of START line and END line."
|
|
(save-excursion
|
|
(save-restriction
|
|
(goto-char start)
|
|
(end-of-line)
|
|
(narrow-to-region (point) end)
|
|
(hide-ifdef-guts))))
|
|
|
|
(defun hif-possibly-hide ()
|
|
"Called at #ifX expression, this hides those parts that should be hidden.
|
|
It uses the judgement of `hide-ifdef-evaluator'."
|
|
;; (message "hif-possibly-hide") (sit-for 1)
|
|
(let ((test (hif-canonicalize))
|
|
(range (hif-find-range)))
|
|
;; (message "test = %s" test) (sit-for 1)
|
|
|
|
(hif-hide-line (hif-range-end range))
|
|
(if (not (hif-not (funcall hide-ifdef-evaluator test)))
|
|
(cond ((hif-range-else range) ; case 1
|
|
(hif-hide-line (hif-range-else range))
|
|
(hide-ifdef-region (hif-range-else range)
|
|
(1- (hif-range-end range)))
|
|
(hif-recurse-on (hif-range-start range)
|
|
(hif-range-else range)))
|
|
(t ; case 2
|
|
(hif-recurse-on (hif-range-start range)
|
|
(hif-range-end range))))
|
|
(cond ((hif-range-else range) ; case 3
|
|
(hif-hide-line (hif-range-else range))
|
|
(hide-ifdef-region (hif-range-start range)
|
|
(1- (hif-range-else range)))
|
|
(hif-recurse-on (hif-range-else range)
|
|
(hif-range-end range)))
|
|
(t ; case 4
|
|
(hide-ifdef-region (point)
|
|
(1- (hif-range-end range))))))
|
|
(hif-hide-line (hif-range-start range)) ; Always hide start.
|
|
(goto-char (hif-range-end range))
|
|
(end-of-line)))
|
|
|
|
|
|
|
|
(defun hide-ifdef-guts ()
|
|
"Does most of the work of `hide-ifdefs'.
|
|
It does not do the work that's pointless to redo on a recursive entry."
|
|
;; (message "hide-ifdef-guts")
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(while (hif-find-any-ifX)
|
|
(hif-possibly-hide))))
|
|
|
|
;;===%%SF%% hide-ifdef-hiding (End) ===
|
|
|
|
|
|
;;===%%SF%% exports (Start) ===
|
|
|
|
(defun hide-ifdef-toggle-read-only ()
|
|
"Toggle `hide-ifdef-read-only'."
|
|
(interactive)
|
|
(setq hide-ifdef-read-only (not hide-ifdef-read-only))
|
|
(message "Hide-Read-Only %s"
|
|
(if hide-ifdef-read-only "ON" "OFF"))
|
|
(if hide-ifdef-hiding
|
|
(setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
|
|
(force-mode-line-update))
|
|
|
|
(defun hide-ifdef-toggle-outside-read-only ()
|
|
"Replacement for `toggle-read-only' within Hide-Ifdef mode."
|
|
(interactive)
|
|
(setq hif-outside-read-only (not hif-outside-read-only))
|
|
(message "Read only %s"
|
|
(if hif-outside-read-only "ON" "OFF"))
|
|
(setq buffer-read-only
|
|
(or (and hide-ifdef-hiding hide-ifdef-read-only)
|
|
hif-outside-read-only))
|
|
(force-mode-line-update))
|
|
|
|
(defun hide-ifdef-toggle-shadowing ()
|
|
"Toggle shadowing."
|
|
(interactive)
|
|
(set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow))
|
|
(message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF"))
|
|
(save-restriction
|
|
(widen)
|
|
(dolist (overlay (overlays-in (point-min) (point-max)))
|
|
(when (overlay-get overlay 'hide-ifdef)
|
|
(if hide-ifdef-shadow
|
|
(progn
|
|
(overlay-put overlay 'invisible nil)
|
|
(overlay-put overlay 'face 'hide-ifdef-shadow))
|
|
(overlay-put overlay 'face nil)
|
|
(overlay-put overlay 'invisible 'hide-ifdef))))))
|
|
|
|
(defun hide-ifdef-define (var)
|
|
"Define a VAR so that #ifdef VAR would be included."
|
|
(interactive "SDefine what? ")
|
|
(hif-set-var var 1)
|
|
(if hide-ifdef-hiding (hide-ifdefs)))
|
|
|
|
(defun hide-ifdef-undef (var)
|
|
"Undefine a VAR so that #ifdef VAR would not be included."
|
|
(interactive "SUndefine what? ")
|
|
(hif-set-var var nil)
|
|
(if hide-ifdef-hiding (hide-ifdefs)))
|
|
|
|
|
|
(defun hide-ifdefs (&optional nomsg)
|
|
"Hide the contents of some #ifdefs.
|
|
Assume that defined symbols have been added to `hide-ifdef-env'.
|
|
The text hidden is the text that would not be included by the C
|
|
preprocessor if it were given the file with those symbols defined.
|
|
|
|
Turn off hiding by calling `show-ifdefs'."
|
|
|
|
(interactive)
|
|
(message "Hiding...")
|
|
(setq hif-outside-read-only buffer-read-only)
|
|
(unless hide-ifdef-mode (hide-ifdef-mode 1)) ; turn on hide-ifdef-mode
|
|
(if hide-ifdef-hiding
|
|
(show-ifdefs)) ; Otherwise, deep confusion.
|
|
(setq hide-ifdef-hiding t)
|
|
(hide-ifdef-guts)
|
|
(setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
|
|
(or nomsg
|
|
(message "Hiding done")))
|
|
|
|
|
|
(defun show-ifdefs ()
|
|
"Cancel the effects of `hide-ifdef': show the contents of all #ifdefs."
|
|
(interactive)
|
|
(setq buffer-read-only hif-outside-read-only)
|
|
(hif-show-all)
|
|
(setq hide-ifdef-hiding nil))
|
|
|
|
|
|
(defun hif-find-ifdef-block ()
|
|
"Utility for hide and show `ifdef-block'.
|
|
Return as (TOP . BOTTOM) the extent of ifdef block."
|
|
(let (max-bottom)
|
|
(cons (save-excursion
|
|
(beginning-of-line)
|
|
(unless (or (hif-looking-at-else) (hif-looking-at-ifX))
|
|
(up-ifdef))
|
|
(prog1 (point)
|
|
(hif-ifdef-to-endif)
|
|
(setq max-bottom (1- (point)))))
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(unless (hif-looking-at-endif)
|
|
(hif-find-next-relevant))
|
|
(while (hif-looking-at-ifX)
|
|
(hif-ifdef-to-endif)
|
|
(hif-find-next-relevant))
|
|
(min max-bottom (1- (point)))))))
|
|
|
|
|
|
(defun hide-ifdef-block ()
|
|
"Hide the ifdef block (true or false part) enclosing or before the cursor."
|
|
(interactive)
|
|
(unless hide-ifdef-mode (hide-ifdef-mode 1))
|
|
(let ((top-bottom (hif-find-ifdef-block)))
|
|
(hide-ifdef-region (car top-bottom) (cdr top-bottom))
|
|
(when hide-ifdef-lines
|
|
(hif-hide-line (car top-bottom))
|
|
(hif-hide-line (1+ (cdr top-bottom))))
|
|
(setq hide-ifdef-hiding t))
|
|
(setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
|
|
|
|
(defun show-ifdef-block ()
|
|
"Show the ifdef block (true or false part) enclosing or before the cursor."
|
|
(interactive)
|
|
(let ((top-bottom (hif-find-ifdef-block)))
|
|
(if hide-ifdef-lines
|
|
(hif-show-ifdef-region
|
|
(save-excursion
|
|
(goto-char (car top-bottom)) (line-beginning-position))
|
|
(save-excursion
|
|
(goto-char (1+ (cdr top-bottom)))
|
|
(hif-end-of-line) (point)))
|
|
(hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom)))))
|
|
|
|
|
|
;;; definition alist support
|
|
|
|
(defvar hide-ifdef-define-alist nil
|
|
"A global assoc list of pre-defined symbol lists.")
|
|
|
|
(defun hif-compress-define-list (env)
|
|
"Compress the define list ENV into a list of defined symbols only."
|
|
(let ((new-defs nil))
|
|
(dolist (def env new-defs)
|
|
(if (hif-lookup (car def)) (push (car env) new-defs)))))
|
|
|
|
(defun hide-ifdef-set-define-alist (name)
|
|
"Set the association for NAME to `hide-ifdef-env'."
|
|
(interactive "SSet define list: ")
|
|
(push (cons name (hif-compress-define-list hide-ifdef-env))
|
|
hide-ifdef-define-alist))
|
|
|
|
(defun hide-ifdef-use-define-alist (name)
|
|
"Set `hide-ifdef-env' to the define list specified by NAME."
|
|
(interactive
|
|
(list (completing-read "Use define list: "
|
|
(mapcar (lambda (x) (symbol-name (car x)))
|
|
hide-ifdef-define-alist)
|
|
nil t)))
|
|
(if (stringp name) (setq name (intern name)))
|
|
(let ((define-list (assoc name hide-ifdef-define-alist)))
|
|
(if define-list
|
|
(setq hide-ifdef-env
|
|
(mapcar (lambda (arg) (cons arg t))
|
|
(cdr define-list)))
|
|
(error "No define list for %s" name))
|
|
(if hide-ifdef-hiding (hide-ifdefs))))
|
|
|
|
(provide 'hideif)
|
|
|
|
;; arch-tag: c6381d17-a59a-483a-b945-658f22277981
|
|
;;; hideif.el ends here
|