aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-06-26 09:40:49 -0400
committerStefan Monnier2014-06-26 09:40:49 -0400
commit7d1fd42bd6480aa9ea1286dba3c730c2391fcc2b (patch)
tree572f89beaf718edbda1dc2ce70d1582e7176d85b
parent436550da1bf8d2cdd92a60f6ce84f131a8045062 (diff)
downloademacs-7d1fd42bd6480aa9ea1286dba3c730c2391fcc2b.tar.gz
emacs-7d1fd42bd6480aa9ea1286dba3c730c2391fcc2b.zip
* lisp/progmodes/hideif.el: Undo last change which should only go to trunk
(do not merge).
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/progmodes/hideif.el623
2 files changed, 51 insertions, 577 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 34d057c10f1..8cc59d88615 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
12014-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * progmodes/hideif.el: Undo last change which should only go to trunk
4 (do not merge).
5
12014-06-26 Glenn Morris <rgm@gnu.org> 62014-06-26 Glenn Morris <rgm@gnu.org>
2 7
3 * emacs-lisp/cl-macs.el (help-add-fundoc-usage): 8 * emacs-lisp/cl-macs.el (help-add-fundoc-usage):
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index b0ca4f0cdd0..39ad676f593 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -36,8 +36,6 @@
36;; 36;;
37;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't 37;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't
38;; pass through. Support complete C/C++ expression and precedence. 38;; pass through. Support complete C/C++ expression and precedence.
39;; It will automatically scans for new #define symbols and macros on the way
40;; parsing.
41;; 39;;
42;; The hidden code is marked by ellipses (...). Be 40;; The hidden code is marked by ellipses (...). Be
43;; cautious when editing near ellipses, since the hidden text is 41;; cautious when editing near ellipses, since the hidden text is
@@ -99,12 +97,11 @@
99;; Extensively modified by Daniel LaLiberte (while at Gould). 97;; Extensively modified by Daniel LaLiberte (while at Gould).
100;; 98;;
101;; Extensively modified by Luke Lee in 2013 to support complete C expression 99;; Extensively modified by Luke Lee in 2013 to support complete C expression
102;; evaluation and argumented macro expansion. 100;; evaluation.
103 101
104;;; Code: 102;;; Code:
105 103
106(require 'cc-mode) 104(require 'cc-mode)
107(require 'cl-lib)
108 105
109(defgroup hide-ifdef nil 106(defgroup hide-ifdef nil
110 "Hide selected code within `ifdef'." 107 "Hide selected code within `ifdef'."
@@ -136,9 +133,6 @@
136 :group 'hide-ifdef 133 :group 'hide-ifdef
137 :version "23.1") 134 :version "23.1")
138 135
139(defcustom hide-ifdef-exclude-define-regexp nil
140 "Ignore #define names if those names match this exclusion pattern."
141 :type 'string)
142 136
143(defvar hide-ifdef-mode-submap 137(defvar hide-ifdef-mode-submap
144 ;; Set up the submap that goes after the prefix key. 138 ;; Set up the submap that goes after the prefix key.
@@ -362,32 +356,12 @@ that form should be displayed.")
362;;; The code that understands what ifs and ifdef in files look like. 356;;; The code that understands what ifs and ifdef in files look like.
363 357
364(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*") 358(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
365(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def"))
366(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) 359(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
367(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+")) 360(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
368(defconst hif-elif-regexp (concat hif-cpp-prefix "elif"))
369(defconst hif-else-regexp (concat hif-cpp-prefix "else")) 361(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
370(defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) 362(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
371(defconst hif-ifx-else-endif-regexp 363(defconst hif-ifx-else-endif-regexp
372 (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|" 364 (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp))
373 hif-endif-regexp))
374(defconst hif-macro-expr-prefix-regexp
375 (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+"))
376
377(defconst hif-white-regexp "[ \t]*")
378(defconst hif-define-regexp
379 (concat hif-cpp-prefix "\\(define\\|undef\\)"))
380(defconst hif-id-regexp
381 (concat "[[:alpha:]_][[:alnum:]_]*"))
382(defconst hif-macroref-regexp
383 (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp
384 "\\("
385 "(" hif-white-regexp
386 "\\(" hif-id-regexp "\\)?" hif-white-regexp
387 "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*"
388 "\\(\\.\\.\\.\\)?" hif-white-regexp
389 ")"
390 "\\)?" ))
391 365
392;; Used to store the current token and the whole token list during parsing. 366;; Used to store the current token and the whole token list during parsing.
393;; Only bound dynamically. 367;; Only bound dynamically.
@@ -423,12 +397,7 @@ that form should be displayed.")
423 ("/" . hif-divide) 397 ("/" . hif-divide)
424 ("%" . hif-modulo) 398 ("%" . hif-modulo)
425 ("?" . hif-conditional) 399 ("?" . hif-conditional)
426 (":" . hif-colon) 400 (":" . hif-colon)))
427 ("," . hif-comma)
428 ("#" . hif-stringify)
429 ("..." . hif-etc)))
430
431(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
432 401
433(defconst hif-token-regexp 402(defconst hif-token-regexp
434 (concat (regexp-opt (mapcar 'car hif-token-alist)) 403 (concat (regexp-opt (mapcar 'car hif-token-alist))
@@ -438,29 +407,10 @@ that form should be displayed.")
438 407
439(defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)") 408(defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)")
440 409
441(defun hif-string-to-number (string &optional base)
442 "Like `string-to-number', but it understands non-decimal floats."
443 (if (or (not base) (= base 10))
444 (string-to-number string base)
445 (let* ((parts (split-string string "\\." t "[ \t]+"))
446 (frac (cadr parts))
447 (fraclen (length frac))
448 (quot (expt (if (zerop fraclen)
449 base
450 (* base 1.0)) fraclen)))
451 (/ (string-to-number (concat (car parts) frac) base) quot))))
452
453;; The dynamic binding variable `hif-simple-token-only' is shared only by
454;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize'
455;; from returning one more value to indicate a simple token is scanned. This help
456;; speeding up macro evaluation on those very simple cases like integers or
457;; literals.
458;; Check the long comments before `hif-find-define' for more details. [lukelee]
459 410
460(defun hif-tokenize (start end) 411(defun hif-tokenize (start end)
461 "Separate string between START and END into a list of tokens." 412 "Separate string between START and END into a list of tokens."
462 (let ((token-list nil)) 413 (let ((token-list nil))
463 (setq hif-simple-token-only t)
464 (with-syntax-table hide-ifdef-syntax-table 414 (with-syntax-table hide-ifdef-syntax-table
465 (save-excursion 415 (save-excursion
466 (goto-char start) 416 (goto-char start)
@@ -473,10 +423,8 @@ that form should be displayed.")
473 ((looking-at hif-string-literal-regexp) 423 ((looking-at hif-string-literal-regexp)
474 (push (substring-no-properties (match-string 1)) token-list) 424 (push (substring-no-properties (match-string 1)) token-list)
475 (goto-char (match-end 0))) 425 (goto-char (match-end 0)))
476
477 ((looking-at hif-token-regexp) 426 ((looking-at hif-token-regexp)
478 (let ((token (buffer-substring-no-properties 427 (let ((token (buffer-substring (point) (match-end 0))))
479 (point) (match-end 0))))
480 (goto-char (match-end 0)) 428 (goto-char (match-end 0))
481 ;; (message "token: %s" token) (sit-for 1) 429 ;; (message "token: %s" token) (sit-for 1)
482 (push 430 (push
@@ -484,22 +432,22 @@ that form should be displayed.")
484 (if (string-equal token "defined") 'hif-defined) 432 (if (string-equal token "defined") 'hif-defined)
485 ;; TODO: 433 ;; TODO:
486 ;; 1. postfix 'l', 'll', 'ul' and 'ull' 434 ;; 1. postfix 'l', 'll', 'ul' and 'ull'
487 ;; 2. floating number formats (like 1.23e4) 435 ;; 2. floating number formats
488 ;; 3. 098 is interpreted as octal conversion error 436 ;; 3. hexadecimal/octal floats
437 ;; 4. 098 is interpreted as octal conversion error
438 ;; FIXME: string-to-number does not convert hex floats
489 (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)" 439 (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)"
490 token) 440 token)
491 (hif-string-to-number (match-string 1 token) 16)) ;; hex 441 (string-to-number (match-string 1 token) 16)) ;; hex
442 ;; FIXME: string-to-number does not convert octal floats
492 (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token) 443 (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token)
493 (hif-string-to-number token 8)) ;; octal 444 (string-to-number token 8)) ;; octal
494 (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'" 445 (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'"
495 token) 446 token)
496 (string-to-number token)) ;; decimal 447 (string-to-number token)) ;; decimal
497 (prog1 (intern token) 448 (intern token))
498 (setq hif-simple-token-only nil)))
499 token-list))) 449 token-list)))
500
501 (t (error "Bad #if expression: %s" (buffer-string))))))) 450 (t (error "Bad #if expression: %s" (buffer-string)))))))
502
503 (nreverse token-list))) 451 (nreverse token-list)))
504 452
505;;------------------------------------------------------------------------ 453;;------------------------------------------------------------------------
@@ -534,115 +482,9 @@ that form should be displayed.")
534 "Pop the next token from token-list into the let variable `hif-token'." 482 "Pop the next token from token-list into the let variable `hif-token'."
535 (setq hif-token (pop hif-token-list))) 483 (setq hif-token (pop hif-token-list)))
536 484
537(defsubst hif-if-valid-identifier-p (id) 485(defun hif-parse-if-exp (token-list)
538 (not (or (numberp id) 486 "Parse the TOKEN-LIST. Return translated list in prefix form."
539 (stringp id)))) 487 (let ((hif-token-list token-list))
540
541(defun hif-define-operator (tokens)
542 "`Upgrade' hif-define xxx to '(hif-define xxx)' so that it won't be
543subsitituted"
544 (let ((result nil)
545 (tok nil))
546 (while (setq tok (pop tokens))
547 (push
548 (if (eq tok 'hif-defined)
549 (progn
550 (setq tok (cadr tokens))
551 (if (eq (car tokens) 'hif-lparen)
552 (if (and (hif-if-valid-identifier-p tok)
553 (eq (caddr tokens) 'hif-rparen))
554 (setq tokens (cdddr tokens))
555 (error "#define followed by non-identifier: %S" tok))
556 (setq tok (car tokens)
557 tokens (cdr tokens))
558 (unless (hif-if-valid-identifier-p tok)
559 (error "#define followed by non-identifier: %S" tok)))
560 (list 'hif-defined 'hif-lparen tok 'hif-rparen))
561 tok)
562 result))
563 (nreverse result)))
564
565(defun hif-flatten (l)
566 "Flatten a tree"
567 (apply #'nconc
568 (mapcar (lambda (x) (if (listp x)
569 (hif-flatten x)
570 (list x))) l)))
571
572(defun hif-expand-token-list (tokens &optional macroname expand_list)
573 "Perform expansion till everything expanded. No self-reference expansion.
574 EXPAND_LIST is the list of macro names currently being expanded."
575 (catch 'self-referencing
576 (let ((expanded nil)
577 (remains (hif-define-operator
578 (hif-token-concatenation
579 (hif-token-stringification tokens))))
580 tok rep)
581 (if macroname
582 (setq expand_list (cons macroname expand_list)))
583 ;; Expanding all tokens till list exhausted
584 (while (setq tok (pop remains))
585 (if (memq tok expand_list)
586 ;; For self-referencing tokens, don't expand it
587 (throw 'self-referencing tokens))
588 (push
589 (cond
590 ((or (memq tok hif-valid-token-list)
591 (numberp tok)
592 (stringp tok))
593 tok)
594
595 ((setq rep (hif-lookup tok))
596 (if (and (listp rep)
597 (eq (car rep) 'hif-define-macro)) ;; a defined macro
598 ;; Recursively expand it
599 (if (cadr rep) ;; Argument list is not nil
600 (if (not (eq (car remains) 'hif-lparen))
601 ;; No argument, no invocation
602 tok
603 ;; Argumented macro, get arguments and invoke it.
604 ;; Dynamically bind hif-token-list and hif-token
605 ;; for hif-macro-supply-arguments
606 (let* ((hif-token-list (cdr remains))
607 (hif-token nil)
608 (parmlist (mapcar 'hif-expand-token-list
609 (hif-get-argument-list
610 tok)))
611 (result
612 (hif-expand-token-list
613 (hif-macro-supply-arguments tok parmlist)
614 tok expand_list)))
615 (setq remains (cons hif-token hif-token-list))
616 result))
617 ;; Argument list is nil, direct expansion
618 (setq rep (hif-expand-token-list
619 (caddr rep) ;; Macro's token list
620 tok expand_list))
621 ;; Replace all remaining references immediately
622 (setq remains (substitute tok rep remains))
623 rep)
624 ;; Lookup tok returns an atom
625 rep))
626
627 ;;[2013-10-22 16:06:12 +0800] Must keep the token, removing
628 ;; this token might results in an incomplete expression that
629 ;; cannot be parsed further.
630 ;;((= 1 (hif-defined tok)) ;; defined (hif-defined tok)=1,
631 ;; ;;but empty (hif-lookup tok)=nil, thus remove this token
632 ;; (setq remains (delete tok remains))
633 ;; nil)
634
635 (t ;; Usual IDs
636 tok))
637
638 expanded))
639
640 (hif-flatten (nreverse expanded)))))
641
642(defun hif-parse-exp (token-list &optional macroname)
643 "Parse the TOKEN-LIST. Return translated list in prefix form. MACRONAME
644is applied when invoking macros to prevent self-referencing macros."
645 (let ((hif-token-list (hif-expand-token-list token-list macroname)))
646 (hif-nexttoken) 488 (hif-nexttoken)
647 (prog1 489 (prog1
648 (and hif-token 490 (and hif-token
@@ -732,8 +574,7 @@ is applied when invoking macros to prevent self-referencing macros."
732 "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift." 574 "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift."
733 (let ((result (hif-logshift-expr)) 575 (let ((result (hif-logshift-expr))
734 (comp-token nil)) 576 (comp-token nil))
735 (while (memq hif-token '(hif-greater hif-less hif-greater-equal 577 (while (memq hif-token '(hif-greater hif-less hif-greater-equal hif-less-equal))
736 hif-less-equal))
737 (setq comp-token hif-token) 578 (setq comp-token hif-token)
738 (hif-nexttoken) 579 (hif-nexttoken)
739 (setq result (list comp-token result (hif-logshift-expr)))) 580 (setq result (list comp-token result (hif-logshift-expr))))
@@ -772,8 +613,7 @@ is applied when invoking macros to prevent self-referencing macros."
772 result)) 613 result))
773 614
774(defun hif-factor () 615(defun hif-factor ()
775 "Parse a factor: '!' factor | '~' factor | '(' expr ')' | 616 "Parse a factor: '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' | 'id(parmlist)' | strings | id."
776'defined(' id ')' | 'id(parmlist)' | strings | id."
777 (cond 617 (cond
778 ((eq hif-token 'hif-not) 618 ((eq hif-token 'hif-not)
779 (hif-nexttoken) 619 (hif-nexttoken)
@@ -806,8 +646,6 @@ is applied when invoking macros to prevent self-referencing macros."
806 646
807 ((numberp hif-token) 647 ((numberp hif-token)
808 (prog1 hif-token (hif-nexttoken))) 648 (prog1 hif-token (hif-nexttoken)))
809 ((stringp hif-token)
810 (hif-string-concatenation))
811 649
812 ;; Unary plus/minus. 650 ;; Unary plus/minus.
813 ((memq hif-token '(hif-minus hif-plus)) 651 ((memq hif-token '(hif-minus hif-plus))
@@ -815,91 +653,10 @@ is applied when invoking macros to prevent self-referencing macros."
815 653
816 (t ; identifier 654 (t ; identifier
817 (let ((ident hif-token)) 655 (let ((ident hif-token))
656 (if (memq ident '(or and))
657 (error "Error: missing identifier"))
818 (hif-nexttoken) 658 (hif-nexttoken)
819 (if (eq hif-token 'hif-lparen) 659 `(hif-lookup (quote ,ident))))))
820 (hif-place-macro-invocation ident)
821 `(hif-lookup (quote ,ident)))))))
822
823(defun hif-get-argument-list (ident)
824 (let ((nest 0)
825 (parmlist nil) ;; A "token" list of parameters, will later be parsed
826 (parm nil))
827
828 (while (or (not (eq (hif-nexttoken) 'hif-rparen))
829 (/= nest 0))
830 (if (eq (car (last parm)) 'hif-comma)
831 (setq parm nil))
832 (cond
833 ((eq hif-token 'hif-lparen)
834 (setq nest (1+ nest)))
835 ((eq hif-token 'hif-rparen)
836 (setq nest (1- nest)))
837 ((and (eq hif-token 'hif-comma)
838 (= nest 0))
839 (push (nreverse parm) parmlist)
840 (setq parm nil)))
841 (push hif-token parm))
842
843 (push (nreverse parm) parmlist) ;; Okay even if parm is nil
844 (hif-nexttoken) ;; Drop the hif-rparen, get next token
845 (nreverse parmlist)))
846
847(defun hif-place-macro-invocation (ident)
848 (let ((parmlist (hif-get-argument-list ident)))
849 `(hif-invoke (quote ,ident) (quote ,parmlist))))
850
851(defun hif-string-concatenation ()
852 "Parse concatenated strings: string | strings string"
853 (let ((result (substring-no-properties hif-token)))
854 (while (stringp (hif-nexttoken))
855 (setq result (concat
856 (substring result 0 -1) ; remove trailing '"'
857 (substring hif-token 1)))) ; remove leading '"'
858 result))
859
860(defun hif-define-macro (parmlist token-body)
861 "A marker for defined macro with arguments, cannot be evaluated alone with
862no parameters inputed."
863 ;;TODO: input arguments at run time, use minibuffer to query all arguments
864 (error
865 "Argumented macro cannot be evaluated without passing any parameter."))
866
867(defun hif-stringify (a)
868 "Stringify a number, string or symbol."
869 (cond
870 ((numberp a)
871 (number-to-string a))
872 ((atom a)
873 (symbol-name a))
874 ((stringp a)
875 (concat "\"" a "\""))
876 (t
877 (error "Invalid token to stringify"))))
878
879(defun intern-safe (str)
880 (if (stringp str)
881 (intern str)))
882
883(defun hif-token-concat (a b)
884 "Concatenate two tokens into a longer token, currently support only simple
885token concatenation. Also support weird (but valid) token concatenation like
886'>' ## '>' becomes '>>'. Here we take care only those that can be evaluated
887during preprocessing time and ignore all those that can only be evaluated at
888C(++) runtime (like '++', '--' and '+='...)."
889 (if (or (memq a hif-valid-token-list)
890 (memq b hif-valid-token-list))
891 (let* ((ra (car (rassq a hif-token-alist)))
892 (rb (car (rassq b hif-token-alist)))
893 (result (and ra rb
894 (cdr (assoc (concat ra rb) hif-token-alist)))))
895 (or result
896 ;;(error "Invalid token to concatenate")
897 (error "Concatenating \"%s\" and \"%s\" does not give a valid \
898preprocessing token."
899 (or ra (symbol-name a))
900 (or rb (symbol-name b)))))
901 (intern-safe (concat (hif-stringify a)
902 (hif-stringify b)))))
903 660
904(defun hif-mathify (val) 661(defun hif-mathify (val)
905 "Treat VAL as a number: if it's t or nil, use 1 or 0." 662 "Treat VAL as a number: if it's t or nil, use 1 or 0."
@@ -962,157 +719,23 @@ preprocessing token."
962 (setq result (funcall hide-ifdef-evaluator e)))) 719 (setq result (funcall hide-ifdef-evaluator e))))
963 result)) 720 result))
964 721
965(defun hif-token-stringification (l)
966 "Scan token list for 'hif-stringify' ('#') token and stringify the next
967token."
968 (let (result)
969 (while l
970 (push (if (eq (car l) 'hif-stringify)
971 (prog1
972 (if (cadr l)
973 (hif-stringify (cadr l))
974 (error "No token to stringify"))
975 (setq l (cdr l)))
976 (car l))
977 result)
978 (setq l (cdr l)))
979 (nreverse result)))
980
981(defun hif-token-concatenation (l)
982 "Scan token list for 'hif-token-concat' ('##') token and concatenate two
983tokens."
984 (let ((prev nil)
985 result)
986 (while l
987 (while (eq (car l) 'hif-token-concat)
988 (unless prev
989 (error "No token before ## to concatenate"))
990 (unless (cdr l)
991 (error "No token after ## to concatenate"))
992 (setq prev (hif-token-concat prev (cadr l)))
993 (setq l (cddr l)))
994 (if prev
995 (setq result (append result (list prev))))
996 (setq prev (car l)
997 l (cdr l)))
998 (if prev
999 (append result (list prev))
1000 result)))
1001
1002(defun hif-delimit (lis atom)
1003 (nconc (mapcan (lambda (l) (list l atom))
1004 (butlast lis))
1005 (last lis)))
1006
1007;; Perform token replacement:
1008(defun hif-macro-supply-arguments (macro-name actual-parms)
1009 "Expand a macro call, replace ACTUAL-PARMS in the macro body."
1010 (let* ((SA (assoc macro-name hide-ifdef-env))
1011 (macro (and SA
1012 (cdr SA)
1013 (eq (cadr SA) 'hif-define-macro)
1014 (cddr SA)))
1015 (formal-parms (and macro (car macro)))
1016 (macro-body (and macro (cadr macro)))
1017 (hide-ifdef-local-env nil) ; dynamic binding local table
1018 actual-count
1019 formal-count
1020 actual
1021 formal
1022 etc)
1023
1024 (when (and actual-parms formal-parms macro-body)
1025 ;; For each actual parameter, evaluate each one and associate it
1026 ;; with the associated actual parameter, put it into local table and finally
1027 ;; evaluate the macro body.
1028 (if (setq etc (eq (car formal-parms) 'hif-etc))
1029 ;; Take care of 'hif-etc first. Prefix 'hif-comma back if needed.
1030 (setq formal-parms (cdr formal-parms)))
1031 (setq formal-count (length formal-parms)
1032 actual-count (length actual-parms))
1033
1034 (if (> formal-count actual-count)
1035 (error "Too few parmameter for macro %S" macro-name)
1036 (if (< formal-count actual-count)
1037 (or etc
1038 (error "Too many parameters for macro %S" macro-name))))
1039
1040 ;; Perform token replacement on the macro-body on the parameters
1041 (while (setq formal (pop formal-parms))
1042 ;; Prevent repetitive substitutation, thus cannot use 'subst'
1043 ;; for example:
1044 ;; #define mac(a,b) (a+b)
1045 ;; #define testmac mac(b,y)
1046 ;; testmac should expand to (b+y): replace of argument a and b
1047 ;; occurs simultaneously, not sequentially. If sequentially,
1048 ;; according to the argument order, it will become:
1049 ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b)
1050 ;; becomes (b+b)
1051 ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b)
1052 ;; becomes (y+y).
1053 (setq macro-body
1054 ;; Unlike 'subst', 'substitute' replace only the top level
1055 ;; instead of the whole tree; more importantly, it's not
1056 ;; destructive.
1057 (substitute (if (and etc (null formal-parms))
1058 (hif-delimit actual-parms 'hif-comma)
1059 (car actual-parms))
1060 formal macro-body))
1061 (setq actual-parms (cdr actual-parms)))
1062
1063 ;; Replacement completed, flatten the whole token list
1064 (setq macro-body (hif-flatten macro-body))
1065
1066 ;; Stringification and token concatenation happens here
1067 (hif-token-concatenation (hif-token-stringification macro-body)))))
1068
1069(defun hif-invoke (macro-name actual-parms)
1070 "Invoke a macro by first expanding it, then reparse the macro-body,
1071finally invoke the macro."
1072 ;; Reparse the macro body and evaluate it
1073 (funcall hide-ifdef-evaluator
1074 (hif-parse-exp
1075 (hif-macro-supply-arguments macro-name actual-parms)
1076 macro-name)))
1077 722
1078;;;----------- end of parser ----------------------- 723;;;----------- end of parser -----------------------
1079 724
1080 725
1081(defun hif-canonicalize-tokens (regexp) ;; for debugging 726(defun hif-canonicalize ()
1082 "Return the expanded result of the scanned tokens." 727 "When at beginning of #ifX, return a Lisp expression for its condition."
1083 (save-excursion 728 (save-excursion
1084 (re-search-forward regexp) 729 (let ((negate (looking-at hif-ifndef-regexp)))
1085 (let* ((curr-regexp (match-string 0)) 730 (re-search-forward hif-ifx-regexp)
1086 (defined (string-match hif-ifxdef-regexp curr-regexp)) 731 (let* ((tokens (hif-tokenize (point)
1087 (negate (and defined 732 (progn (hif-end-of-line) (point))))
1088 (string= (match-string 2 curr-regexp) "n"))) 733 (expr (hif-parse-if-exp tokens)))
1089 (hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize' 734 ;; (message "hif-canonicalized: %s" expr)
1090 (tokens (hif-tokenize (point) 735 (if negate
1091 (progn (hif-end-of-line) (point))))) 736 (list 'hif-not expr)
1092 (if defined 737 expr)))))
1093 (setq tokens (list 'hif-defined tokens))) 738
1094 (if negate
1095 (setq tokens (list 'hif-not tokens)))
1096 tokens)))
1097
1098(defun hif-canonicalize (regexp)
1099 "When at beginning of `regexp' (i.e. #ifX), return a Lisp expression for
1100its condition."
1101 (let ((case-fold-search nil))
1102 (save-excursion
1103 (re-search-forward regexp)
1104 (let* ((curr-regexp (match-string 0))
1105 (defined (string-match hif-ifxdef-regexp curr-regexp))
1106 (negate (and defined
1107 (string= (match-string 2 curr-regexp) "n")))
1108 (hif-simple-token-only nil) ;; Dynamic binding for `hif-tokenize'
1109 (tokens (hif-tokenize (point)
1110 (progn (hif-end-of-line) (point)))))
1111 (if defined
1112 (setq tokens (list 'hif-defined tokens)))
1113 (if negate
1114 (setq tokens (list 'hif-not tokens)))
1115 (hif-parse-exp tokens)))))
1116 739
1117(defun hif-find-any-ifX () 740(defun hif-find-any-ifX ()
1118 "Move to next #if..., or #ifndef, at point or after." 741 "Move to next #if..., or #ifndef, at point or after."
@@ -1123,10 +746,10 @@ its condition."
1123 746
1124 747
1125(defun hif-find-next-relevant () 748(defun hif-find-next-relevant ()
1126 "Move to next #if..., #elif..., #else, or #endif, after the current line." 749 "Move to next #if..., #else, or #endif, after the current line."
1127 ;; (message "hif-find-next-relevant at %d" (point)) 750 ;; (message "hif-find-next-relevant at %d" (point))
1128 (end-of-line) 751 (end-of-line)
1129 ;; Avoid infinite recursion by only going to line-beginning if match found 752 ;; avoid infinite recursion by only going to beginning of line if match found
1130 (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t) 753 (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t)
1131 (beginning-of-line))) 754 (beginning-of-line)))
1132 755
@@ -1134,7 +757,7 @@ its condition."
1134 "Move to previous #if..., #else, or #endif, before the current line." 757 "Move to previous #if..., #else, or #endif, before the current line."
1135 ;; (message "hif-find-previous-relevant at %d" (point)) 758 ;; (message "hif-find-previous-relevant at %d" (point))
1136 (beginning-of-line) 759 (beginning-of-line)
1137 ;; Avoid infinite recursion by only going to line-beginning if match found 760 ;; avoid infinite recursion by only going to beginning of line if match found
1138 (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t) 761 (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t)
1139 (beginning-of-line))) 762 (beginning-of-line)))
1140 763
@@ -1146,19 +769,15 @@ its condition."
1146(defun hif-looking-at-else () 769(defun hif-looking-at-else ()
1147 (looking-at hif-else-regexp)) 770 (looking-at hif-else-regexp))
1148 771
1149(defun hif-looking-at-elif ()
1150 (looking-at hif-elif-regexp))
1151 772
1152 773
1153(defun hif-ifdef-to-endif () 774(defun hif-ifdef-to-endif ()
1154 "If positioned at #ifX, #elif, or #else form, skip to corresponding #endif." 775 "If positioned at #ifX or #else form, skip to corresponding #endif."
1155 ;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1) 776 ;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1)
1156 (hif-find-next-relevant) 777 (hif-find-next-relevant)
1157 (cond ((hif-looking-at-ifX) 778 (cond ((hif-looking-at-ifX)
1158 (hif-ifdef-to-endif) ; find endif of nested if 779 (hif-ifdef-to-endif) ; find endif of nested if
1159 (hif-ifdef-to-endif)) ; find outer endif or else 780 (hif-ifdef-to-endif)) ; find outer endif or else
1160 ((hif-looking-at-elif)
1161 (hif-ifdef-to-endif))
1162 ((hif-looking-at-else) 781 ((hif-looking-at-else)
1163 (hif-ifdef-to-endif)) ; find endif following else 782 (hif-ifdef-to-endif)) ; find endif following else
1164 ((hif-looking-at-endif) 783 ((hif-looking-at-endif)
@@ -1331,7 +950,7 @@ Point is left unchanged."
1331;;; A bit slimy. 950;;; A bit slimy.
1332 951
1333(defun hif-hide-line (point) 952(defun hif-hide-line (point)
1334 "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil." 953 "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil."
1335 (when hide-ifdef-lines 954 (when hide-ifdef-lines
1336 (save-excursion 955 (save-excursion
1337 (goto-char point) 956 (goto-char point)
@@ -1375,7 +994,7 @@ Point is left unchanged."
1375 "Called at #ifX expression, this hides those parts that should be hidden. 994 "Called at #ifX expression, this hides those parts that should be hidden.
1376It uses the judgment of `hide-ifdef-evaluator'." 995It uses the judgment of `hide-ifdef-evaluator'."
1377 ;; (message "hif-possibly-hide") (sit-for 1) 996 ;; (message "hif-possibly-hide") (sit-for 1)
1378 (let ((test (hif-canonicalize hif-ifx-regexp)) 997 (let ((test (hif-canonicalize))
1379 (range (hif-find-range))) 998 (range (hif-find-range)))
1380 ;; (message "test = %s" test) (sit-for 1) 999 ;; (message "test = %s" test) (sit-for 1)
1381 1000
@@ -1403,145 +1022,16 @@ It uses the judgment of `hide-ifdef-evaluator'."
1403 (goto-char (hif-range-end range)) 1022 (goto-char (hif-range-end range))
1404 (end-of-line))) 1023 (end-of-line)))
1405 1024
1406(defun hif-parse-macro-arglist (str)
1407 "Parse argument list formatted as '( arg1 [ , argn] [...] )', including
1408the '...'. Return a list of the arguments, if '...' exists the first arg
1409will be hif-etc."
1410 (let* ((hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize'
1411 (tokenlist
1412 (cdr (hif-tokenize
1413 (- (point) (length str)) (point)))) ; remove hif-lparen
1414 etc result token)
1415 (while (not (eq (setq token (pop tokenlist)) 'hif-rparen))
1416 (cond
1417 ((eq token 'hif-etc)
1418 (setq etc t))
1419 ((eq token 'hif-comma)
1420 t)
1421 (t
1422 (push token result))))
1423 (if etc
1424 (cons 'hif-etc (nreverse result))
1425 (nreverse result))))
1426
1427;; The original version of hideif evaluates the macro early and store the
1428;; final values for the defined macro into the symbol database (aka
1429;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed
1430;; tree -> [value]". (The square bracket refers to what's stored in in our
1431;; `hide-ifdef-env'.)
1432;;
1433;; This forbids the evaluation of an argumented macro since the parameters
1434;; are applied at run time. In order to support argumented macro I then
1435;; postponed the evaluation process one stage and store the "parsed tree"
1436;; into symbol database. The evaluation process was then "strings -> tokens
1437;; -> [parsed tree] -> value". Hideif therefore run slower since it need to
1438;; evaluate the parsed tree everytime when trying to expand the symbol. These
1439;; temporarily code changes are obsolete and not in Emacs source repository.
1440;;
1441;; Furthermore, CPP did allow partial expression to be defined in several
1442;; macros and later got concatenated into a complete expression and then
1443;; evaluate it. In order to match this behavior I had to postpone one stage
1444;; further, otherwise those partial expression will be fail on parsing and
1445;; we'll miss all macros that reference it. The evaluation process thus
1446;; became "strings -> [tokens] -> parsed tree -> value." This degraded the
1447;; performance since we need to parse tokens and evaluate them everytime
1448;; when that symbol is referenced.
1449;;
1450;; In real cases I found a lot portion of macros are "simple macros" that
1451;; expand to literals like integers or other symbols. In order to enhance
1452;; the performance I use this `hif-simple-token-only' to notify my code and
1453;; save the final [value] into symbol database. [lukelee]
1454 1025
1455(defun hif-find-define (&optional min max)
1456 "Parse texts and retrieve all defines within the region MIN and MAX."
1457 (interactive)
1458 (and min (goto-char min))
1459 (and (re-search-forward hif-define-regexp max t)
1460 (or
1461 (let* ((defining (string= "define" (match-string 2)))
1462 (name (and (re-search-forward hif-macroref-regexp max t)
1463 (match-string 1)))
1464 (parsed nil)
1465 (parmlist (and (match-string 3) ;; First arg id found
1466 (hif-parse-macro-arglist (match-string 2)))))
1467 (if defining
1468 ;; Ignore name (still need to return 't), or define the name
1469 (or (and hide-ifdef-exclude-define-regexp
1470 (string-match hide-ifdef-exclude-define-regexp
1471 name))
1472
1473 (let* ((start (point))
1474 (end (progn (hif-end-of-line) (point)))
1475 (hif-simple-token-only nil) ;; Dynamic binding
1476 (tokens
1477 (and name
1478 ;; `hif-simple-token-only' is set/clear
1479 ;; only in this block
1480 (condition-case nil
1481 ;; Prevent C statements like
1482 ;; 'do { ... } while (0)'
1483 (hif-tokenize start end)
1484 (error
1485 ;; We can't just return nil here since
1486 ;; this will stop hideif from searching
1487 ;; for more #defines.
1488 (setq hif-simple-token-only t)
1489 (buffer-substring-no-properties
1490 start end)))))
1491 ;; For simple tokens we save only the parsed result;
1492 ;; otherwise we save the tokens and parse it after
1493 ;; parameter replacement
1494 (expr (and tokens
1495 ;; `hif-simple-token-only' is checked only
1496 ;; here.
1497 (or (and hif-simple-token-only
1498 (listp tokens)
1499 (= (length tokens) 1)
1500 (hif-parse-exp tokens))
1501 `(hif-define-macro ,parmlist
1502 ,tokens))))
1503 (SA (and name
1504 (assoc (intern name) hide-ifdef-env))))
1505 (and name
1506 (if SA
1507 (or (setcdr SA expr) t)
1508 ;; Lazy evaluation, eval only if hif-lookup find it.
1509 ;; Define it anyway, even if nil it's still in list
1510 ;; and therefore considerred defined
1511 (push (cons (intern name) expr) hide-ifdef-env)))))
1512 ;; #undef
1513 (and name
1514 (hif-undefine-symbol (intern name))))))
1515 t))
1516
1517
1518(defun hif-add-new-defines (&optional min max)
1519 "Scan and add all #define macros between MIN and MAX"
1520 (interactive)
1521 (save-excursion
1522 (save-restriction
1523 ;; (mark-region min max) ;; for debugging
1524 (while (hif-find-define min max)
1525 (setf min (point)))
1526 (if max (goto-char max)
1527 (goto-char (point-max))))))
1528 1026
1529(defun hide-ifdef-guts () 1027(defun hide-ifdef-guts ()
1530 "Does most of the work of `hide-ifdefs'. 1028 "Does most of the work of `hide-ifdefs'.
1531It does not do the work that's pointless to redo on a recursive entry." 1029It does not do the work that's pointless to redo on a recursive entry."
1532 ;; (message "hide-ifdef-guts") 1030 ;; (message "hide-ifdef-guts")
1533 (save-excursion 1031 (save-excursion
1534 (let ((case-fold-search nil)
1535 min max)
1536 (goto-char (point-min)) 1032 (goto-char (point-min))
1537 (setf min (point)) 1033 (while (hif-find-any-ifX)
1538 (loop do 1034 (hif-possibly-hide))))
1539 (setf max (hif-find-any-ifX))
1540 (hif-add-new-defines min max)
1541 (if max
1542 (hif-possibly-hide))
1543 (setf min (point))
1544 while max))))
1545 1035
1546;;===%%SF%% hide-ifdef-hiding (End) === 1036;;===%%SF%% hide-ifdef-hiding (End) ===
1547 1037
@@ -1555,8 +1045,7 @@ It does not do the work that's pointless to redo on a recursive entry."
1555 (message "Hide-Read-Only %s" 1045 (message "Hide-Read-Only %s"
1556 (if hide-ifdef-read-only "ON" "OFF")) 1046 (if hide-ifdef-read-only "ON" "OFF"))
1557 (if hide-ifdef-hiding 1047 (if hide-ifdef-hiding
1558 (setq buffer-read-only (or hide-ifdef-read-only 1048 (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
1559 hif-outside-read-only)))
1560 (force-mode-line-update)) 1049 (force-mode-line-update))
1561 1050
1562(defun hide-ifdef-toggle-outside-read-only () 1051(defun hide-ifdef-toggle-outside-read-only ()
@@ -1592,32 +1081,12 @@ It does not do the work that's pointless to redo on a recursive entry."
1592 (hif-set-var var 1) 1081 (hif-set-var var 1)
1593 (if hide-ifdef-hiding (hide-ifdefs))) 1082 (if hide-ifdef-hiding (hide-ifdefs)))
1594 1083
1595(defun hif-undefine-symbol (var) 1084(defun hide-ifdef-undef (var)
1596 (setq hide-ifdef-env
1597 (delete (assoc var hide-ifdef-env) hide-ifdef-env)))
1598
1599;;(defun hide-ifdef-undef (var)
1600;; "Undefine a VAR so that #ifdef VAR would not be included."
1601;; (interactive "SUndefine what? ")
1602;; ;;(hif-set-var var nil);;Luke fixed: set it nil is still considered
1603;; ;;defined so #ifdef VAR is still true.
1604;; (hif-undefine-symbol var)
1605;; (if hide-ifdef-hiding (hide-ifdefs)))
1606
1607(defun hide-ifdef-undef (start end)
1608 "Undefine a VAR so that #ifdef VAR would not be included." 1085 "Undefine a VAR so that #ifdef VAR would not be included."
1609 (interactive "r") 1086 (interactive "SUndefine what? ")
1610 (let* ((symstr 1087 (hif-set-var var nil)
1611 (or (and mark-active 1088 (if hide-ifdef-hiding (hide-ifdefs)))
1612 (buffer-substring-no-properties start end)) 1089
1613 (read-string "Undefine what? " (current-word))))
1614 (sym (and symstr
1615 (intern symstr))))
1616 (if (zerop (hif-defined sym))
1617 (message "`%s' not defined, no need to undefine it" symstr)
1618 (hif-undefine-symbol sym)
1619 (if hide-ifdef-hiding (hide-ifdefs))
1620 (message "`%S' undefined" sym))))
1621 1090
1622(defun hide-ifdefs (&optional nomsg) 1091(defun hide-ifdefs (&optional nomsg)
1623 "Hide the contents of some #ifdefs. 1092 "Hide the contents of some #ifdefs.