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")))
\f
;;; Variables also used at compile time.
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)
`(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)))
;; 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
(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)
;; 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)
;; 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))))
;; `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))
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)
(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.
;; 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.
(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
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)
(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.
(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")
(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")
(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)
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.")
\f
;;; Some helper constants.
(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)
(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
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")))))
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