branch: master commit 61b8c493c44211bb0d7ee0aab5883f51de129bf9 Merge: f89ef19 294b511 Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com> Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Merge commit '294b5117b42d2622f4fb0a1da219d45d98566b6e' from context-coloring --- packages/context-coloring/.travis.yml | 25 ++- packages/context-coloring/Makefile | 2 +- packages/context-coloring/README.md | 12 +- .../benchmark/context-coloring-benchmark.el | 16 +- packages/context-coloring/context-coloring.el | 211 ++++++++++++-------- .../context-coloring/test/context-coloring-test.el | 24 ++- 6 files changed, 181 insertions(+), 109 deletions(-) diff --git a/packages/context-coloring/.travis.yml b/packages/context-coloring/.travis.yml index a732f67..8a9d303 100644 --- a/packages/context-coloring/.travis.yml +++ b/packages/context-coloring/.travis.yml @@ -1,23 +1,24 @@ -# https://github.com/rolandwalker/emacs-travis - language: emacs-lisp node_js: - "0.10" env: - matrix: - - EMACS=emacs24 + - EVM_EMACS=emacs-24.3-bin + - EVM_EMACS=emacs-24.4-bin + - EVM_EMACS=emacs-24.5-bin -install: - - if [ "$EMACS" = "emacs24" ]; then - sudo add-apt-repository -y ppa:cassou/emacs && - sudo apt-get update -qq && - sudo apt-get install -qq emacs24 emacs24-el; - fi - - curl -fsSL https://raw.github.com/cask/cask/master/go | python +before_install: + - sudo mkdir /usr/local/evm + - sudo chown travis:travis /usr/local/evm - export PATH="/home/travis/.cask/bin:$PATH" + - export PATH="/home/travis/.evm/bin:$PATH" + - curl -fsSkL https://raw.github.com/rejeep/evm/master/go | bash + - evm install ${EVM_EMACS} --use + - curl -fsSkL https://raw.github.com/cask/cask/master/go | python + - cask - npm install -g scopifier script: - make test EMACS=${EMACS} + - emacs --version + - make test diff --git a/packages/context-coloring/Makefile b/packages/context-coloring/Makefile index 0b37043..dfa219d 100644 --- a/packages/context-coloring/Makefile +++ b/packages/context-coloring/Makefile @@ -1,5 +1,5 @@ -CASK = cask EMACS = emacs +CASK = EMACS=${EMACS} cask DEPENDENCIES = .cask/ SCOPIFIER_PORT = $$(lsof -t -i :6969) KILL_SCOPIFIER = if [ -n "${SCOPIFIER_PORT}" ]; then kill ${SCOPIFIER_PORT}; fi diff --git a/packages/context-coloring/README.md b/packages/context-coloring/README.md index 40506e7..6e8865f 100644 --- a/packages/context-coloring/README.md +++ b/packages/context-coloring/README.md @@ -21,10 +21,11 @@ By default, comments and strings are still highlighted syntactically. - `defun`, `lambda`, `let`, `let*`, `cond`, `condition-case`, `defadvice`, `dolist`, `quote`, `backquote` and backquote splicing. - Instantaneous lazy coloring, 8000 lines-per-second full coloring. + - Works in `eval-expression` too. ## Installation -Requires Emacs 24+. +Requires Emacs 24.3+. JavaScript language support requires either [js2-mode][], or [Node.js 0.10+][node] and the [scopifier][] executable. @@ -68,14 +69,17 @@ Add the following to your init file: ```lisp ;; js-mode: -(add-hook 'js-mode-hook 'context-coloring-mode) +(add-hook 'js-mode-hook #'context-coloring-mode) ;; js2-mode: (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode)) -(add-hook 'js2-mode-hook 'context-coloring-mode) +(add-hook 'js2-mode-hook #'context-coloring-mode) ;; emacs-lisp-mode: -(add-hook 'emacs-lisp-mode-hook 'context-coloring-mode) +(add-hook 'emacs-lisp-mode-hook #'context-coloring-mode) + +;; eval-expression: +(add-hook 'minibuffer-setup-hook #'context-coloring-mode) ``` ## Customizing diff --git a/packages/context-coloring/benchmark/context-coloring-benchmark.el b/packages/context-coloring/benchmark/context-coloring-benchmark.el index c2dd653..1f5885c 100644 --- a/packages/context-coloring/benchmark/context-coloring-benchmark.el +++ b/packages/context-coloring/benchmark/context-coloring-benchmark.el @@ -26,6 +26,7 @@ ;;; Code: (require 'context-coloring) +(require 'elp) (require 'js2-mode) @@ -115,7 +116,6 @@ with STATISTICS." callbacks. Measure the performance of all FIXTURES, calling CALLBACK when all are done." (funcall setup) - (elp-instrument-package "context-coloring-") (let ((result-file (context-coloring-benchmark-resolve-path (format "./logs/results-%s-%s.log" title (format-time-string "%s"))))) @@ -134,10 +134,12 @@ CALLBACK when all are done." original-function (lambda () (setq count (+ count 1)) - (push (- (float-time) colorization-start-time) colorization-times) - ;; Test 5 times. + ;; First 5 runs are for gathering real coloring times, + ;; unaffected by elp instrumentation. + (when (<= count 5) + (push (- (float-time) colorization-start-time) colorization-times)) (cond - ((= count 5) + ((= count 10) (advice-remove #'context-coloring-colorize advice) (context-coloring-benchmark-log-results result-file @@ -148,8 +150,14 @@ CALLBACK when all are done." :words (count-words (point-min) (point-max)) :colorization-times colorization-times :average-colorization-time (/ (apply #'+ colorization-times) 5))) + (elp-restore-all) (kill-buffer) (funcall callback)) + ;; The last 5 runs are for gathering function call and + ;; duration statistics. + ((= count 5) + (elp-instrument-package "context-coloring-") + (context-coloring-colorize)) (t (setq colorization-start-time (float-time)) (context-coloring-colorize)))))))) diff --git a/packages/context-coloring/context-coloring.el b/packages/context-coloring/context-coloring.el index c4423f0..327dbc3 100644 --- a/packages/context-coloring/context-coloring.el +++ b/packages/context-coloring/context-coloring.el @@ -3,9 +3,9 @@ ;; Copyright (C) 2014-2015 Free Software Foundation, Inc. ;; Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com> -;; Version: 6.4.1 +;; Version: 6.5.0 ;; Keywords: convenience faces tools -;; Package-Requires: ((emacs "24") (js2-mode "20150126")) +;; Package-Requires: ((emacs "24.3") (js2-mode "20150126")) ;; URL: https://github.com/jacksonrayhamilton/context-coloring ;; This file is part of GNU Emacs. @@ -196,7 +196,7 @@ Supported modes: `js-mode', `js3-mode'" (defun context-coloring-setup-idle-change-detection () "Setup idle change detection." - (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode))) + (let ((dispatch (context-coloring-get-current-dispatch))) (add-hook 'after-change-functions #'context-coloring-change-function nil t) (add-hook @@ -447,10 +447,13 @@ bound as variables.") (defvar context-coloring-parse-interruptable-p t "Set this to nil to force parse to continue until finished.") -(defconst context-coloring-elisp-sexps-per-pause 1000 +(defconst context-coloring-elisp-sexps-per-pause 350 "Pause after this many iterations to check for user input. If user input is pending, stop the parse. This makes for a -smoother user experience for large files.") +smoother user experience for large files. + +This number should trigger pausing at about 60 frames per +second.") (defvar context-coloring-elisp-sexp-count 0 "Current number of sexps leading up to the next pause.") @@ -635,37 +638,25 @@ header in CALLBACK." (forward-char) (context-coloring-elisp-pop-scope))) -(defun context-coloring-elisp-parse-header (callback start) - "Parse a function header at point with CALLBACK. If there is -no header, skip past the sexp at START." - (cond - ((= (context-coloring-get-syntax-code) context-coloring-OPEN-PARENTHESIS-CODE) - (funcall callback)) - (t - ;; Skip it. - (goto-char start) - (context-coloring-elisp-forward-sexp)))) +(defun context-coloring-elisp-parse-header (callback) + "Parse a function header at point with CALLBACK." + (when (= (context-coloring-get-syntax-code) context-coloring-OPEN-PARENTHESIS-CODE) + (funcall callback))) (defun context-coloring-elisp-colorize-defun-like (callback) "Color the defun-like function at point, parsing the header with CALLBACK." - (let ((start (point))) - (context-coloring-elisp-colorize-scope - (lambda () - (cond - ((context-coloring-elisp-identifier-p (context-coloring-get-syntax-code)) - ;; Color the defun's name with the top-level color. - (context-coloring-colorize-region - (point) - (progn (forward-sexp) - (point)) - 0) - (context-coloring-elisp-forward-sws) - (context-coloring-elisp-parse-header callback start)) - (t - ;; Skip it. - (goto-char start) - (context-coloring-elisp-forward-sexp))))))) + (context-coloring-elisp-colorize-scope + (lambda () + (when (context-coloring-elisp-identifier-p (context-coloring-get-syntax-code)) + ;; Color the defun's name with the top-level color. + (context-coloring-colorize-region + (point) + (progn (forward-sexp) + (point)) + 0) + (context-coloring-elisp-forward-sws) + (context-coloring-elisp-parse-header callback))))) (defun context-coloring-elisp-colorize-defun () "Color the `defun' at point." @@ -687,17 +678,14 @@ with CALLBACK." (t ;; Ignore artifacts. (context-coloring-elisp-forward-sexp))) - (context-coloring-elisp-forward-sws)) - ;; Exit. - (forward-char))))) + (context-coloring-elisp-forward-sws)))))) (defun context-coloring-elisp-colorize-lambda-like (callback) "Color the lambda-like function at point, parsing the header with CALLBACK." - (let ((start (point))) - (context-coloring-elisp-colorize-scope - (lambda () - (context-coloring-elisp-parse-header callback start))))) + (context-coloring-elisp-colorize-scope + (lambda () + (context-coloring-elisp-parse-header callback)))) (defun context-coloring-elisp-colorize-lambda () "Color the `lambda' at point." @@ -1008,44 +996,61 @@ point. It could be a quoted or backquoted expression." (max-specpdl-size (max max-specpdl-size 3000))) (context-coloring-elisp-colorize-region start end))) -(defun context-coloring-elisp-colorize () - "Color the current buffer, parsing elisp to determine its -scopes and variables." - (interactive) +(defun context-coloring-elisp-colorize-guard (callback) + "Silently color in CALLBACK." (with-silent-modifications (save-excursion (condition-case nil - (cond - ;; Just colorize the changed region. - (context-coloring-changed-p - (let* (;; Prevent `beginning-of-defun' from making poor assumptions. - (open-paren-in-column-0-is-defun-start nil) - ;; Seek the beginning and end of the previous and next - ;; offscreen defuns, so just enough is colored. - (start (progn (goto-char context-coloring-changed-start) - (while (and (< (point-min) (point)) - (pos-visible-in-window-p)) - (end-of-line 0)) - (beginning-of-defun) - (point))) - (end (progn (goto-char context-coloring-changed-end) - (while (and (> (point-max) (point)) - (pos-visible-in-window-p)) - (forward-line 1)) - (end-of-defun) - (point)))) - (context-coloring-elisp-colorize-region-initially start end) - ;; Fast coloring is nice, but if the code is not well-formed - ;; (e.g. an unclosed string literal is parsed at any time) then - ;; there could be leftover incorrectly-colored code offscreen. So - ;; do a clean sweep as soon as appropriate. - (context-coloring-schedule-coloring context-coloring-default-delay))) - (t - (context-coloring-elisp-colorize-region-initially (point-min) (point-max)))) + (funcall callback) ;; Scan errors can happen virtually anywhere if parenthesis are ;; unbalanced. Just swallow them. (`progn' for test coverage.) (scan-error (progn)))))) +(defun context-coloring-elisp-colorize () + "Color the current buffer, parsing elisp to determine its +scopes and variables." + (interactive) + (context-coloring-elisp-colorize-guard + (lambda () + (cond + ;; Just colorize the changed region. + (context-coloring-changed-p + (let* ( ;; Prevent `beginning-of-defun' from making poor assumptions. + (open-paren-in-column-0-is-defun-start nil) + ;; Seek the beginning and end of the previous and next + ;; offscreen defuns, so just enough is colored. + (start (progn (goto-char context-coloring-changed-start) + (while (and (< (point-min) (point)) + (pos-visible-in-window-p)) + (end-of-line 0)) + (beginning-of-defun) + (point))) + (end (progn (goto-char context-coloring-changed-end) + (while (and (> (point-max) (point)) + (pos-visible-in-window-p)) + (forward-line 1)) + (end-of-defun) + (point)))) + (context-coloring-elisp-colorize-region-initially start end) + ;; Fast coloring is nice, but if the code is not well-formed + ;; (e.g. an unclosed string literal is parsed at any time) then + ;; there could be leftover incorrectly-colored code offscreen. So + ;; do a clean sweep as soon as appropriate. + (context-coloring-schedule-coloring context-coloring-default-delay))) + (t + (context-coloring-elisp-colorize-region-initially (point-min) (point-max))))))) + +(defun context-coloring-eval-expression-colorize () + "Color the `eval-expression' minibuffer prompt as elisp." + (interactive) + (context-coloring-elisp-colorize-guard + (lambda () + (context-coloring-elisp-colorize-region-initially + (progn + (string-match "\\`Eval: " (buffer-string)) + (1+ (match-end 0))) + (point-max))))) + ;;; Shell command scopification / colorization @@ -1223,13 +1228,22 @@ lists, which contain details about the strategies.") (defvar context-coloring-mode-hash-table (make-hash-table :test #'eq) "Map major mode names to dispatch property lists.") -(defun context-coloring-get-dispatch-for-mode (mode) - "Return the dispatch for MODE (or a derivative mode)." - (let ((parent mode) +(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) + (parent major-mode) dispatch) - (while (and parent - (not (setq dispatch (gethash parent context-coloring-mode-hash-table))) - (setq parent (get parent 'derived-mode-parent)))) + ;; 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) + (while (and parent + (not (setq dispatch (gethash parent context-coloring-mode-hash-table))) + (setq parent (get parent 'derived-mode-parent))))) dispatch)) (defun context-coloring-define-dispatch (symbol &rest properties) @@ -1243,13 +1257,15 @@ server that returns scope data (`:command', `:host' and `:port'). In the latter two cases, the scope data will be used to automatically color the buffer. -PROPERTIES must include `:modes' and one of `:colorizer', -`:scopifier' or `:command'. +PROPERTIES must include one of `:modes' or `:predicate', and one +of `:colorizer' or `:command'. `:modes' - List of major modes this dispatch is valid for. -`:colorizer' - Symbol referring to a function that parses and -colors the buffer. +`:predicate' - Function that determines if the dispatch is valid +for any given state. + +`:colorizer' - Function that parses and colors the buffer. `:executable' - Optional name of an executable required by `:command'. @@ -1276,16 +1292,22 @@ should be numeric, e.g. \"2\", \"19700101\", \"1.2.3\", `: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)) (command (plist-get properties :command))) - (when (null modes) - (error "No mode defined for dispatch")) + (when (null (or modes + predicate)) + (error "No mode or predicate defined for dispatch")) (when (not (or colorizer command)) (error "No colorizer or command defined for dispatch")) (puthash symbol properties context-coloring-dispatch-hash-table) (dolist (mode modes) - (puthash mode properties context-coloring-mode-hash-table)))) + (puthash mode properties context-coloring-mode-hash-table)) + (when predicate + (push (lambda () + (when (funcall predicate) + properties)) context-coloring-dispatch-predicates)))) ;;; Colorization @@ -1350,7 +1372,7 @@ produces (1 0 0), \"19700101\" produces (19700101), etc." "Asynchronously invoke CALLBACK with a predicate indicating whether the current scopifier version satisfies the minimum version number required for the current major mode." - (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode))) + (let ((dispatch (context-coloring-get-current-dispatch))) (when dispatch (let ((version (plist-get dispatch :version)) (command (plist-get dispatch :command))) @@ -1738,13 +1760,28 @@ precedence, i.e. the car of `custom-enabled-themes'." :setup #'context-coloring-setup-idle-change-detection :teardown #'context-coloring-teardown-idle-change-detection) +;; `eval-expression-minibuffer-setup-hook' is not available in Emacs 24.3, so +;; the backwards-compatible recommendation is to use `minibuffer-setup-hook' and +;; rely on this predicate instead. +(defun context-coloring-eval-expression-predicate () + "Non-nil if the minibuffer is for `eval-expression'." + (eq this-command 'eval-expression)) + +(context-coloring-define-dispatch + 'eval-expression + :predicate #'context-coloring-eval-expression-predicate + :colorizer #'context-coloring-eval-expression-colorize + :delay 0.016 + :setup #'context-coloring-setup-idle-change-detection + :teardown #'context-coloring-teardown-idle-change-detection) + (defun context-coloring-dispatch (&optional callback) "Determine the optimal track for scopification / coloring of the current buffer, then execute it. Invoke CALLBACK when complete. It is invoked synchronously for elisp tracks, and asynchronously for shell command tracks." - (let* ((dispatch (context-coloring-get-dispatch-for-mode major-mode)) + (let* ((dispatch (context-coloring-get-current-dispatch)) (colorizer (plist-get dispatch :colorizer)) (command (plist-get dispatch :command)) (host (plist-get dispatch :host)) @@ -1804,7 +1841,7 @@ Feature inspired by Douglas Crockford." (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-dispatch-for-mode major-mode))) + (let ((dispatch (context-coloring-get-current-dispatch))) (cond (dispatch (let ((command (plist-get dispatch :command)) @@ -1841,7 +1878,7 @@ Feature inspired by Douglas Crockford." (t (message "Context coloring is not available for this major mode"))))) (t - (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode))) + (let ((dispatch (context-coloring-get-current-dispatch))) (when dispatch (let ((command (plist-get dispatch :command)) (teardown (plist-get dispatch :teardown))) diff --git a/packages/context-coloring/test/context-coloring-test.el b/packages/context-coloring/test/context-coloring-test.el index 7020589..39f2f80 100644 --- a/packages/context-coloring/test/context-coloring-test.el +++ b/packages/context-coloring/test/context-coloring-test.el @@ -234,6 +234,10 @@ ARGS)." :extension "el" :enable-context-coloring-mode t) +(context-coloring-test-define-deftest eval-expression + :mode #'fundamental-mode + :no-fixture t) + (context-coloring-test-define-deftest define-theme :mode #'fundamental-mode :no-fixture t @@ -410,7 +414,7 @@ ARGS)." (lambda () (context-coloring-define-dispatch 'define-dispatch-no-modes)) - "No mode defined for dispatch") + "No mode or predicate defined for dispatch") (context-coloring-test-assert-error (lambda () (context-coloring-define-dispatch @@ -1268,6 +1272,24 @@ nnnnn n nnn nnnnnnnn"))) 1111 111 nnnn nn"))) +(context-coloring-test-deftest-eval-expression let + (lambda () + (minibuffer-with-setup-hook + (lambda () + ;; Perform the test in a hook as it's the only way I know of examining + ;; the minibuffer's contents. The contents are implicitly submitted, + ;; so we have to ignore the errors in the arbitrary test subject code. + (insert "(ignore-errors (let (a) (message a free)))") + (context-coloring-colorize) + (context-coloring-test-assert-coloring " +xxxx: 0000000-000000 1111 111 11111111 1 0000110")) + ;; Simulate user input because `call-interactively' is blocking and + ;; doesn't seem to run the hook. + (execute-kbd-macro + (vconcat + [?\C-u] ;; Don't output the result of the arbitrary test subject code. + [?\M-:]))))) + (provide 'context-coloring-test) ;;; context-coloring-test.el ends here