X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/47003633639a963d2a911d51bf69f4e29d36ff53..10501882f7c23525c14f3f4712ce34f7fe335864:/lisp/progmodes/cc-defs.el diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 91c5773ebb..dc31fde131 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -86,6 +86,11 @@ 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. @@ -195,7 +200,7 @@ If the referenced position doesn't exist, the closest accessible point to it is returned. This function does not modify the point or the mark." (if (eq (car-safe position) 'quote) - (let ((position (nth 1 position))) + (let ((position (eval position))) (cond ((eq position 'bol) @@ -885,7 +890,7 @@ MODE is either a mode symbol or a list of mode symbols." `(c-lang-major-mode-is ,mode) (if (eq (car-safe mode) 'quote) - (let ((mode (nth 1 mode))) + (let ((mode (eval mode))) (if (listp mode) `(memq c-buffer-is-cc-mode ',mode) `(eq c-buffer-is-cc-mode ',mode))) @@ -900,10 +905,32 @@ MODE is either a mode symbol or a list of mode symbols." ;; properties set on a single character and that never spread to any ;; other characters. +(eval-and-compile + ;; Constant used at compile time to decide whether or not to use + ;; XEmacs extents. Check all the extent functions we'll use since + ;; some packages might add compatibility aliases for some of them in + ;; Emacs. + (defconst c-use-extents (and (cc-bytecomp-fboundp 'extent-at) + (cc-bytecomp-fboundp 'set-extent-property) + (cc-bytecomp-fboundp 'set-extent-properties) + (cc-bytecomp-fboundp 'make-extent) + (cc-bytecomp-fboundp 'extent-property) + (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 - (cond ((featurep 'xemacs) + (cc-eval-when-compile + (cond (c-use-extents + ;; XEmacs. + (byte-compile (lambda (pos property value) (let ((ext (extent-at pos nil property))) (if ext @@ -912,19 +939,20 @@ MODE is either a mode symbol or a list of mode symbols." (cons property (cons value '(start-open t - end-open t)))))))) + end-open t))))))))) ((not (cc-bytecomp-boundp 'text-property-default-nonsticky)) ;; In Emacs < 21 we have to mess with the `rear-nonsticky' property. + (byte-compile (lambda (pos property value) (put-text-property pos (1+ pos) property value) (let ((prop (get-text-property pos 'rear-nonsticky))) (or (memq property prop) (put-text-property pos (1+ pos) 'rear-nonsticky - (cons property prop)))))) + (cons property prop))))))) ;; This won't be used for anything. - (t #'ignore))) + (t 'ignore)))) (cc-bytecomp-defun c-put-char-property-fun) ; Make it known below. (defmacro c-put-char-property (pos property value) @@ -939,38 +967,42 @@ MODE is either a mode symbol or a list of mode symbols." ;; 21) then it's assumed that the property is present on it. ;; ;; This macro does a hidden buffer change. - (if (or (featurep 'xemacs) + (setq property (eval property)) + (if (or c-use-extents (not (cc-bytecomp-boundp 'text-property-default-nonsticky))) ;; XEmacs and Emacs < 21. - `(c-put-char-property-fun ,pos ,property ,value) + `(c-put-char-property-fun ,pos ',property ,value) ;; In Emacs 21 we got the `rear-nonsticky' property covered ;; by `text-property-default-nonsticky'. `(let ((-pos- ,pos)) - (put-text-property -pos- (1+ -pos-) ,property ,value)))) + (put-text-property -pos- (1+ -pos-) ',property ,value)))) (defmacro c-get-char-property (pos property) ;; Get the value of the given property on the character at POS if ;; it's been put there by `c-put-char-property'. PROPERTY is ;; assumed to be constant. - (if (featurep 'xemacs) + (setq property (eval property)) + (if c-use-extents ;; XEmacs. - `(let ((ext (extent-at ,pos nil ,property))) - (if ext (extent-property ext ,property))) + `(let ((ext (extent-at ,pos nil ',property))) + (if ext (extent-property ext ',property))) ;; Emacs. - `(get-text-property ,pos ,property))) + `(get-text-property ,pos ',property))) ;; `c-clear-char-property' is complex enough in Emacs < 21 to make it ;; a function, since we have to mess with the `rear-nonsticky' property. (defalias 'c-clear-char-property-fun - (unless (or (featurep 'xemacs) + (cc-eval-when-compile + (unless (or c-use-extents (cc-bytecomp-boundp 'text-property-default-nonsticky)) + (byte-compile (lambda (pos property) (when (get-text-property pos property) (remove-text-properties pos (1+ pos) (list property nil)) (put-text-property pos (1+ pos) 'rear-nonsticky (delq property (get-text-property - pos 'rear-nonsticky))))))) + pos 'rear-nonsticky))))))))) (cc-bytecomp-defun c-clear-char-property-fun) ; Make it known below. (defmacro c-clear-char-property (pos property) @@ -979,10 +1011,8 @@ MODE is either a mode symbol or a list of mode symbols." ;; constant. ;; ;; This macro does a hidden buffer change. - (if (eq 'quote (car-safe property)) - (setq property (nth 1 property)) - (error "`property' should be a quoted constant")) - (cond ((featurep 'xemacs) + (setq property (eval property)) + (cond (c-use-extents ;; XEmacs. `(let ((ext (extent-at ,pos nil ',property))) (if ext (delete-extent ext)))) @@ -1007,10 +1037,8 @@ MODE is either a mode symbol or a list of mode symbols." ;; `syntax-table'. ;; ;; This macro does hidden buffer changes. - (if (eq 'quote (car-safe property)) - (setq property (nth 1 property)) - (error "`property' should be a quoted constant")) - (if (featurep 'xemacs) + (setq property (eval property)) + (if c-use-extents ;; XEmacs. `(map-extents (lambda (ext ignored) (delete-extent ext)) @@ -1080,7 +1108,7 @@ been put there by c-put-char-property. POINT remains unchanged." which have the value VALUE, as tested by `equal'. These properties are assumed to be over individual characters, having been put there by c-put-char-property. POINT remains unchanged." - (if (featurep 'xemacs) + (if c-use-extents ;; XEmacs `(let ((-property- ,property)) (map-extents (lambda (ext val) @@ -1171,9 +1199,6 @@ 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) ;; Mark the "<" character at POS as a template opener using the ;; `syntax-table' property via the `category' property. @@ -1184,9 +1209,6 @@ been put there by c-put-char-property. POINT remains unchanged." ;; cheaply. We use this, for instance, in `c-parse-state'. (c-put-char-property pos 'category '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) ;; Mark the ">" character at POS as an sexp list closer using the ;; syntax-table property. @@ -1402,8 +1424,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 @@ -1421,11 +1443,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) @@ -1544,6 +1562,32 @@ non-nil, a caret is prepended to invert the set." (defconst c-emacs-features (let (list) + (if (boundp 'infodock-version) + ;; I've no idea what this actually is, but it's legacy. /mast + (setq list (cons 'infodock list))) + + ;; XEmacs uses 8-bit modify-syntax-entry flags. + ;; Emacs uses a 1-bit flag. We will have to set up our + ;; syntax tables differently to handle this. + (let ((table (copy-syntax-table)) + entry) + (modify-syntax-entry ?a ". 12345678" table) + (cond + ;; Emacs + ((arrayp table) + (setq entry (aref table ?a)) + ;; In Emacs, table entries are cons cells + (if (consp entry) (setq entry (car entry)))) + ;; XEmacs + ((fboundp 'get-char-table) + (setq entry (get-char-table ?a table))) + ;; incompatible + (t (error "CC Mode is incompatible with this version of Emacs"))) + (setq list (cons (if (= (logand (lsh entry -16) 255) 255) + '8-bit + '1-bit) + list))) + ;; Check whether beginning/end-of-defun call ;; beginning/end-of-defun-function nicely, passing through the ;; argument and respecting the return code. @@ -1566,19 +1610,42 @@ non-nil, a caret is prepended to invert the set." (not (end-of-defun)))) (setq list (cons 'argumentative-bod-function list)))) - (with-temp-buffer - (let ((parse-sexp-lookup-properties t) - (parse-sexp-ignore-comments t) - (lookup-syntax-properties t)) ; XEmacs + (let ((buf (generate-new-buffer " test")) + parse-sexp-lookup-properties + parse-sexp-ignore-comments + lookup-syntax-properties) ; XEmacs + (with-current-buffer buf (set-syntax-table (make-syntax-table)) - ;; Find out if generic comment delimiters work. + ;; For some reason we have to set some of these after the + ;; buffer has been made current. (Specifically, + ;; `parse-sexp-ignore-comments' in Emacs 21.) + (setq parse-sexp-lookup-properties t + parse-sexp-ignore-comments t + lookup-syntax-properties t) + + ;; Find out if the `syntax-table' text property works. + (modify-syntax-entry ?< ".") + (modify-syntax-entry ?> ".") + (insert "<()>") + (c-mark-<-as-paren (point-min)) + (c-mark->-as-paren (+ 3 (point-min))) + (goto-char (point-min)) + (c-forward-sexp) + (if (= (point) (+ 4 (point-min))) + (setq list (cons 'syntax-properties list)) + (error (concat + "CC Mode is incompatible with this version of Emacs - " + "support for the `syntax-table' text property " + "is required."))) + + ;; 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") @@ -1608,11 +1675,11 @@ non-nil, a caret is prepended to invert the set." (cond ;; XEmacs. Afaik this is currently an Emacs-only ;; feature, but it's good to be prepared. - ((featurep 'xemacs) + ((memq '8-bit list) (modify-syntax-entry ?/ ". 1456") (modify-syntax-entry ?* ". 23")) ;; Emacs - (t + ((memq '1-bit list) (modify-syntax-entry ?/ ". 124b") (modify-syntax-entry ?* ". 23"))) (modify-syntax-entry ?\n "> b") @@ -1621,7 +1688,17 @@ non-nil, a caret is prepended to invert the set." (if (bobp) (setq list (cons 'col-0-paren list))))) - (set-buffer-modified-p nil))) + (set-buffer-modified-p nil)) + (kill-buffer buf)) + + ;; See if `parse-partial-sexp' returns the eighth element. + (if (c-safe (>= (length (save-excursion + (parse-partial-sexp (point) (point)))) + 10)) + (setq list (cons 'pps-extended-state list)) + (error (concat + "CC Mode is incompatible with this version of Emacs - " + "`parse-partial-sexp' has to return at least 10 elements."))) ;;(message "c-emacs-features: %S" list) list) @@ -1630,16 +1707,28 @@ There are many flavors of Emacs out there, each with different features supporting those needed by CC Mode. The following values might be present: -`argumentative-bod-function' `beginning-of-defun' passes ARG through - to a non-null `beginning-of-defun-function.' It is assumed - that `end-of-defun' does the same thing. -`gen-comment-delim' Generic comment delimiters work +'8-bit 8 bit syntax entry flags (XEmacs style). +'1-bit 1 bit syntax entry flags (Emacs style). +'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. +'gen-comment-delim Generic comment delimiters work (i.e. the syntax class `!'). -`gen-string-delim' Generic string delimiters work +'gen-string-delim Generic string delimiters work (i.e. the syntax class `|'). -`posix-char-classes' The regexp engine understands POSIX character classes. -`col-0-paren' It's possible to turn off the ad-hoc rule that a paren - in column zero is the start of a defun.") +'pps-extended-state `parse-partial-sexp' returns a list with at least 10 + elements, i.e. it contains the position of the start of + the last comment or string. It's always set - CC Mode + no longer works in emacsen without this feature. +'posix-char-classes The regexp engine understands POSIX character classes. +'col-0-paren It's possible to turn off the ad-hoc rule that a paren + in column zero is the start of a defun. +'infodock This is Infodock (based on XEmacs). + +'8-bit and '1-bit are mutually exclusive.") ;;; Some helper constants. @@ -1715,18 +1804,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) @@ -1743,7 +1832,9 @@ 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 @@ -1935,6 +2026,11 @@ LANG is the name of the language, i.e. the mode name without the language. NAME and LANG are not evaluated so they should not be quoted." + (or (symbolp name) + (error "Not a symbol: %S" name)) + (or (symbolp lang) + (error "Not a symbol: %S" lang)) + (let ((sym (intern (symbol-name name) c-lang-constants)) (mode (when lang (intern (concat (symbol-name lang) "-mode"))))) @@ -2095,56 +2191,57 @@ fallback definition for all modes, to break the cycle).") value)))) (defun c-find-assignment-for-mode (source-pos mode match-any-lang _name) - "Find the first assignment entry that applies to MODE at or after -SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with `t' as -the language list are considered to match, otherwise they don't. -On return SOURCE-POS is updated to point to the next assignment -after the returned one. If no assignment is found, -`c-lang--novalue' is returned as a magic value. - -SOURCE-POS is a vector that points out a specific assignment in -the double alist that's used in the `source' property. The first -element is the position in the top alist which is indexed with -the source files, and the second element is the position in the -nested bindings alist. - -NAME is only used for error messages." + ;; Find the first assignment entry that applies to MODE at or after + ;; SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with `t' as + ;; the language list are considered to match, otherwise they don't. + ;; On return SOURCE-POS is updated to point to the next assignment + ;; after the returned one. If no assignment is found, + ;; `c-lang--novalue' is returned as a magic value. + ;; + ;; SOURCE-POS is a vector that points out a specific assignment in + ;; the double alist that's used in the `source' property. The first + ;; element is the position in the top alist which is indexed with + ;; the source files, and the second element is the position in the + ;; nested bindings alist. + ;; + ;; NAME is only used for error messages. (catch 'found (let ((file-entry (elt source-pos 0)) (assignment-entry (elt source-pos 1)) assignment) - (while (or assignment-entry - ;; Handled the last assignment from one file, begin on the - ;; next. Due to the check in `c-lang-defconst', we know - ;; there's at least one. - (when file-entry - - (unless (aset source-pos 1 - (setq assignment-entry (cdar file-entry))) - ;; The file containing the source definitions has not - ;; been loaded. - (let ((file (symbol-name (caar file-entry))) - (c-lang-constants-under-evaluation nil)) - ;;(message (concat "Loading %s to get the source " - ;; "value for language constant %s") - ;; file name) - (load file nil t)) - - (unless (setq assignment-entry (cdar file-entry)) - ;; The load didn't fill in the source for the - ;; constant as expected. The situation is - ;; probably that a derived mode was written for - ;; and compiled with another version of CC Mode, - ;; and the requested constant isn't in the - ;; currently loaded one. Put in a dummy - ;; assignment that matches no language. - (setcdr (car file-entry) - (setq assignment-entry (list (list nil)))))) - - (aset source-pos 0 (setq file-entry (cdr file-entry))) - t)) + (while (if assignment-entry + t + ;; Handled the last assignment from one file, begin on the + ;; next. Due to the check in `c-lang-defconst', we know + ;; there's at least one. + (when file-entry + + (unless (aset source-pos 1 + (setq assignment-entry (cdar file-entry))) + ;; The file containing the source definitions has not + ;; been loaded. + (let ((file (symbol-name (caar file-entry))) + (c-lang-constants-under-evaluation nil)) + ;;(message (concat "Loading %s to get the source " + ;; "value for language constant %s") + ;; file name) + (load file nil t)) + + (unless (setq assignment-entry (cdar file-entry)) + ;; The load didn't fill in the source for the + ;; constant as expected. The situation is + ;; probably that a derived mode was written for + ;; and compiled with another version of CC Mode, + ;; and the requested constant isn't in the + ;; currently loaded one. Put in a dummy + ;; assignment that matches no language. + (setcdr (car file-entry) + (setq assignment-entry (list (list nil)))))) + + (aset source-pos 0 (setq file-entry (cdr file-entry))) + t)) (setq assignment (car assignment-entry)) (aset source-pos 1