lisp/progmodes/hideif.el

   1 ;;; hideif.el --- hides selected code within ifdef
   2
   3 ;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
   4 ;;   2008, 2009, 2010, 2011  Free Software Foundation, Inc.
   5
   6 ;; Author: Brian Marick
   7 ;;      Daniel LaLiberte <liberte@holonexus.org>
   8 ;; Maintainer: FSF
   9 ;; Keywords: c, outlines
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; To initialize, toggle the hide-ifdef minor mode with
  29 ;;
  30 ;; M-x hide-ifdef-mode
  31 ;;
  32 ;; This will set up key bindings and call hide-ifdef-mode-hook if it
  33 ;; has a value.  To explicitly hide ifdefs using a buffer-local
  34 ;; define list (default empty), type
  35 ;;
  36 ;; M-x hide-ifdefs  or C-c @ h
  37 ;;
  38 ;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't
  39 ;; pass through.  The support of constant expressions in #if lines is
  40 ;; limited to identifiers, parens, and the operators: &&, ||, !, and
  41 ;; "defined".  Please extend this.
  42 ;;
  43 ;; The hidden code is marked by ellipses (...).  Be
  44 ;; cautious when editing near ellipses, since the hidden text is
  45 ;; still in the buffer, and you can move the point into it and modify
  46 ;; text unawares.
  47 ;; You can make your buffer read-only while hide-ifdef-hiding by setting
  48 ;; hide-ifdef-read-only to a non-nil value.  You can toggle this
  49 ;; variable with hide-ifdef-toggle-read-only (C-c @ C-q).
  50 ;;
  51 ;; You can undo the effect of hide-ifdefs by typing
  52 ;;
  53 ;; M-x show-ifdefs  or C-c @ s
  54 ;;
  55 ;; Use M-x hide-ifdef-define (C-c @ d) to define a symbol.
  56 ;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol.
  57 ;;
  58 ;; If you define or undefine a symbol while hide-ifdef-mode is in effect,
  59 ;; the display will be updated.  Only the define list for the current
  60 ;; buffer will be affected.  You can save changes to the local define
  61 ;; list with hide-ifdef-set-define-alist.  This adds entries
  62 ;; to hide-ifdef-define-alist.
  63 ;;
  64 ;; If you have defined a hide-ifdef-mode-hook, you can set
  65 ;; up a list of symbols that may be used by hide-ifdefs as in the
  66 ;; following example:
  67 ;;
  68 ;; (add-hook 'hide-ifdef-mode-hook
  69 ;;      (lambda ()
  70 ;;       (unless hide-ifdef-define-alist
  71 ;;         (setq hide-ifdef-define-alist
  72 ;;              '((list1 ONE TWO)
  73 ;;                (list2 TWO THREE))))
  74 ;;       (hide-ifdef-use-define-alist 'list2))) ; use list2 by default
  75 ;;
  76 ;; You can call hide-ifdef-use-define-alist (C-c @ U) at any time to specify
  77 ;; another list to use.
  78 ;;
  79 ;; To cause ifdefs to be hidden as soon as hide-ifdef-mode is called,
  80 ;; set hide-ifdef-initially to non-nil.
  81 ;;
  82 ;; If you set hide-ifdef-lines to t, hide-ifdefs hides all the #ifdef lines.
  83 ;; In the absence of highlighting, that might be a bad idea.  If you set
  84 ;; hide-ifdef-lines to nil (the default), the surrounding preprocessor
  85 ;; lines will be displayed.  That can be confusing in its own
  86 ;; right.  Other variations on display are possible, but not much
  87 ;; better.
  88 ;;
  89 ;; You can explicitly hide or show individual ifdef blocks irrespective
  90 ;; of the define list by using hide-ifdef-block and show-ifdef-block.
  91 ;;
  92 ;; You can move the point between ifdefs with forward-ifdef, backward-ifdef,
  93 ;; up-ifdef, down-ifdef, next-ifdef, and previous-ifdef.
  94 ;;
  95 ;; If you have minor-mode-alist in your mode line (the default) two labels
  96 ;; may appear.  "Ifdef" will appear when hide-ifdef-mode is active.  "Hiding"
  97 ;; will appear when text may be hidden ("hide-ifdef-hiding" is non-nil).
  98 ;;
  99 ;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL.
 100 ;; Extensively modified by Daniel LaLiberte (while at Gould).
 101
 102 ;;; Code:
 103
 104 (require 'cc-mode)
 105
 106 (defgroup hide-ifdef nil
 107   "Hide selected code within `ifdef'."
 108   :group 'c)
 109
 110 (defcustom hide-ifdef-initially nil
 111   "Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
 112   :type 'boolean
 113   :group 'hide-ifdef)
 114
 115 (defcustom hide-ifdef-read-only nil
 116   "Set to non-nil if you want buffer to be read-only while hiding text."
 117   :type 'boolean
 118   :group 'hide-ifdef)
 119
 120 (defcustom hide-ifdef-lines nil
 121   "Non-nil means hide the #ifX, #else, and #endif lines."
 122   :type 'boolean
 123   :group 'hide-ifdef)
 124
 125 (defcustom hide-ifdef-shadow nil
 126   "Non-nil means shadow text instead of hiding it."
 127   :type 'boolean
 128   :group 'hide-ifdef
 129   :version "23.1")
 130
 131 (defface hide-ifdef-shadow '((t (:inherit shadow)))
 132   "Face for shadowing ifdef blocks."
 133   :group 'hide-ifdef
 134   :version "23.1")
 135
 136
 137 (defvar hide-ifdef-mode-submap
 138   ;; Set up the submap that goes after the prefix key.
 139   (let ((map (make-sparse-keymap)))
 140     (define-key map "d" 'hide-ifdef-define)
 141     (define-key map "u" 'hide-ifdef-undef)
 142     (define-key map "D" 'hide-ifdef-set-define-alist)
 143     (define-key map "U" 'hide-ifdef-use-define-alist)
 144
 145     (define-key map "h" 'hide-ifdefs)
 146     (define-key map "s" 'show-ifdefs)
 147     (define-key map "\C-d" 'hide-ifdef-block)
 148     (define-key map "\C-s" 'show-ifdef-block)
 149
 150     (define-key map "\C-q" 'hide-ifdef-toggle-read-only)
 151     (define-key map "\C-w" 'hide-ifdef-toggle-shadowing)
 152     (substitute-key-definition
 153      'toggle-read-only 'hide-ifdef-toggle-outside-read-only map)
 154     map)
 155   "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
 156
 157 (defconst hide-ifdef-mode-prefix-key "\C-c@"
 158   "Prefix key for all Hide-Ifdef mode commands.")
 159
 160 (defvar hide-ifdef-mode-map
 161   ;; Set up the mode's main map, which leads via the prefix key to the submap.
 162   (let ((map (make-sparse-keymap)))
 163     (define-key map hide-ifdef-mode-prefix-key hide-ifdef-mode-submap)
 164     map)
 165   "Keymap used with `hide-ifdef-mode'.")
 166
 167 (easy-menu-define hide-ifdef-mode-menu hide-ifdef-mode-map
 168   "Menu for `hide-ifdef-mode'."
 169   '("Hide-Ifdef"
 170     ["Hide some ifdefs" hide-ifdefs
 171      :help "Hide the contents of some #ifdefs"]
 172     ["Show all ifdefs" show-ifdefs
 173      :help "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs"]
 174     ["Hide ifdef block" hide-ifdef-block
 175      :help "Hide the ifdef block (true or false part) enclosing or before the cursor"]
 176     ["Show ifdef block" show-ifdef-block
 177      :help "Show the ifdef block (true or false part) enclosing or before the cursor"]
 178     ["Define a variable..." hide-ifdef-define
 179      :help "Define a VAR so that #ifdef VAR would be included"]
 180     ["Undefine a variable..." hide-ifdef-undef
 181      :help "Undefine a VAR so that #ifdef VAR would not be included"]
 182     ["Define an alist..." hide-ifdef-set-define-alist
 183      :help "Set the association for NAME to `hide-ifdef-env'"]
 184     ["Use an alist..." hide-ifdef-use-define-alist
 185      :help "Set `hide-ifdef-env' to the define list specified by NAME"]
 186     ["Toggle read only" hide-ifdef-toggle-read-only
 187      :style toggle :selected hide-ifdef-read-only
 188      :help "Buffer should be read-only while hiding text"]
 189     ["Toggle shadowing" hide-ifdef-toggle-shadowing
 190      :style toggle :selected hide-ifdef-shadow
 191      :help "Text should be shadowed instead of hidden"]))
 192
 193 (defvar hide-ifdef-hiding nil
 194   "Non-nil when text may be hidden.")
 195
 196 (or (assq 'hide-ifdef-hiding minor-mode-alist)
 197     (setq minor-mode-alist
 198           (cons '(hide-ifdef-hiding " Hiding")
 199                 minor-mode-alist)))
 200
 201 ;; fix c-mode syntax table so we can recognize whole symbols.
 202 (defvar hide-ifdef-syntax-table
 203   (let ((st (copy-syntax-table c-mode-syntax-table)))
 204     (modify-syntax-entry ?_ "w" st)
 205     (modify-syntax-entry ?& "." st)
 206     (modify-syntax-entry ?\| "." st)
 207     st)
 208   "Syntax table used for tokenizing #if expressions.")
 209
 210 (defvar hide-ifdef-env nil
 211   "An alist of defined symbols and their values.")
 212
 213 (defvar hif-outside-read-only nil
 214   "Internal variable.  Saves the value of `buffer-read-only' while hiding.")
 215
 216 ;;;###autoload
 217 (define-minor-mode hide-ifdef-mode
 218   "Toggle Hide-Ifdef mode.  This is a minor mode, albeit a large one.
 219 With ARG, turn Hide-Ifdef mode on if arg is positive, off otherwise.
 220 In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor
 221 would eliminate may be hidden from view.  Several variables affect
 222 how the hiding is done:
 223
 224 `hide-ifdef-env'
 225         An association list of defined and undefined symbols for the
 226         current buffer.  Initially, the global value of `hide-ifdef-env'
 227         is used.
 228
 229 `hide-ifdef-define-alist'
 230         An association list of defined symbol lists.
 231         Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env'
 232         and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env'
 233         from one of the lists in `hide-ifdef-define-alist'.
 234
 235 `hide-ifdef-lines'
 236         Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
 237         #endif lines when hiding.
 238
 239 `hide-ifdef-initially'
 240         Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
 241         is activated.
 242
 243 `hide-ifdef-read-only'
 244         Set to non-nil if you want to make buffers read only while hiding.
 245         After `show-ifdefs', read-only status is restored to previous value.
 246
 247 \\{hide-ifdef-mode-map}"
 248   :group 'hide-ifdef :lighter " Ifdef"
 249   (if hide-ifdef-mode
 250       (progn
 251         ;; inherit global values
 252         (set (make-local-variable 'hide-ifdef-env)
 253              (default-value 'hide-ifdef-env))
 254         (set (make-local-variable 'hide-ifdef-hiding)
 255              (default-value 'hide-ifdef-hiding))
 256         (set (make-local-variable 'hif-outside-read-only) buffer-read-only)
 257         (set (make-local-variable 'line-move-ignore-invisible) t)
 258         (add-hook 'change-major-mode-hook
 259                   (lambda () (hide-ifdef-mode -1)) nil t)
 260
 261         (add-to-invisibility-spec '(hide-ifdef . t))
 262
 263         (if hide-ifdef-initially
 264             (hide-ifdefs)
 265           (show-ifdefs)))
 266     ;; else end hide-ifdef-mode
 267     (kill-local-variable 'line-move-ignore-invisible)
 268     (remove-from-invisibility-spec '(hide-ifdef . t))
 269     (when hide-ifdef-hiding
 270       (show-ifdefs))))
 271
 272
 273 (defun hif-show-all ()
 274   "Show all of the text in the current buffer."
 275   (interactive)
 276   (hif-show-ifdef-region (point-min) (point-max)))
 277
 278 ;; By putting this on after-revert-hook, we arrange that it only
 279 ;; does anything when revert-buffer avoids turning off the mode.
 280 ;; (That can happen in VC.)
 281 (defun hif-after-revert-function ()
 282   (and hide-ifdef-mode hide-ifdef-hiding
 283        (hide-ifdefs t)))
 284 (add-hook 'after-revert-hook 'hif-after-revert-function)
 285
 286 (defun hif-end-of-line ()
 287   (end-of-line)
 288   (while (= (logand 1 (skip-chars-backward "\\\\")) 1)
 289     (end-of-line 2)))
 290
 291 (defun hide-ifdef-region-internal (start end)
 292   (remove-overlays start end 'hide-ifdef t)
 293   (let ((o (make-overlay start end)))
 294     (overlay-put o 'hide-ifdef t)
 295     (if hide-ifdef-shadow
 296         (overlay-put o 'face 'hide-ifdef-shadow)
 297       (overlay-put o 'invisible 'hide-ifdef))))
 298
 299 (defun hide-ifdef-region (start end)
 300   "START is the start of a #if or #else form.  END is the ending part.
 301 Everything including these lines is made invisible."
 302   (save-excursion
 303     (goto-char start) (hif-end-of-line) (setq start (point))
 304     (goto-char end) (hif-end-of-line) (setq end (point))
 305     (hide-ifdef-region-internal start end)))
 306
 307 (defun hif-show-ifdef-region (start end)
 308   "Everything between START and END is made visible."
 309   (remove-overlays start end 'hide-ifdef t))
 310
 311
 312 ;;===%%SF%% evaluation (Start)  ===
 313
 314 ;; It is not useful to set this to anything but `eval'.
 315 ;; In fact, the variable might as well be eliminated.
 316 (defvar hide-ifdef-evaluator 'eval
 317   "The function to use to evaluate a form.
 318 The evaluator is given a canonical form and returns t if text under
 319 that form should be displayed.")
 320
 321 (defvar hif-undefined-symbol nil
 322   "...is by default considered to be false.")
 323
 324
 325 (defun hif-set-var (var value)
 326   "Prepend (var value) pair to hide-ifdef-env."
 327   (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
 328
 329
 330 (defun hif-lookup (var)
 331   ;; (message "hif-lookup %s" var)
 332   (let ((val (assoc var hide-ifdef-env)))
 333     (if val
 334         (cdr val)
 335       hif-undefined-symbol)))
 336
 337 (defun hif-defined (var)
 338    (if (assoc var hide-ifdef-env) 1 0))
 339
 340 ;;===%%SF%% evaluation (End)  ===
 341
 342
 343
 344 ;;===%%SF%% parsing (Start)  ===
 345 ;;;  The code that understands what ifs and ifdef in files look like.
 346
 347 (defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
 348 (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
 349 (defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
 350 (defconst hif-else-regexp (concat hif-cpp-prefix "else"))
 351 (defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
 352 (defconst hif-ifx-else-endif-regexp
 353   (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp))
 354
 355 ;; Used to store the current token and the whole token list during parsing.
 356 ;; Only bound dynamically.
 357 (defvar hif-token)
 358 (defvar hif-token-list)
 359
 360 (defconst hif-token-alist
 361   '(("||" . or)
 362     ("&&" . and)
 363     ("|"  . hif-logior)
 364     ("&"  . hif-logand)
 365     ("==" . equal)
 366     ("!=" . hif-notequal)
 367     ("!"  . not)
 368     ("("  . lparen)
 369     (")"  . rparen)
 370     (">"  . hif-greater)
 371     ("<"  . hif-less)
 372     (">=" . hif-greater-equal)
 373     ("<=" . hif-less-equal)
 374     ("+"  . hif-plus)
 375     ("-"  . hif-minus)
 376     ("?"  . hif-conditional)
 377     (":"  . hif-colon)))
 378
 379 (defconst hif-token-regexp
 380   (concat (regexp-opt (mapcar 'car hif-token-alist)) "\\|\\w+"))
 381
 382 (defun hif-tokenize (start end)
 383   "Separate string between START and END into a list of tokens."
 384   (let ((token-list nil))
 385     (with-syntax-table hide-ifdef-syntax-table
 386       (save-excursion
 387         (goto-char start)
 388         (while (progn (forward-comment (point-max)) (< (point) end))
 389           ;; (message "expr-start = %d" expr-start) (sit-for 1)
 390           (cond
 391            ((looking-at "\\\\\n")
 392             (forward-char 2))
 393
 394            ((looking-at hif-token-regexp)
 395             (let ((token (buffer-substring (point) (match-end 0))))
 396               (goto-char (match-end 0))
 397               ;; (message "token: %s" token) (sit-for 1)
 398               (push (or (cdr (assoc token hif-token-alist))
 399                         (if (string-equal token "defined") 'hif-defined)
 400                         (if (string-match "\\`[0-9]*\\'" token)
 401                             (string-to-number token))
 402                         (intern token))
 403                     token-list)))
 404            (t (error "Bad #if expression: %s" (buffer-string)))))))
 405     (nreverse token-list)))
 406
 407 ;;;-----------------------------------------------------------------
 408 ;;; Translate C preprocessor #if expressions using recursive descent.
 409 ;;; This parser is limited to the operators &&, ||, !, and "defined".
 410 ;;; Added ==, !=, +, and -.  Gary Oberbrunner, garyo@avs.com, 8/9/94
 411
 412 (defsubst hif-nexttoken ()
 413   "Pop the next token from token-list into the let variable \"hif-token\"."
 414   (setq hif-token (pop hif-token-list)))
 415
 416 (defun hif-parse-if-exp (hif-token-list)
 417   "Parse the TOKEN-LIST.  Return translated list in prefix form."
 418   (hif-nexttoken)
 419   (prog1
 420       (hif-expr)
 421     (if hif-token ; is there still a token?
 422         (error "Error: unexpected token: %s" hif-token))))
 423
 424 (defun hif-expr ()
 425   "Parse an expression as found in #if.
 426        expr : or-expr | or-expr '?' expr ':' expr."
 427   (let ((result (hif-or-expr))
 428         middle)
 429     (while (eq hif-token 'hif-conditional)
 430       (hif-nexttoken)
 431       (setq middle (hif-expr))
 432       (if (eq hif-token 'hif-colon)
 433           (progn
 434             (hif-nexttoken)
 435             (setq result (list 'hif-conditional result middle (hif-expr))))
 436         (error "Error: unexpected token: %s" hif-token)))
 437     result))
 438
 439 (defun hif-or-expr ()
 440   "Parse n or-expr : and-expr | or-expr '||' and-expr."
 441   (let ((result (hif-and-expr)))
 442     (while (eq hif-token 'or)
 443       (hif-nexttoken)
 444       (setq result (list 'hif-or result (hif-and-expr))))
 445   result))
 446
 447 (defun hif-and-expr ()
 448   "Parse an and-expr : eq-expr | and-expr '&&' eq-expr."
 449   (let ((result (hif-eq-expr)))
 450     (while (eq hif-token 'and)
 451       (hif-nexttoken)
 452       (setq result (list 'hif-and result (hif-eq-expr))))
 453     result))
 454
 455 (defun hif-eq-expr ()
 456   "Parse an eq-expr : math | eq-expr `=='|`!='|`<'|`>'|`>='|`<=' math."
 457   (let ((result (hif-math))
 458         (eq-token nil))
 459     (while (memq hif-token '(equal hif-notequal hif-greater hif-less
 460                              hif-greater-equal hif-less-equal))
 461       (setq eq-token hif-token)
 462       (hif-nexttoken)
 463       (setq result (list eq-token result (hif-math))))
 464     result))
 465
 466 (defun hif-math ()
 467   "Parse an expression with + or - and simpler things.
 468        math : factor | math '+|-' factor."
 469   (let ((result (hif-factor))
 470         (math-op nil))
 471     (while (memq hif-token '(hif-plus hif-minus hif-logior hif-logand))
 472       (setq math-op hif-token)
 473       (hif-nexttoken)
 474       (setq result (list math-op result (hif-factor))))
 475   result))
 476
 477 (defun hif-factor ()
 478   "Parse a factor: '!' factor | '(' expr ')' | 'defined(' id ')' | id."
 479   (cond
 480    ((eq hif-token 'not)
 481     (hif-nexttoken)
 482     (list 'hif-not (hif-factor)))
 483
 484    ((eq hif-token 'lparen)
 485     (hif-nexttoken)
 486     (let ((result (hif-expr)))
 487       (if (not (eq hif-token 'rparen))
 488           (error "Bad token in parenthesized expression: %s" hif-token)
 489         (hif-nexttoken)
 490         result)))
 491
 492    ((eq hif-token 'hif-defined)
 493     (hif-nexttoken)
 494     (let ((paren (when (eq hif-token 'lparen) (hif-nexttoken) t))
 495           (ident hif-token))
 496       (if (memq hif-token '(or and not hif-defined lparen rparen))
 497           (error "Error: unexpected token: %s" hif-token))
 498       (when paren
 499         (hif-nexttoken)
 500         (unless (eq hif-token 'rparen)
 501           (error "Error: expected \")\" after identifier")))
 502       (hif-nexttoken)
 503       `(hif-defined (quote ,ident))))
 504
 505    ((numberp hif-token)
 506     (prog1 hif-token (hif-nexttoken)))
 507
 508    ;; Unary plus/minus.
 509    ((memq hif-token '(hif-minus hif-plus))
 510     (list (prog1 hif-token (hif-nexttoken)) 0 (hif-factor)))
 511
 512    (t                                   ; identifier
 513     (let ((ident hif-token))
 514       (if (memq ident '(or and))
 515           (error "Error: missing identifier"))
 516       (hif-nexttoken)
 517       `(hif-lookup (quote ,ident))))))
 518
 519 (defun hif-mathify (val)
 520   "Treat VAL as a number: if it's t or nil, use 1 or 0."
 521   (cond ((eq val t) 1)
 522         ((null val) 0)
 523         (t val)))
 524
 525 (defun hif-conditional (a b c)
 526   (if (not (zerop (hif-mathify a))) (hif-mathify b) (hif-mathify c)))
 527 (defun hif-and (a b)
 528   (and (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b)))))
 529 (defun hif-or (a b)
 530   (or (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b)))))
 531 (defun hif-not (a)
 532   (zerop (hif-mathify a)))
 533
 534 (defmacro hif-mathify-binop (fun)
 535   `(lambda (a b)
 536      ,(format "Like `%s' but treat t and nil as 1 and 0." fun)
 537      (,fun (hif-mathify a) (hif-mathify b))))
 538
 539 (defalias 'hif-plus          (hif-mathify-binop +))
 540 (defalias 'hif-minus         (hif-mathify-binop -))
 541 (defalias 'hif-notequal      (hif-mathify-binop /=))
 542 (defalias 'hif-greater       (hif-mathify-binop >))
 543 (defalias 'hif-less          (hif-mathify-binop <))
 544 (defalias 'hif-greater-equal (hif-mathify-binop >=))
 545 (defalias 'hif-less-equal    (hif-mathify-binop <=))
 546 (defalias 'hif-logior        (hif-mathify-binop logior))
 547 (defalias 'hif-logand        (hif-mathify-binop logand))
 548
 549 ;;;----------- end of parser -----------------------
 550
 551
 552 (defun hif-canonicalize ()
 553   "When at beginning of #ifX, return a Lisp expression for its condition."
 554   (save-excursion
 555     (let ((negate (looking-at hif-ifndef-regexp)))
 556       (re-search-forward hif-ifx-regexp)
 557       (let* ((tokens (hif-tokenize (point)
 558                                    (progn (hif-end-of-line) (point))))
 559              (expr (hif-parse-if-exp tokens)))
 560         ;; (message "hif-canonicalized: %s" expr)
 561         (if negate
 562             (list 'hif-not expr)
 563           expr)))))
 564
 565
 566 (defun hif-find-any-ifX ()
 567   "Move to next #if..., or #ifndef, at point or after."
 568   ;; (message "find ifX at %d" (point))
 569   (prog1
 570       (re-search-forward hif-ifx-regexp (point-max) t)
 571     (beginning-of-line)))
 572
 573
 574 (defun hif-find-next-relevant ()
 575   "Move to next #if..., #else, or #endif, after the current line."
 576   ;; (message "hif-find-next-relevant at %d" (point))
 577   (end-of-line)
 578   ;; avoid infinite recursion by only going to beginning of line if match found
 579   (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t)
 580       (beginning-of-line)))
 581
 582 (defun hif-find-previous-relevant ()
 583   "Move to previous #if..., #else, or #endif, before the current line."
 584   ;; (message "hif-find-previous-relevant at %d" (point))
 585   (beginning-of-line)
 586   ;; avoid infinite recursion by only going to beginning of line if match found
 587   (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t)
 588      (beginning-of-line)))
 589
 590
 591 (defun hif-looking-at-ifX ()            ;; Should eventually see #if
 592   (looking-at hif-ifx-regexp))
 593 (defun hif-looking-at-endif ()
 594   (looking-at hif-endif-regexp))
 595 (defun hif-looking-at-else ()
 596   (looking-at hif-else-regexp))
 597
 598
 599
 600 (defun hif-ifdef-to-endif ()
 601   "If positioned at #ifX or #else form, skip to corresponding #endif."
 602   ;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1)
 603   (hif-find-next-relevant)
 604   (cond ((hif-looking-at-ifX)
 605          (hif-ifdef-to-endif) ; find endif of nested if
 606          (hif-ifdef-to-endif)) ; find outer endif or else
 607         ((hif-looking-at-else)
 608          (hif-ifdef-to-endif)) ; find endif following else
 609         ((hif-looking-at-endif)
 610          'done)
 611         (t
 612          (error "Mismatched #ifdef #endif pair"))))
 613
 614
 615 (defun hif-endif-to-ifdef ()
 616   "If positioned at #endif form, skip backward to corresponding #ifX."
 617   ;; (message "hif-endif-to-ifdef at %d" (point))
 618   (let ((start (point)))
 619     (hif-find-previous-relevant)
 620     (if (= start (point))
 621         (error "Mismatched #ifdef #endif pair")))
 622   (cond ((hif-looking-at-endif)
 623          (hif-endif-to-ifdef) ; find beginning of nested if
 624          (hif-endif-to-ifdef)) ; find beginning of outer if or else
 625         ((hif-looking-at-else)
 626          (hif-endif-to-ifdef))
 627         ((hif-looking-at-ifX)
 628          'done)
 629         (t)))                   ; never gets here
 630
 631
 632 (defun forward-ifdef (&optional arg)
 633   "Move point to beginning of line of the next ifdef-endif.
 634 With argument, do this that many times."
 635   (interactive "p")
 636   (or arg (setq arg 1))
 637   (if (< arg 0) (backward-ifdef (- arg))
 638     (while (< 0 arg)
 639       (setq arg (- arg))
 640       (let ((start (point)))
 641         (unless (hif-looking-at-ifX)
 642           (hif-find-next-relevant))
 643         (if (hif-looking-at-ifX)
 644             (hif-ifdef-to-endif)
 645           (goto-char start)
 646           (error "No following #ifdef"))))))
 647
 648
 649 (defun backward-ifdef (&optional arg)
 650   "Move point to beginning of the previous ifdef-endif.
 651 With argument, do this that many times."
 652   (interactive "p")
 653   (or arg (setq arg 1))
 654   (if (< arg 0) (forward-ifdef (- arg))
 655     (while (< 0 arg)
 656       (setq arg (1- arg))
 657       (beginning-of-line)
 658       (let ((start (point)))
 659         (unless (hif-looking-at-endif)
 660           (hif-find-previous-relevant))
 661         (if (hif-looking-at-endif)
 662             (hif-endif-to-ifdef)
 663           (goto-char start)
 664           (error "No previous #ifdef"))))))
 665
 666
 667 (defun down-ifdef ()
 668   "Move point to beginning of nested ifdef or else-part."
 669     (interactive)
 670     (let ((start (point)))
 671       (hif-find-next-relevant)
 672       (if (or (hif-looking-at-ifX) (hif-looking-at-else))
 673           ()
 674         (goto-char start)
 675         (error "No following #ifdef"))))
 676
 677
 678 (defun up-ifdef ()
 679   "Move point to beginning of enclosing ifdef or else-part."
 680   (interactive)
 681   (beginning-of-line)
 682   (let ((start (point)))
 683     (unless (hif-looking-at-endif)
 684       (hif-find-previous-relevant))
 685     (if (hif-looking-at-endif)
 686         (hif-endif-to-ifdef))
 687       (if (= start (point))
 688           (error "No previous #ifdef"))))
 689
 690 (defun next-ifdef (&optional arg)
 691   "Move to the beginning of the next #ifX, #else, or #endif.
 692 With argument, do this that many times."
 693   (interactive "p")
 694   (or arg (setq arg 1))
 695   (if (< arg 0) (previous-ifdef (- arg))
 696     (while (< 0 arg)
 697       (setq arg (1- arg))
 698       (hif-find-next-relevant)
 699       (when (eolp)
 700         (beginning-of-line)
 701         (error "No following #ifdefs, #elses, or #endifs")))))
 702
 703 (defun previous-ifdef (&optional arg)
 704   "Move to the beginning of the previous #ifX, #else, or #endif.
 705 With argument, do this that many times."
 706   (interactive "p")
 707   (or arg (setq arg 1))
 708   (if (< arg 0) (next-ifdef (- arg))
 709     (while (< 0 arg)
 710       (setq arg (1- arg))
 711       (let ((start (point)))
 712         (hif-find-previous-relevant)
 713         (if (= start (point))
 714             (error "No previous #ifdefs, #elses, or #endifs"))))))
 715
 716
 717 ;;===%%SF%% parsing (End)  ===
 718
 719
 720 ;;===%%SF%% hide-ifdef-hiding (Start)  ===
 721
 722
 723 ;;; A range is a structure with four components:
 724 ;;; ELSE-P      True if there was an else clause for the ifdef.
 725 ;;; START       The start of the range. (beginning of line)
 726 ;;; ELSE        The else marker (beginning of line)
 727 ;;;                     Only valid if ELSE-P is true.
 728 ;;; END         The end of the range.  (beginning of line)
 729
 730 (defsubst hif-make-range (start end &optional else)
 731   (list start else end))
 732
 733 (defsubst hif-range-start (range) (elt range 0))
 734 (defsubst hif-range-else (range) (elt range 1))
 735 (defsubst hif-range-end (range) (elt range 2))
 736
 737
 738
 739 ;;; Find-Range
 740 ;;; The workhorse, it delimits the #if region.  Reasonably simple:
 741 ;;; Skip until an #else or #endif is found, remembering positions.  If
 742 ;;; an #else was found, skip some more, looking for the true #endif.
 743
 744 (defun hif-find-range ()
 745   "Return a Range structure describing the current #if region.
 746 Point is left unchanged."
 747   ;; (message "hif-find-range at %d" (point))
 748   (save-excursion
 749     (beginning-of-line)
 750     (let ((start (point))
 751           (else nil)
 752           (end nil))
 753       ;; Part one.  Look for either #endif or #else.
 754       ;; This loop-and-a-half dedicated to E. Dijkstra.
 755       (while (progn
 756                (hif-find-next-relevant)
 757                (hif-looking-at-ifX))            ; Skip nested ifdef
 758         (hif-ifdef-to-endif))
 759       ;; Found either a #else or an #endif.
 760       (cond ((hif-looking-at-else)
 761              (setq else (point)))
 762             (t
 763              (setq end (point)))) ; (line-end-position)
 764       ;; If found #else, look for #endif.
 765       (when else
 766         (while (progn
 767                  (hif-find-next-relevant)
 768                  (hif-looking-at-ifX))  ; Skip nested ifdef
 769           (hif-ifdef-to-endif))
 770         (if (hif-looking-at-else)
 771             (error "Found two elses in a row?  Broken!"))
 772         (setq end (point)))            ; (line-end-position)
 773       (hif-make-range start end else))))
 774
 775
 776 ;;; A bit slimy.
 777
 778 (defun hif-hide-line (point)
 779   "Hide the line containing point.  Does nothing if `hide-ifdef-lines' is nil."
 780   (when hide-ifdef-lines
 781     (save-excursion
 782       (goto-char point)
 783       (hide-ifdef-region-internal
 784        (line-beginning-position) (progn (hif-end-of-line) (point))))))
 785
 786
 787 ;;;  Hif-Possibly-Hide
 788 ;;;  There are four cases.  The #ifX expression is "taken" if it
 789 ;;;  the hide-ifdef-evaluator returns T.  Presumably, this means the code
 790 ;;;  inside the #ifdef would be included when the program was
 791 ;;;  compiled.
 792 ;;;
 793 ;;;  Case 1:  #ifX taken, and there's an #else.
 794 ;;;     The #else part must be hidden.  The #if (then) part must be
 795 ;;;     processed for nested #ifX's.
 796 ;;;  Case 2:  #ifX taken, and there's no #else.
 797 ;;;     The #if part must be processed for nested #ifX's.
 798 ;;;  Case 3:  #ifX not taken, and there's an #else.
 799 ;;;     The #if part must be hidden.  The #else part must be processed
 800 ;;;     for nested #ifs.
 801 ;;;  Case 4:  #ifX not taken, and there's no #else.
 802 ;;;     The #ifX part must be hidden.
 803 ;;;
 804 ;;;  Further processing is done by narrowing to the relevant region
 805 ;;;  and just recursively calling hide-ifdef-guts.
 806 ;;;
 807 ;;;  When hif-possibly-hide returns, point is at the end of the
 808 ;;;  possibly-hidden range.
 809
 810 (defun hif-recurse-on (start end)
 811   "Call `hide-ifdef-guts' after narrowing to end of START line and END line."
 812   (save-excursion
 813     (save-restriction
 814       (goto-char start)
 815       (end-of-line)
 816       (narrow-to-region (point) end)
 817       (hide-ifdef-guts))))
 818
 819 (defun hif-possibly-hide ()
 820   "Called at #ifX expression, this hides those parts that should be hidden.
 821 It uses the judgement of `hide-ifdef-evaluator'."
 822   ;; (message "hif-possibly-hide") (sit-for 1)
 823   (let ((test (hif-canonicalize))
 824         (range (hif-find-range)))
 825     ;; (message "test = %s" test) (sit-for 1)
 826
 827     (hif-hide-line (hif-range-end range))
 828     (if (not (hif-not (funcall hide-ifdef-evaluator test)))
 829         (cond ((hif-range-else range)   ; case 1
 830                (hif-hide-line (hif-range-else range))
 831                (hide-ifdef-region (hif-range-else range)
 832                                   (1- (hif-range-end range)))
 833                (hif-recurse-on (hif-range-start range)
 834                                (hif-range-else range)))
 835               (t                        ; case 2
 836                (hif-recurse-on (hif-range-start range)
 837                                (hif-range-end range))))
 838       (cond ((hif-range-else range)     ; case 3
 839              (hif-hide-line (hif-range-else range))
 840              (hide-ifdef-region (hif-range-start range)
 841                                 (1- (hif-range-else range)))
 842              (hif-recurse-on (hif-range-else range)
 843                              (hif-range-end range)))
 844             (t                          ; case 4
 845              (hide-ifdef-region (point)
 846                                 (1- (hif-range-end range))))))
 847     (hif-hide-line (hif-range-start range)) ; Always hide start.
 848     (goto-char (hif-range-end range))
 849     (end-of-line)))
 850
 851
 852
 853 (defun hide-ifdef-guts ()
 854   "Does most of the work of `hide-ifdefs'.
 855 It does not do the work that's pointless to redo on a recursive entry."
 856   ;; (message "hide-ifdef-guts")
 857   (save-excursion
 858     (goto-char (point-min))
 859     (while (hif-find-any-ifX)
 860       (hif-possibly-hide))))
 861
 862 ;;===%%SF%% hide-ifdef-hiding (End)  ===
 863
 864
 865 ;;===%%SF%% exports (Start)  ===
 866
 867 (defun hide-ifdef-toggle-read-only ()
 868   "Toggle `hide-ifdef-read-only'."
 869   (interactive)
 870   (setq hide-ifdef-read-only (not hide-ifdef-read-only))
 871   (message "Hide-Read-Only %s"
 872            (if hide-ifdef-read-only "ON" "OFF"))
 873   (if hide-ifdef-hiding
 874       (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
 875   (force-mode-line-update))
 876
 877 (defun hide-ifdef-toggle-outside-read-only ()
 878   "Replacement for `toggle-read-only' within Hide-Ifdef mode."
 879   (interactive)
 880   (setq hif-outside-read-only (not hif-outside-read-only))
 881   (message "Read only %s"
 882            (if hif-outside-read-only "ON" "OFF"))
 883   (setq buffer-read-only
 884         (or (and hide-ifdef-hiding hide-ifdef-read-only)
 885             hif-outside-read-only))
 886   (force-mode-line-update))
 887
 888 (defun hide-ifdef-toggle-shadowing ()
 889   "Toggle shadowing."
 890   (interactive)
 891   (set (make-local-variable 'hide-ifdef-shadow) (not hide-ifdef-shadow))
 892   (message "Shadowing %s" (if hide-ifdef-shadow "ON" "OFF"))
 893   (save-restriction
 894     (widen)
 895     (dolist (overlay (overlays-in (point-min) (point-max)))
 896       (when (overlay-get overlay 'hide-ifdef)
 897         (if hide-ifdef-shadow
 898             (progn
 899               (overlay-put overlay 'invisible nil)
 900               (overlay-put overlay 'face 'hide-ifdef-shadow))
 901           (overlay-put overlay 'face nil)
 902           (overlay-put overlay 'invisible 'hide-ifdef))))))
 903
 904 (defun hide-ifdef-define (var)
 905   "Define a VAR so that #ifdef VAR would be included."
 906   (interactive "SDefine what? ")
 907   (hif-set-var var 1)
 908   (if hide-ifdef-hiding (hide-ifdefs)))
 909
 910 (defun hide-ifdef-undef (var)
 911   "Undefine a VAR so that #ifdef VAR would not be included."
 912   (interactive "SUndefine what? ")
 913   (hif-set-var var nil)
 914   (if hide-ifdef-hiding (hide-ifdefs)))
 915
 916
 917 (defun hide-ifdefs (&optional nomsg)
 918   "Hide the contents of some #ifdefs.
 919 Assume that defined symbols have been added to `hide-ifdef-env'.
 920 The text hidden is the text that would not be included by the C
 921 preprocessor if it were given the file with those symbols defined.
 922
 923 Turn off hiding by calling `show-ifdefs'."
 924
 925   (interactive)
 926   (message "Hiding...")
 927   (setq hif-outside-read-only buffer-read-only)
 928   (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; turn on hide-ifdef-mode
 929   (if hide-ifdef-hiding
 930       (show-ifdefs))                    ; Otherwise, deep confusion.
 931   (setq hide-ifdef-hiding t)
 932   (hide-ifdef-guts)
 933   (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
 934   (or nomsg
 935       (message "Hiding done")))
 936
 937
 938 (defun show-ifdefs ()
 939   "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs."
 940   (interactive)
 941   (setq buffer-read-only hif-outside-read-only)
 942   (hif-show-all)
 943   (setq hide-ifdef-hiding nil))
 944
 945
 946 (defun hif-find-ifdef-block ()
 947   "Utility for hide and show `ifdef-block'.
 948 Return as (TOP . BOTTOM) the extent of ifdef block."
 949   (let (max-bottom)
 950     (cons (save-excursion
 951             (beginning-of-line)
 952             (unless (or (hif-looking-at-else) (hif-looking-at-ifX))
 953               (up-ifdef))
 954             (prog1 (point)
 955               (hif-ifdef-to-endif)
 956               (setq max-bottom (1- (point)))))
 957           (save-excursion
 958             (beginning-of-line)
 959             (unless (hif-looking-at-endif)
 960               (hif-find-next-relevant))
 961             (while (hif-looking-at-ifX)
 962               (hif-ifdef-to-endif)
 963               (hif-find-next-relevant))
 964             (min max-bottom (1- (point)))))))
 965
 966
 967 (defun hide-ifdef-block ()
 968   "Hide the ifdef block (true or false part) enclosing or before the cursor."
 969   (interactive)
 970   (unless hide-ifdef-mode (hide-ifdef-mode 1))
 971   (let ((top-bottom (hif-find-ifdef-block)))
 972     (hide-ifdef-region (car top-bottom) (cdr top-bottom))
 973     (when hide-ifdef-lines
 974       (hif-hide-line (car top-bottom))
 975       (hif-hide-line (1+ (cdr top-bottom))))
 976     (setq hide-ifdef-hiding t))
 977   (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
 978
 979 (defun show-ifdef-block ()
 980   "Show the ifdef block (true or false part) enclosing or before the cursor."
 981   (interactive)
 982   (let ((top-bottom (hif-find-ifdef-block)))
 983     (if hide-ifdef-lines
 984         (hif-show-ifdef-region
 985          (save-excursion
 986            (goto-char (car top-bottom)) (line-beginning-position))
 987          (save-excursion
 988            (goto-char (1+ (cdr top-bottom)))
 989            (hif-end-of-line) (point)))
 990       (hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom)))))
 991
 992
 993 ;;;  definition alist support
 994
 995 (defvar hide-ifdef-define-alist nil
 996   "A global assoc list of pre-defined symbol lists.")
 997
 998 (defun hif-compress-define-list (env)
 999   "Compress the define list ENV into a list of defined symbols only."
1000   (let ((new-defs nil))
1001     (dolist (def env new-defs)
1002       (if (hif-lookup (car def)) (push (car env) new-defs)))))
1003
1004 (defun hide-ifdef-set-define-alist (name)
1005   "Set the association for NAME to `hide-ifdef-env'."
1006   (interactive "SSet define list: ")
1007   (push (cons name (hif-compress-define-list hide-ifdef-env))
1008         hide-ifdef-define-alist))
1009
1010 (defun hide-ifdef-use-define-alist (name)
1011   "Set `hide-ifdef-env' to the define list specified by NAME."
1012   (interactive
1013    (list (completing-read "Use define list: "
1014                           (mapcar (lambda (x) (symbol-name (car x)))
1015                                   hide-ifdef-define-alist)
1016                           nil t)))
1017   (if (stringp name) (setq name (intern name)))
1018   (let ((define-list (assoc name hide-ifdef-define-alist)))
1019     (if define-list
1020         (setq hide-ifdef-env
1021               (mapcar (lambda (arg) (cons arg t))
1022                       (cdr define-list)))
1023       (error "No define list for %s" name))
1024     (if hide-ifdef-hiding (hide-ifdefs))))
1025
1026 (provide 'hideif)
1027
1028 ;;; hideif.el ends here