;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Author: Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
-;; Version: 7.2.1
+;; Version: 8.0.1
;; Keywords: convenience faces tools
;; Package-Requires: ((emacs "24.3"))
;; URL: https://github.com/jacksonrayhamilton/context-coloring
:type 'float
:group 'context-coloring)
-(make-obsolete-variable
- 'context-coloring-delay
- 'context-coloring-default-delay
- "6.4.0")
-
(defun context-coloring-cancel-timer (timer)
"Cancel TIMER."
(when timer
end
`(face ,(context-coloring-bounded-level-face level))))
-(make-obsolete-variable
- 'context-coloring-comments-and-strings
- "use `context-coloring-syntactic-comments' and
- `context-coloring-syntactic-strings' instead."
- "6.1.0")
-
(defcustom context-coloring-syntactic-comments t
"If non-nil, also color comments using `font-lock'."
:type 'boolean
"Color a string according to STATE."
(if (nth 3 state) font-lock-string-face nil))
-(defsubst context-coloring-colorize-comments-and-strings (&optional min max)
+(defsubst context-coloring-colorize-comments-and-strings (&optional min max keywords-p)
"Maybe color comments and strings in buffer from MIN to MAX.
-MIN defaults to beginning of buffer. MAX defaults to end."
+MIN defaults to beginning of buffer. MAX defaults to end. If
+KEYWORDS-P is non-nil, also color keywords from MIN to MAX."
(when (or context-coloring-syntactic-comments
context-coloring-syntactic-strings)
(let ((min (or min (point-min)))
font-lock-syntactic-face-function))))
(save-excursion
(font-lock-fontify-syntactically-region min max)
- ;; TODO: Make configurable at the dispatch level.
- (when (eq major-mode 'emacs-lisp-mode)
+ (when keywords-p
(font-lock-fontify-keywords-region min max))))))
(defcustom context-coloring-initial-level 0
;;; Dispatch
+;;;###autoload
(defvar context-coloring-dispatch-hash-table (make-hash-table :test #'eq)
- "Map dispatch strategy names to their property lists.")
-
-(defvar context-coloring-mode-hash-table (make-hash-table :test #'eq)
- "Map major mode names to dispatch property lists.")
-
-(defvar context-coloring-dispatch-predicates '()
- "Functions which may return a dispatch.")
-
-(defun context-coloring-get-current-dispatch ()
- "Return the first dispatch appropriate for the current state."
- (let ((predicates context-coloring-dispatch-predicates)
- dispatch)
- ;; Maybe a predicate will be satisfied and return a dispatch.
- (while (and predicates
- (not (setq dispatch (funcall (pop predicates))))))
- ;; If not, maybe a major mode (or a derivative) will define a dispatch.
- (when (not dispatch)
- (setq dispatch (gethash major-mode context-coloring-mode-hash-table)))
- dispatch))
-
-(defun context-coloring-define-dispatch (symbol &rest properties)
- "Define a new dispatch named SYMBOL with PROPERTIES.
+ "Map dispatch strategy names to their property lists.
A \"dispatch\" is a property list describing a strategy for
coloring a buffer.
-PROPERTIES must include one of `:modes' or `:predicate', and a
-`:colorizer'.
+Its properties must include one of `:modes' or `:predicate', and
+a `:colorizer'.
`:modes' - List of major modes this dispatch is valid for.
`context-coloring-mode' is enabled.
`:teardown' - Arbitrary code to tear down this dispatch when
-`context-coloring-mode' is disabled."
- (let ((modes (plist-get properties :modes))
- (predicate (plist-get properties :predicate))
- (colorizer (plist-get properties :colorizer)))
- (when (null (or modes predicate))
- (error "No mode or predicate defined for dispatch"))
- (when (not colorizer)
- (error "No colorizer defined for dispatch"))
- (puthash symbol properties context-coloring-dispatch-hash-table)
- (dolist (mode modes)
- (puthash mode properties context-coloring-mode-hash-table))
- (when predicate
- (push (lambda ()
- (when (funcall predicate)
- properties)) context-coloring-dispatch-predicates))))
+`context-coloring-mode' is disabled.")
+
+(defun context-coloring-find-dispatch (predicate)
+ "Find the first dispatch satisfying PREDICATE."
+ (let (found)
+ (maphash
+ (lambda (_ dispatch)
+ (when (and (not found)
+ (funcall predicate dispatch))
+ (setq found dispatch)))
+ context-coloring-dispatch-hash-table)
+ found))
+
+(defun context-coloring-get-current-dispatch ()
+ "Return the first dispatch appropriate for the current state."
+ (cond
+ ;; Maybe a predicate will be satisfied.
+ ((context-coloring-find-dispatch
+ (lambda (dispatch)
+ (let ((predicate (plist-get dispatch :predicate)))
+ (and predicate (funcall predicate))))))
+ ;; If not, maybe a major mode (or a derivative) will.
+ ((context-coloring-find-dispatch
+ (lambda (dispatch)
+ (let ((modes (plist-get dispatch :modes))
+ match)
+ (while (and modes (not match))
+ (setq match (eq (pop modes) major-mode)))
+ match))))))
(defun context-coloring-before-colorize ()
"Set up environment for colorization."
(let* ((dispatch (context-coloring-get-current-dispatch))
(colorizer (plist-get dispatch :colorizer)))
(context-coloring-before-colorize)
- (catch 'interrupted
- (funcall colorizer))))
+ (when colorizer
+ (catch 'interrupted
+ (funcall colorizer)))))
;;; Colorization
(setq ignore-p (funcall (pop predicates))))
ignore-p))
-(defvar context-coloring-parse-interruptable-p t
- "Set this to nil to force parse to continue until finished.")
+(defvar context-coloring-interruptable-p t
+ "When non-nil, coloring may be interrupted by user input.")
;;;###autoload
(define-minor-mode context-coloring-mode
nil " Context" nil
(cond
(context-coloring-mode
- ;; Font lock is incompatible with this mode; the converse is also true.
- (font-lock-mode 0)
- (jit-lock-mode nil)
- ;; ...but we do use font-lock functions here.
- (font-lock-set-defaults)
- ;; Safely change the value of this function as necessary.
- (make-local-variable 'font-lock-syntactic-face-function)
(let ((dispatch (context-coloring-get-current-dispatch)))
(cond
(dispatch
+ ;; Font lock is incompatible with this mode; the converse is also true.
+ (font-lock-mode 0)
+ ;; ...but we do use font-lock functions here.
+ (font-lock-set-defaults)
+ ;; Safely change the value of this function as necessary.
+ (make-local-variable 'font-lock-syntactic-face-function)
(let ((setup (plist-get dispatch :setup)))
(when setup
(funcall setup))
;; Colorize once initially.
- (let ((context-coloring-parse-interruptable-p nil))
+ (let ((context-coloring-interruptable-p nil))
(context-coloring-colorize))))
((not (context-coloring-ignore-unavailable-message-p))
(message "Context coloring is unavailable here")))))
(let ((teardown (plist-get dispatch :teardown)))
(when teardown
(funcall teardown)))))
- (font-lock-mode)
- (jit-lock-mode t))))
+ (turn-on-font-lock-if-desired))))
(provide 'context-coloring)