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