X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c8b22035d67421b02c69a20d0809b732ab4c7f01..c12598a62e2e31f3377c52fe4b283b710ce1451e:/lisp/progmodes/cc-defs.el diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 5d528caabb..46cb2f9862 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -64,15 +64,14 @@ (not (fboundp 'push))) (cc-load "cc-fix"))) -; (eval-after-load "font-lock" ; 2006-07-09. font-lock is now preloaded -; ' -(if (and (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS - ; to make the call to f-l-c-k throw an error. - (not (featurep 'cc-fix)) ; only load the file once. - (let (font-lock-keywords) - (font-lock-compile-keywords '("\\<\\>")) - font-lock-keywords)) ; did the previous call foul this up? - (load "cc-fix")) ;) +(when (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS + ; to make the call to f-l-c-k throw an error. + (eval-after-load "font-lock" + '(if (and (not (featurep 'cc-fix)) ; only load the file once. + (let (font-lock-keywords) + (font-lock-compile-keywords '("\\<\\>")) + font-lock-keywords)) ; did the previous call foul this up? + (load "cc-fix")))) ;; The above takes care of the delayed loading, but this is necessary ;; to ensure correct byte compilation. @@ -86,10 +85,15 @@ font-lock-keywords))) (cc-load "cc-fix"))) +;; XEmacs 21.4 doesn't have `delete-dups'. +(eval-and-compile + (if (and (not (fboundp 'delete-dups)) + (not (featurep 'cc-fix))) + (cc-load "cc-fix"))) ;;; Variables also used at compile time. -(defconst c-version "5.32.5" +(defconst c-version "5.33" "CC Mode version number.") (defconst c-version-sym (intern c-version)) @@ -169,6 +173,10 @@ This variant works around bugs in `eval-when-compile' in various (put 'cc-eval-when-compile 'lisp-indent-hook 0)) +(eval-and-compile + (defalias 'c--macroexpand-all + (if (fboundp 'macroexpand-all) + 'macroexpand-all 'cl-macroexpand-all))) ;;; Macros. @@ -327,16 +335,42 @@ to it is returned. This function does not modify the point or the mark." (t (error "Unknown buffer position requested: %s" position)))) (point)))) +(eval-and-compile + ;; Constant to decide at compilation time whether to use category + ;; properties. Currently (2010-03) they're available only on GNU Emacs. + (defconst c-use-category + (with-temp-buffer + (let ((parse-sexp-lookup-properties t) + (lookup-syntax-properties t)) + (set-syntax-table (make-syntax-table)) + (insert "<()>") + (put-text-property (point-min) (1+ (point-min)) + 'category 'c-<-as-paren-syntax) + (put-text-property (+ 3 (point-min)) (+ 4 (point-min)) + 'category 'c->-as-paren-syntax) + (goto-char (point-min)) + (forward-sexp) + (= (point) (+ 4 (point-min))))))) + +(defvar c-use-extents) + +(defmacro c-next-single-property-change (position prop &optional object limit) + ;; See the doc string for either of the defuns expanded to. + (if (and c-use-extents + (fboundp 'next-single-char-property-change)) + ;; XEmacs >= 2005-01-25 + `(next-single-char-property-change ,position ,prop ,object ,limit) + ;; Emacs and earlier XEmacs + `(next-single-property-change ,position ,prop ,object ,limit))) + (defmacro c-region-is-active-p () ;; Return t when the region is active. The determination of region ;; activeness is different in both Emacs and XEmacs. - ;; FIXME? Emacs has region-active-p since 23.1, so maybe this test - ;; should be updated. - (if (cc-bytecomp-boundp 'mark-active) - ;; Emacs. - 'mark-active - ;; XEmacs. - '(region-active-p))) + (if (cc-bytecomp-fboundp 'region-active-p) + ;; XEmacs. + '(region-active-p) + ;; Old Emacs. + 'mark-active)) (defmacro c-set-region-active (activate) ;; Activate the region if ACTIVE is non-nil, deactivate it @@ -913,6 +947,12 @@ MODE is either a mode symbol or a list of mode symbols." (cc-bytecomp-fboundp 'delete-extent) (cc-bytecomp-fboundp 'map-extents)))) +(defconst c-<-as-paren-syntax '(4 . ?>)) +(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax) + +(defconst c->-as-paren-syntax '(5 . ?<)) +(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax) + ;; `c-put-char-property' is complex enough in XEmacs and Emacs < 21 to ;; make it a function. (defalias 'c-put-char-property-fun @@ -1046,8 +1086,8 @@ nil; point is then left undefined." (while (and (< place ,(or limit '(point-max))) - (not (equal (get-text-property place ,property) ,value))) - (setq place (next-single-property-change + (not (equal (c-get-char-property place ,property) ,value))) + (setq place (c-next-single-property-change place ,property nil ,(or limit '(point-max))))) (when (< place ,(or limit '(point-max))) (goto-char place) @@ -1065,10 +1105,15 @@ point is then left undefined." (while (and (> place ,(or limit '(point-min))) - (not (equal (get-text-property (1- place) ,property) ,value))) - (setq place (previous-single-property-change + (not (equal (c-get-char-property (1- place) ,property) ,value))) + (setq place (,(if (and c-use-extents + (fboundp 'previous-single-char-property-change)) + ;; XEmacs > 2005-01-25. + 'previous-single-char-property-change + ;; Emacs and earlier XEmacs. + 'previous-single-property-change) place ,property nil ,(or limit '(point-min))))) - (when (> place ,(or limit '(point-max))) + (when (> place ,(or limit '(point-min))) (goto-char place) (search-backward-regexp ".") ; to set the match-data. (point)))) @@ -1085,9 +1130,9 @@ been put there by c-put-char-property. POINT remains unchanged." (and (< place to) (not (equal (get-text-property place property) value))) - (setq place (next-single-property-change place property nil to))) + (setq place (c-next-single-property-change place property nil to))) (< place to)) - (setq end-place (next-single-property-change place property nil to)) + (setq end-place (c-next-single-property-change place property nil to)) (remove-text-properties place end-place (cons property nil)) ;; Do we have to do anything with stickiness here? (setq place end-place)))) @@ -1104,7 +1149,7 @@ been put there by c-put-char-property. POINT remains unchanged." (if (equal (extent-property ext -property-) val) (delete-extent ext))) nil ,from ,to ,value nil -property-)) - ;; Gnu Emacs + ;; GNU Emacs `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. @@ -1188,42 +1233,43 @@ been put there by c-put-char-property. POINT remains unchanged." (if (< (point) start) (goto-char (point-max))))) -(defconst c-<-as-paren-syntax '(4 . ?>)) -(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax) - -(defsubst c-mark-<-as-paren (pos) +(defmacro c-mark-<-as-paren (pos) ;; Mark the "<" character at POS as a template opener using the - ;; `syntax-table' property via the `category' property. + ;; `syntax-table' property either directly (XEmacs) or via a `category' + ;; property (GNU Emacs). ;; ;; This function does a hidden buffer change. Note that we use ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. - (c-put-char-property pos 'category 'c-<-as-paren-syntax)) + (if c-use-category + `(c-put-char-property ,pos 'category 'c-<-as-paren-syntax) + `(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax))) -(defconst c->-as-paren-syntax '(5 . ?<)) -(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax) -(defsubst c-mark->-as-paren (pos) +(defmacro c-mark->-as-paren (pos) ;; Mark the ">" character at POS as an sexp list closer using the - ;; syntax-table property. + ;; `syntax-table' property either directly (XEmacs) or via a `category' + ;; property (GNU Emacs). ;; ;; This function does a hidden buffer change. Note that we use ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. - (c-put-char-property pos 'category 'c->-as-paren-syntax)) - -(defsubst c-unmark-<->-as-paren (pos) - ;; Unmark the "<" or "<" character at POS as an sexp list opener using - ;; the syntax-table property indirectly through the `category' text - ;; property. + (if c-use-category + `(c-put-char-property ,pos 'category 'c->-as-paren-syntax) + `(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax))) + +(defmacro c-unmark-<->-as-paren (pos) + ;; Unmark the "<" or "<" character at POS as an sexp list opener using the + ;; `syntax-table' property either directly or indirectly through a + ;; `category' text property. ;; - ;; This function does a hidden buffer change. Note that we use + ;; This function does a hidden buffer change. Note that we try to use ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. - (c-clear-char-property pos 'category)) + `(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table))) (defsubst c-suppress-<->-as-parens () ;; Suppress the syntactic effect of all marked < and > as parens. Note @@ -1304,6 +1350,124 @@ been put there by c-put-char-property. POINT remains unchanged." (widen) (c-set-cpp-delimiters ,beg ,end))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following macros are to be used only in `c-parse-state' and its +;; subroutines. Their main purpose is to simplify the handling of C++/Java +;; template delimiters and CPP macros. In GNU Emacs, this is done slickly by +;; the judicious use of 'category properties. These don't exist in XEmacs. +;; +;; Note: in the following macros, there is no special handling for parentheses +;; inside CPP constructs. That is because CPPs are always syntactically +;; balanced, thanks to `c-neutralize-CPP-line' in cc-mode.el. +(defmacro c-sc-scan-lists-no-category+1+1 (from) + ;; Do a (scan-lists FROM 1 1). Any finishing position which either (i) is + ;; determined by and angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from 1 1))) + (while (eq (char-before pos) ?>) + (setq pos (scan-lists pos 1 1))) + pos)) + +(defmacro c-sc-scan-lists-no-category+1-1 (from) + ;; Do a (scan-lists FROM 1 -1). Any finishing position which either (i) is + ;; determined by an angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from 1 -1))) + (while (eq (char-before pos) ?<) + (setq pos (scan-lists pos 1 1)) + (setq pos (scan-lists pos 1 -1))) + pos)) + +(defmacro c-sc-scan-lists-no-category-1+1 (from) + ;; Do a (scan-lists FROM -1 1). Any finishing position which either (i) is + ;; determined by and angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from -1 1))) + (while (eq (char-after pos) ?<) + (setq pos (scan-lists pos -1 1))) + pos)) + +(defmacro c-sc-scan-lists-no-category-1-1 (from) + ;; Do a (scan-lists FROM -1 -1). Any finishing position which either (i) is + ;; determined by and angle bracket; or (ii) is inside a macro whose start + ;; isn't POINT-MACRO-START doesn't count as a finishing position. + `(let ((here (point)) + (pos (scan-lists ,from -1 -1))) + (while (eq (char-after pos) ?>) + (setq pos (scan-lists pos -1 1)) + (setq pos (scan-lists pos -1 -1))) + pos)) + +(defmacro c-sc-scan-lists (from count depth) + (if c-use-category + `(scan-lists ,from ,count ,depth) + (cond + ((and (eq count 1) (eq depth 1)) + `(c-sc-scan-lists-no-category+1+1 ,from)) + ((and (eq count 1) (eq depth -1)) + `(c-sc-scan-lists-no-category+1-1 ,from)) + ((and (eq count -1) (eq depth 1)) + `(c-sc-scan-lists-no-category-1+1 ,from)) + ((and (eq count -1) (eq depth -1)) + `(c-sc-scan-lists-no-category-1-1 ,from)) + (t (error "Invalid parameter(s) to c-sc-scan-lists"))))) + + +(defun c-sc-parse-partial-sexp-no-category (from to targetdepth stopbefore + oldstate) + ;; Do a parse-partial-sexp using the supplied arguments, disregarding + ;; template/generic delimiters < > and disregarding macros other than the + ;; one at POINT-MACRO-START. + ;; + ;; NOTE that STOPBEFORE must be nil. TARGETDEPTH should be one less than + ;; the depth in OLDSTATE. This function is thus a SPECIAL PURPOSE variation + ;; on parse-partial-sexp, designed for calling from + ;; `c-remove-stale-state-cache'. + ;; + ;; Any finishing position which is determined by an angle bracket delimiter + ;; doesn't count as a finishing position. + ;; + ;; Note there is no special handling of CPP constructs here, since these are + ;; always syntactically balanced (thanks to `c-neutralize-CPP-line'). + (let ((state + (parse-partial-sexp from to targetdepth stopbefore oldstate))) + (while + (and (< (point) to) + ;; We must have hit targetdepth. + (or (eq (char-before) ?<) + (eq (char-before) ?>))) + (setcar state + (if (memq (char-before) '(?> ?\) ?\} ?\])) + (1+ (car state)) + (1- (car state)))) + (setq state + (parse-partial-sexp (point) to targetdepth stopbefore oldstate))) + state)) + +(defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore + oldstate) + (if c-use-category + `(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate) + `(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore + ,oldstate))) + + +(defvar c-emacs-features) + +(defmacro c-looking-at-non-alphnumspace () + "Are we looking at a character which isn't alphanumeric or space?" + (if (memq 'gen-comment-delim c-emacs-features) + `(looking-at +"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)") + `(or (looking-at +"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)" + (let ((prop (c-get-char-property (point) 'syntax-table))) + (eq prop '(14))))))) ; '(14) is generic comment delimiter. + + (defsubst c-intersect-lists (list alist) ;; return the element of ALIST that matches the first element found ;; in LIST. Uses assq. @@ -1419,8 +1583,8 @@ Notably, null elements in LIST are ignored." (defun c-make-keywords-re (adorn list &optional mode) "Make a regexp that matches all the strings the list. -Duplicates and nil elements in the list are removed. The resulting -regexp may contain zero or more submatch expressions. +Duplicates and nil elements in the list are removed. The +resulting regexp may contain zero or more submatch expressions. If ADORN is t there will be at least one submatch and the first surrounds the matched alternative, and the regexp will also not match @@ -1438,11 +1602,7 @@ The optional MODE specifies the language to get `c-nonsymbol-key' from when it's needed. The default is the current language taken from `c-buffer-is-cc-mode'." - (let (unique) - (dolist (elt list) - (unless (member elt unique) - (push elt unique))) - (setq list (delete nil unique))) + (setq list (delete nil (delete-dups list))) (if list (let (re) @@ -1609,6 +1769,9 @@ non-nil, a caret is prepended to invert the set." (not (end-of-defun)))) (setq list (cons 'argumentative-bod-function list)))) + ;; Record whether the `category' text property works. + (if c-use-category (setq list (cons 'category-properties list))) + (let ((buf (generate-new-buffer " test")) parse-sexp-lookup-properties parse-sexp-ignore-comments @@ -1638,13 +1801,13 @@ non-nil, a caret is prepended to invert the set." "support for the `syntax-table' text property " "is required."))) - ;; Find out if generic comment delimiters work. + ;; Find out if "\\s!" (generic comment delimiters) work. (c-safe (modify-syntax-entry ?x "!") (if (string-match "\\s!" "x") (setq list (cons 'gen-comment-delim list)))) - ;; Find out if generic string delimiters work. + ;; Find out if "\\s|" (generic string delimiters) work. (c-safe (modify-syntax-entry ?x "|") (if (string-match "\\s|" "x") @@ -1691,7 +1854,8 @@ non-nil, a caret is prepended to invert the set." (kill-buffer buf)) ;; See if `parse-partial-sexp' returns the eighth element. - (if (c-safe (>= (length (save-excursion (parse-partial-sexp (point) (point)))) + (if (c-safe (>= (length (save-excursion + (parse-partial-sexp (point) (point)))) 10)) (setq list (cons 'pps-extended-state list)) (error (concat @@ -1707,13 +1871,14 @@ might be present: '8-bit 8 bit syntax entry flags (XEmacs style). '1-bit 1 bit syntax entry flags (Emacs style). -'argumentative-bod-function beginning-of-defun passes ARG through - to a non-null beginning-of-defun-function. It is assumed - the end-of-defun does the same thing. +'argumentative-bod-function beginning-of-defun and end-of-defun pass + ARG through to beginning/end-of-defun-function. 'syntax-properties It works to override the syntax for specific characters in the buffer with the 'syntax-table property. It's always set - CC Mode no longer works in emacsen without this feature. +'category-properties Syntax routines can add a level of indirection to text + properties using the 'category property. 'gen-comment-delim Generic comment delimiters work (i.e. the syntax class `!'). 'gen-string-delim Generic string delimiters work @@ -1803,18 +1968,18 @@ system." (error "Unknown base mode `%s'" base-mode)) (put mode 'c-fallback-mode base-mode)) -(defvar c-lang-constants (make-vector 151 0) - "Obarray used as a cache to keep track of the language constants. -The constants stored are those defined by `c-lang-defconst' and the values -computed by `c-lang-const'. It's mostly used at compile time but it's not -stored in compiled files. +(defvar c-lang-constants (make-vector 151 0)) +;; Obarray used as a cache to keep track of the language constants. +;; The constants stored are those defined by `c-lang-defconst' and the values +;; computed by `c-lang-const'. It's mostly used at compile time but it's not +;; stored in compiled files. -The obarray contains all the language constants as symbols. The -value cells hold the evaluated values as alists where each car is -the mode name symbol and the corresponding cdr is the evaluated -value in that mode. The property lists hold the source definitions -and other miscellaneous data. The obarray might also contain -various other symbols, but those don't have any variable bindings.") +;; The obarray contains all the language constants as symbols. The +;; value cells hold the evaluated values as alists where each car is +;; the mode name symbol and the corresponding cdr is the evaluated +;; value in that mode. The property lists hold the source definitions +;; and other miscellaneous data. The obarray might also contain +;; various other symbols, but those don't have any variable bindings. (defvar c-lang-const-expansion nil) @@ -1831,14 +1996,16 @@ various other symbols, but those don't have any variable bindings.") (t ;; Being evaluated interactively. (buffer-file-name))))) - (and file (file-name-base file)))) + (and file + (file-name-sans-extension + (file-name-nondirectory file))))) (defmacro c-lang-defconst-eval-immediately (form) "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM immediately, i.e. at the same time as the `c-lang-defconst' form itself is evaluated." ;; Evaluate at macro expansion time, i.e. in the - ;; `macroexpand-all' inside `c-lang-defconst'. + ;; `c--macroexpand-all' inside `c-lang-defconst'. (eval form)) (defmacro c-lang-defconst (name &rest args) @@ -1882,7 +2049,7 @@ constant. A file is identified by its base name." (let* ((sym (intern (symbol-name name) c-lang-constants)) ;; Make `c-lang-const' expand to a straightforward call to - ;; `c-get-lang-constant' in `macroexpand-all' below. + ;; `c-get-lang-constant' in `c--macroexpand-all' below. ;; ;; (The default behavior, i.e. to expand to a call inside ;; `eval-when-compile' should be equivalent, since that macro @@ -1945,7 +2112,7 @@ constant. A file is identified by its base name." ;; reason, but we also use this expansion handle ;; `c-lang-defconst-eval-immediately' and to register ;; dependencies on the `c-lang-const's in VAL.) - (setq val (macroexpand-all val)) + (setq val (c--macroexpand-all val)) (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings) args (cdr args)))) @@ -2270,4 +2437,8 @@ fallback definition for all modes, to break the cycle).") (cc-provide 'cc-defs) +;;; Local Variables: +;;; indent-tabs-mode: t +;;; tab-width: 8 +;;; End: ;;; cc-defs.el ends here