comparison lisp/font-lock.el @ 4219:24f3ca095be9

(perl-font-lock-keywords): Add a `(... . 1)' to the first element of the list. (font-lock-hack-keywords, font-lock-unfontify-region) (font-lock-fontify-region): Bind buffer-read-only to nil, and don't alter buffer-modified-p. (font-lock-fontify-region): Use comment-start-skip, not comment-start. (font-lock-function-name-face): defvar renamed. (font-lock-hack-keywords): Evaluate face specs from keyword list.

4218:8e42b7df5c4f

(defvar font-lock-string-face
  'underline
  "Face to use for string constants.")

(defvar font-lock-function-face
  'bold-italic
  "Face to use for function names.")

(defvar font-lock-keyword-face
  'bold

  "Put proper face on each string and comment between START and END."
  (save-excursion
    (goto-char start)
    (beginning-of-line)
    (setq end (min end (point-max)))
    (let (state startline prev prevstate)
      ;; Find the state at the line-beginning before START.
      (setq startline (point))
      (if (eq (point) font-lock-cache-position)
	  (setq state font-lock-cache-state)
	;; Find outermost containing sexp.

	    (put-text-property beg (point) 'face font-lock-comment-face)
	    (setq state (parse-partial-sexp beg (point) nil nil state))))
      ;; Find each interesting place between here and END.
      (while (and (< (point) end)
		  (setq prev (point) prevstate state)
		  (re-search-forward (concat "\\s\"\\|" (regexp-quote comment-start)) end t)
		  ;; Clear out the fonts of what we skip over.
		  (progn (remove-text-properties prev (point) '(face nil)) t)
		  ;; Verify the state at that place
		  ;; so we don't get fooled by \" or \;.
		  (setq state (parse-partial-sexp prev (point)

	      ))
	;; Make sure PREV is non-nil after the loop
	;; only if it was set on the very last iteration.
	(setq prev nil))
      (and prev
	   (remove-text-properties prev end '(face nil))))))

;; This code used to be used to show a string on reaching the end of it.
;; It is probably not needed due to later changes to handle strings
;; starting before the region in question.
;;	    (if (and (null (nth 3 state))

;;				       (if (= (car state) 1)
;;					   font-lock-doc-string-face
;;					 font-lock-string-face)))))

(defun font-lock-unfontify-region (beg end)
  (remove-text-properties beg end '(face nil)))

;; Called when any modification is made to buffer text.
(defun font-lock-after-change-function (beg end old-len)
  (save-excursion
    (save-match-data

(defun font-lock-hack-keywords (start end &optional loudly)
  (goto-char start)
  (let ((case-fold-search font-lock-keywords-case-fold-search)
	(rest font-lock-keywords)
	(count 0)
	first str match face s e allow-overlap-p)
    (while rest
      (setq first (car rest) rest (cdr rest))
      (goto-char start)
      (cond ((consp first)
	     (setq str (car first))
	     (cond ((consp (cdr first))
		    (setq match (nth 1 first)
			  face (nth 2 first)
			  allow-overlap-p (nth 3 first)))
		   ((symbolp (cdr first))
		    (setq match 0 allow-overlap-p nil
			  face (cdr first)))
		   (t
		    (setq match (cdr first)
			  allow-overlap-p nil
			  face font-lock-keyword-face))))
	    (t

	(or (if allow-overlap-p nil (font-lock-any-properties-p s e))
	    (progn
	      (put-text-property s e 'face face))))
      (if loudly (message "Fontifying %s... (regexps...%s)"
			  (buffer-name)
			  (make-string (setq count (1+ count)) ?.))))))


;; The user level functions

(defvar font-lock-mode nil) ; for modeline
(or (assq 'font-lock-mode minor-mode-alist)

  "Additional expressions to highlight in C++ mode.")


(defvar perl-font-lock-keywords
  (list
   (concat "[ \n\t{]*\\("
	   (mapconcat 'identity
		      '("if" "until" "while" "elsif" "else" "unless" "for"
			"foreach" "continue" "exit" "die" "last" "goto" "next"
			"redo" "return" "local" "exec")
		      "\\|")
	   "\\)[ \n\t;(]")
   (mapconcat 'identity
	      '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include"
		"#define" "#undef")
	      "\\|")
   '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)\\{" . font-lock-function-name-face)

4219:24f3ca095be9

(defvar font-lock-string-face
  'underline
  "Face to use for string constants.")

(defvar font-lock-function-name-face
  'bold-italic
  "Face to use for function names.")

(defvar font-lock-keyword-face
  'bold

  "Put proper face on each string and comment between START and END."
  (save-excursion
    (goto-char start)
    (beginning-of-line)
    (setq end (min end (point-max)))
    (let ((buffer-read-only nil)
	  state startline prev prevstate
	  (modified (buffer-modified-p)))
      ;; Find the state at the line-beginning before START.
      (setq startline (point))
      (if (eq (point) font-lock-cache-position)
	  (setq state font-lock-cache-state)
	;; Find outermost containing sexp.

	    (put-text-property beg (point) 'face font-lock-comment-face)
	    (setq state (parse-partial-sexp beg (point) nil nil state))))
      ;; Find each interesting place between here and END.
      (while (and (< (point) end)
		  (setq prev (point) prevstate state)
		  (re-search-forward (concat "\\s\"\\|" comment-start-skip) end t)
		  ;; Clear out the fonts of what we skip over.
		  (progn (remove-text-properties prev (point) '(face nil)) t)
		  ;; Verify the state at that place
		  ;; so we don't get fooled by \" or \;.
		  (setq state (parse-partial-sexp prev (point)

	      ))
	;; Make sure PREV is non-nil after the loop
	;; only if it was set on the very last iteration.
	(setq prev nil))
      (and prev
	   (remove-text-properties prev end '(face nil)))
      (set-buffer-modified-p modified))))

;; This code used to be used to show a string on reaching the end of it.
;; It is probably not needed due to later changes to handle strings
;; starting before the region in question.
;;	    (if (and (null (nth 3 state))

;;				       (if (= (car state) 1)
;;					   font-lock-doc-string-face
;;					 font-lock-string-face)))))

(defun font-lock-unfontify-region (beg end)
  (let ((modified (buffer-modified-p))
	(buffer-read-only nil))
    (remove-text-properties beg end '(face nil))
    (set-buffer-modified-p modified)))

;; Called when any modification is made to buffer text.
(defun font-lock-after-change-function (beg end old-len)
  (save-excursion
    (save-match-data

(defun font-lock-hack-keywords (start end &optional loudly)
  (goto-char start)
  (let ((case-fold-search font-lock-keywords-case-fold-search)
	(rest font-lock-keywords)
	(count 0)
	(buffer-read-only nil)
	(modified (buffer-modified-p))
	first str match face s e allow-overlap-p)
    (while rest
      (setq first (car rest) rest (cdr rest))
      (goto-char start)
      (cond ((consp first)
	     (setq str (car first))
	     (cond ((consp (cdr first))
		    (setq match (nth 1 first)
			  face (eval (nth 2 first))
			  allow-overlap-p (nth 3 first)))
		   ((symbolp (cdr first))
		    (setq match 0 allow-overlap-p nil
			  face (eval (cdr first))))
		   (t
		    (setq match (cdr first)
			  allow-overlap-p nil
			  face font-lock-keyword-face))))
	    (t

	(or (if allow-overlap-p nil (font-lock-any-properties-p s e))
	    (progn
	      (put-text-property s e 'face face))))
      (if loudly (message "Fontifying %s... (regexps...%s)"
			  (buffer-name)
			  (make-string (setq count (1+ count)) ?.))))
    (set-buffer-modified-p modified)))

;; The user level functions

(defvar font-lock-mode nil) ; for modeline
(or (assq 'font-lock-mode minor-mode-alist)

  "Additional expressions to highlight in C++ mode.")


(defvar perl-font-lock-keywords
  (list
   (cons (concat "[ \n\t{]*\\("
		 (mapconcat 'identity
			    '("if" "until" "while" "elsif" "else" "unless" "for"
			      "foreach" "continue" "exit" "die" "last" "goto" "next"
			      "redo" "return" "local" "exec")
			    "\\|")
		 "\\)[ \n\t;(]") 1)
   (mapconcat 'identity
	      '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include"
		"#define" "#undef")
	      "\\|")
   '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)\\{" . font-lock-function-name-face)