diff --git a/lib/tools/pike.el b/lib/tools/pike.el
index 538d9b8b15273ac653a8adabd4882bf4f4fab3c0..b5bda468fb093added85a8d0ef6e059e6e007c4a 100644
--- a/lib/tools/pike.el
+++ b/lib/tools/pike.el
@@ -1,5 +1,5 @@
;;; pike.el -- Font lock definitions for Pike and other LPC files.
-;;; $Id: pike.el,v 1.24 2001/04/16 03:05:41 mast Exp $
+;;; $Id: pike.el,v 1.25 2001/04/23 16:31:30 mast Exp $
;;; Copyright (C) 1995, 1996, 1997, 1998, 1999 Per Hedbor.
;;; This file is distributed as GPL
@@ -38,23 +38,23 @@
(defface pike-font-lock-refdoc-face
'((t))
- "Face to use for normal text in Pike documentation comments. It's
-overlaid over the `font-lock-comment-face'."
+ "Face to use for normal text in Pike documentation comments.
+It's overlaid over the `font-lock-comment-face'."
:group 'pike-faces)
(defface pike-font-lock-refdoc-init-face
'((t (:bold t)))
- "Face to use for the magic init char of Pike documentation comments. It's
-overlaid over the `font-lock-comment-face'."
+ "Face to use for the magic init char of Pike documentation comments.
+It's overlaid over the `font-lock-comment-face'."
:group 'pike-faces)
(defface pike-font-lock-refdoc-init2-face
'((t))
- "Face to use for the comment starters Pike documentation comments. It's
-overlaid over the `font-lock-comment-face'."
+ "Face to use for the comment starters Pike documentation comments.
+It's overlaid over the `font-lock-comment-face'."
:group 'pike-faces)
(defface pike-font-lock-refdoc-keyword-face
'((t))
- "Face to use for markup keywords Pike documentation comments. It's
-overlaid over the `font-lock-reference-face'."
+ "Face to use for markup keywords Pike documentation comments.
+It's overlaid over the `font-lock-reference-face'."
:group 'pike-faces)
(defface pike-font-lock-refdoc-error-face
'((((class color) (background light)) (:foreground "red"))
@@ -94,12 +94,6 @@ overlaid over the `font-lock-reference-face'."
(letter "a-zA-Z\241-\377_")
(digit "0-9"))
- (defconst pike-font-lock-type-chars
- ;; Not using letter here since this string is used in
- ;; skip-chars-backward, which at least in Emacs 19.34 is broken
- ;; and hangs when it gets characters in the high eight bit range.
- (concat "a-zA-Z_" digit " \t\n\r:()[].|,"))
-
(defconst pike-font-lock-identifier-regexp
(concat "\\(\\<[" letter "][" letter digit "]*\\>\\|"
pike-font-lock-operator-identifiers
@@ -120,15 +114,17 @@ The name is assumed to begin with a capital letter.")
(concat "[ \t\n\r]*"
"\\(" ; 1
(concat "\\(" ; 2
- "//[^\n]*"
+ "//[^\n\r]*[\n\r]"
"\\|"
"/\\*\\([^*]\\|\\*[^/]\\)*\\*/" ; 3
+ "\\|"
+ "\\\\[\n\r]"
"\\)")
"[ \t\n\r]*"
"\\)*"))
(defconst pike-font-lock-qualified-identifier
- (concat "\\(\\.?" ; 1
+ (concat "\\([ \t\n\r]*\\.?[ \t\n\r]*" ; 1
pike-font-lock-identifier-regexp ; 2
"\\)+"))
@@ -143,37 +139,58 @@ The name is assumed to begin with a capital letter.")
(set-buffer-file-coding-system (symbol-concat coding))))
(t nil)))
-(defconst pike-font-lock-maybe-type
- (concat pike-font-lock-identifier-regexp "[ \t\n\r]*" ; 1
- "\\(\\.\\.\\.[ \t\n\r]*\\)?" ; 2
- (concat "\\(" ; 3
- "[\]\)][\]\) \t\n\r]*"
- pike-font-lock-semantic-whitespace ; 4-6
- (concat "\\(" ; 7
- pike-font-lock-identifier-regexp ; 8
- "\\|\("
- "\\)")
- "\\|"
- pike-font-lock-semantic-whitespace ; 9-11
- pike-font-lock-identifier-regexp ; 12
- "\\)")))
+(defconst pike-font-lock-maybe-type-end
+ (concat "\\(\\.\\.\\.\\|[\]\)]\\)" ; 1
+ pike-font-lock-semantic-whitespace ; 2-4
+ "\\(\\<\\sw\\|\\<\\s_\\|`\\|\(\\)" ; 5
+ "\\|"
+ "\\(\\sw\\|\\s_\\)" ; 6
+ pike-font-lock-semantic-whitespace ; 7-9
+ "\\(\\<\\sw\\|\\<\\s_\\|`\\)")) ; 10
(defvar pike-font-lock-last-type-end nil)
(defvar pike-font-lock-real-limit nil)
+(defvar pike-font-lock-more-identifiers nil)
-(defun pike-font-lock-find-first-type (limit)
- "Finds the first identifier/keyword in a type."
+;; The following variable records the identifiers that have been font
+;; locked so far in the latest run of `pike-font-lock-find-type' and
+;; the following `pike-font-lock-fontify-type's. It's used to undo all
+;; the highlights in the current type if we later find chars that
+;; don't belong in a type.
+(defvar pike-font-lock-maybe-ids nil)
+
+(defsubst pike-font-lock-forward-syntactic-ws ()
+ (forward-comment 134217727)
+ (while (looking-at "\\\\$")
+ (forward-char)
+ (forward-comment 134217727)))
+
+(defsubst pike-font-lock-backward-syntactic-ws ()
+ ;; If forward-comment in Emacs 19.34 is given a large negative
+ ;; value, it'll loop all the way through if it it hits bob.
+ (let ((pos (point)))
+ (forward-comment -20)
+ (while (or (and (< (point) pos)
+ (memq (preceding-char) '(?\ ?\t ?\n ?\r ?/)))
+ (when (and (eolp) (eq (preceding-char) ?\\))
+ (backward-char)
+ t))
+ (setq pos (point))
+ (forward-comment -20))))
+
+(defun pike-font-lock-find-type (limit)
+ "Finds the beginning of a type."
;; The trick we use here is (in principle) to find two consecutive
;; identifiers without an operator between them. It works only if
;; things like keywords have been fontified first.
- (let* ((start (point)) cast cast-end-pos no-face-pos
- (large-pos (point-max)) (large-neg (- large-pos)))
+ (let* ((start (point))
+ no-face-pos continue-pos check-macro-end cast cast-end-pos beg-pos)
;; We store the limit given to this function for use in the
;; anchored functions, since font-lock somewhat obnoxiously always
;; limits anchors to the same line, which we want to ignore.
(setq pike-font-lock-real-limit limit)
(catch 'done
- (while (re-search-forward pike-font-lock-maybe-type limit t)
+ (while (re-search-forward pike-font-lock-maybe-type-end limit t)
(if (not (memq (get-text-property (match-beginning 0) 'face)
'(font-lock-type-face nil)))
;; Ignore a match where what we think is a type is already
@@ -184,162 +201,216 @@ The name is assumed to begin with a capital letter.")
;; hits especially inside strings and comments.
(goto-char no-face-pos)
(throw 'done nil))
- (goto-char (setq pike-font-lock-last-type-end
- (or (match-beginning 7) (match-beginning 12))))
+ (setq continue-pos (or (match-beginning 5) (match-beginning 10)))
(catch 'continue
- (forward-comment large-neg)
+ (goto-char (or (match-end 1) (match-end 6)))
+ (setq check-macro-end
+ ;; If there's a newline between the end of the type and the
+ ;; following expression, the type part might end a macro.
+ ;; We'll have to check up on that later.
+ (< (save-excursion (end-of-line) (point)) continue-pos))
(when (setq cast (assq (preceding-char) '((?\) . ?\() (?\] . ?\[))))
;; This might be a cast.
(setq cast-end-pos (1- (point))
cast (cdr cast)))
;; Now at the end of something that might be a type. Back
- ;; up to the beginning of it by balanced sexps, accepting
- ;; only identifiers and the type operators in between.
+ ;; up to the beginning of the expression but not past a
+ ;; point that might be a preceding type or cast.
(condition-case nil
- (let ((type-min-pos
- (save-excursion
- ;; NB: Doesn't work if there are comments in the type.
- (skip-chars-backward pike-font-lock-type-chars)
- (point))))
+ (progn
+ (setq beg-pos nil)
(goto-char (scan-sexps (point) -1))
- (if (< (point) type-min-pos) (throw 'continue nil))
- (while (or (eq (following-char) ?\()
- (progn
- (forward-comment large-neg)
- (when (memq (preceding-char) '(?| ?.))
- (backward-char)
- t)))
- (goto-char (scan-sexps (point) -1))
- (if (< (point) type-min-pos) (throw 'continue nil))
+ (while (and
+ (let ((prev-beg-pos beg-pos)
+ (tok-beg (following-char)))
+ (setq beg-pos (point))
+ (pike-font-lock-backward-syntactic-ws)
+ (cond
+ ((eq tok-beg ?\()
+ ;; Cast or a subtype expression start.
+ (when (memq (char-syntax (preceding-char)) '(?w ?_))
+ (goto-char (scan-sexps (point) -1))
+ (if (looking-at pike-font-lock-type-regexp)
+ ;; Is a subtype expression start.
+ t
+ (unless (looking-at "return\\|case\\|break\\|continue")
+ ;; If it's a word before the paren and it's
+ ;; not one of the above it can't be a cast.
+ (if prev-beg-pos
+ (setq beg-pos prev-beg-pos)
+ (throw 'continue t))
+ nil))))
+ ((eq tok-beg ?\[)
+ ;; Soft cast.
+ nil)
+ ((memq (preceding-char) '(?| ?. ?& ?! ?~))
+ ;; Some operator valid on the top level of a type
+ ;; (yes, we're a little ahead of time here).
+ (goto-char (scan-sexps (point) -1))
+ t)))
+ (>= (point) start))
(setq cast nil)))
;; Should only get here if the scan-sexps above fails.
(error nil))
- (forward-comment large-pos)
- (when (and (save-excursion
+ (goto-char beg-pos)
+ (when (and check-macro-end
+ ;; End of the type and beg of the expression are on
+ ;; different lines...
+ (save-excursion
+ (goto-char continue-pos)
+ (beginning-of-line)
+ ;; bob can't happen here.
+ (not (eq (char-after (- (point) 2)) ?\\)))
+ ;; ...and the expression is not part of a macro...
+ (save-excursion
(beginning-of-line)
- (looking-at "\\s *#\\s *define\\s *"))
- (eq (match-end 0) (point)))
- ;; Got to check for the case "#define x(foo) bar".
- (throw 'continue nil))
- (when (eq (following-char) cast)
- ;; Jumped over exactly one sexp surrounded with ( ) or [
- ;; ], so it's a cast and the type begins inside it. Also
- ;; make sure that pike-font-lock-find-following-identifier
- ;; doesn't highlight any following identifier.
- (skip-chars-forward " \t\n\r([")
- (setq pike-font-lock-last-type-end cast-end-pos))
- (when (and (not (looking-at
-"\\(if\\|while\\|for\\|foreach\\|switch\\|lambda\\)\\>[^_]"))
- (looking-at pike-font-lock-identifier-regexp))
- (when (< (point) start)
- ;; Type started before the start of the search, so we
- ;; jump to the first identifier in the type that's after
- ;; the start. This search should never fail.
+ (while (and (>= (- (point) 2) (point-min))
+ (eq (char-after (- (point) 2)) ?\\))
+ (forward-line -1))
+ (eq (following-char) ?#)))
+ ;; ...but the type is. They therefore don't correspond to each
+ ;; other and we should ignore it. Set continue-pos to continue
+ ;; searching after the macro. We also set start so we don't go
+ ;; back into the macro a second time.
+ (save-restriction
+ (end-of-line)
+ (while (and (not (eobp))
+ (eq (preceding-char) ?\\))
+ (forward-char)
+ (end-of-line))
+ (setq start (point)
+ continue-pos (point)))
+ (throw 'continue t))
+ (setq pike-font-lock-more-identifiers nil
+ pike-font-lock-maybe-ids nil)
+ (if (< (point) start)
+ ;; Might have gone before the start. Start off inside
+ ;; the type in that case.
(goto-char start)
- (re-search-forward pike-font-lock-identifier-or-integer limit))
- (goto-char (match-end 0))
- (throw 'done t)))
- (goto-char pike-font-lock-last-type-end)
+ (when (eq (following-char) cast)
+ ;; Jumped over exactly one sexp surrounded with ( ) or [ ],
+ ;; so it's a cast.
+ (forward-char)
+ ;; Make sure that pike-font-lock-find-following-identifier
+ ;; doesn't highlight any following identifier.
+ (setq pike-font-lock-last-type-end cast-end-pos)
+ (throw 'done t)))
+ (setq pike-font-lock-last-type-end continue-pos)
+ (throw 'done t))
+ (goto-char continue-pos)
)))))
-(defun pike-font-lock-find-next-type (limit)
+(defun pike-font-lock-fontify-type (limit)
"Finds the next identifier/keyword in a type.
-Used after `pike-font-lock-find-first-type' or
-`pike-font-lock-match-next-type' have matched."
- (skip-chars-forward " \t\n\r:().|," pike-font-lock-last-type-end)
- (when (< (point) pike-font-lock-last-type-end)
- (if (looking-at pike-font-lock-identifier-or-integer)
- (goto-char (match-end 0))
- (goto-char pike-font-lock-last-type-end)
- nil)))
-
-(defvar pike-font-lock-more-identifiers nil)
+Used after `pike-font-lock-find-type' or `pike-font-lock-fontify-type'
+have matched."
+ (pike-font-lock-forward-syntactic-ws)
+ (while (> (skip-chars-forward ":().|,&!~") 0)
+ (pike-font-lock-forward-syntactic-ws))
+ (if (< (point) pike-font-lock-last-type-end)
+ (if (looking-at pike-font-lock-identifier-or-integer)
+ (progn
+ (when (match-beginning 1)
+ (setq pike-font-lock-maybe-ids
+ (cons (cons (match-beginning 1) (match-end 1))
+ pike-font-lock-maybe-ids)))
+ (goto-char (match-end 0)))
+ ;; Turned out to be too expression-like to be highlighted as
+ ;; a type; undo the highlights.
+ (while pike-font-lock-maybe-ids
+ (let ((range (car pike-font-lock-maybe-ids)))
+ (when (eq (get-text-property (car range) 'face) 'font-lock-type-face)
+ (put-text-property (car range) (cdr range) 'face nil))
+ (setq pike-font-lock-maybe-ids (cdr pike-font-lock-maybe-ids))))
+ (goto-char pike-font-lock-last-type-end)
+ nil)
+ (goto-char pike-font-lock-last-type-end)
+ nil))
(defun pike-font-lock-find-following-identifier (limit)
"Finds the following identifier after a type.
-Used after `pike-font-lock-find-first-type',
-`pike-font-lock-find-next-type' or
-`pike-font-lock-find-following-identifier' have matched. Should the
+Used after `pike-font-lock-find-type', `pike-font-lock-fontify-type'
+or `pike-font-lock-find-following-identifier' have matched. Should the
variable name be followed by a comma after an optional value, we
reposition the cursor to fontify more identifiers."
- (when (looking-at pike-font-lock-identifier-regexp)
- (let ((match (match-data))
- (start (point))
- (value-start (match-end 1))
- (large-pos (point-max))
- (more pike-font-lock-more-identifiers)
- chr)
- (goto-char value-start)
- (forward-comment large-pos)
- (setq chr (following-char)
- pike-font-lock-more-identifiers nil)
- (prog1
- (cond
- ((and (eq chr ?\() (not more))
- ;; It's a function identifier. Make the first submatch
- ;; second to get the right face.
- (setcdr (cdr match) (cons nil (cons nil (cdr (cdr match)))))
- t)
- ((eq chr ?,)
- ;; It's a variable identifier in a list containing more
- ;; identifiers.
- (forward-char)
- (forward-comment large-pos)
- (if (> (point) pike-font-lock-real-limit)
- (goto-char pike-font-lock-real-limit))
- ;; Signal that we've gone on looking at an identifier that
- ;; isn't first in a list. It can't be a function then.
- (setq pike-font-lock-more-identifiers t)
- t)
- ((memq chr '(?\; ?\)))
- ;; It's a variable identifier at the end of a list.
- t)
- ((eq chr ?=)
- ;; It's a variable identifier with a value assignment.
- ;; Move over it to the next comma, if any.
- (condition-case nil
- (save-restriction
- (narrow-to-region (point) pike-font-lock-real-limit)
- ;; Note: Both `scan-sexps' and the second goto-char can
- ;; generate an error which is caught by the
- ;; `condition-case' expression.
- (while (progn
- (forward-comment large-pos)
- (not (looking-at "\\(\\(,\\)\\|;\\|$\\)")))
- (goto-char (or (scan-sexps (point) 1) (point-max))))
- (goto-char (match-end 2)) ; non-nil
- (forward-comment large-pos))
- (error
- (goto-char value-start)))
- t)
- ((>= (point) pike-font-lock-real-limit)
- (goto-char pike-font-lock-real-limit)
- t)
- (t
- (if more (goto-char start))
- nil))
- (set-match-data match)))))
+ (if (and pike-font-lock-maybe-ids
+ (looking-at pike-font-lock-identifier-regexp))
+ (let ((match (match-data))
+ (start (point))
+ (value-start (match-end 1))
+ (more pike-font-lock-more-identifiers)
+ chr)
+ (goto-char value-start)
+ (save-restriction
+ (narrow-to-region (point-min) pike-font-lock-real-limit)
+ (pike-font-lock-forward-syntactic-ws)
+ (setq chr (following-char)
+ pike-font-lock-more-identifiers nil)
+ (prog1
+ (cond
+ ((and (eq chr ?\() (not more))
+ ;; It's a function identifier. Make the first submatch
+ ;; second to get the right face.
+ (setcdr (cdr match) (cons nil (cons nil (cdr (cdr match)))))
+ t)
+ ((eq chr ?,)
+ ;; It's a variable identifier in a list containing more
+ ;; identifiers.
+ (forward-char)
+ (pike-font-lock-forward-syntactic-ws)
+ ;; Signal that we've gone on looking at an identifier that
+ ;; isn't first in a list. It can't be a function then.
+ (setq pike-font-lock-more-identifiers t)
+ t)
+ ((memq chr '(?\; ?\) ?\]))
+ ;; It's a variable identifier at the end of a list.
+ t)
+ ((eq chr ?=)
+ ;; It's a variable identifier with a value assignment.
+ ;; Move over it to the next comma, if any.
+ (condition-case nil
+ (progn
+ ;; Note: Both `scan-sexps' and the second goto-char can
+ ;; generate an error which is caught by the
+ ;; `condition-case' expression.
+ (while (progn
+ (pike-font-lock-forward-syntactic-ws)
+ (not (looking-at "\\(\\(,\\)\\|;\\|$\\)")))
+ (goto-char (or (scan-sexps (point) 1) (point-max))))
+ (goto-char (match-end 2)) ; non-nil
+ (pike-font-lock-forward-syntactic-ws))
+ (error
+ (goto-char value-start)))
+ t)
+ ((= (point) pike-font-lock-real-limit)
+ t)
+ (t
+ (if more (goto-char start))
+ nil))
+ (set-match-data match))))
+ ;; If it was a cast we must skip forward a bit to not recognize it again.
+ (skip-chars-forward ")]" pike-font-lock-real-limit)
+ nil))
(defun pike-font-lock-find-label (limit)
(catch 'found
- (let ((large-neg (- (point-max))))
- (while (re-search-forward (concat pike-font-lock-identifier-regexp ":[^:]") limit t)
- (unless
- ;; Ignore hits inside highlighted stuff.
- (get-text-property (match-beginning 1) 'face)
- (save-excursion
- (goto-char (match-beginning 1))
- (forward-comment large-neg)
- (if (or
- ;; Check for a char that precedes a statement.
- (memq (preceding-char) '(?\} ?\{ ?\) ?\;))
- ;; Check for a keyword that precedes a statement.
- (condition-case nil
- (progn (backward-sexp) nil)
- (error t))
- (save-match-data
- (looking-at "\\(else\\|do\\)\\>[^_]")))
- (throw 'found t))))))))
+ (while (re-search-forward (concat pike-font-lock-identifier-regexp ":[^:]") limit t)
+ (unless
+ ;; Ignore hits inside highlighted stuff.
+ (get-text-property (match-beginning 1) 'face)
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (pike-font-lock-backward-syntactic-ws)
+ (if (or
+ ;; Check for a char that precedes a statement.
+ (memq (preceding-char) '(?\} ?\{ ?\) ?\;))
+ ;; Check for a keyword that precedes a statement.
+ (condition-case nil
+ (progn (backward-sexp) nil)
+ (error t))
+ (save-match-data
+ (looking-at "\\(else\\|do\\)\\>[^_]")))
+ (throw 'found t)))))))
(defconst pike-font-lock-some
`(;; Keywords:
@@ -402,16 +473,34 @@ reposition the cursor to fontify more identifiers."
"\\):")
1 font-lock-reference-face)
- ;; Scopes.
+ ;; Scope references.
((lambda (limit)
(when (re-search-forward
- ,(concat pike-font-lock-identifier-regexp
- "\\s *\\(\\.\\|::\\)\\s *\\(\\sw\\|`\\)")
+ ,(concat pike-font-lock-identifier-regexp ; 1
+ "[ \t\n\r]*\\(\\.\\|::\\)" ; 2
+ "[ \t\n\r]*\\(\\sw\\|`\\)") ; 3
limit t)
;; Must back up the last bit since it can be the next
;; identifier to match.
(goto-char (match-beginning 3))))
- 1 font-lock-reference-face))))
+ 1 font-lock-reference-face)
+
+ ;; Inherits.
+ (,(concat "\\<inherit\\s +"
+ "\\(" pike-font-lock-qualified-identifier "\\)" ; 1-3
+ "[ \t\n\r]*\\(:" ; 4
+ pike-font-lock-semantic-whitespace ; 5-7
+ pike-font-lock-identifier-regexp ; 8
+ "\\)?")
+ (8 font-lock-reference-face nil t)
+ ((lambda (limit)
+ (when (looking-at ,(concat "\\.?[ \t\n\r]*"
+ pike-font-lock-identifier-regexp
+ "[ \t\n\r]*"))
+ (goto-char (match-end 0))))
+ (goto-char (match-beginning 1))
+ (goto-char (match-end 0))
+ (1 font-lock-type-face))))))
(defconst pike-font-lock-more-lastly
`(;; Constants. This is after type font locking to get typed
@@ -420,7 +509,8 @@ reposition the cursor to fontify more identifiers."
pike-font-lock-identifier-regexp)
1 font-lock-variable-name-face)
- ;; Simple types that might not have been catched by earlier rules.
+ ;; Simple types that might not have been catched by the
+ ;; earlier rules.
(,pike-font-lock-type-regexp
1 font-lock-type-face)
@@ -497,10 +587,9 @@ types are recognized.")
pike-font-lock-more
- `(;; Catches most types and declarations.
- (pike-font-lock-find-first-type
- (1 font-lock-type-face nil t)
- (pike-font-lock-find-next-type
+ `(;; Catches declarations and casts except in the strangest cases.
+ (pike-font-lock-find-type
+ (pike-font-lock-fontify-type
nil nil
(1 font-lock-type-face nil t))
(pike-font-lock-find-following-identifier