[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 7ea9a82 2/2: Merge branch 'master' of git+ssh://git.sv.gnu
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master 7ea9a82 2/2: Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs/elpa |
|
Date: |
Mon, 09 Feb 2015 17:37:11 +0000 |
branch: master
commit 7ea9a823be6efe19e755d52b695f23133ba73478
Merge: 1b6c302 b8bade4
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs/elpa
---
packages/auto-overlays/auto-overlay-common.el | 15 +-
packages/auto-overlays/auto-overlay-manual.info | 142 ++++----
packages/auto-overlays/auto-overlays.el | 6 +-
packages/auto-overlays/dir | 2 +-
packages/context-coloring/README.md | 12 +-
packages/context-coloring/context-coloring.el | 333 ++++++++++++++----
.../context-coloring/test/context-coloring-test.el | 384 +++++++++++++++++++-
packages/seq/seq.el | 23 +-
packages/seq/tests/seq-tests.el | 6 +-
9 files changed, 743 insertions(+), 180 deletions(-)
diff --git a/packages/auto-overlays/auto-overlay-common.el
b/packages/auto-overlays/auto-overlay-common.el
index 19ddd34..994b20d 100644
--- a/packages/auto-overlays/auto-overlay-common.el
+++ b/packages/auto-overlays/auto-overlay-common.el
@@ -29,6 +29,7 @@
(provide 'auto-overlay-common)
+;;;###autoload
(defun auto-overlays-at-point (&optional point prop-test inactive)
"Return overlays overlapping POINT
(or the point, if POINT is null). If PROP-TEST is supplied, it
@@ -76,13 +77,13 @@ PROP-TEST."
(= (overlay-start o) point))
(push o overlay-list)))
- overlay-list)
-)
+ overlay-list))
-;; FIXME: get rid of INACTIVE argument
+;;;###autoload
(defun auto-overlays-in (start end &optional prop-test within inactive)
+;; FIXME: get rid of INACTIVE argument?
"Return auto overlays overlapping region between START and END.
If PROP-TEST is supplied, it should be a list which specifies a
@@ -163,11 +164,11 @@ PROP-TEST."
;; add overlay to result list if its properties matched
(when result (push o overlay-list)))
;; return result list
- overlay-list)
-)
+ overlay-list))
+;;;###autoload
(defun auto-overlay-highest-priority-at-point (&optional point proptest)
"Return highest priority overlay at POINT (defaults to the point).
@@ -197,11 +198,11 @@ See `auto-overlays-at' for ane explanation of the
PROPTEST argument."
(setq overlay o1)))
;; return the overlay
- overlay)
-)
+ overlay))
+;;;###autoload
(defun auto-overlay-local-binding (symbol &optional point only-overlay)
"Return \"overlay local \" binding of SYMBOL at POINT,
or the current local binding if there is no overlay binding. If
diff --git a/packages/auto-overlays/auto-overlay-manual.info
b/packages/auto-overlays/auto-overlay-manual.info
index 84c8fd2..cf33500 100644
--- a/packages/auto-overlays/auto-overlay-manual.info
+++ b/packages/auto-overlays/auto-overlay-manual.info
@@ -4,12 +4,12 @@ auto-overlay-manual/auto-overlay-manual.texinfo.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
-* auto-overlays (auto-overlay-manual). Automatic regexp-delimited overlays
+* auto-overlays: (auto-overlay-manual). Automatic regexp-delimited overlays
END-INFO-DIR-ENTRY
- This manual describes the Emacs Auto-Overlays package, version 0.10
+ This manual describes the Emacs Auto-Overlays package, version 0.10.8
- Copyright (C) 2007, 2008 Toby Cubitt
+ Copyright (C) 2007-2015 Toby Cubitt
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -24,9 +24,9 @@ File: auto-overlay-manual.info, Node: Top, Next: Overview,
Up: (dir)
Emacs Auto-Overlays Manual
**************************
-This manual describes the Emacs Auto-Overlays package, version 0.10
+This manual describes the Emacs Auto-Overlays package, version 0.10.8
- Copyright (C) 2007, 2008 Toby Cubitt
+ Copyright (C) 2007-2015 Toby Cubitt
Permission is granted to copy, distribute and/or modify this
document under the terms of the GNU Free Documentation License,
@@ -115,7 +115,7 @@ the overlay (*note Defining Regexps::). Any additional
regexps, beyond
the minimum requirements, act as alternatives; if more than one of the
regexps matches overlapping regions of text, the one that appears
earlier in the list will take precedence. The predefined regexp classes
-are: `word', `line', `self', `nested' and `flat', but the auto-overlay
+are: `word', `line', `self', `nested' and `flat', but the auto-overlays
package can easily be extended with new classes.
`word'
@@ -334,15 +334,12 @@ regexp set does _not_ delete its regexp definitions.
Since scanning the whole buffer for regexp matches can take some
time, especially for large buffers, auto-overlay data can be saved to an
auxiliary file so that the overlays can be restored more quickly if the
-same regexp set is subsequently re-activated. Of course, if the text in
-the buffer is modified whilst the regexp set is disabled, or the regexp
-definitions differ from those that were active when the overlay data was
-saved, the saved data will be out of date. Auto-overlays automatically
-checks if the text has been modified and, if it has, ignores the saved
-data and re-scans the buffer. However, no check is made to ensure the
-regexp definitions used in the buffer and saved data are consistent
-(*note To-Do::); the saved data will be used even if the definitions
-have changed.
+same regexp set is subsequently re-activated. Of course, if either the
+text in the buffer or the overlay definitions are modified whilst the
+regexp set is disabled, then the saved data will be out of date.
+Auto-overlays automatically checks whether the text or overlay
+definitions have been modified since the data was saved. If so, it
+ignores the saved data and re-scans the buffer.
The usual time to save and restore overlay data is when a regexp set
is deactivated or activated. The auxilliary file name is then
@@ -352,11 +349,11 @@ auto-overlays can also be saved and restored manually.
`(auto-overlay-start SET-ID @optional BUFFER SAVE-FILE NO-REGEXP-CHECK)'
Activate the auto-overlay regexp set identified by the symbol
SET-ID in BUFFER, or the current buffer if the latter is `nil'. If
- there is an file called `auto-overlay-'BUFFER-NAME`-'SET-ID in the
+ there is a file called `auto-overlay-'BUFFER-NAME`-'SET-ID
containing up-to-date overlay data, it will be used to restore the
auto-overlays (BUFFER-NAME is the name of the file visited by the
- buffer, or the buffer name itself if there is none). Otherwise, the
- entire buffer will be scanned for regexp matches.
+ buffer, or the buffer name itself if there is none). Otherwise,
+ the entire buffer will be scanned for regexp matches.
The string SAVE-FILE specifies the where to look for the file of
saved overlay data. If it is nil, it defaults to the current
@@ -389,7 +386,8 @@ auto-overlays can also be saved and restored manually.
none). If SAVE-FILE is a string, it overrides the default save
location, overriding either the directory if it only specifies a
path (relative paths are relative to the current directory), or
- the file name if it only specifies a file name, or both.
+ the file name if it only specifies a filename, or both if it
+ specifies a full path.
`(auto-overlay-save-overlays SET-ID @optional BUFFER FILE)'
Save auto-overlay data for the regexp set identified by the symbol
@@ -397,9 +395,10 @@ auto-overlays can also be saved and restored manually.
file called FILE. If FILE is nil, the overlay data are saved to a
file called `auto-overlay-'BUFFER-NAME`-'SET-ID in the current
directory (BUFFER-NAME is the name of the file visited by the
- buffer, or the buffer name itself if there is none). Note that
- this is the only name that will be recognized by
- `auto-overlay-start'.
+ buffer, or the buffer name itself if it's not visiting a file). If
+ `file' is a directory name (either an absolute path or relative to
+ the current directory), the overlay data are saved to the default
+ file name under that directory.
`(auto-overlay-load-overlays SET-ID @optional BUFFER FILE NO-REGEXP-CHECK)'
Load auto-overlay data for the regexp set identified by the symbol
@@ -408,10 +407,13 @@ auto-overlays can also be saved and restored manually.
the overlay data from a file called
`auto-overlay-'BUFFER-NAME`-'SET-ID in the current directory
(BUFFER-NAME is the name of the file visited by the buffer, or the
- buffer name itself if there is none). If NO-REGEXP-CHECK is
- no-nil, the saved overlays will be loaded even if different regexp
- definitions were active when the overlays were saved. Returns `t'
- if the overlays were successfully loaded, `nil' otherwise.
+ buffer name itself if it's not visiting a file). If `file' is a
+ directory name (either an absolute path or relative to the current
+ directory), it attempts to load the overlay data from the default
+ file name under that directory. If NO-REGEXP-CHECK is no-nil, the
+ saved overlays will be loaded even if different regexp definitions
+ were active when the overlays were saved. Returns `t' if the
+ overlays were successfully loaded, `nil' otherwise.
File: auto-overlay-manual.info, Node: Searching for Overlays, Prev: Starting
and Stopping Auto-Overlays, Up: Auto-Overlay Functions
@@ -465,7 +467,7 @@ functions.
will be returned, not overlays that extend outside that region.
`(auto-overlay-highest-priority-at-point @optional POINT PROP-TEST)'
- Return the highest priority overlay at POINT (or the point, of
+ Return the highest priority overlay at POINT (or the point, if
POINT is null). The PROP-TEST argument has the same behaviour as
in `auto-overlays-at-point', above. An overlay's priority is
determined by the value of its `priority' property (*note Overlay
@@ -493,11 +495,11 @@ File: auto-overlay-manual.info, Node: Worked Example,
Next: Extending the Auto
****************
The interaction of all the different regexp definitions, overlay
-properties and auto-overlay classes provided by the auto-overlay package
-can be a little daunting. This section will go through an example of how
-the auto-overlay regexps could be defined to create overlays for a
-subset of LaTeX, which is complex enough to demonstrate most of the
-features.
+properties and auto-overlay classes provided by the auto-overlays
+package can be a little daunting. This section will go through an
+example of how the auto-overlay regexps could be defined to create
+overlays for a subset of LaTeX, which is complex enough to demonstrate
+most of the features.
LaTeX is a markup language, so a LaTeX document combines markup
commands with normal text. Commands start with `\', and end at the
@@ -955,7 +957,7 @@ The new, complicated-looking regexps will only match `{'
and `}'
characters if they are _not_ preceded by a `\' character (*note Regular
Expressions: (elisp)Regular Expressions.). Note that the character
alternative `[^\]\|^' can match any character that isn't a `\' _or_ the
-start of a line. This is required because macthes to auto-overlay
+start of a line. This is required because matches to auto-overlay
regexps are not allowed to span more than one line. If `{' or `}'
appear at the beginning of a line, there will be no character in front
(the newline character doesn't count, since it isn't on the same line),
@@ -1040,7 +1042,7 @@ File: auto-overlay-manual.info, Node: Extending the
Auto-Overlays Package, Nex
4 Extending the Auto-Overlays Package
*************************************
-The auto-overlay package can easily be extended by adding new overlay
+The auto-overlays package can easily be extended by adding new overlay
classes(1). The next sections document the functions and interfaces
provided by the auto-overlays package for this purpose.
@@ -1073,7 +1075,7 @@ File: auto-overlay-manual.info, Node: Auto-Overlays in
Depth, Next: Integratin
==========================
In order to write new classes, a deeper understanding is required of how
-the auto-overlay package works. In fact, two kinds of overlays are
+the auto-overlays package works. In fact, two kinds of overlays are
automatically created, updated and destroyed when auto-overlays are
active: the auto-overlays themselves, and "match" overlays, used to
mark text that matches an auto-overlay regexp.
@@ -1103,7 +1105,7 @@ the match overlay's `parent' property(2).
are scanned for new regexp matches. If one is found, a new match overlay
is created covering the matching text, and then passed as an argument to
the appropriate "parse" function(3) for its class. This deals with
-creating or updating the auto-overlays as appropriate. If the text
+creating or updating the auto-overlays, as appropriate. If the text
within a match overlay is modified, the match overlay checks whether
the text it covers still matches the regexp. If it no longer matches,
the match overlay is passed as an argument to the appropriate "suicide"
@@ -1260,8 +1262,8 @@ tasks require interaction with the core of the
auto-overlays package.
update all appropriate properties (such as `parent', `start' and
`end' properties, and any properties specified in regexp
definitions), and update other auto-overlays in the region covered
- by OVERLAY if required because the `exclusive' or `priority'
- properties of OVERLAY have changed.
+ by OVERLAY as necessary (usually because the `exclusive' or
+ `priority' properties of OVERLAY have changed).
If START or END are match overlays, match the corresponding edge
of OVERLAY. The edge is moved to the location defined by the match
@@ -1278,7 +1280,7 @@ tasks require interaction with the core of the
auto-overlays package.
If START or END are numbers or markers, move the corresponding
edge of OVERLAY to that location and set it as unmatched. The
`start' or `end' property of OVERLAY and the `parent' property of
- any corresponding match overlay are set to `nil'). If START or END
+ any corresponding match overlay are set to `nil'. If START or END
are non-nil but neither of the above, leave the corresponding edge
of OVERLAY where it is, but set it unmatched (as described above).
If START or END are null, don't change the corresponding edge.
@@ -1498,17 +1500,17 @@ Appendix A Function Index
(line 52)
* auto-overlay-load-definition: Defining Regexps. (line 46)
* auto-overlay-load-overlays: Starting and Stopping Auto-Overlays.
- (line 85)
+ (line 84)
* auto-overlay-load-regexp: Defining Regexps. (line 57)
* auto-overlay-local-binding: Searching for Overlays.
(line 64)
* auto-overlay-save-overlays: Starting and Stopping Auto-Overlays.
- (line 75)
+ (line 73)
* auto-overlay-share-regexp-set: Defining Regexps. (line 79)
* auto-overlay-start: Starting and Stopping Auto-Overlays.
- (line 33)
+ (line 30)
* auto-overlay-stop: Starting and Stopping Auto-Overlays.
- (line 57)
+ (line 54)
* auto-overlay-unload-definition: Defining Regexps. (line 70)
* auto-overlay-unload-regexp: Defining Regexps. (line 74)
* auto-overlay-unload-set: Defining Regexps. (line 67)
@@ -2215,32 +2217,32 @@ permit their use in free software.
Tag Table:
-Node: Top795
-Node: Overview2850
-Node: Auto-Overlay Functions7841
-Node: Defining Regexps9295
-Node: Starting and Stopping Auto-Overlays14154
-Node: Searching for Overlays19680
-Node: Worked Example23678
-Node: Extending the Auto-Overlays Package44510
-Ref: Extending the Auto-Overlays Package-Footnote-145572
-Node: Auto-Overlays in Depth45781
-Ref: Auto-Overlays in Depth-Footnote-148574
-Ref: Auto-Overlays in Depth-Footnote-248755
-Ref: Auto-Overlays in Depth-Footnote-348909
-Node: Integrating New Overlay Classes48939
-Node: Functions for Writing New Overlay Classes51658
-Node: Standard Parse and Suicide Functions52592
-Node: Functions for Modifying Overlays54065
-Node: Functions for Querying Overlays57797
-Node: Auto-Overlay Hooks59629
-Node: Auto-Overlay Modification Pseudo-Hooks60684
-Ref: Auto-Overlay Modification Pseudo-Hooks-Footnote-162777
-Node: To-Do62837
-Node: Function Index63994
-Node: Variable Index68574
-Node: Concept Index69369
-Node: Copying this Manual86107
-Node: GNU Free Documentation License86309
+Node: Top797
+Node: Overview2853
+Node: Auto-Overlay Functions7845
+Node: Defining Regexps9299
+Node: Starting and Stopping Auto-Overlays14158
+Node: Searching for Overlays19821
+Node: Worked Example23819
+Node: Extending the Auto-Overlays Package44652
+Ref: Extending the Auto-Overlays Package-Footnote-145715
+Node: Auto-Overlays in Depth45924
+Ref: Auto-Overlays in Depth-Footnote-148719
+Ref: Auto-Overlays in Depth-Footnote-248900
+Ref: Auto-Overlays in Depth-Footnote-349054
+Node: Integrating New Overlay Classes49084
+Node: Functions for Writing New Overlay Classes51803
+Node: Standard Parse and Suicide Functions52737
+Node: Functions for Modifying Overlays54210
+Node: Functions for Querying Overlays57952
+Node: Auto-Overlay Hooks59784
+Node: Auto-Overlay Modification Pseudo-Hooks60839
+Ref: Auto-Overlay Modification Pseudo-Hooks-Footnote-162932
+Node: To-Do62992
+Node: Function Index64149
+Node: Variable Index68729
+Node: Concept Index69524
+Node: Copying this Manual86262
+Node: GNU Free Documentation License86464
End Tag Table
diff --git a/packages/auto-overlays/auto-overlays.el
b/packages/auto-overlays/auto-overlays.el
index 3cd9af2..cfb704d 100644
--- a/packages/auto-overlays/auto-overlays.el
+++ b/packages/auto-overlays/auto-overlays.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2005-2015 Free Software Foundation, Inc
-;; Version: 0.10.8
+;; Version: 0.10.9
;; Author: Toby Cubitt <address@hidden>
;; Maintainer: Toby Cubitt <address@hidden>
;; Keywords: extensions
@@ -383,6 +383,7 @@ Comparison is done with `eq'."
;;;=========================================================
;;; auto-overlay definition functions
+;;;###autoload
(defun auto-overlay-load-definition (set-id definition &optional pos)
"Load DEFINITION into the set of auto-overlay definitions SET-ID
in the current buffer. If SET-ID does not exist, it is created.
@@ -477,6 +478,7 @@ symbol that can be used to uniquely identify REGEXP (see
+;;;###autoload
(defun auto-overlay-load-regexp (set-id definition-id regexp &optional pos)
"Load REGEXP into the auto-overlay definition identified by
DEFINITION-ID in the regexp list named SET-ID in the current
@@ -653,6 +655,7 @@ Returns the deleted regexp."
+;;;###autoload
(defun auto-overlay-share-regexp-set (set-id from-buffer &optional to-buffer)
"Make TO-BUFFER share the regexp set identified by SET-ID with FROM-BUFFER.
Any changes to that regexp set in either buffer will be reflected in the
@@ -857,6 +860,7 @@ The overlays can be loaded again later using
+;;;###autoload
(defun auto-overlay-load-overlays (set-id &optional buffer
file no-regexp-check)
"Load overlays for BUFFER from FILE.
diff --git a/packages/auto-overlays/dir b/packages/auto-overlays/dir
index ea6a679..833235e 100644
--- a/packages/auto-overlays/dir
+++ b/packages/auto-overlays/dir
@@ -15,5 +15,5 @@ File: dir, Node: Top This is the top of the INFO tree
* Menu:
Emacs
-* auto-overlays (auto-overlay-manual).
+* auto-overlays: (auto-overlay-manual).
Automatic regexp-delimited overlays
diff --git a/packages/context-coloring/README.md
b/packages/context-coloring/README.md
index 21ba184..ff305c1 100644
--- a/packages/context-coloring/README.md
+++ b/packages/context-coloring/README.md
@@ -90,8 +90,9 @@ Add the following to your `~/.emacs` file:
## Customizing
Color schemes for custom themes are automatically applied when those themes are
-active. Built-in theme support is available for: `leuven`, `monokai`,
-`solarized`, `tango` and `zenburn`.
+active. Built-in theme support is available for: `ample`, `anti-zenburn`,
+`grandshell`, `leuven`, `monokai`, `solarized`, `spacegray`, `tango` and
+`zenburn`.
You can define your own theme colors too:
@@ -111,11 +112,14 @@ You can define your own theme colors too:
"#DCA3A3"))
```
+See `C-h f context-coloring-define-theme` for more info on theme parameters.
+
## Extending
To add support for a new language, write a "scopifier" for it, and define a new
coloring dispatch strategy with `context-coloring-define-dispatch`. Then the
-plugin should handle the rest.
+plugin should handle the rest. (See `C-h f context-coloring-define-dispatch`
for
+more info on dispatch strategies.)
A "scopifier" is a CLI program that reads a buffer's contents from stdin and
writes a JSON array of numbers to stdout. Every three numbers in the array
@@ -171,9 +175,7 @@ required.
[linter]: http://jshint.com/about/
[flycheck]: http://www.flycheck.org/
-[zenburn]: http://github.com/bbatsov/zenburn-emacs
[point]: http://www.gnu.org/software/emacs/manual/html_node/elisp/Point.html
[js2-mode]: https://github.com/mooz/js2-mode
[node]: http://nodejs.org/download/
[scopifier]: https://github.com/jacksonrayhamilton/scopifier
-[load path]:
https://www.gnu.org/software/emacs/manual/html_node/emacs/Lisp-Libraries.html
diff --git a/packages/context-coloring/context-coloring.el
b/packages/context-coloring/context-coloring.el
index 6af9444..6b6ffe9 100644
--- a/packages/context-coloring/context-coloring.el
+++ b/packages/context-coloring/context-coloring.el
@@ -5,7 +5,7 @@
;; Author: Jackson Ray Hamilton <address@hidden>
;; URL: https://github.com/jacksonrayhamilton/context-coloring
;; Keywords: context coloring syntax highlighting
-;; Version: 4.1.0
+;; Version: 5.0.0
;; Package-Requires: ((emacs "24") (js2-mode "20150126"))
;; This file is part of GNU Emacs.
@@ -56,13 +56,6 @@
(require 'js2-mode)
-;;; Constants
-
-(defconst context-coloring-path
- (file-name-directory (or load-file-name buffer-file-name))
- "This file's directory.")
-
-
;;; Customizable options
(defcustom context-coloring-delay 0.25
@@ -81,8 +74,8 @@ Supported modes: `js-mode', `js3-mode'"
(defcustom context-coloring-js-block-scopes nil
"If non-nil, also color block scopes in the scope hierarchy in JavaScript.
-The block-scope-inducing `let' and `const' are introduced in ES6.
-If you are writing ES6 code, enable this; otherwise, don't.
+The block-scoped `let' and `const' are introduced in ES6. If you
+are writing ES6 code, enable this; otherwise, don't.
Supported modes: `js2-mode'"
:group 'context-coloring)
@@ -115,23 +108,28 @@ used.")
;;; Faces
(defun context-coloring-defface (level tty light dark)
+ "Dynamically define a face for LEVEL with colors for TTY, LIGHT
+and DARK backgrounds."
(let ((face (intern (format "context-coloring-level-%s-face" level)))
(doc (format "Context coloring face, level %s." level)))
- (eval (macroexpand `(defface ,face
- '((((type tty)) (:foreground ,tty))
- (((background light)) (:foreground ,light))
- (((background dark)) (:foreground ,dark)))
- ,doc
- :group 'context-coloring)))))
+ (eval
+ (macroexpand
+ `(defface ,face
+ '((((type tty)) (:foreground ,tty))
+ (((background light)) (:foreground ,light))
+ (((background dark)) (:foreground ,dark)))
+ ,doc
+ :group 'context-coloring)))))
(defvar context-coloring-face-count nil
- "Number of faces available for context coloring.")
+ "Number of faces available for coloring.")
(defun context-coloring-defface-default (level)
- (context-coloring-defface level "white" "#3f3f3f" "#cdcdcd"))
+ "Define a face for LEVEL with the default neutral colors."
+ (context-coloring-defface level nil "#3f3f3f" "#cdcdcd"))
(defun context-coloring-set-colors-default ()
- (context-coloring-defface 0 "white" "#000000" "#ffffff")
+ (context-coloring-defface 0 nil "#000000" "#ffffff")
(context-coloring-defface 1 "yellow" "#007f80" "#ffff80")
(context-coloring-defface 2 "green" "#001580" "#cdfacd")
(context-coloring-defface 3 "cyan" "#550080" "#d8d8ff")
@@ -292,7 +290,8 @@ element."
(defun context-coloring-parse-array (input)
"Specialized JSON parser for a flat array of numbers."
- (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1)
","))))
+ (vconcat
+ (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
(defun context-coloring-kill-scopifier ()
"Kills the currently-running scopifier process for this
@@ -339,8 +338,11 @@ Invokes CALLBACK when complete."
(if callback (funcall callback)))))))
;; Give the process its input so it can begin.
- (process-send-region context-coloring-scopifier-process (point-min)
(point-max))
- (process-send-eof context-coloring-scopifier-process))
+ (process-send-region
+ context-coloring-scopifier-process
+ (point-min) (point-max))
+ (process-send-eof
+ context-coloring-scopifier-process))
;;; Dispatch
@@ -479,51 +481,243 @@ would be redundant."
(defvar context-coloring-theme-hash-table (make-hash-table :test 'eq)
"Mapping of theme names to theme properties.")
+(defun context-coloring-theme-p (theme)
+ "Return t if THEME is defined, nil otherwise."
+ (and (gethash theme context-coloring-theme-hash-table)))
+
+(defconst context-coloring-level-face-regexp
+ "context-coloring-level-\\([[:digit:]]+\\)-face"
+ "Regular expression for extracting a level from a face.")
+
+(defvar context-coloring-originally-set-theme-hash-table
+ (make-hash-table :test 'eq)
+ "Cache of custom themes who originally set their own
+ `context-coloring-level-N-face' faces.")
+
+(defun context-coloring-theme-originally-set-p (theme)
+ "Return t if there is a `context-coloring-level-N-face'
+originally set for THEME, nil otherwise."
+ (let (originally-set)
+ (cond
+ ;; `setq' might return a non-nil value for the sake of this `cond'.
+ ((setq
+ originally-set
+ (gethash
+ theme
+ context-coloring-originally-set-theme-hash-table))
+ (eq originally-set 'yes))
+ (t
+ (let* ((settings (get theme 'theme-settings))
+ (tail settings)
+ found)
+ (while (and tail (not found))
+ (and (eq (nth 0 (car tail)) 'theme-face)
+ (string-match
+ context-coloring-level-face-regexp
+ (symbol-name (nth 1 (car tail))))
+ (setq found t))
+ (setq tail (cdr tail)))
+ found)))))
+
+(defun context-coloring-cache-originally-set (theme originally-set)
+ "Remember if THEME had colors originally set for it; if
+ORIGINALLY-SET is non-nil, it did, otherwise it didn't."
+ ;; Caching whether a theme was originally set is kind of dirty, but we have
to
+ ;; do it to remember the past state of the theme. There are probably some
+ ;; edge cases where caching will be an issue, but they are probably rare.
+ (puthash
+ theme
+ (if originally-set 'yes 'no)
+ context-coloring-originally-set-theme-hash-table))
+
+(defun context-coloring-warn-theme-originally-set (theme)
+ "Warns the user that the colors for a theme are already
+originally set."
+ (warn "Context coloring colors for theme `%s' are already defined" theme))
+
+(defun context-coloring-theme-highest-level (theme)
+ "Return the highest level N of a face like
+`context-coloring-level-N-face' set for THEME, or -1 if there is
+none."
+ (let* ((settings (get theme 'theme-settings))
+ (tail settings)
+ face-string
+ number
+ (found -1))
+ (while tail
+ (and (eq (nth 0 (car tail)) 'theme-face)
+ (setq face-string (symbol-name (nth 1 (car tail))))
+ (string-match
+ context-coloring-level-face-regexp
+ face-string)
+ (setq number (string-to-number
+ (substring face-string
+ (match-beginning 1)
+ (match-end 1))))
+ (> number found)
+ (setq found number))
+ (setq tail (cdr tail)))
+ found))
+
(defun context-coloring-apply-theme (theme)
"Applies THEME's properties to its respective custom theme,
which must already exist and which *should* already be enabled."
- (let ((properties (gethash theme context-coloring-theme-hash-table)))
- (when (null properties)
- (error (format "No such theme `%s'" theme)))
- (let ((colors (plist-get properties :colors)))
- (setq context-coloring-face-count (length colors)) ; Side-effect?
- (let ((level -1))
- ;; AFAIK, no way to know if a theme already has a face set, so just
- ;; override blindly for now.
- (apply
- 'custom-theme-set-faces
- theme
- (mapcar
- (lambda (color)
- (setq level (+ level 1))
- `(,(context-coloring-face-symbol level) ((t (:foreground
,color)))))
- colors))))))
+ (let* ((properties (gethash theme context-coloring-theme-hash-table))
+ (colors (plist-get properties :colors))
+ (level -1))
+ (setq context-coloring-face-count (length colors))
+ (apply
+ 'custom-theme-set-faces
+ theme
+ (mapcar
+ (lambda (color)
+ (setq level (+ level 1))
+ `(,(context-coloring-face-symbol level) ((t (:foreground ,color)))))
+ colors))))
(defun context-coloring-define-theme (theme &rest properties)
- "Define a theme named THEME for coloring scope levels.
+ "Define a context theme named THEME for coloring scope levels.
+
PROPERTIES is a property list specifiying the following details:
-`:colors': List of colors that this theme uses."
- (let ((aliases (plist-get properties :aliases)))
+`:aliases': List of symbols of other custom themes that these
+colors are applicable to.
+
+`:colors': List of colors that this context theme uses.
+
+`:override': If non-nil, this context theme is intentionally
+overriding colors set by a custom theme. Don't set this non-nil
+unless there is a custom theme you want to use which sets
+`context-coloring-level-N-face' faces that you want to replace.
+
+`:recede': If non-nil, this context theme should not apply its
+colors if a custom theme already sets
+`context-coloring-level-N-face' faces. This option is
+optimistic; set this non-nil if you would rather confer the duty
+of picking colors to a custom theme author (if / when he ever
+gets around to it).
+
+By default, context themes will always override custom themes,
+even if those custom themes set `context-coloring-level-N-face'
+faces. If a context theme does override a custom theme, a
+warning will be raised, at which point you may want to enable the
+`:override' option, or just delete your context theme and opt to
+use your custom theme's author's colors instead.
+
+Context themes only work for the custom theme with the highest
+precedence, i.e. the car of `custom-enabled-themes'."
+ (let ((aliases (plist-get properties :aliases))
+ (override (plist-get properties :override))
+ (recede (plist-get properties :recede)))
(dolist (name (append `(,theme) aliases))
(puthash name properties context-coloring-theme-hash-table)
- ;; Compensate for already-enabled themes by applying their colors now.
- (when (custom-theme-enabled-p name)
- (context-coloring-apply-theme name)))))
-
-(defun context-coloring-load-theme (&optional rest)
- (declare (obsolete
- "themes are now loaded alongside custom themes automatically."
- "4.1.0")))
+ (when (custom-theme-p name)
+ (let ((originally-set (context-coloring-theme-originally-set-p name)))
+ (context-coloring-cache-originally-set name originally-set)
+ ;; In the particular case when you innocently define colors that a
+ ;; custom theme originally set, warn. Arguably this only has to be
+ ;; done at enable time, but it is probably more useful to do it at
+ ;; definition time for prompter feedback.
+ (when (and originally-set
+ (not recede)
+ (not override))
+ (context-coloring-warn-theme-originally-set name))
+ ;; Set (or overwrite) colors.
+ (when (not (and originally-set
+ recede))
+ (context-coloring-apply-theme name)))))))
+
+(defun context-coloring-enable-theme (theme)
+ "Applies THEME if its colors are not already set, else just
+sets `context-coloring-face-count' to the correct value for
+THEME."
+ (let* ((properties (gethash theme context-coloring-theme-hash-table))
+ (recede (plist-get properties :recede))
+ (override (plist-get properties :override)))
+ (cond
+ (recede
+ (let ((highest-level (context-coloring-theme-highest-level theme)))
+ (cond
+ ;; This can be true whether originally set by a custom theme or by a
+ ;; context theme.
+ ((> highest-level -1)
+ (setq context-coloring-face-count (+ highest-level 1)))
+ ;; It is possible that the corresponding custom theme did not exist at
+ ;; the time of defining this context theme, and in that case the above
+ ;; condition proves the custom theme did not originally set any faces,
+ ;; so we have license to apply the context theme for the first time
+ ;; here.
+ (t
+ (context-coloring-apply-theme theme)))))
+ (t
+ (let ((originally-set (context-coloring-theme-originally-set-p theme)))
+ ;; Cache now in case the context theme was defined after the custom
+ ;; theme.
+ (context-coloring-cache-originally-set theme originally-set)
+ (when (and originally-set
+ (not override))
+ (context-coloring-warn-theme-originally-set theme))
+ (context-coloring-apply-theme theme))))))
(defadvice enable-theme (after context-coloring-enable-theme (theme) activate)
- "Add colors to themes just-in-time."
- (when (and (not (eq theme 'user)) ; Called internally.
- (custom-theme-p theme)) ; Guard against non-existent themes.
- (context-coloring-apply-theme theme)))
+ "Enable colors for context themes just-in-time. We can't set
+faces for custom themes that might not exist yet."
+ (when (and (not (eq theme 'user)) ; Called internally by `enable-theme'.
+ (custom-theme-p theme) ; Guard against non-existent themes.
+ (context-coloring-theme-p theme))
+ (context-coloring-enable-theme theme)))
+
+(defadvice disable-theme (after context-coloring-disable-theme (theme)
activate)
+ "Colors are disabled normally, but
+`context-coloring-face-count' isn't. Update it here."
+ (when (custom-theme-p theme) ; Guard against non-existent themes.
+ (let ((enabled-theme (car custom-enabled-themes)))
+ (if (context-coloring-theme-p enabled-theme)
+ (context-coloring-enable-theme enabled-theme)
+ (context-coloring-set-colors-default)))))
+
+(context-coloring-define-theme
+ 'ample
+ :recede t
+ :colors '("#bdbdb3"
+ "#baba36"
+ "#6aaf50"
+ "#5180b3"
+ "#ab75c3"
+ "#cd7542"
+ "#dF9522"
+ "#454545"))
+
+(context-coloring-define-theme
+ 'anti-zenburn
+ :recede t
+ :colors '("#232333"
+ "#6c1f1c"
+ "#401440"
+ "#0f2050"
+ "#205070"
+ "#336c6c"
+ "#23733c"
+ "#6b400c"
+ "#603a60"
+ "#2f4070"
+ "#235c5c"))
+
+(context-coloring-define-theme
+ 'grandshell
+ :recede t
+ :colors '("#bebebe"
+ "#5af2ee"
+ "#b2baf6"
+ "#f09fff"
+ "#efc334"
+ "#f6df92"
+ "#acfb5a"
+ "#888888"))
(context-coloring-define-theme
'leuven
+ :recede t
:colors '("#333333"
"#0000FF"
"#6434A3"
@@ -536,6 +730,7 @@ PROPERTIES is a property list specifiying the following
details:
(context-coloring-define-theme
'monokai
+ :recede t
:colors '("#F8F8F2"
"#66D9EF"
"#A1EFE4"
@@ -548,6 +743,7 @@ PROPERTIES is a property list specifiying the following
details:
(context-coloring-define-theme
'solarized
+ :recede t
:aliases '(solarized-light
solarized-dark
sanityinc-solarized-light
@@ -571,7 +767,20 @@ PROPERTIES is a property list specifiying the following
details:
"#9EA0E5"))
(context-coloring-define-theme
+ 'spacegray
+ :recede t
+ :colors '("#ffffff"
+ "#89AAEB"
+ "#C189EB"
+ "#bf616a"
+ "#DCA432"
+ "#ebcb8b"
+ "#B4EB89"
+ "#89EBCA"))
+
+(context-coloring-define-theme
'tango
+ :recede t
:colors '("#2e3436"
"#346604"
"#204a87"
@@ -588,6 +797,7 @@ PROPERTIES is a property list specifiying the following
details:
(context-coloring-define-theme
'zenburn
+ :recede t
:colors '("#DCDCCC"
"#93E0E3"
"#BFEBBF"
@@ -612,12 +822,14 @@ PROPERTIES is a property list specifiying the following
details:
(context-coloring-kill-scopifier)
(when context-coloring-colorize-idle-timer
(cancel-timer context-coloring-colorize-idle-timer))
- (remove-hook 'js2-post-parse-callbacks 'context-coloring-colorize t)
- (remove-hook 'after-change-functions 'context-coloring-change-function
t)
+ (remove-hook
+ 'js2-post-parse-callbacks 'context-coloring-colorize t)
+ (remove-hook
+ 'after-change-functions 'context-coloring-change-function t)
(font-lock-mode)
(jit-lock-mode t))
- ;; Remember this buffer. This value should not be dynamically-bound.
+ ;; Remember this buffer. This value should not be dynamically-bound.
(setq context-coloring-buffer (current-buffer))
;; Font lock is incompatible with this mode; the converse is also true.
@@ -632,16 +844,13 @@ PROPERTIES is a property list specifiying the following
details:
;; Only recolor on reparse.
(add-hook 'js2-post-parse-callbacks 'context-coloring-colorize nil t))
(t
- ;; Only recolor on change.
- (add-hook 'after-change-functions 'context-coloring-change-function nil
t)))
-
- (when (not (equal major-mode 'js2-mode))
- ;; Only recolor idly.
+ ;; Only recolor on change, idly.
+ (add-hook 'after-change-functions 'context-coloring-change-function nil
t)
(setq context-coloring-colorize-idle-timer
(run-with-idle-timer
context-coloring-delay
t
- 'context-coloring-maybe-colorize)))))
+ 'context-coloring-maybe-colorize))))))
(provide 'context-coloring)
diff --git a/packages/context-coloring/test/context-coloring-test.el
b/packages/context-coloring/test/context-coloring-test.el
index 607882b..fdb0d83 100644
--- a/packages/context-coloring/test/context-coloring-test.el
+++ b/packages/context-coloring/test/context-coloring-test.el
@@ -19,6 +19,9 @@
;;; Code:
+(require 'ert-async)
+
+
;;; Test running utilities
(defconst context-coloring-test-path
@@ -68,7 +71,8 @@ is done."
(kill-buffer temp-buffer))
(set-buffer previous-buffer))))))
-(defun context-coloring-test-with-fixture-async (fixture callback &optional
setup)
+(defun context-coloring-test-with-fixture-async
+ (fixture callback &optional setup)
"Evaluate CALLBACK in a temporary buffer with the relative
FIXTURE. A teardown callback is passed to CALLBACK for it to
invoke when it is done. An optional SETUP callback can be passed
@@ -117,7 +121,8 @@ instantiated in SETUP."
format."
(let ((test-name (intern (format "context-coloring-test-js-mode-%s" name)))
(fixture (format "./fixtures/%s.js" name))
- (function-name (intern-soft (format "context-coloring-test-js-%s"
name))))
+ (function-name (intern-soft
+ (format "context-coloring-test-js-%s" name))))
`(ert-deftest-async ,test-name (done)
(context-coloring-test-js-mode
,fixture
@@ -131,7 +136,8 @@ format."
"Define a test for `js2-mode' in the typical format."
(let ((test-name (intern (format "context-coloring-test-js2-mode-%s" name)))
(fixture (format "./fixtures/%s.js" name))
- (function-name (intern-soft (format "context-coloring-test-js-%s"
name))))
+ (function-name (intern-soft
+ (format "context-coloring-test-js-%s" name))))
`(ert-deftest ,test-name ()
(context-coloring-test-js2-mode
,fixture
@@ -153,10 +159,6 @@ region. Provides the free variables `i', `length',
`point',
,@body)
(setq i (+ i 1)))))
-(defconst context-coloring-test-level-regexp
- "context-coloring-level-\\([[:digit:]]+\\)-face"
- "Regular expression for extracting a level from a face.")
-
(defun context-coloring-test-assert-region-level (start end level)
"Assert that all points in the range [START, END) are of level
LEVEL."
@@ -164,7 +166,7 @@ LEVEL."
(when (not (when face
(let* ((face-string (symbol-name face))
(matches (string-match
- context-coloring-test-level-regexp
+ context-coloring-level-face-regexp
face-string)))
(when matches
(setq actual-level (string-to-number
@@ -209,32 +211,69 @@ EXPECTED-FACE."
(context-coloring-test-assert-region-face
start end 'font-lock-string-face))
-(defun context-coloring-test-assert-message (expected)
- "Assert that the *Messages* buffer has message EXPECTED."
- (with-current-buffer "*Messages*"
+(defun context-coloring-test-assert-message (expected buffer)
+ "Assert that BUFFER has message EXPECTED."
+ (when (null (get-buffer buffer))
+ (ert-fail
+ (format
+ (concat
+ "Expected buffer `%s' to have message \"%s\", "
+ "but the buffer did not have any messages.")
+ buffer expected)))
+ (with-current-buffer buffer
(let ((messages (split-string
(buffer-substring-no-properties
(point-min)
(point-max))
"\n")))
(let ((message (car (nthcdr (- (length messages) 2) messages))))
- (should (equal message expected))))))
-
-(defun context-coloring-test-assert-face (level foreground)
+ (when (not (equal message expected))
+ (ert-fail
+ (format
+ (concat
+ "Expected buffer `%s' to have message \"%s\", "
+ "but instead it was \"%s\"")
+ buffer expected
+ message)))))))
+
+(defun context-coloring-test-assert-no-message (buffer)
+ "Assert that BUFFER has no message."
+ (when (get-buffer buffer)
+ (ert-fail (format (concat "Expected buffer `%s' to have no messages, "
+ "but it did: `%s'")
+ buffer
+ (with-current-buffer buffer
+ (buffer-string))))))
+
+(defun context-coloring-test-kill-buffer (buffer)
+ "Kill BUFFER if it exists."
+ (if (get-buffer buffer) (kill-buffer buffer)))
+
+(defun context-coloring-test-assert-face (level foreground &optional negate)
"Assert that a face for LEVEL exists and that its `:foreground'
is FOREGROUND."
(let* ((face (context-coloring-face-symbol level))
actual-foreground)
- (when (not face)
+ (when (not (or negate
+ face))
(ert-fail (format (concat "Expected face for level `%s' to exist; "
"but it didn't")
level)))
(setq actual-foreground (face-attribute face :foreground))
- (when (not (string-equal foreground actual-foreground))
+ (when (funcall (if negate 'identity 'not)
+ (string-equal foreground actual-foreground))
(ert-fail (format (concat "Expected face for level `%s' "
- "to have foreground `%s'; but it was `%s'")
+ "%sto have foreground `%s'; "
+ "but it %s.")
level
- foreground actual-foreground)))))
+ (if negate "not " "") foreground
+ (if negate "did" (format "was `%s'"
actual-foreground)))))))
+
+(defun context-coloring-test-assert-not-face (&rest arguments)
+ "Assert that LEVEL does not have a face with `:foreground'
+FOREGROUND."
+ (apply 'context-coloring-test-assert-face
+ (append arguments '(t))))
;;; The tests
@@ -244,7 +283,8 @@ is FOREGROUND."
"./fixtures/function-scopes.js"
(context-coloring-mode)
(context-coloring-test-assert-message
- "Context coloring is not available for this major mode")))
+ "Context coloring is not available for this major mode"
+ "*Messages*")))
(ert-deftest context-coloring-test-set-colors ()
;; This test has an irreversible side-effect in that it defines faces beyond
@@ -272,6 +312,312 @@ is FOREGROUND."
(context-coloring-test-assert-face 8 "#888888")
(context-coloring-test-assert-face 9 "#999999"))
+(defvar context-coloring-test-theme-index 0
+ "Unique index for unique theme names.")
+
+(defun context-coloring-test-get-next-theme ()
+ "Return a unique symbol for a throwaway theme."
+ (prog1
+ (intern (format "context-coloring-test-theme-%s"
+ context-coloring-test-theme-index))
+ (setq context-coloring-test-theme-index
+ (+ context-coloring-test-theme-index 1))))
+
+(defun context-coloring-test-assert-theme-originally-set-p
+ (settings &optional negate)
+ "Assert that `context-coloring-theme-originally-set-p' returns
+t for a theme with SETTINGS (or the inverse if NEGATE is
+non-nil)."
+ (let ((theme (context-coloring-test-get-next-theme)))
+ (put theme 'theme-settings settings)
+ (when (funcall (if negate 'identity 'not)
+ (context-coloring-theme-originally-set-p theme))
+ (ert-fail (format (concat "Expected theme `%s' with settings `%s' "
+ "%sto be considered to have defined a level, "
+ "but it %s.")
+ theme settings
+ (if negate "not " "")
+ (if negate "was" "wasn't"))))))
+
+(defun context-coloring-test-assert-not-theme-originally-set-p (&rest
arguments)
+ "Assert that `context-coloring-theme-originally-set-p' does not
+return t for a theme with SETTINGS."
+ (apply 'context-coloring-test-assert-theme-originally-set-p
+ (append arguments '(t))))
+
+(ert-deftest context-coloring-test-theme-originally-set-p ()
+ (context-coloring-test-assert-theme-originally-set-p
+ '((theme-face context-coloring-level-0-face)))
+ (context-coloring-test-assert-theme-originally-set-p
+ '((theme-face face)
+ (theme-face context-coloring-level-0-face)))
+ (context-coloring-test-assert-theme-originally-set-p
+ '((theme-face context-coloring-level-0-face)
+ (theme-face face)))
+ (context-coloring-test-assert-not-theme-originally-set-p
+ '((theme-face face)))
+ )
+
+(defun context-coloring-test-assert-theme-settings-highest-level
+ (settings expected-level)
+ "Assert that a theme with SETTINGS has the highest level
+EXPECTED-LEVEL."
+ (let ((theme (context-coloring-test-get-next-theme)))
+ (put theme 'theme-settings settings)
+ (context-coloring-test-assert-theme-highest-level theme expected-level)))
+
+(defun context-coloring-test-assert-theme-highest-level
+ (theme expected-level &optional negate)
+ "Assert that THEME has the highest level EXPECTED-LEVEL."
+ (let ((highest-level (context-coloring-theme-highest-level theme)))
+ (when (funcall (if negate 'identity 'not) (eq highest-level
expected-level))
+ (ert-fail (format (concat "Expected theme with settings `%s' "
+ "%sto have a highest level of `%s', "
+ "but it %s.")
+ (get theme 'theme-settings)
+ (if negate "not " "") expected-level
+ (if negate "did" (format "was %s" highest-level)))))))
+
+(defun context-coloring-test-assert-theme-not-highest-level (&rest arguments)
+ "Assert that THEME's highest level is not EXPECTED-LEVEL."
+ (apply 'context-coloring-test-assert-theme-highest-level
+ (append arguments '(t))))
+
+(ert-deftest context-coloring-test-theme-highest-level ()
+ (context-coloring-test-assert-theme-settings-highest-level
+ '((theme-face foo))
+ -1)
+ (context-coloring-test-assert-theme-settings-highest-level
+ '((theme-face context-coloring-level-0-face))
+ 0)
+ (context-coloring-test-assert-theme-settings-highest-level
+ '((theme-face context-coloring-level-1-face))
+ 1)
+ (context-coloring-test-assert-theme-settings-highest-level
+ '((theme-face context-coloring-level-1-face)
+ (theme-face context-coloring-level-0-face))
+ 1)
+ (context-coloring-test-assert-theme-settings-highest-level
+ '((theme-face context-coloring-level-0-face)
+ (theme-face context-coloring-level-1-face))
+ 1)
+ )
+
+(defmacro context-coloring-test-deftest-define-theme (name &rest body)
+ "Define a test with an automatically-generated theme symbol
+available as a free variable `theme'. Side-effects from enabling
+themes are reversed after the test completes."
+ (declare (indent defun))
+ (let ((deftest-name (intern
+ (format "context-coloring-test-define-theme-%s" name))))
+ `(ert-deftest ,deftest-name ()
+ (context-coloring-test-kill-buffer "*Warnings*")
+ (let ((theme (context-coloring-test-get-next-theme)))
+ (unwind-protect
+ (progn
+ ,@body)
+ ;; Always cleanup.
+ (disable-theme theme)
+ (context-coloring-set-colors-default))))))
+
+(defun context-coloring-test-deftheme (theme)
+ "Dynamically define theme THEME."
+ (eval (macroexpand `(deftheme ,theme))))
+
+(context-coloring-test-deftest-define-theme additive
+ (context-coloring-test-deftheme theme)
+ (context-coloring-define-theme
+ theme
+ :colors '("#aaaaaa"
+ "#bbbbbb"))
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (enable-theme theme)
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(defun context-coloring-test-assert-defined-warning (theme)
+ "Assert that a warning about colors already being defined for
+theme THEME is signaled."
+ (context-coloring-test-assert-message
+ (format (concat "Warning (emacs): Context coloring colors for theme "
+ "`%s' are already defined")
+ theme)
+ "*Warnings*"))
+
+(context-coloring-test-deftest-define-theme unintentional-override
+ (context-coloring-test-deftheme theme)
+ (custom-theme-set-faces
+ theme
+ '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
+ '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
+ (context-coloring-define-theme
+ theme
+ :colors '("#cccccc"
+ "#dddddd"))
+ (context-coloring-test-assert-defined-warning theme)
+ (context-coloring-test-kill-buffer "*Warnings*")
+ (enable-theme theme)
+ (context-coloring-test-assert-defined-warning theme)
+ (context-coloring-test-assert-face 0 "#cccccc")
+ (context-coloring-test-assert-face 1 "#dddddd"))
+
+(context-coloring-test-deftest-define-theme intentional-override
+ (context-coloring-test-deftheme theme)
+ (custom-theme-set-faces
+ theme
+ '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
+ '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
+ (context-coloring-define-theme
+ theme
+ :override t
+ :colors '("#cccccc"
+ "#dddddd"))
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (enable-theme theme)
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#cccccc")
+ (context-coloring-test-assert-face 1 "#dddddd"))
+
+(context-coloring-test-deftest-define-theme pre-recede
+ (context-coloring-define-theme
+ theme
+ :recede t
+ :colors '("#aaaaaa"
+ "#bbbbbb"))
+ (context-coloring-test-deftheme theme)
+ (custom-theme-set-faces
+ theme
+ '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
+ '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
+ (enable-theme theme)
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#cccccc")
+ (context-coloring-test-assert-face 1 "#dddddd"))
+
+(context-coloring-test-deftest-define-theme post-recede
+ (context-coloring-test-deftheme theme)
+ (custom-theme-set-faces
+ theme
+ '(context-coloring-level-0-face ((t (:foreground "#aaaaaa"))))
+ '(context-coloring-level-1-face ((t (:foreground "#bbbbbb")))))
+ (context-coloring-define-theme
+ theme
+ :recede t
+ :colors '("#cccccc"
+ "#dddddd"))
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb")
+ (enable-theme theme)
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(context-coloring-test-deftest-define-theme recede-not-defined
+ (context-coloring-test-deftheme theme)
+ (custom-theme-set-faces
+ theme
+ '(foo-face ((t (:foreground "#ffffff")))))
+ (context-coloring-define-theme
+ theme
+ :recede t
+ :colors '("#aaaaaa"
+ "#bbbbbb"))
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb")
+ (enable-theme theme)
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(context-coloring-test-deftest-define-theme unintentional-obstinance
+ (context-coloring-define-theme
+ theme
+ :colors '("#aaaaaa"
+ "#bbbbbb"))
+ (context-coloring-test-deftheme theme)
+ (custom-theme-set-faces
+ theme
+ '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
+ '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
+ (enable-theme theme)
+ (context-coloring-test-assert-defined-warning theme)
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(context-coloring-test-deftest-define-theme intentional-obstinance
+ (context-coloring-define-theme
+ theme
+ :override t
+ :colors '("#aaaaaa"
+ "#bbbbbb"))
+ (context-coloring-test-deftheme theme)
+ (custom-theme-set-faces
+ theme
+ '(context-coloring-level-0-face ((t (:foreground "#cccccc"))))
+ '(context-coloring-level-1-face ((t (:foreground "#dddddd")))))
+ (enable-theme theme)
+ (context-coloring-test-assert-no-message "*Warnings*")
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb"))
+
+(defun context-coloring-test-assert-face-count (count &optional negate)
+ "Assert that `context-coloring-face-count' is COUNT."
+ (when (funcall (if negate 'identity 'not)
+ (eq context-coloring-face-count count))
+ (ert-fail (format (concat "Expected `context-coloring-face-count' "
+ "%sto be `%s', "
+ "but it %s.")
+ (if negate "not " "") count
+ (if negate
+ "was"
+ (format "was `%s'" context-coloring-face-count))))))
+
+(defun context-coloring-test-assert-not-face-count (&rest arguments)
+ "Assert that `context-coloring-face-count' is not COUNT."
+ (apply 'context-coloring-test-assert-face-count
+ (append arguments '(t))))
+
+(context-coloring-test-deftest-define-theme disable-cascade
+ (context-coloring-test-deftheme theme)
+ (context-coloring-define-theme
+ theme
+ :colors '("#aaaaaa"
+ "#bbbbbb"))
+ (let ((second-theme (context-coloring-test-get-next-theme)))
+ (context-coloring-test-deftheme second-theme)
+ (context-coloring-define-theme
+ second-theme
+ :colors '("#cccccc"
+ "#dddddd"
+ "#eeeeee"))
+ (let ((third-theme (context-coloring-test-get-next-theme)))
+ (context-coloring-test-deftheme third-theme)
+ (context-coloring-define-theme
+ third-theme
+ :colors '("#111111"
+ "#222222"
+ "#333333"
+ "#444444"))
+ (enable-theme theme)
+ (enable-theme second-theme)
+ (enable-theme third-theme)
+ (disable-theme third-theme)
+ (context-coloring-test-assert-face 0 "#cccccc")
+ (context-coloring-test-assert-face 1 "#dddddd")
+ (context-coloring-test-assert-face 2 "#eeeeee")
+ (context-coloring-test-assert-face-count 3))
+ (disable-theme second-theme)
+ (context-coloring-test-assert-face 0 "#aaaaaa")
+ (context-coloring-test-assert-face 1 "#bbbbbb")
+ (context-coloring-test-assert-face-count 2))
+ (disable-theme theme)
+ (context-coloring-test-assert-not-face 0 "#aaaaaa")
+ (context-coloring-test-assert-not-face 1 "#bbbbbb")
+ (context-coloring-test-assert-not-face-count 2))
+
(defun context-coloring-test-js-function-scopes ()
(context-coloring-test-assert-region-level 1 9 0)
(context-coloring-test-assert-region-level 9 23 1)
diff --git a/packages/seq/seq.el b/packages/seq/seq.el
index ca36515..bc0344d 100644
--- a/packages/seq/seq.el
+++ b/packages/seq/seq.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <address@hidden>
;; Keywords: sequences
-;; Version: 1.1
+;; Version: 1.1.1
;; Package: seq
;; Maintainer: address@hidden
@@ -246,17 +246,16 @@ negative integer or 0, nil is returned."
"Apply FUNCTION to each element of SEQ.
Separate the elements of SEQ into an alist using the results as
keys. Keys are compared using `equal'."
- (nreverse
- (seq-reduce
- (lambda (acc elt)
- (let* ((key (funcall function elt))
- (cell (assoc key acc)))
- (if cell
- (setcdr cell (push elt (cdr cell)))
- (push (list key elt) acc))
- acc))
- seq
- nil)))
+ (seq-reduce
+ (lambda (acc elt)
+ (let* ((key (funcall function elt))
+ (cell (assoc key acc)))
+ (if cell
+ (setcdr cell (push elt (cdr cell)))
+ (push (list key elt) acc))
+ acc))
+ (seq-reverse seq)
+ nil))
(defun seq--drop-list (list n)
"Return a list from LIST without its first N elements.
diff --git a/packages/seq/tests/seq-tests.el b/packages/seq/tests/seq-tests.el
index ecbc004..b92a15c 100644
--- a/packages/seq/tests/seq-tests.el
+++ b/packages/seq/tests/seq-tests.el
@@ -216,10 +216,10 @@ Evaluate BODY for each created sequence.
(should (equal (seq-partition '(1 2 3) -1) '())))
(ert-deftest test-seq-group-by ()
- (should (equal (seq-group-by #'test-sequences-oddp [1 2 3 4])
- '((t 3 1) (nil 4 2))))
+ (should (equal (seq-group-by #'test-sequences-oddp '(1 2 3 4))
+ '((t 1 3) (nil 2 4))))
(should (equal (seq-group-by #'car '((a 1) (b 3) (c 4) (a 2)))
- '((a (a 2) (a 1)) (b (b 3)) (c (c 4))))))
+ '((b (b 3)) (c (c 4)) (a (a 1) (a 2))))))
(provide 'seq-tests)
;;; seq-tests.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master 7ea9a82 2/2: Merge branch 'master' of git+ssh://git.sv.gnu.org/srv/git/emacs/elpa,
Stefan Monnier <=