gergely/my-emacs-d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add new packages

Browse Source
This commit is contained in:
Gergely Polonkai 2016-09-15 13:54:46 +02:00
parent 697f492aba
commit b4f2fb14c0
86 changed files with 21872 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

239
elpa/flycheck-20160912.814/flycheck-autoloads.el Normal file
View File

@ -0,0 +1,239 @@
;;; flycheck-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "flycheck" "flycheck.el" (22490 28019 716696
;;;;;; 411000))
;;; Generated autoloads from flycheck.el
(autoload 'flycheck-manual "flycheck" "\
Open the Flycheck manual.
\(fn)" t nil)
(autoload 'flycheck-mode "flycheck" "\
Minor mode for on-the-fly syntax checking.
When called interactively, toggle `flycheck-mode'. With prefix
ARG, enable `flycheck-mode' if ARG is positive, otherwise disable
it.
When called from Lisp, enable `flycheck-mode' if ARG is omitted,
nil or positive. If ARG is `toggle', toggle `flycheck-mode'.
Otherwise behave as if called interactively.
In `flycheck-mode' the buffer is automatically syntax-checked
using the first suitable syntax checker from `flycheck-checkers'.
Use `flycheck-select-checker' to select a checker for the current
buffer manually.
\\{flycheck-mode-map}
\(fn &optional ARG)" t nil)
(defvar global-flycheck-mode nil "\
Non-nil if Global-Flycheck mode is enabled.
See the command `global-flycheck-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-flycheck-mode'.")
(custom-autoload 'global-flycheck-mode "flycheck" nil)
(autoload 'global-flycheck-mode "flycheck" "\
Toggle Flycheck mode in all buffers.
With prefix ARG, enable Global-Flycheck mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Flycheck mode is enabled in all buffers where
`flycheck-mode-on-safe' would do it.
See `flycheck-mode' for more information on Flycheck mode.
\(fn &optional ARG)" t nil)
(autoload 'flycheck-define-error-level "flycheck" "\
Define a new error LEVEL with PROPERTIES.
The following PROPERTIES constitute an error level:
`:severity SEVERITY'
A number denoting the severity of this level. The higher
the number, the more severe is this level compared to other
levels. Defaults to 0.
The severity is used by `flycheck-error-level-<' to
determine the ordering of errors according to their levels.
`:compilation-level LEVEL'
A number indicating the broad class of messages that errors
at this level belong to: one of 0 (info), 1 (warning), or
2 or nil (error). Defaults to nil.
This is used by `flycheck-checker-pattern-to-error-regexp'
to map error levels into `compilation-mode''s hierarchy and
to get proper highlighting of errors in `compilation-mode'.
`:overlay-category CATEGORY'
A symbol denoting the overlay category to use for error
highlight overlays for this level. See Info
node `(elisp)Overlay Properties' for more information about
overlay categories.
A category for an error level overlay should at least define
the `face' property, for error highlighting. Another useful
property for error level categories is `priority', to
influence the stacking of multiple error level overlays.
`:fringe-bitmap BITMAP'
A fringe bitmap symbol denoting the bitmap to use for fringe
indicators for this level. See Info node `(elisp)Fringe
Bitmaps' for more information about fringe bitmaps,
including a list of built-in fringe bitmaps.
`:fringe-face FACE'
A face symbol denoting the face to use for fringe indicators
for this level.
`:error-list-face FACE'
A face symbol denoting the face to use for messages of this
level in the error list. See `flycheck-list-errors'.
\(fn LEVEL &rest PROPERTIES)" nil nil)
(put 'flycheck-define-error-level 'lisp-indent-function '1)
(autoload 'flycheck-define-command-checker "flycheck" "\
Define SYMBOL as syntax checker to run a command.
Define SYMBOL as generic syntax checker via
`flycheck-define-generic-checker', which uses an external command
to check the buffer. SYMBOL and DOCSTRING are the same as for
`flycheck-define-generic-checker'.
In addition to the properties understood by
`flycheck-define-generic-checker', the following PROPERTIES
constitute a command syntax checker. Unless otherwise noted, all
properties are mandatory. Note that the default `:error-filter'
of command checkers is `flycheck-sanitize-errors'.
`:command COMMAND'
The command to run for syntax checking.
COMMAND is a list of the form `(EXECUTABLE [ARG ...])'.
EXECUTABLE is a string with the executable of this syntax
checker. It can be overridden with the variable
`flycheck-SYMBOL-executable'. Note that this variable is
NOT implicitly defined by this function. Use
`flycheck-def-executable-var' to define this variable.
Each ARG is an argument to the executable, either as string,
or as special symbol or form for
`flycheck-substitute-argument', which see.
`:error-patterns PATTERNS'
A list of patterns to parse the output of the `:command'.
Each ITEM in PATTERNS is a list `(LEVEL SEXP ...)', where
LEVEL is a Flycheck error level (see
`flycheck-define-error-level'), followed by one or more RX
`SEXP's which parse an error of that level and extract line,
column, file name and the message.
See `rx' for general information about RX, and
`flycheck-rx-to-string' for some special RX forms provided
by Flycheck.
All patterns are applied in the order of declaration to the
whole output of the syntax checker. Output already matched
by a pattern will not be matched by subsequent patterns. In
other words, the first pattern wins.
This property is optional. If omitted, however, an
`:error-parser' is mandatory.
`:error-parser FUNCTION'
A function to parse errors with.
The function shall accept three arguments OUTPUT CHECKER
BUFFER. OUTPUT is the syntax checker output as string,
CHECKER the syntax checker that was used, and BUFFER a
buffer object representing the checked buffer. The function
must return a list of `flycheck-error' objects parsed from
OUTPUT.
This property is optional. If omitted, it defaults to
`flycheck-parse-with-patterns'. In this case,
`:error-patterns' is mandatory.
`:standard-input t'
Whether to send the buffer contents on standard input.
If this property is given and has a non-nil value, send the
contents of the buffer on standard input.
Defaults to nil.
Note that you may not give `:start', `:interrupt', and
`:print-doc' for a command checker. You can give a custom
`:verify' function, though, whose results will be appended to the
default `:verify' function of command checkers.
\(fn SYMBOL DOCSTRING &rest PROPERTIES)" nil nil)
(put 'flycheck-define-command-checker 'lisp-indent-function '1)
(put 'flycheck-define-command-checker 'doc-string-elt '2)
(autoload 'flycheck-def-config-file-var "flycheck" "\
Define SYMBOL as config file variable for CHECKER, with default FILE-NAME.
SYMBOL is declared as customizable variable using `defcustom', to
provide a configuration file for the given syntax CHECKER.
CUSTOM-ARGS are forwarded to `defcustom'.
FILE-NAME is the initial value of the new variable. If omitted,
the default value is nil.
Use this together with the `config-file' form in the `:command'
argument to `flycheck-define-checker'.
\(fn SYMBOL CHECKER &optional FILE-NAME &rest CUSTOM-ARGS)" nil t)
(put 'flycheck-def-config-file-var 'lisp-indent-function '3)
(autoload 'flycheck-def-option-var "flycheck" "\
Define SYMBOL as option variable with INIT-VALUE for CHECKER.
SYMBOL is declared as customizable variable using `defcustom', to
provide an option for the given syntax CHECKERS (a checker or a
list of checkers). INIT-VALUE is the initial value of the
variable, and DOCSTRING is its docstring. CUSTOM-ARGS are
forwarded to `defcustom'.
Use this together with the `option', `option-list' and
`option-flag' forms in the `:command' argument to
`flycheck-define-checker'.
\(fn SYMBOL INIT-VALUE CHECKERS DOCSTRING &rest CUSTOM-ARGS)" nil t)
(put 'flycheck-def-option-var 'lisp-indent-function '3)
(put 'flycheck-def-option-var 'doc-string-elt '4)
;;;***
;;;### (autoloads nil nil ("flycheck-buttercup.el" "flycheck-ert.el"
;;;;;; "flycheck-pkg.el") (22490 28019 735908 443000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; flycheck-autoloads.el ends here

144
elpa/flycheck-20160912.814/flycheck-buttercup.el Normal file
View File

@ -0,0 +1,144 @@
;;; flycheck-buttercup.el --- Flycheck: Extensions to Buttercup -*- lexical-binding: t; -*-
;; Copyright (C) 2016 Sebastian Wiesner and Flycheck contributors
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; Keywords: lisp, tools
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Extensions to Buttercup to write BDD tests for Flycheck.
;;
;; Buttercup is a BDD testing framework for Emacs, see URL
;; `https://github.com/jorgenschaefer/emacs-buttercup/'. Flycheck uses
;; Buttercup extensively for new tests.
;;
;; This library provides extensions to Buttercup to write Specs for Flycheck.
;;
;; * Custom matchers
;;
;; (expect 'foo :to-be-local) - Is `foo' a local variable in the current buffer?
;;; Code:
(require 'buttercup)
(require 'flycheck)
(require 'seq)
;;; Buttercup helpers
(defun flycheck-buttercup-format-error-list (errors)
"Format ERRORS into a human-readable string."
(mapconcat (lambda (e) (flycheck-error-format e 'with-file-name))
errors "\n"))
;;; Data matchers
(buttercup-define-matcher :to-be-empty-string (s)
(if (equal s "")
(cons t (format "Expected %S not be an empty string" s))
(cons nil (format "Expected %S to be an empty string" s))))
(buttercup-define-matcher :to-match-with-group (re s index match)
(let* ((matches? (string-match re s))
(result (and matches? (match-string index s))))
(if (and matches? (equal result match))
(cons t (format "Expected %S not to match %S with %S in group %s"
re s match index))
(cons nil (format "Expected %S to match %S with %S in group %s, %s"
re s match index
(if matches?
(format "but got %S" result)
"but did not match"))))))
;;; Emacs feature matchers
(buttercup-define-matcher :to-be-live (buffer)
(let ((buffer (get-buffer buffer)))
(if (buffer-live-p buffer)
(cons t (format "Expected %S not to be a live buffer, but it is"
buffer))
(cons nil (format "Expected %S to be a live buffer, but it is not"
buffer)))))
(buttercup-define-matcher :to-be-visible (buffer)
(let ((buffer (get-buffer buffer)))
(cond
((and buffer (get-buffer-window buffer))
(cons t (format "Expected %S not to be a visible buffer, but it is"
buffer)))
((not (bufferp buffer))
(cons nil
(format "Expected %S to be a visible buffer, but it is not a buffer"
buffer)))
(t (cons
nil
(format "Expected %S to be a visible buffer, but it is not visible"
buffer))))))
(buttercup-define-matcher :to-be-local (symbol)
(if (local-variable-p symbol)
(cons t (format "Expected %S not to be a local variable, but it is"
symbol))
(cons nil (format "Expected %S to be a local variable, but it is not"
symbol))))
(buttercup-define-matcher :to-contain-match (buffer re)
(if (not (get-buffer buffer))
(cons nil (format "Expected %S to contain a match of %s, \
but is not a buffer" buffer re))
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(if (re-search-forward re nil 'noerror)
(cons t (format "Expected %S to contain a match \
for %s, but it did not" buffer re))
(cons nil (format "Expected %S not to contain a match for \
%s but it did not." buffer re)))))))
;;; Flycheck matchers
(buttercup-define-matcher :to-be-equal-flycheck-errors (a b)
(let ((a-formatted (flycheck-buttercup-format-error-list a))
(b-formatted (flycheck-buttercup-format-error-list b)))
(if (equal a b)
(cons t (format "Expected
%s
not to be equal to
%s" a-formatted b-formatted))
(cons nil (format "Expected
%s
to be equal to
%s" a-formatted b-formatted)))))
(provide 'flycheck-buttercup)
;; Disable byte compilation for this library, to prevent package.el choking on a
;; missing `buttercup' library. See
;; https://github.com/flycheck/flycheck/issues/860
;; Local Variables:
;; no-byte-compile: t
;; End:
;;; flycheck-buttercup.el ends here

432
elpa/flycheck-20160912.814/flycheck-ert.el Normal file
View File

@ -0,0 +1,432 @@
;;; flycheck-ert.el --- Flycheck: ERT extensions -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2016 Sebastian Wiesner and Flycheck contributors
;; Author: Sebastian Wiesner <swiesner@lunaryorn.com>
;; Maintainer: Sebastian Wiesner <swiesner@lunaryorn.com>
;; URL: https://github.com/flycheck/flycheck
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit testing library for Flycheck, the modern on-the-fly syntax checking
;; extension for GNU Emacs.
;; Provide various utility functions and unit test helpers to test Flycheck and
;; Flycheck extensions.
;;; Code:
(require 'flycheck)
(require 'ert)
(require 'macroexp) ; For macro utilities
;;; Compatibility
(eval-and-compile
;; Provide `ert-skip' and friends for Emacs 24.3
(defconst flycheck-ert-ert-can-skip (fboundp 'ert-skip)
"Whether ERT supports test skipping.")
(unless flycheck-ert-ert-can-skip
;; Fake skipping
(setf (get 'flycheck-ert-skipped 'error-message) "Test skipped")
(setf (get 'flycheck-ert-skipped 'error-conditions) '(error))
(defun ert-skip (data)
(signal 'flycheck-ert-skipped data))
(defmacro skip-unless (form)
`(unless (ignore-errors ,form)
(signal 'flycheck-ert-skipped ',form)))
(defun ert-test-skipped-p (result)
(and (ert-test-failed-p result)
(eq (car (ert-test-failed-condition result))
'flycheck-ert-skipped)))))
;;; Internal variables
(defvar flycheck-ert--resource-directory nil
"The directory to get resources from in this test suite.")
;;; Resource management macros
(defmacro flycheck-ert-with-temp-buffer (&rest body)
"Eval BODY within a temporary buffer.
Like `with-temp-buffer', but resets the modification state of the
temporary buffer to make sure that it is properly killed even if
it has a backing file and is modified."
(declare (indent 0))
`(with-temp-buffer
(unwind-protect
,(macroexp-progn body)
;; Reset modification state of the buffer, and unlink it from its backing
;; file, if any, because Emacs refuses to kill modified buffers with
;; backing files, even if they are temporary.
(set-buffer-modified-p nil)
(set-visited-file-name nil 'no-query))))
(defmacro flycheck-ert-with-file-buffer (file-name &rest body)
"Create a buffer from FILE-NAME and eval BODY.
BODY is evaluated with `current-buffer' being a buffer with the
contents FILE-NAME."
(declare (indent 1))
`(let ((file-name ,file-name))
(unless (file-exists-p file-name)
(error "%s does not exist" file-name))
(flycheck-ert-with-temp-buffer
(insert-file-contents file-name 'visit)
(set-visited-file-name file-name 'no-query)
(cd (file-name-directory file-name))
;; Mark the buffer as not modified, because we just loaded the file up to
;; now.
(set-buffer-modified-p nil)
,@body)))
(defmacro flycheck-ert-with-help-buffer (&rest body)
"Execute BODY and kill the help buffer afterwards.
Use this macro to test functions that create a Help buffer."
(declare (indent 0))
`(unwind-protect
,(macroexp-progn body)
(when (buffer-live-p (get-buffer (help-buffer)))
(kill-buffer (help-buffer)))))
(defmacro flycheck-ert-with-global-mode (&rest body)
"Execute BODY with Global Flycheck Mode enabled.
After BODY, restore the old state of Global Flycheck Mode."
(declare (indent 0))
`(let ((old-state global-flycheck-mode))
(unwind-protect
(progn
(global-flycheck-mode 1)
,@body)
(global-flycheck-mode (if old-state 1 -1)))))
(defmacro flycheck-ert-with-env (env &rest body)
"Add ENV to `process-environment' in BODY.
Execute BODY with a `process-environment' with contains all
variables from ENV added.
ENV is an alist, where each cons cell `(VAR . VALUE)' is a
environment variable VAR to be added to `process-environment'
with VALUE."
(declare (indent 1))
`(let ((process-environment (copy-sequence process-environment)))
(pcase-dolist (`(,var . ,value) ,env)
(setenv var value))
,@body))
;;; Test resources
(defun flycheck-ert-resource-filename (resource-file)
"Determine the absolute file name of a RESOURCE-FILE.
Relative file names are expanded against
`flycheck-ert-resources-directory'."
(expand-file-name resource-file flycheck-ert--resource-directory))
(defmacro flycheck-ert-with-resource-buffer (resource-file &rest body)
"Create a temp buffer from a RESOURCE-FILE and execute BODY.
The absolute file name of RESOURCE-FILE is determined with
`flycheck-ert-resource-filename'."
(declare (indent 1))
`(flycheck-ert-with-file-buffer
(flycheck-ert-resource-filename ,resource-file)
,@body))
;;; Test suite initialization
(defun flycheck-ert-initialize (resource-dir)
"Initialize a test suite with RESOURCE-DIR.
RESOURCE-DIR is the directory, `flycheck-ert-resource-filename'
should use to lookup resource files."
(when flycheck-ert--resource-directory
(error "Test suite already initialized"))
(let ((tests (ert-select-tests t t)))
;; Select all tests
(unless tests
(error "No tests defined. Call `flycheck-ert-initialize' after defining all tests!"))
(setq flycheck-ert--resource-directory resource-dir)
;; Emacs 24.3 don't support skipped tests, so we add poor man's test
;; skipping: We mark skipped tests as expected failures by adjusting the
;; expected result of all test cases. Not particularly pretty, but works :)
(unless flycheck-ert-ert-can-skip
(dolist (test tests)
(let ((result (ert-test-expected-result-type test)))
(setf (ert-test-expected-result-type test)
`(or ,result (satisfies ert-test-skipped-p))))))))
;;; Test case definitions
(defmacro flycheck-ert-def-checker-test (checker language name
&rest keys-and-body)
"Define a test case for a syntax CHECKER for LANGUAGE.
CHECKER is a symbol or a list of symbols denoting syntax checkers
being tested by the test. The test case is skipped, if any of
these checkers cannot be used. LANGUAGE is a symbol or a list of
symbols denoting the programming languages supported by the
syntax checkers. This is currently only used for tagging the
test appropriately.
NAME is a symbol denoting the local name of the test. The test
itself is ultimately named
`flycheck-define-checker/CHECKER/NAME'. If CHECKER is a list,
the first checker in the list is used for naming the test.
Optionally, the keyword arguments `:tags' and `:expected-result'
may be given. They have the same meaning as in `ert-deftest.',
and are added to the tags and result expectations set up by this
macro.
The remaining forms KEYS-AND-BODY denote the body of the test
case, including assertions and setup code."
(declare (indent 3))
(unless checker
(error "No syntax checkers specified"))
(unless language
(error "No languages specified"))
(let* ((checkers (if (symbolp checker) (list checker) checker))
(checker (car checkers))
(languages (if (symbolp language) (list language) language))
(language-tags (mapcar (lambda (l) (intern (format "language-%s" l)))
languages))
(checker-tags (mapcar (lambda (c) (intern (format "checker-%s" c)))
checkers))
(local-name (or name 'default))
(full-name (intern (format "flycheck-define-checker/%s/%s"
checker local-name)))
(keys-and-body (ert--parse-keys-and-body keys-and-body))
(body (cadr keys-and-body))
(keys (car keys-and-body))
(default-tags '(syntax-checker external-tool)))
`(ert-deftest ,full-name ()
:expected-result
(list 'or
'(satisfies flycheck-ert-syntax-check-timed-out-p)
,(or (plist-get keys :expected-result) :passed))
:tags (append ',(append default-tags language-tags checker-tags)
,(plist-get keys :tags))
,@(mapcar (lambda (c) `(skip-unless
;; Ignore non-command checkers
(or (not (flycheck-checker-get ',c 'command))
(executable-find (flycheck-checker-executable ',c)))))
checkers)
,@body)))
;;; Test case results
(defun flycheck-ert-syntax-check-timed-out-p (result)
"Whether RESULT denotes a timed-out test.
RESULT is an ERT test result object."
(and (ert-test-failed-p result)
(eq (car (ert-test-failed-condition result))
'flycheck-ert-syntax-check-timed-out)))
;;; Syntax checking in tests
(defvar-local flycheck-ert-syntax-checker-finished nil
"Non-nil if the current checker has finished.")
(add-hook 'flycheck-after-syntax-check-hook
(lambda () (setq flycheck-ert-syntax-checker-finished t)))
(defconst flycheck-ert-checker-wait-time 10
"Time to wait until a checker is finished in seconds.
After this time has elapsed, the checker is considered to have
failed, and the test aborted with failure.")
(put 'flycheck-ert-syntax-check-timed-out 'error-message
"Syntax check timed out.")
(put 'flycheck-ert-syntax-check-timed-out 'error-conditions '(error))
(defun flycheck-ert-wait-for-syntax-checker ()
"Wait until the syntax check in the current buffer is finished."
(let ((starttime (float-time)))
(while (and (not flycheck-ert-syntax-checker-finished)
(< (- (float-time) starttime) flycheck-ert-checker-wait-time))
(sleep-for 1))
(unless (< (- (float-time) starttime) flycheck-ert-checker-wait-time)
(flycheck-stop)
(signal 'flycheck-ert-syntax-check-timed-out nil)))
(setq flycheck-ert-syntax-checker-finished nil))
(defun flycheck-ert-buffer-sync ()
"Like `flycheck-buffer', but synchronously."
(setq flycheck-ert-syntax-checker-finished nil)
(should (not (flycheck-running-p)))
(flycheck-mode) ; This will only start a deferred check,
(flycheck-buffer) ; so we need an explicit manual check
;; After starting the check, the checker should either be running now, or
;; already be finished (if it was fast).
(should (or flycheck-current-syntax-check
flycheck-ert-syntax-checker-finished))
;; Also there should be no deferred check pending anymore
(should-not (flycheck-deferred-check-p))
(flycheck-ert-wait-for-syntax-checker))
(defun flycheck-ert-ensure-clear ()
"Clear the current buffer.
Raise an assertion error if the buffer is not clear afterwards."
(flycheck-clear)
(should (not flycheck-current-errors))
(should (not (-any? (lambda (ov) (overlay-get ov 'flycheck-overlay))
(overlays-in (point-min) (point-max))))))
;;; Test assertions
(defun flycheck-ert-should-overlay (error)
"Test that ERROR has a proper overlay in the current buffer.
ERROR is a Flycheck error object."
(let* ((overlay (-first (lambda (ov) (equal (overlay-get ov 'flycheck-error)
error))
(flycheck-overlays-in 0 (+ 1 (buffer-size)))))
(region (flycheck-error-region-for-mode error 'symbols))
(level (flycheck-error-level error))
(category (flycheck-error-level-overlay-category level))
(face (get category 'face))
(fringe-bitmap (flycheck-error-level-fringe-bitmap level))
(fringe-face (flycheck-error-level-fringe-face level))
(fringe-icon (list 'left-fringe fringe-bitmap fringe-face)))
(should overlay)
(should (overlay-get overlay 'flycheck-overlay))
(should (= (overlay-start overlay) (car region)))
(should (= (overlay-end overlay) (cdr region)))
(should (eq (overlay-get overlay 'face) face))
(should (equal (get-char-property 0 'display
(overlay-get overlay 'before-string))
fringe-icon))
(should (eq (overlay-get overlay 'category) category))
(should (equal (overlay-get overlay 'flycheck-error) error))))
(defun flycheck-ert-should-errors (&rest errors)
"Test that the current buffers has ERRORS.
ERRORS is a list of errors expected to be present in the current
buffer. Each error is given as a list of arguments to
`flycheck-error-new-at'.
If ERRORS are omitted, test that there are no errors at all in
the current buffer.
With ERRORS, test that each error in ERRORS is present in the
current buffer, and that the number of errors in the current
buffer is equal to the number of given ERRORS. In other words,
check that the buffer has all ERRORS, and no other errors."
(let ((expected (mapcar (apply-partially #'apply #'flycheck-error-new-at)
errors)))
(should (equal expected flycheck-current-errors))
(mapc #'flycheck-ert-should-overlay expected))
(should (= (length errors)
(length (flycheck-overlays-in (point-min) (point-max))))))
(defun flycheck-ert-should-syntax-check (resource-file modes &rest errors)
"Test a syntax check in RESOURCE-FILE with MODES.
RESOURCE-FILE is the file to check. MODES is a single major mode
symbol or a list thereof, specifying the major modes to syntax
check with. If more than one major mode is specified, the test
is run for each mode separately, so if you give three major
modes, the entire test will run three times. ERRORS is the list
of expected errors, as in `flycheck-ert-should-errors'. If
omitted, the syntax check must not emit any errors. The errors
are cleared after each test.
The syntax checker is selected via standard syntax checker
selection. To test a specific checker, you need to set
`flycheck-checker' or `flycheck-disabled-checkers' accordingly
before using this predicate, depending on whether you want to use
manual or automatic checker selection.
During the syntax check, configuration files of syntax checkers
are also searched in the `config-files' sub-directory of the
resource directory."
(when (symbolp modes)
(setq modes (list modes)))
(dolist (mode modes)
(unless (fboundp mode)
(ert-skip (format "%S missing" mode)))
(flycheck-ert-with-resource-buffer resource-file
(funcall mode)
;; Load safe file-local variables because some tests depend on them
(let ((enable-local-variables :safe)
;; Disable all hooks at this place, to prevent 3rd party packages
;; from interferring
(hack-local-variables-hook))
(hack-local-variables))
;; Configure config file locating for unit tests
(let ((process-hook-called 0))
(add-hook 'flycheck-process-error-functions
(lambda (_err)
(setq process-hook-called (1+ process-hook-called))
nil)
nil :local)
(flycheck-ert-buffer-sync)
(apply #'flycheck-ert-should-errors errors)
(should (= process-hook-called (length errors))))
(flycheck-ert-ensure-clear))))
(defun flycheck-ert-at-nth-error (n)
"Determine whether point is at the N'th Flycheck error.
Return non-nil if the point is at the N'th Flycheck error in the
current buffer. Otherwise return nil."
(let* ((error (nth (1- n) flycheck-current-errors))
(mode flycheck-highlighting-mode)
(region (flycheck-error-region-for-mode error mode)))
(and (member error (flycheck-overlay-errors-at (point)))
(= (point) (car region)))))
(defun flycheck-ert-explain--at-nth-error (n)
"Explain a failed at-nth-error predicate at N."
(let ((errors (flycheck-overlay-errors-at (point))))
(if (null errors)
(format "Expected to be at error %s, but no error at point %s"
n (point))
(let ((pos (cl-position (car errors) flycheck-current-errors)))
(format "Expected to be at error %s, but point %s is at error %s"
n (point) (1+ pos))))))
(put 'flycheck-ert-at-nth-error 'ert-explainer
'flycheck-ert-explain--at-nth-error)
(provide 'flycheck-ert)
;;; flycheck-ert.el ends here

11
elpa/flycheck-20160912.814/flycheck-pkg.el Normal file
View File

@ -0,0 +1,11 @@
(define-package "flycheck" "20160912.814" "On-the-fly syntax checking"
'((dash "2.12.1")
(pkg-info "0.4")
(let-alist "1.0.4")
(seq "1.11")
(emacs "24.3"))
:url "http://www.flycheck.org" :keywords
'("convenience" "languages" "tools"))
;; Local Variables:
;; no-byte-compile: t
;; End:

9070
elpa/flycheck-20160912.814/flycheck.el Normal file
View File

File diff suppressed because it is too large Load Diff

16
elpa/gnome-calendar-20140112.359/gnome-calendar-autoloads.el Normal file
View File

@ -0,0 +1,16 @@
;;; gnome-calendar-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("gnome-calendar.el") (22490 32826 162208
;;;;;; 449000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; gnome-calendar-autoloads.el ends here

1
elpa/gnome-calendar-20140112.359/gnome-calendar-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "gnome-calendar" "20140112.359" "Integration with the GNOME Shell calendar" 'nil :keywords '("gnome" "calendar"))

87
elpa/gnome-calendar-20140112.359/gnome-calendar.el Normal file
View File

@ -0,0 +1,87 @@
;;; gnome-calendar.el --- Integration with the GNOME Shell calendar
;; Copyright (C) 2013-2014 Nicolas Petton
;;
;; Author: Nicolas Petton <petton.nicolas@gmail.com>
;; Keywords: gnome calendar
;; Package-Version: 20140112.359
;; Package: gnome-calendar
;; Version: 0.2
;; gnome-calendar is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.
;;
;; gnome-calendar.el is distributed in the hope that it will be
;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;;; Commentary:
;;; GNOME Shell calendar integration
;;; Code:
(require 'dbus)
(defvar gsc-gnome-calendar-dbus-object nil)
(defvar gsc-get-items-function nil "function to be called to retrieve items")
(defun gnome-shell-calendar-register-service (function)
"Register to the GnomeShell calendar service.
FUNCTION is called to fill the Gnome calendar with items."
(setq gsc-get-items-function function)
(dbus-register-service :session
"org.gnome.Shell.CalendarServer"
:replace-existing)
(setq gsc-gnome-calendar-dbus-object
(dbus-register-method :session
"org.gnome.Shell.CalendarServer"
"/org/gnome/Shell/CalendarServer"
"org.gnome.Shell.CalendarServer"
"GetEvents"
'gsc-select-items)))
(defun gnome-shell-calendar-unregister-service ()
"Unregister from the DBus service"
(when gsc-gnome-calendar-dbus-object
(dbus-unregister-object gsc-gnome-calendar-dbus-object)
(dbus-unregister-service :session "org.gnome.Shell.CalendarServer")
(setq gsc-gnome-calendar-dbus-object nil)))
(defun gsc-select-items (since until force-reload)
(let ((day-since (floor (time-to-number-of-days (seconds-to-time since))))
(day-until (floor (time-to-number-of-days (seconds-to-time until))))
(items (funcall gsc-get-items-function))
selected-items)
(dolist (item items)
(let ((day (floor (time-to-number-of-days (cdr item)))))
(when (and (>= day day-since)
(<= day day-until))
(add-to-list 'selected-items item))))
(list :array (gsc-items-to-dbus-entries selected-items))))
(defun gsc-items-to-dbus-entries (items)
(mapcar (lambda (item)
(list :struct
""
(car item)
""
:boolean (not (gsc-item-has-time-p item))
:int64 (floor (time-to-seconds (cdr item)))
:int64 (+ 1 (floor (time-to-seconds (cdr item))))
(list :array :signature "{sv}")))
items))
(defun gsc-item-has-time-p (item)
(let ((time (decode-time (cdr item))))
(or (not (= 0 (nth 0 time)))
(not (= 0 (nth 1 time)))
(not (= 0 (nth 2 time))))))
(provide 'gnome-calendar)
;;; gnome-calendar.el ends here

122
elpa/go-20160430.1739/back-ends/gtp-pipe.el Normal file
View File

@ -0,0 +1,122 @@
;;; gtp-pipe.el --- GTP backend through a pipe
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'go-api)
(require 'gtp)
(require 'comint)
(defvar *gtp-pipe-board* nil
"Board associated with the current gtp pipe process.")
(defvar *gtp-pipe-last* nil
"Last move of the current game.")
(defvar *gtp-pipe-inhibit* nil
"Prevent infinite loops of commands.")
(defun gtp-pipe-start (command)
"Connect a `gtp-pipe' instance to the process created by COMMAND.
Pass \"netcat -lp 6666\" as COMMAND to listen on a local port, or
pass \"netcat localhost 6666\" to connect to a listening local
port."
(interactive "sgtp-pipe command: ")
(pop-to-buffer (go-connect (make-instance 'gtp-pipe :command command))))
(defun gtp-pipe-process-filter (proc string)
(go-re-cond string
("^\\(black\\|white\\) \\(.*\\)$"
(let ((color (go-re-cond (match-string 1 string)
("black" :B)
("white" :W)))
(action (match-string 2 string)))
(go-re-cond action
("^pass" (let ((*gtp-pipe-inhibit* t)) (go-pass *gtp-pipe-board*)))
("^resign" (let ((*gtp-pipe-inhibit* t)) (go-resign *gtp-pipe-board*)))
(t (let ((move (gtp-to-pos color action)))
(setf *gtp-pipe-last* move)
(setf (go-move *gtp-pipe-board*) move))))))
("^genmove_\\(black\\|white\\)"
(message "gtp-pipe: %s's turn" (match-string 1 string)))
("^last_move" (go-to-gtp-command *gtp-pipe-last*))
("^quit" (let ((*gtp-pipe-inhibit* t)) (go-quit *gtp-pipe-board*)))
("^undo" (let ((*gtp-pipe-inhibit* t)) (go-undo *gtp-pipe-board*)))
("^string \\(.*\\)$" (message "gtp-pipe: %S" (match-string 1 string)))
(t (message "gtp-pipe unknown command: %S" string))))
;;; Class and interface
(defclass gtp-pipe (gtp)
((buffer :initarg :buffer :accessor buffer)
(command :initarg :command :accessor command)))
(defmethod go-connect ((gtp-pipe gtp-pipe))
(setf (buffer gtp-pipe)
(let* ((cmd-&-args (split-string (command gtp-pipe) " " 'omit-nulls))
(buf (apply #'make-comint "gtp-pipe"
(car cmd-&-args) nil (cdr cmd-&-args))))
(with-current-buffer buf
(comint-mode)
(set (make-local-variable '*gtp-pipe-last*) nil)
(set (make-local-variable '*gtp-pipe-inhibit*) nil)
(set (make-local-variable '*gtp-pipe-board*)
(save-excursion
(make-instance 'board
:buffer (go-board gtp-pipe (make-instance 'sgf)))))
(set-process-filter (get-buffer-process (current-buffer))
(make-go-insertion-filter
#'gtp-pipe-process-filter)))
buf)))
(defmethod gtp-command ((gtp-pipe gtp-pipe) command)
(with-current-buffer (buffer gtp-pipe)
(unless *gtp-pipe-inhibit*
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert command)
(comint-send-input))))
(defmethod go-comment ((gtp-pipe gtp-pipe))
(signal 'unsupported-back-end-command (list gtp-pipe :comment)))
(defmethod set-go-comment ((gtp-pipe gtp-pipe) comment)
(gtp-command gtp-pipe (format "string %s" comment)))
(defmethod go-color ((gtp-pipe gtp-pipe))
(with-current-buffer (buffer gtp-pipe)
(go-color *gtp-pipe-board*)))
(defmethod go-name ((gtp-pipe gtp-pipe)) "GTP pipe")
(defmethod go-size ((gtp-pipe gtp-pipe))
(read-from-minibuffer "GTP board size: " nil nil 'read))
(defmethod go-quit ((gtp-pipe gtp-pipe))
(gtp-command gtp-pipe "quit")
(with-current-buffer (buffer gtp-pipe)
(signal-process (get-buffer-process) 'KILL)))
(defmethod go-player-name ((gtp-pipe gtp-pipe) color) "GTP pipe")
(defmethod set-player-name ((gtp-pipe gtp-pipe) color name)
(signal 'unsupported-back-end-command (list gtp-pipe :set-player-name name)))
(provide 'gtp-pipe)
;;; gtp-pipe.el ends here

164
elpa/go-20160430.1739/back-ends/gtp.el Normal file
View File

@ -0,0 +1,164 @@
;;; gtp.el --- GTP GO back-end
;; Copyright (C) 2008 2012 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf gtp gnugo
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Commentary:
;; This file should be useful for translating between sgf and the GO
;; text protocol (GTP) see http://www.lysator.liu.se/~gunnar/gtp/.
;; The GMP command set may be implemented as an extension.
;;
;; see http://www.lysator.liu.se/~gunnar/gtp/gtp2-spec-draft2/gtp2-spec.html
;;
;; The following commands are required by GTP
;; - protocol_version
;; - name
;; - version
;; - known_command
;; - list_commands
;; - quit
;; - boardsize
;; - clear_board
;; - komi
;; - play
;; - genmove
;; Code:
(require 'go-api)
(defun gtp-expand-color (turn)
(case turn
(:B "black")
(:W "white")
(t (error "gtp: unknown turn %S" turn))))
(defun go-pos-to-gtp (pos)
(format "%c%d" (num-to-char (1+ (car pos))) (1+ (cdr pos))))
(defun gtp-to-pos (color gtp)
(cons color (cons :pos (cons (char-to-num (aref gtp 0))
(1- (read (substring gtp 1)))))))
(defun go-to-gtp-command (element)
"Convert an go ELEMENT to a gtp command."
(let ((key (car element))
(val (cdr element)))
(case key
(:B (format "black %s" (go-pos-to-gtp (aget (list val) :pos))))
(:W (format "white %s" (go-pos-to-gtp (aget (list val) :pos))))
((:SZ :S) (format "boardsize %s" val))
(:KM (format "komi %s" val))
(t nil))))
(defun gtp-territory (gtp color)
(let ((output (ecase color
(:B (gtp-command gtp "final_status_list black_territory"))
(:W (gtp-command gtp "final_status_list white_territory")))))
(mapcar (lambda (gtp-point) (gtp-to-pos color gtp-point))
(mapcar #'symbol-name
(read (format "(%s)" output))))))
;;; Class and interface
(defclass gtp nil nil "Class for the GTP GO GO back end.")
(defgeneric gtp-command (back-end command)
"Send gtp COMMAND to OBJECT and return any output.")
(defmethod go-size ((gtp gtp))
(read (gtp-command gtp "query_boardsize")))
(defmethod set-go-size ((gtp gtp) size)
(gtp-command gtp (format "boardsize %d" size)))
(defmethod go-level ((gtp gtp))
(signal 'unsupported-back-end-command (list gtp :go-level)))
(defmethod set-go-level ((gtp gtp) level)
(gtp-command gtp (format "level %d" level)))
(defmethod go-name ((gtp gtp))
(gtp-command gtp "name"))
(defmethod set-go-name ((gtp gtp) name)
(signal 'unsupported-back-end-command (list gtp :set-name name)))
(defmethod go-move ((gtp gtp))
(let* ((color (go-color gtp))
(move (case color
(:B (gtp-command gtp "genmove_black"))
(:W (gtp-command gtp "genmove_white")))))
(if (string= move "PASS")
:pass
(gtp-to-pos color move))))
(defmethod set-go-move ((gtp gtp) move)
(gtp-command gtp (go-to-gtp-command move)))
(defmethod go-labels ((gtp gtp))
(signal 'unsupported-back-end-command (list gtp :labels)))
(defmethod set-go-labels ((gtp gtp) labels)
(signal 'unsupported-back-end-command (list gtp :set-labels labels)))
(defmethod go-comment ((gtp gtp))
(signal 'unsupported-back-end-command (list gtp :comment)))
(defmethod set-go-comment ((gtp gtp) comment)
(signal 'unsupported-back-end-command (list gtp :set-comment comment)))
(defmethod go-alt ((gtp gtp))
(signal 'unsupported-back-end-command (list gtp :alt)))
(defmethod set-go-alt ((gtp gtp) alt)
(signal 'unsupported-back-end-command (list gtp :set-alt alt)))
(defmethod go-color ((gtp gtp))
(case (condition-case err
(intern (car (split-string (gtp-command gtp "last_move"))))
(error 'white)) ('white :B) ('black :W)))
(defmethod set-go-color ((gtp gtp) color)
(signal 'unsupported-back-end-command (list gtp :set-color color)))
;; non setf'able generic functions
(defmethod go-undo ((gtp gtp)) (gtp-command gtp "undo"))
(defmethod go-pass ((gtp gtp))
(gtp-command gtp (format "%s pass" (gtp-expand-color (go-color gtp)))))
(defmethod go-resign ((gtp gtp))
(gtp-command gtp (format "%s resign" (gtp-expand-color (go-color gtp)))))
(defmethod go-reset ((gtp gtp)) (gtp-command gtp "clear_board"))
(defmethod go-quit ((gtp gtp)) (gtp-command gtp "quit"))
(defmethod go-score ((gtp gtp)) (gtp-command gtp "final_score"))
(defmethod go-territory ((gtp gtp))
(append (gtp-territory gtp :B) (gtp-territory gtp :W)))
(defmethod go-dead ((gtp gtp))
(signal 'unsupported-back-end-command (list gtp :dead)))
(provide 'gtp)
;;; gtp.el ends here

501
elpa/go-20160430.1739/back-ends/igs.el Normal file
View File

@ -0,0 +1,501 @@
;;; igs.el --- IGS GO back-end
;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf igs
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Commentary:
;; http://www.pandanet.co.jp/English/commands/term/Summary.html
;; Code:
(require 'go-api)
(require 'list-buffer)
(defvar igs-ignore-shouts t
"Ignore shouts on the IGS server.")
(defvar igs-telnet-command "telnet"
"Telnet command used by igs.")
(defvar igs-server "igs.joyjoy.net"
"Address of the IGS server.")
(defvar igs-port 6969
"Port to use when connecting to an IGS server.")
(defvar igs-username "guest"
"User name to use when connecting to an IGS server.")
(defvar igs-process-name "igs"
"Name for the igs process.")
(defvar igs-server-ping-delay 300
"Minimum time between pings to remind the IGS server we're still listening.")
(defvar igs-message-types
'((:unknown . 0)
(:automat . 35) ;; Automatch announcement
(:autoask . 36) ;; Automatch accept
(:choices . 38) ;; game choices
(:clivrfy . 41) ;; Client verify message
(:beep . 2) ;; \7 telnet
(:board . 3) ;; Board being drawn
(:down . 4) ;; The server is going down
(:error . 5) ;; An error reported
(:fil . 6) ;; File being sent
(:games . 7) ;; Games listing
(:help . 8) ;; Help file
(:info . 9) ;; Generic info
(:last . 10) ;; Last command
(:kibitz . 11) ;; Kibitz strings
(:load . 12) ;; Loading a game
(:look_m . 13) ;; Look
(:message . 14) ;; Message listing
(:move . 15) ;; Move #:(B) A1
(:observe . 16) ;; Observe report
(:prompt . 1) ;; A Prompt (never)
(:refresh . 17) ;; Refresh of a board
(:saved . 18) ;; Stored command
(:say . 19) ;; Say string
(:score_m . 20) ;; Score report
(:sgf_m . 34) ;; SGF variation
(:shout . 21) ;; Shout string
(:show . 29) ;; Shout string
(:status . 22) ;; Current Game status
(:stored . 23) ;; Stored games
(:teach . 33) ;; teaching game
(:tell . 24) ;; Tell string
(:dot . 40) ;; your . string
(:thist . 25) ;; Thist report
(:tim . 26) ;; times command
(:trans . 30) ;; Translation info
(:ttt_board . 37) ;; tic tac toe
(:who . 27) ;; who command
(:undo . 28) ;; Undo report
(:user . 42) ;; Long user report
(:version . 39) ;; IGS Version
(:yell . 32))) ;; Channel yelling
(defvar *igs-instance* nil
"IGS instance associated with the current buffer.")
(defvar *igs-time-last-sent* nil
"Time stamp of the last command sent.
This is used to re-send messages to keep the IGS server from timing out.")
(defvar *igs-last-command* nil
"Last command sent to the IGS process.")
(defvar *igs-games* nil
"List holding the current games on the IGS server.")
(defvar *igs-current-game* nil
"Number of the current IGS game (may change frequently).")
;;; Class and interface
(defclass igs ()
((buffer :initarg :buffer :accessor buffer :initform nil)
;; number of an observed IGS game
(number :initarg :number :accessor number :initform nil)
(active :initarg :active :accessor active :initform t)))
(defmethod go-connect ((igs igs)) (igs-connect igs))
(defmacro with-igs (igs &rest body)
(declare (indent 1))
`(with-current-buffer (buffer ,igs) ,@body))
(defmethod go-level ((igs igs))
(signal 'unsupported-back-end-command (list igs :level)))
(defmethod set-go-level ((igs igs) level)
(signal 'unsupported-back-end-command (list igs :set-level level)))
(defmethod go-size ((igs igs))
(with-igs igs (aget (igs-current-game) :size)))
(defmethod set-go-size ((igs igs) size)
(signal 'unsupported-back-end-command (list igs :set-size size)))
(defmethod go-name ((igs igs))
(with-igs igs (let ((game (igs-current-game)))
(format "%s(%s) vs %s(%s)"
(aget game :white-name)
(aget game :white-rank)
(aget game :black-name)
(aget game :black-rank)))))
(defmethod set-go-name ((igs igs) name)
(signal 'unsupported-back-end-command (list igs :set-name name)))
(defmethod go-move ((igs igs))
(signal 'unsupported-back-end-command (list igs :move)))
(defmethod set-go-move ((igs igs) move)
(signal 'unsupported-back-end-command (list igs :set-move move)))
(defmethod go-labels ((igs igs))
(signal 'unsupported-back-end-command (list igs :labels)))
(defmethod set-go-labels ((igs igs) labels)
(signal 'unsupported-back-end-command (list igs :set-labels labels)))
(defmethod go-comment ((igs igs))
(signal 'unsupported-back-end-command (list igs :comment)))
(defmethod set-go-comment ((igs igs) comment)
(signal 'unsupported-back-end-command (list igs :set-comment comment)))
(defmethod go-alt ((igs igs))
(signal 'unsupported-back-end-command (list igs :alt)))
(defmethod set-go-alt ((igs igs) alt)
(signal 'unsupported-back-end-command (list igs :set-alt alt)))
(defmethod go-color ((igs igs))
(signal 'unsupported-back-end-command (list igs :color)))
(defmethod set-go-color ((igs igs) color)
(signal 'unsupported-back-end-command (list igs :set-color color)))
(defmethod go-player-name ((igs igs) color)
(with-igs igs (aget (igs-current-game)
(case color
(:W :white-name)
(:B :black-name)))))
(defmethod set-go-player-name ((igs igs) color name)
(signal 'unsupported-back-end-command (list igs :set-player-name color name)))
(defmethod go-player-time ((igs igs) color)
(signal 'unsupported-back-end-command (list igs :player-time color)))
(defmethod set-go-player-time ((igs igs) color time)
(signal 'unsupported-back-end-command (list igs :set-player-time color time)))
;; non setf'able generic functions
(defmethod go-undo ((igs igs))
(signal 'unsupported-back-end-command (list igs :undo)))
(defmethod go-pass ((igs igs))
(signal 'unsupported-back-end-command (list igs :pass)))
(defmethod go-resign ((igs igs))
(signal 'unsupported-back-end-command (list igs :resign)))
(defmethod go-reset ((igs igs))
(signal 'unsupported-back-end-command (list igs :reset)))
(defmethod go-quit ((igs igs))
(with-igs igs
(if (number igs)
(progn
;; TOOD: ensure still on our server-side observation list
;; (e.g., hasn't been removed after a resignation)
(when (active igs)
(igs-send (format "observe %d" (number igs))))
(setf (number igs) nil))
(igs-send "quit"))))
(defmethod go-score ((igs igs))
(signal 'unsupported-back-end-command (list igs :score)))
(defmethod go-territory ((igs igs))
(signal 'unsupported-back-end-command (list igs :territory)))
(defmethod go-dead ((igs igs))
(signal 'unsupported-back-end-command (list igs :dead)))
(defmacro igs-w-proc (proc &rest body)
(declare (indent 1))
`(with-current-buffer (process-buffer proc) ,@body))
(def-edebug-spec igs-w-proc (form body))
(defun igs-send (command)
"Send string COMMAND to the IGS process in the current buffer."
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert command)
(setq *igs-time-last-sent* (current-time))
(setq *igs-last-command* (and (string-match "^\\([^ ]*\\)" command)
(match-string 1 command)))
(comint-send-input))
(defun igs-process-filter (proc string)
(when (string-match "^\\([[:digit:]]+\\) \\(.+\\)$" string)
(let* ((number (read (match-string 1 string)))
(type (car (rassoc number igs-message-types)))
(content (match-string 2 string)))
(case type
(:prompt
(go-re-cond (or *igs-last-command* "")
("^games" (igs-list-games *igs-instance* *igs-games*))
(t nil))
(setq *igs-last-command* nil))
(:info
(go-re-cond content
;; Game NN: name1 vs name2 has adjourned.
("^Game \\([0-9]*\\): .*adjourned.$"
(igs-handle-adjournment (match-string 1 content)))
;; {Game NN: name1 vs name2 : color resigns.}
("^{Game \\([0-9]*\\): \\(Black\\|White\\) resigns.}$"
(igs-handle-resignation (go-re-cond (match-string 2 content)
("black" :black)
("white" :white))))
(t (unless (string= content "yes")
(message "igs-info: %s" content)))))
(:games (igs-w-proc proc (igs-handle-game content)))
(:move (igs-w-proc proc (igs-handle-move content)))
(:kibitz (message "igs-kibitz: %s" content))
(:tell (igs-handle-tell content))
(:beep nil)
(:shout (unless igs-ignore-shouts (igs-handle-shout content)))
(t (message "igs-unknown: [%s]%s" type content)))
(when (and *igs-time-last-sent*
(> (time-to-seconds (time-since *igs-time-last-sent*))
igs-server-ping-delay))
(igs-send "ayt")))))
(defun igs-connect (igs)
"Open a connection to `igs-server'."
(cl-flet ((wait (prompt)
(message "IGS waiting for %S..." prompt)
(while (and (goto-char (or comint-last-input-end (point-min)))
(not (re-search-forward prompt nil t)))
(accept-process-output proc))))
(let ((buffer (apply 'make-comint
igs-process-name
igs-telnet-command nil
(list igs-server (number-to-string igs-port)))))
(setf (buffer igs) buffer)
(with-current-buffer buffer
(comint-mode)
(set (make-local-variable '*igs-instance*) igs)
(set (make-local-variable '*igs-last-command*) "")
(set (make-local-variable '*igs-games*) nil)
(set (make-local-variable '*igs-current-game*) nil)
(set (make-local-variable '*go-partial-line*) nil)
(set (make-local-variable '*igs-time-last-sent*) (current-time))
(let ((proc (get-buffer-process (current-buffer))))
(wait "^Login:")
(goto-char (process-mark proc))
(igs-send igs-username)
(wait "^\#> ")
(igs-toggle "client" t)
(set-process-filter
proc (make-go-insertion-filter #'igs-process-filter))))
buffer)))
(defun igs-toggle (setting value)
(igs-send (format "toggle %s %s" setting (if value "true" "false"))))
(defun igs-observe (game) (igs-send (format "observe %s" game)))
(defun igs-list-games (instance games)
(lexical-let ((instance instance))
(list-buffer-create
"*igs-game-list*"
(cl-mapcar #'cons
(mapcar #'car games)
(mapcar (curry #'mapcar #'cdr) (mapcar #'cdr games)))
'("#" "white" "rk" "black" "rk" "move" "size" "H" "Komi" "by" "fr" "#")
(lambda (row col)
(let ((id (car (nth row *buffer-list*))))
(with-igs instance (igs-observe id))))
(lambda (row col)
(message "refreshing games list...")
(igs-get-games instance)))))
;;; Specific handlers
(defvar igs-player-name-re
"[[:alpha:][:digit:]]+"
"Regular expression used to match igs player name.")
(defvar igs-player-rating-re
"[[:digit:]]+[kd]\\*?"
"Regular expression used to match igs player rating.")
(defvar igs-player-game-info-re "([-[:digit:]]+ [-[:digit:]]+ [-[:digit:]]+)"
"Regular expression used to match igs player game info.")
(defvar igs-player-re
(format "\\(%s\\) +\\[ *\\(%s\\)\\]" igs-player-name-re igs-player-rating-re)
"Regular expression used to parse igs player name and rating.")
(defvar igs-game-re
(format
"\\[\\([[:digit:]]+\\)\\] +%s +vs. +%s +\\((.+)\\) \\((.+)\\)[[:space:]]*$"
igs-player-re igs-player-re)
"Regular expression used to parse igs game listings.")
(defvar igs-move-piece-re
"[[:digit:]]+(\\([WB]\\)): \\([[:alpha:]][[:digit:]]+\\)"
"Regular expression used to match an IGS move.")
(defvar igs-move-time-re "TIME")
(defvar igs-move-props-re "GAMEPROPS")
(defvar igs-move-game-re
(format "Game \\([[:digit:]]+\\) I: \\(%s\\) \\(%s\\) vs \\(%s\\) \\(%s\\)"
igs-player-name-re igs-player-game-info-re
igs-player-name-re igs-player-game-info-re)
"Regular expression used to match Game updates.")
(defun igs-handle-game (game-string)
;; [##] white name [ rk ] black name [ rk ] (Move size H Komi BY FR) (###)
(when (string-match igs-game-re game-string)
(let* ((num (match-string 1 game-string))
(white-name (match-string 2 game-string))
(white-rank (match-string 3 game-string))
(black-name (match-string 4 game-string))
(black-rank (match-string 5 game-string))
(other1 (read (match-string 6 game-string)))
(other2 (read (match-string 7 game-string))))
(push `(,(read num)
(:white-name . ,white-name)
(:white-rank . ,white-rank)
(:black-name . ,black-name)
(:black-rank . ,black-rank)
(:move . ,(nth 0 other1))
(:size . ,(nth 1 other1))
(:h . ,(nth 2 other1))
(:komi . ,(nth 3 other1))
(:by . ,(nth 4 other1))
(:fr . ,(nth 5 other1))
(:other . ,(car other2)))
*igs-games*)
;; update the game list buffer
(when (get-buffer "*igs-game-list*")
(save-excursion
(set-buffer (get-buffer "*igs-game-list*"))
(list-buffer-refresh))))))
(defun igs-handle-adjournment (number-string)
(if (aget (igs-current-game) :board)
(with-current-buffer (buffer (aget (igs-current-game) :board))
(with-backends backend
(when (equal (class-of backend) 'igs)
(setf (active backend) nil))))
(error "igs-handle-adjournment: no board!")))
(defun igs-handle-resignation (color)
(if (aget (igs-current-game) :board)
(progn
(go-resign (aget (igs-current-game) :board))
(with-current-buffer (buffer (aget (igs-current-game) :board))
(with-backends backend
(when (equal (class-of backend) 'igs)
(setf (active backend) nil)))))
(error "igs-handle-adjournment: no board!")))
(defun igs-to-pos (color igs)
(cons (make-keyword color)
(cons :pos
(cons (char-to-num (aref igs 0))
(1- (read (substring igs 1)))))))
(defun igs-current-game ()
(aget *igs-games* *igs-current-game*))
(defun set-igs-current-game (new)
(setf (aget *igs-games* *igs-current-game*) new))
(defsetf igs-current-game set-igs-current-game)
(defun igs-handle-tell (string)
(unless (string-match (format "\\*\\(%s\\)\\*: \\(.*\\)$" igs-player-name-re)
string)
(error "igs: malformed tell string %S" string))
;; TODO: keep a message buffer for each user in which conversations
;; may be saved... during games store messages as SGF comments.
(message "igs[%s]: %s" (match-string 1 string) (match-string 2 string)))
(defun igs-handle-shout (string)
(unless (string-match "^\\([^:]*\\): \\(.*\\)$" string)
(error "igs: malformed shout string %S" string))
(message "IGS[%s]: %s" (match-string 1 string) (match-string 2 string)))
(defun igs-apply-move (move)
(if (aget (igs-current-game) :board)
(setf (go-move (aget (igs-current-game) :board)) move)
(message "igs-apply-move: no board!")))
(defun igs-register-game (number)
(setq *igs-current-game* number)
(unless (aget (igs-current-game) :board)
(setf (aget (igs-current-game) :board)
(save-excursion
(setf (number *igs-instance*) number)
(make-instance 'board
:buffer (go-board *igs-instance*
(make-instance 'sgf)))))
(when (aget (igs-current-game) :board)
(igs-send (format "moves %s" number)))))
(defun igs-update-game-info (info)
(let ((color (car info))
(name (cadr info))
(other (cddr info)))
;; (message "[%s] %s: %s" color name other)
))
(defun igs-handle-move (move-string)
(go-re-cond move-string
(igs-move-piece-re (igs-apply-move
(igs-to-pos (match-string 1 move-string)
(match-string 2 move-string))))
(igs-move-time-re nil)
(igs-move-props-re nil)
(igs-move-game-re
(let ((number (read (match-string 1 move-string)))
(white-info (cons (match-string 2 move-string)
(read (match-string 3 move-string))))
(black-info (cons (match-string 4 move-string)
(read (match-string 5 move-string)))))
(igs-register-game number)
(igs-update-game-info (cons :W white-info))
(igs-update-game-info (cons :B black-info))))))
;;; Interface
;;
;; If we find another backend providing game lists and observations
;; then this could be generalized to an interface.
(defun igs-start (&optional name)
"Connect to an IGS server and return the `igs' instance."
(interactive)
(set-buffer (get-buffer-create (or name "*igs*")))
(if (get-buffer-process (current-buffer))
*igs-instance*
(let ((*igs* (make-instance 'igs)))
(igs-connect *igs*)
*igs*)))
(defun igs-get-games (&optional instance)
"List the games of the igs instance."
(interactive)
(set-buffer (buffer (or instance (igs-start))))
(setf *igs-games* nil)
(igs-send "games"))
(provide 'igs)
;;; igs.el ends here

196
elpa/go-20160430.1739/back-ends/sgf.el Normal file
View File

@ -0,0 +1,196 @@
;;; sgf.el --- SGF GO back end
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Commentary:
;; This file implements an `go-trans' interface into an SGF file.
;; Code:
(require 'go-api)
(defun sgf-nthcdr (sgf index)
(let ((part sgf))
(while (cdr index)
(setq part (nth (car index) part))
(setq index (cdr index)))
(setq part (nthcdr (car index) part))
part))
(defun sgf-ref (sgf index)
(let ((part sgf))
(while (car index)
(setq part (nth (car index) part))
(setq index (cdr index)))
part))
(defun set-sgf-ref (sgf index new)
(eval `(setf ,(reduce (lambda (acc el) (list 'nth el acc))
index :initial-value 'sgf)
',new)))
(defsetf sgf-ref set-sgf-ref)
;;; Class
(defclass sgf nil
((self :initarg :self :accessor self :initform nil)
(index :initarg :index :accessor index :initform (list 0)))
"Class for the SGF back end.")
(defun sgf-from-file (file)
(interactive "f")
(make-instance 'sgf :self (sgf2el-file-to-el file)))
(defun sgf-to-file (sgf file)
(interactive "F")
(when (and (file-exists-p file)
(not (y-or-n-p (format "overwrite %s? " file))))
(error "aborted"))
(with-temp-file file
(delete-region (point-min) (point-max))
(insert (pp (self sgf)))))
(defmethod current ((sgf sgf))
(sgf-ref (self sgf) (index sgf)))
(defun set-current (sgf new)
(setf (sgf-ref (self sgf) (index sgf)) new))
(defsetf current set-current)
(defmethod root ((sgf sgf))
(sgf-ref (self sgf) '(0)))
(defun set-root (sgf new)
(if (self sgf)
(setf (car (self sgf)) new)
(setf (self sgf) (list new))))
(defsetf root set-root)
(defmethod next ((sgf sgf))
(incf (car (last (index sgf)))))
(defmethod prev ((sgf sgf))
(decf (car (last (index sgf)))))
;;; interface
(defmethod go-size ((sgf sgf))
(or (aget (root sgf) :S)
(aget (root sgf) :SZ)))
(defmethod set-go-size ((sgf sgf) size)
(cond
((aget (root sgf) :S) (setf (cdr (assoc :S (root sgf))) size))
((aget (root sgf) :SZ) (setf (cdr (assoc :SZ (root sgf))) size))
(t (push (cons :S size) (root sgf)))))
(defmethod go-level ((sgf sgf))
(signal 'unsupported-back-end-command (list sgf :go-level)))
(defmethod set-go-level ((sgf sgf) level)
(signal 'unsupported-back-end-command (list sgf :set-go-level level)))
(defmethod go-name ((sgf sgf))
(or (aget (root sgf) :GN)
(aget (root sgf) :EV)))
(defmethod set-go-name ((sgf sgf) name)
(cond
((aget (root sgf) :GN) (setf (cdr (assoc :GN (root sgf))) name))
((aget (root sgf) :EV) (setf (cdr (assoc :EV (root sgf))) name))
(t (push (cons :GN name) (root sgf)))))
(defmethod go-move ((sgf sgf))
(next sgf)
(let ((turn (current sgf)))
(if turn
(or (assoc :B turn) (assoc :W turn))
(prev sgf)
(error "sgf: no more moves"))))
;; TODO: currently this only works with linear sgf files w/o alternatives
(defmethod set-go-move ((sgf sgf) move)
(next sgf)
(if (current sgf)
(setf (current sgf) (list move))
(setf (self sgf) (rcons (list move) (self sgf)))))
(defmethod go-labels ((sgf sgf))
(let ((turn (current sgf)))
(if turn
(remove-if-not (lambda (pair) (member (car pair) '(:LB :LW))) turn)
(prev sgf)
(error "sgf: no more moves"))))
(defmethod set-go-lables ((sgf sgf) labels)
(if (current sgf)
(setf (current sgf) (cons (or (assoc :B (current sgf))
(assoc :W (current sgf)))
labels))
(rpush labels (sgf-ref (self sgf) (butlast (index sgf))))))
(defmethod go-comment ((sgf sgf))
(aget (current sgf) :C))
(defmethod set-go-comment ((sgf sgf) comment)
(if (aget (current sgf) :C)
(setf (cdr (assoc :C (current sgf))) comment)
(push (cons :C comment) (current sgf))))
(defmethod go-alt ((sgf sgf))
(error "sgf: go-alt not yet supported"))
(defmethod set-go-alt ((sgf sgf) alt)
(error "sgf: set-go-alt not yet supported"))
(defmethod go-color ((sgf sgf))
(signal 'unsupported-back-end-command (list sgf :move)))
(defmethod set-go-color ((sgf sgf) color)
(signal 'unsupported-back-end-command (list sgf :set-color color)))
;; non setf'able generic functions
(defmethod go-undo ((sgf sgf)) (prev sgf))
(defmethod go-pass ((sgf sgf))
(signal 'unsupported-back-end-command (list sgf :pass)))
(defmethod go-resign ((sgf sgf))
(signal 'unsupported-back-end-command (list sgf :resign)))
(defmethod go-quit ((sgf sgf))
(when (y-or-n-p "Save game to file: ")
(sgf-to-file sgf (read-file-name "Save game to: "))))
(defmethod go-score ((sgf sgf))
(signal 'unsupported-back-end-command (list sgf :score)))
(defmethod go-territory ((sgf sgf))
(signal 'unsupported-back-end-command (list sgf :territory)))
(defmethod go-dead ((sgf sgf))
(signal 'unsupported-back-end-command (list sgf :dead)))
(provide 'sgf)
;;; sgf.el ends here

188
elpa/go-20160430.1739/back-ends/sgf2el.el Normal file
View File

@ -0,0 +1,188 @@
;;; sgf2el.el --- conversion between sgf and emacs-lisp
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'go-util)
(defvar prop-re
"\\([[:alpha:]]+\\)\\(\\(\\[\\]\\|[[:space:]]*\\[[^\000]*?[^\\]\\]\\)+\\)")
(defvar prop-val-re
"\\(\\[\\]\\|\\[\\([^\000]*?[^\\]\\)\\]\\)")
(defvar sgf2el-special-properties nil
"A-list of properties and functions to specially convert their values.")
(defun make-keyword (string)
(intern (concat ":" (upcase string))))
(defun sgf2el-convert-prop-key (key)
"Convert a keyerty name to elisp."
(save-match-data (make-keyword key)))
(defun sgf2el-read-prop (val)
(when (and (stringp val) (not (equal val "")))
(or (go-number-p val) val)))
(defun sgf2el-convert-prop-vals (key vals)
"Convert a property value to elisp."
(save-match-data
(let ((func (cdr (assoc key sgf2el-special-properties))))
(if func
(funcall func vals)
(delete nil (mapcar #'sgf2el-read-prop vals))))))
(defun sgf2el-all-matches (str re &optional sub-exp)
(save-match-data
(with-temp-buffer
(insert str)
(goto-char (point-min))
(loop while (re-search-forward re nil t)
collect (go-clean-text-properties
(match-string (or sub-exp 0)))))))
(defun sgf2el-region (&optional start end)
(interactive "r")
(let ((start (copy-marker (or start (point-min))))
(end (copy-marker (or end (point-max))))
(re (format "\\(%s\\|%s\\)" prop-re "\\(([[:space:]]*\\)*\\(;\\)"))
last-node)
(save-excursion (goto-char start)
(while (re-search-forward re end t)
(let ((start (marker-position start)))
(message "parsing %.2f%%"
(* 100 (/ (float (- (point) start))
(float (- (marker-position end) start))))))
(if (string= (match-string 6) ";")
(progn
(replace-match "(" nil nil nil 6)
(when last-node
(save-excursion (goto-char (match-beginning 0)) (insert ")")))
(setq last-node t))
(let* ((key (sgf2el-convert-prop-key (match-string 2)))
(val (sgf2el-convert-prop-vals key
(sgf2el-all-matches (match-string 3) prop-val-re 2)))
(rep (format "%S " (cons key (if (= 1 (length val))
(car val) val)))))
(replace-match rep nil 'literal))))
(when last-node (insert ")")))
(message "parsing DONE")))
(defun sgf2el-normalize (&optional buffer)
"Cleanup the formatting of the elisp sgf data in BUFFER."
(interactive)
(let ((buffer (or buffer (current-buffer))) temp)
(sgf2el-set-to-var temp buffer)
(with-current-buffer buffer
(save-excursion
(delete-region (point-min) (point-max))
(insert (pp temp))))
temp))
(defun sgf2el (&optional sgf-buffer)
"Convert the content of SGF-BUFFER to emacs-lisp in a new buffer."
(interactive)
(let* ((sgf-buffer (or sgf-buffer (current-buffer)))
(buffer (generate-new-buffer (concat (buffer-name sgf-buffer) "-el")))
(sgf-str (with-current-buffer sgf-buffer (buffer-string))))
(with-current-buffer buffer
(insert sgf-str)
(goto-char (point-min))
(sgf2el-region)
(emacs-lisp-mode))
(pop-to-buffer buffer)))
(defun sgf2el-read (&optional buf)
(with-current-buffer (or buf (current-buffer))
(goto-char (point-min))
(read (current-buffer))))
(defun sgf2el-buffer-to-el (&optional bufffer)
"Convert the sgf contents of BUFFER to emacs lisp."
(interactive "b")
(with-current-buffer (or bufffer (current-buffer))
(sgf2el-region (point-min) (point-max))
(sgf2el-read)))
(defun sgf2el-str-to-el (str)
"Convert a string of sgf into the equivalent Emacs Lisp."
(interactive)
(with-temp-buffer (insert str) (sgf2el-buffer-to-el)))
(defun sgf2el-file-to-el (file)
"Convert the sgf contents of FILE to emacs lisp."
(interactive "f")
(with-temp-buffer
(insert-file-contents-literally file)
(sgf2el-buffer-to-el)))
;;; Specific property converters
(defun process-date (date-args)
(save-match-data (parse-time-string
(if (> 1 (length date-args))
(mapconcat #'number-to-string date-args " ")
(car date-args)))))
(add-to-list 'sgf2el-special-properties (cons :DT #'process-date))
(defun process-position (position-string)
(cl-flet ((char-to-num (char)
(cond
((or (< char ?A) (< ?z char))
(error "sgf: invalid char %s" char))
((< char ?a) (+ 26 (- char ?A)))
(t (- char ?a)))))
(cons (char-to-num (aref position-string 0))
(char-to-num (aref position-string 1)))))
(defun process-move (move-args)
(list (cons :pos (process-position (car move-args)))))
(add-to-list 'sgf2el-special-properties (cons :B #'process-move))
(add-to-list 'sgf2el-special-properties (cons :W #'process-move))
(defun process-label (label-args)
(let ((res (mapcar (lambda (l-arg)
(if (string-match "\\([[:alpha:]]+\\):\\(.*\\)" l-arg)
(list
(cons :label (match-string 2 l-arg))
(cons :pos (process-position
(match-string 1 l-arg))))
(error "sgf: malformed label %S" l-arg)))
label-args)))
(if (= 1 (length label-args)) (list res) res)))
(add-to-list 'sgf2el-special-properties (cons :LB #'process-label))
(add-to-list 'sgf2el-special-properties (cons :LW #'process-label))
(defun process-comment (comments)
(let ((replacements '(("\\(" . "(")
("\\)" . ")")
("\\[" . "[")
("\\]" . "]"))))
(mapcar (lambda (comment)
(dolist (pair replacements comment)
(setq comment (replace-regexp-in-string
(regexp-quote (car pair)) (cdr pair) comment))))
comments)))
(add-to-list 'sgf2el-special-properties (cons :C #'process-comment))
(provide 'sgf2el)
;;; sgf2el.el ends here

78
elpa/go-20160430.1739/go-api.el Normal file
View File

@ -0,0 +1,78 @@
;;; go-api.el --- a uniform API for communication between GO back-ends
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A board-based interface to GO games which may be connected to a
;; number of GO back-ends through a generic API. To play a game of GO
;; against the gnugo back-end run `play-go'. Current back-ends
;; include the following.
;; - the SGF format
;; - the Go Text Protocol (GTP)
;; - TODO: the IGS protocol
;;; Code:
(require 'go-util)
(require 'eieio)
(put 'unsupported-back-end-command
'error-conditions
'(error unsupported-back-end-command))
(defmacro ignoring-unsupported (&rest body)
`(condition-case err ,@body
(unsupported-back-end-command nil)))
(defmacro defgeneric-w-setf (name doc)
(let ((set-name (intern (concat "set-" (symbol-name name)))))
`(progn
(defgeneric ,name (back-end) ,doc)
(defgeneric ,set-name (back-end new))
(defsetf ,name ,set-name))))
;; setf'able back-end access
(defgeneric-w-setf go-size "Access BACK-END size.")
(defgeneric-w-setf go-level "Access level of BACK-END.")
(defgeneric-w-setf go-name "Access BACK-END name.")
(defgeneric-w-setf go-move "Access current BACK-END move.")
(defgeneric-w-setf go-labels "Access current BACK-END labels.")
(defgeneric-w-setf go-comment "Access current BACK-END comment.")
(defgeneric-w-setf go-alt "Access current BACK-END alternative move.")
(defgeneric-w-setf go-color "Access current BACK-END turn color.")
(defgeneric-w-setf go-player-name "Access current BACK-END player name.")
(defgeneric-w-setf go-player-time "Access current BACK-END player time.")
(defgeneric-w-setf
go-player-prisoners "Access current BACK-END player prisoners.")
;; sending messages to the back-end
(defgeneric go-connect (back-end) "Connect to BACK-END.")
(defgeneric go-undo (back-end) "Send undo to BACK-END.")
(defgeneric go-pass (back-end) "Send pass to BACK-END.")
(defgeneric go-resign (back-end) "Send resign to BACK-END.")
(defgeneric go-reset (back-end) "Send reset to BACK-END.")
(defgeneric go-quit (back-end) "Quit the BACK-END.")
(defgeneric go-score (back-end) "Ask BACK-END to report the score.")
(defgeneric go-territory (back-end) "Ask BACK-END to report the territory.")
(defgeneric go-dead (back-end) "Ask BACK-END to dead stones.")
(provide 'go-api)
;;; go-api.el ends here

32
elpa/go-20160430.1739/go-autoloads.el Normal file
View File

@ -0,0 +1,32 @@
;;; go-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "go" "go.el" (22490 32825 89857 211000))
;;; Generated autoloads from go.el
(autoload 'go-play "go" "\
Play a game of GO.
\(fn)" t nil)
(autoload 'go-view-sgf "go" "\
View an SGF file.
\(fn &optional FILE)" t nil)
;;;***
;;;### (autoloads nil nil ("go-api.el" "go-board-faces.el" "go-board.el"
;;;;;; "go-pkg.el" "go-util.el" "list-buffer.el") (22490 32825 112091
;;;;;; 153000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; go-autoloads.el ends here

177
elpa/go-20160430.1739/go-board-faces.el Normal file
View File

@ -0,0 +1,177 @@
;;; go-board-faces.el -- Color for GO boards
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(defface go-board-background
'((t (:background "#b36108" :foreground "#6f3c04")))
"woodsy background")
(defface go-board-hoshi
'((t (:background "#b36108" :foreground "#6d3300")))
"woodsy background with darker hoshi mark")
(defface go-board-black
'((t (:background "#b36108" :foreground "black")))
"black piece on woodsy background")
(defface go-board-white
'((t (:background "#b36108" :foreground "white")))
"white piece on woodsy background")
(defface go-board-black-territory-background
'((t (:background "#6a4014" :foreground "#6f3c04")))
"woodsy background")
(defface go-board-black-territory-hoshi
'((t (:background "#6a4014" :foreground "#6d3300")))
"woodsy background with darker hoshi mark")
(defface go-board-black-territory-black
'((t (:background "#6a4014" :foreground "black")))
"black piece on black territory")
(defface go-board-black-territory-white
'((t (:background "#6a4014" :foreground "#6b6b6b")))
"white piece on black territory")
(defface go-board-white-territory-background
'((t (:background "#cd9c67" :foreground "#6f3c04")))
"white territory")
(defface go-board-white-territory-hoshi
'((t (:background "#cd9c67" :foreground "#6d3300")))
"white territory with darker hoshi mark")
(defface go-board-white-territory-black
'((t (:background "#cd9c67" :foreground "#6b6b6b")))
"black piece on white territory")
(defface go-board-white-territory-white
'((t (:background "#cd9c67" :foreground "white")))
"white piece on white territory")
;; Maybe use `face-remap-add-relative' to change image sizes.
;;; Image utility functions
(defun go-board-svg-trans (list)
(if (and (listp list) (listp (car list)))
(concat (format "<%s%s" (caar list) (if (cdar list) " " ""))
(mapconcat (lambda (pair) (format "%s=\"%s\"" (car pair) (cdr pair)))
(cdar list) " ")
(if (cdr list)
(concat ">"
(mapconcat #'go-board-svg-trans (cdr list) " ")
(format "</%s>" (caar list)))
"/>"))
list))
(defun go-board-cross (color)
(mapconcat #'go-board-svg-trans
`(((line (x1 . 3.125) (y1 . 3.125) (x2 . 21.875) (y2 . 21.875)
(style . ,(format "stroke: %s;" color))))
((line (x1 . 3.125) (y1 . 21.875) (x2 . 21.875) (y2 . 3.125)
(style . ,(format "stroke: %s;" color)))))
""))
(defun go-board-label (color label)
(go-board-svg-trans
`((text (x . 8.75) (y . 16.25) (r . 12.25)
(style . ,(format "font-size:12.5;fill:%s;" color)))
,label)))
(defun go-board-mark (overlay mark)
"Write MARK over top of the SVG image in OVERLAY."
(let* ((disp (cdr (copy-tree (overlay-get overlay 'display))))
(data (plist-get disp :data)))
(when (and data (string-match (regexp-quote "</svg>") data))
(plist-put disp :data (concat (substring data 0 (match-beginning 0))
mark
(substring data (match-beginning 0))))
(overlay-put overlay 'display (cons 'image disp)))))
(defmacro go-board-wrap (&rest body)
`(concat
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
(go-board-svg-trans
'((svg (xmlns . "http://www.w3.org/2000/svg")
(xmlns:xlink . "http://www.w3.org/1999/xlink")
(width . 25) (height . 25) (version . 1.0))
,@body))))
;; TODO: To allow images to scale with text, this should return a
;; function instead of a list. This function should take a base
;; size (e.g., 12.5), and should return the image list
;; appropriate for that size.
(defmacro go-board-image (&rest body)
``(image :type svg :ascent center :data
,(go-board-wrap
((rect (width . 25) (height . 25) (fill . "#dcb35c")))
,@body)))
(defmacro go-board-image-sides (name &rest base)
(declare (indent 1))
`(progn
,@(mapcar
(lambda (p)
`(defvar ,(sym-cat 'go-board-image name (car p))
(go-board-image
,(when (cdr p)
`((path (stroke . "#000") (stroke-width . 1) (d . ,(cdr p)))))
,@base)))
'((left . "M12,12.5H25M12.5,0V25")
(right . "M0,12.5H13M12.5,0V25")
(top . "M0,12.5H25M12.5,12V25")
(bottom . "M0,12.5H25M12.5,0V12.5")
(top-left . "M12,12.5H25M12.5,12V25")
(top-right . "M0,12.5H13M12.5,12V25")
(bottom-left . "M12,12.5H25M12.5,0V13")
(bottom-right . "M0,12.5H13M12.5,0V13")
(nil . "M0,12.5H25M12.5,0V25")))))
;;; SVG Images
(go-board-image-sides background)
(go-board-image-sides black
((defs)
((radialGradient (id . "$rg") (cx . ".3") (cy . ".3") (r . ".8"))
((stop (offset . 0) (stop-color . "#777")))
((stop (offset . 0.3) (stop-color . "#222")))
((stop (offset . 1) (stop-color . "#000")))))
((circle (cx . 12.5) (cy . 12.5) (r . 9.375) (fill . "url(#$rg)"))))
(go-board-image-sides white
((defs)
((radialGradient (id . "$rg") (cx . ".47") (cy . ".49") (r . ".48"))
((stop (offset . 0.7) (stop-color . "#FFF")))
((stop (offset . 0.9) (stop-color . "#DDD")))
((stop (offset . 1) (stop-color . "#777")))))
((circle (cx . 12.5) (cy . 12.5) (r . 9.375) (fill . "url(#$rg)"))))
(defvar go-board-image-hoshi
(go-board-image
((path (stroke . "#000") (stroke-width . 1) (d . "M0,12.5H25M12.5,0V25")))
((circle (cx . 12.5) (cy . 12.5) (r . 2.5)))))
(provide 'go-board-faces)
;;; go-board-faces.el ends here

578
elpa/go-20160430.1739/go-board.el Normal file
View File

@ -0,0 +1,578 @@
;;; go-board.el --- Smart Game Format GO board visualization
;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'go-util)
(require 'go-api)
(require 'go-board-faces)
(defvar *history* nil "Holds the board history for a GO buffer.")
(defvar *size* nil "Holds the board size.")
(defvar *turn* nil "Holds the color of the current turn.")
(defvar *black* nil "Plist of info on black player.")
(defvar *white* nil "Plist of info on white player.")
(defvar *back-end* nil "Holds the primary back-end connected to a board.")
(defvar *trackers* nil "Holds a list of back-ends which should track the game.")
(defvar *autoplay* nil "Should `*back-end*' automatically respond to moves.")
(defvar black-piece "X")
(defvar white-piece "O")
(defvar go-board-use-images t)
(defvar *go-board-overlays* nil
"List of overlays carrying GO board painting information.")
(defvar go-board-use-move-sound nil)
(defvar go-board-move-sound
`(sound :file ,(expand-file-name "stone.wav"
(file-name-directory
(or load-file-name (buffer-file-name))))))
;;; Board manipulation functions
(defun make-board (size) (make-vector (* size size) nil))
(defun board-size (board) (round (sqrt (length board))))
(defun go-player-get (color property)
(plist-get (case color (:W *white*) (:B *black*)) property))
(defun go-player-set (color property value)
(let ((player (case color (:W *white*) (:B *black*))))
(plist-put player property value)))
(defsetf go-player-get go-player-set)
(defun move-type (move)
(cond
((member (car move) '(:B :W)) :move)
((member (car move) '(:LB :LW)) :label)))
(defun other-color (color)
(if (equal color :B) :W :B))
(defun point-of-pos (pos)
(catch 'found-pos
(dotimes (p (1- (point-max)) (error "go: pos %S not found" pos))
(let ((pos-at-point (get-text-property (1+ p) :pos)))
(when (and pos-at-point (tree-equal pos pos-at-point))
(throw 'found-pos (1+ p)))))))
(defun apply-turn-to-board (moves)
(let ((board (pieces-to-board (car *history*) *size*)))
(clear-labels board)
(when go-board-use-move-sound (play-sound go-board-move-sound))
(dolist (move moves) (apply-move board move))
(push (board-to-pieces board) *history*)
(update-display (current-buffer))))
(defun apply-move (board move)
(cl-flet ((bset (val data)
(let ((data (if (listp (car data)) data (list data))))
(setf (aref board (pos-to-index (aget data :pos)
(board-size board)))
(case val
(:B :B)
(:W :W)
(:LB (aget data :label))
(:LW (aget data :label))
(t nil))))))
(case (move-type move)
(:move
(bset (car move) (cdr move))
(let ((color (if (equal :B (car move)) :B :W)))
(remove-dead board (other-color color))
(remove-dead board color)))
(:label
(dolist (data (cdr move)) (bset (car move) data))))))
(defun clear-labels (board)
(dotimes (point (length board) board)
(when (aref board point)
(unless (member (aref board point) '(:B :W))
(setf (aref board point) nil)))))
(defun neighbors (board piece)
(let ((size (board-size board))
neighbors)
(when (not (= (mod piece size) (1- size))) (push (1+ piece) neighbors))
(when (not (= (mod piece size) 0)) (push (1- piece) neighbors))
(when (< (+ piece size) (length board)) (push (+ piece size) neighbors))
(when (> (- piece size) 0) (push (- piece size) neighbors))
neighbors))
(defun alive-p (board piece &optional already)
(let* ((val (aref board piece))
(enemy (other-color val))
(neighbors (remove-if (lambda (n) (member n already))
(neighbors board piece)))
(neighbor-vals (mapcar (lambda (n) (aref board n)) neighbors))
(friendly (delete nil (mapcar
(lambda (n) (when (equal (aref board n) val) n))
neighbors)))
(already (cons piece already)))
(or (some (lambda (v) (not (or (equal v enemy) ; touching open space
(equal v val))))
neighbor-vals)
(some (lambda (n) (alive-p board n already)) ; touching alive dragon
friendly))))
(defun remove-dead (board color)
;; must remove one color at a time for ko situations
(let (cull)
(dotimes (n (length board) board)
(when (and (equal (aref board n) color) (not (alive-p board n)))
(push n cull)))
(incf (go-player-get (other-color color) :prisoners) (length cull))
(dolist (n cull cull) (setf (aref board n) nil))))
(defun board-to-pieces (board)
(let (pieces)
(dotimes (n (length board) pieces)
(let ((val (aref board n)))
(when val (push (cons val n) pieces))))))
(defun pieces-to-board (pieces size)
(let ((board (make-vector (* size size) nil)))
(dolist (piece pieces board)
(setf (aref board (cdr piece)) (car piece)))))
;;; Visualization
(defun board-header (board)
(cl-flet ((hd (str hd)
(put-text-property 0 1 :type `(,hd . :offboard) str)
str))
(let ((size (board-size board)))
(concat " "
(hd " " :filler)
(mapconcat (lambda (n)
(let ((char (+ ?A n)))
(when (>= char ?I) (setq char (+ 1 char)))
(hd (string char) :header)))
(range size) (hd " " :filler))))))
(defun board-pos-to-string (board pos)
(let ((size (board-size board)))
(cl-flet ((emph (n)
(cond
((= size 19)
(or (= 3 n)
(= 4 (- size n))
(= n (/ (- size 1) 2))))
((= size 13)
(or (= 3 n)
(= 9 n)))
((= size 9)
(or (= 2 n)
(= 6 n)))))
(put (str prop val) (put-text-property 0 (length str) prop val str)))
(let* ((val (aref board (pos-to-index pos size)))
(str (cond
((equal val :W) white-piece)
((equal val :B) black-piece)
((and (stringp val) (= 1 (length val)) val))
(t (if (and (emph (car pos)) (emph (cdr pos))) "+" ".")))))
(put str :type
(cons (cond ;; foreground
((string= str white-piece) :white)
((string= str black-piece) :black)
((string= str "+") :hoshi)
((string= str ".") :background-1)
(t :background))
(cond ;; background
((and (= 0 (car pos)) (= 0 (cdr pos))) :bl)
((and (= 0 (car pos)) (= (1- size) (cdr pos))) :br)
((and (= (1- size) (car pos)) (= 0 (cdr pos))) :tl)
((and (= (1- size) (car pos)) (= (1- size) (cdr pos))) :tr)
((= 0 (car pos)) :b)
((= (1- size) (car pos)) :t)
((= 0 (cdr pos)) :l)
((= (1- size) (cdr pos)) :r)
(t nil))))
(put str :pos (cons (cdr pos) (car pos)))
str))))
(defun board-row-to-string (board row)
(let* ((size (board-size board))
(label (format "%3d" (1+ row)))
(row-body "")
(filler " "))
(put-text-property 0 1 :type (cons :background nil) filler)
(dotimes (n size)
(setq row-body
(concat row-body
(board-pos-to-string board (cons row n))
filler)))
(concat label " " (substring row-body 0 (1- (length row-body))) label)))
(defun board-body-to-string (board)
(let ((board (transpose-array board)))
(mapconcat (lambda (m) (board-row-to-string board m))
(reverse (range (board-size board))) "\n")))
(defun board-to-string (board)
(let ((header (board-header board))
(body (board-body-to-string board)))
(mapconcat #'identity (list header body header) "\n")))
(defun go-board-paint (&optional start end)
(interactive "r")
(cl-flet ((ov (point face &optional back)
(let ((ovly (make-overlay point (1+ point))))
(overlay-put ovly 'go-pt point)
(overlay-put ovly 'face (sym-cat 'go-board face))
(when go-board-use-images
(overlay-put ovly 'display
(if (equal face 'filler)
'(space :width (18))
(eval (sym-cat 'go-board 'image face back)))))
(push ovly *go-board-overlays*)))
(hide (point)
(let ((ovly (make-overlay point (1+ point))))
(overlay-put ovly 'invisible t)
(push ovly *go-board-overlays*))))
(let ((start (or start (point-min)))
(end (or end (point-max))))
(dolist (point (range start end))
(if (get-text-property point :turn)
(font-lock-prepend-text-property point (1+ point) 'face 'underline)
(let ((back (case (cdr (get-text-property point :type))
(:tl 'top-left)
(:tr 'top-right)
(:bl 'bottom-left)
(:br 'bottom-right)
(:t 'top)
(:b 'bottom)
(:l 'left)
(:r 'right)
(:offboard 'offboard))))
(case (car (get-text-property point :type))
(:header nil)
(:filler (ov point 'filler back))
(:hoshi (ov point 'hoshi))
(:white (ov point 'white back))
(:black (ov point 'black back))
(:background (if go-board-use-images
(hide point)
(ov point 'background)))
(:background-1 (ov point 'background back)))))))))
(defun player-to-string (color)
(format "%10s: %3d"
(let ((name (go-player-get color :name)))
(put-text-property 0 (length name) :turn (equal *turn* color) name)
name)
(go-player-get color :prisoners)))
(defun update-display (buffer)
(with-current-buffer buffer
(let ((point (point)))
(delete-region (point-min) (point-max))
(insert "\n"
(board-to-string
(pieces-to-board (car *history*) *size*)) "\n\n"
(player-to-string :W) "\n"
(player-to-string :B) "\n")
(let ((comment (ignoring-unsupported (go-comment *back-end*))))
(when comment
(insert (make-string (+ 6 (* 2 *size*)) ?=)
"\n\n"
comment)))
(go-board-paint)
(goto-char point)))
buffer)
(defun go-board (back-end &rest trackers)
(let ((buffer (generate-new-buffer "*GO*")))
(with-current-buffer buffer
(go-board-mode)
(let ((name (go-name back-end)))
(when name
(rename-buffer (ear-muffs name) 'unique)
(mapcar (lambda (tr) (setf (go-name tr) name)) trackers)))
(set (make-local-variable '*back-end*) back-end)
(set (make-local-variable '*turn*) :B)
(set (make-local-variable '*black*) '(:name "black" :prisoners 0))
(set (make-local-variable '*white*) '(:name "white" :prisoners 0))
(set (make-local-variable '*size*) (go-size back-end))
(set (make-local-variable '*autoplay*) nil)
(set (make-local-variable '*go-board-overlays*) nil)
(mapcar (lambda (tr) (setf (go-size tr) *size*)) trackers)
(set (make-local-variable '*history*)
(list (board-to-pieces (make-board *size*))))
(set (make-local-variable '*trackers*) trackers))
(pop-to-buffer buffer)
(plist-put *black* :prisoners 0)
(plist-put *white* :prisoners 0)
(setq truncate-lines t)
(update-display buffer)))
;;; User input
(defmacro with-trackers (sym &rest body)
(declare (indent 1))
`(ignoring-unsupported
(mapcar (lambda (tr) (let ((,sym tr)) ,@body)) *trackers*)))
(defmacro with-backends (sym &rest body)
(declare (indent 1))
`(save-window-excursion
(ignoring-unsupported
(prog1 (let ((,sym *back-end*)) ,@body)
(with-trackers ,sym ,@body)))))
(def-edebug-spec with-backends (sexp body))
(defvar go-board-actions '(move resign undo comment)
"List of actions which may be taken on an GO board.")
(defun go-board-act ()
"Send a command to the current GO board."
(interactive)
(let ((command (go-completing-read
"Action: " (mapcar #'symbol-name go-board-actions))))
(case (intern command)
(move (message "make a move"))
(resign (message "game over"))
(undo (message "loser"))
(comment (message "what?")))))
(defun go-board-move (&optional pos)
(interactive)
(let* ((color (case *turn* (:B "black") (:W "white")))
(pos (or pos (cons (char-to-num
(aref (downcase
(go-completing-read
(format "[%s] X pos: " color)
(mapcar #'string
(mapcar #'gtp-num-to-char
(range 1 *size*)))))
0))
(1- (string-to-number
(go-completing-read
(format "[%s] Y pos: " color)
(mapcar #'number-to-string
(range 1 *size*))))))))
(move (cons *turn* (cons :pos pos))))
(with-backends back
(setf (go-move back) move))
(setf *turn* (other-color *turn*))
(apply-turn-to-board (list move)))
(when *autoplay* (go-board-next)))
(defun go-board-refresh ()
(interactive)
(update-display (current-buffer)))
(defun go-board-resign ()
(interactive)
(with-backends back (go-resign back)))
(defun go-board-mark-point (point mark)
(mapc (lambda (ov) (go-board-mark ov mark)) (overlays-at point)))
(defun go-board-pass ()
(interactive)
(with-backends back (go-pass back))
(save-window-excursion
(setf *turn* (other-color *turn*))
(when *autoplay*
(when (equalp :pass (go-board-next))
;; mark open points
(mapc (lambda (move)
(go-board-mark-point (point-of-pos (cddr move))
(go-board-cross (ecase (car move)
(:B 'black)
(:W 'white)))))
(with-backends back (go-territory back)))
;; mark dead stones
(mapc (lambda (move)
(let* ((point (point-of-pos (cddr move)))
(color (car (get-text-property point :type))))
(go-board-mark-point point
(go-board-cross (ecase color
(:black 'white)
(:white 'black))))))
(with-backends back (go-dead back)))
(message "final score: %s" (with-backends back (go-score back)))))))
(defun go-board-undo (&optional num)
(interactive "p")
(with-backends back (go-undo back))
(pop *history*)
(update-display (current-buffer))
(setf *turn* (other-color *turn*)))
(defun go-board-comment (&optional comment)
(interactive "MComment: ")
(with-backends back (setf (go-comment back) comment)))
(defun go-board-level (&optional level)
(interactive "nLevel: ")
(with-backends back (setf (go-level back) level)))
(defun go-board-next (&optional count)
(interactive "p")
(let (move)
(dotimes (n (or count 1) move)
(setf move (go-move *back-end*))
(if (equal move :pass)
(message "pass")
(setf *turn* (other-color *turn*))
(apply-turn-to-board
(cons move (ignoring-unsupported (go-labels *back-end*)))))
(with-trackers tr (setf (go-move tr) move))
(if (equal move :pass)
(goto-char (point-min))
(goto-char (point-of-pos (cddr move)))))))
(defun go-board-mouse-move (ev)
(interactive "e")
(go-board-move (get-text-property (posn-point (event-start ev)) :pos)))
(defun go-board-quit ()
(interactive)
(when (y-or-n-p "quit: ")
(kill-buffer (current-buffer))))
(defun go-board-safe-quit ()
(ignore-errors (with-backends tr (go-quit tr)))
t)
;;; Display mode
(defvar go-board-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "<mouse-1>") 'go-board-mouse-move)
(define-key map (kbd "m") 'go-board-move)
(define-key map (kbd "r") 'go-board-refresh)
(define-key map (kbd "R") 'go-board-resign)
(define-key map (kbd "u") 'go-board-undo)
(define-key map (kbd "c") 'go-board-comment)
(define-key map (kbd "l") 'go-board-level)
(define-key map (kbd "p") 'go-board-pass)
(define-key map (kbd "<right>") 'go-board-next)
(define-key map (kbd "<left>") 'go-board-undo)
(define-key map (kbd "q") 'go-board-quit)
map)
"Keymap for `go-board-mode'.")
(define-derived-mode go-board-mode nil "GO"
"Major mode for viewing a GO board."
(set (make-local-variable 'kill-buffer-query-functions)
(add-to-list 'kill-buffer-query-functions 'go-board-safe-quit)))
;;; Class and interface
(defclass board ()
((buffer :initarg :buffer :accessor buffer :initform nil)))
(defmacro with-board (board &rest body)
(declare (indent 1))
`(with-current-buffer (buffer ,board) ,@body))
(defmethod go-size ((board board))
(with-board board *size*))
(defmethod set-go-size ((board board) size)
(with-board board (setq *size* size)))
(defmethod go-name ((board board))
(un-ear-muffs (buffer-name (buffer board))))
(defmethod set-go-name ((board board) name)
(with-board board (rename-buffer name 'unique)))
(defmethod go-move ((board board))
(signal 'unsupported-back-end-command (list board :move)))
(defmethod set-go-move ((board board) move)
(with-board board
(setf *turn* (other-color *turn*))
(apply-turn-to-board (list move))
(goto-char (point-of-pos (cddr move)))
(with-trackers tr (setf (go-move tr) move))))
(defmethod go-labels ((board board))
(signal 'unsupported-back-end-command (list board :labels)))
(defmethod set-go-labels ((board board) labels)
(signal 'unsupported-back-end-command (list board :set-labels labels)))
(defmethod go-comment ((board board))
(signal 'unsupported-back-end-command (list board :comment)))
(defmethod set-go-comment ((board board) comment)
(signal 'unsupported-back-end-command (list board :set-comment comment)))
(defmethod go-alt ((board board))
(signal 'unsupported-back-end-command (list board :alt)))
(defmethod set-go-alt ((board board) alt)
(signal 'unsupported-back-end-command (list board :set-alt alt)))
(defmethod go-color ((board board))
(with-board board *turn*))
(defmethod set-go-color ((board board) color)
(with-board board (setq *turn* color)))
(defmethod go-player-name ((board board) color)
(with-board board (go-player-get color :name)))
(defmethod set-go-player-name ((board board) color name)
(with-board board (go-player-set color :name name)))
(defmethod go-player-time ((board board) color)
(with-board board (go-player-get color :time)))
(defmethod set-go-player-time ((board board) color time)
(with-board board (go-player-set color :time time)))
(defmethod go-player-prisoners ((board board) color)
(with-board board (go-player-get color :prisoners)))
(defmethod set-go-player-prisoners ((board board) color prisoners)
(with-board board (go-player-set color :prisoners prisoners)))
;; non setf'able generic functions
(defmethod go-undo ((board board))
(with-board board (go-board-undo)))
(defmethod go-pass ((board board))
(with-board board
(message "pass")
(setf *turn* (other-color *turn*))))
(defmethod go-resign ((board board))
(with-board board (message "%s resign" *turn*)))
(defmethod go-reset ((board board))
(with-board board
(setf *history* nil)
(update-display)))
(defmethod go-quit ((board board))
(with-board board (go-quit)))
(provide 'go-board)
;;; go-board.el ends here

7
elpa/go-20160430.1739/go-pkg.el Normal file
View File

@ -0,0 +1,7 @@
(define-package "go" "20160430.1739" "Play GO, translate and transfer between GO back ends"
'((emacs "24"))
:url "http://eschulte.github.io/el-go/" :keywords
'("game" "go" "sgf"))
;; Local Variables:
;; no-byte-compile: t
;; End:

177
elpa/go-20160430.1739/go-util.el Normal file
View File

@ -0,0 +1,177 @@
;;; go-util.el --- utility functions for GO functions
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(eval-when-compile (require 'cl))
(require 'assoc)
(defun curry (function &rest arguments)
(lexical-let ((function function)
(arguments arguments))
(lambda (&rest more) (apply function (append arguments more)))))
(defun rcurry (function &rest arguments)
(lexical-let ((function function)
(arguments arguments))
(lambda (&rest more) (apply function (append more arguments)))))
(defun compose (function &rest more-functions)
(cl-reduce (lambda (f g)
(lexical-let ((f f) (g g))
(lambda (&rest arguments)
(funcall f (apply g arguments)))))
more-functions
:initial-value function))
(defun indexed (list)
(loop for el in list as i from 0 collect (list i el)))
(defun rcons (x lst)
(append lst (list x)))
(defmacro rpush (x place)
"Insert X at the back of the list stored in PLACE."
(if (symbolp place) (list 'setq place (list 'rcons x place))
(list 'callf2 'rcons x place)))
(defun range (a &optional b)
(block nil
(let (tmp)
(unless b
(cond ((> a 0) (decf a))
((= a 0) (return nil))
((> 0 a) (incf a)))
(setq b a a 0))
(if (> a b) (setq tmp a a b b tmp))
(let ((res (number-sequence a b)))
(if tmp (nreverse res) res)))))
(defun take (num list) (subseq list 0 num))
(defun set-aget (list key new)
(if (aget list key)
(setf (cdr (assoc key list)) new)
(setf (cdr (last list)) (list (cons key new)))))
(defsetf aget set-aget)
(defmacro until (test &rest body)
(declare (indent 1))
`(while (not ,test) ,@body))
(defun alistp (list)
(and (listp list)
(listp (car list))
(not (listp (caar list)))))
(defun pos-to-index (pos size)
(+ (car pos) (* (cdr pos) size)))
(defun transpose-array (board)
(let ((size (round (sqrt (length board))))
(trans (make-vector (length board) nil)))
(dotimes (row size trans)
(dotimes (col size)
(setf (aref trans (pos-to-index (cons row col) size))
(aref board (pos-to-index (cons col row) size)))))))
(defun ear-muffs (str) (concat "*" str "*"))
(defun un-ear-muffs (str)
(let ((pen-ult (1- (length str))))
(if (and (= ?\* (aref str 0))
(= ?\* (aref str pen-ult)))
(substring str 1 pen-ult)
str)))
(defun char-to-num (char)
(cl-flet ((err () (error "gtp: invalid char %s" char)))
(cond
((< char ?A) (err))
((< char ?I) (- char ?A))
((<= char ?T) (1- (- char ?A)))
((< char ?a) (err))
((< char ?i) (- char ?a))
((<= char ?t) (1- (- char ?a)))
(t (err)))))
(defun num-to-char (num)
(cl-flet ((err () (error "gtp: invalid num %s" num)))
(cond
((< num 1) (err))
((< num 9) (+ ?A (1- num)))
(t (+ ?A num)))))
(defun sym-cat (&rest syms)
(intern (mapconcat #'symbol-name (delq nil syms) "-")))
(defun go-number-p (string)
"If STRING represents a number return its value."
(if (and (string-match "[0-9]+" string)
(string-match "^-?[0-9]*\\.?[0-9]*$" string)
(= (length (substring string (match-beginning 0)
(match-end 0)))
(length string)))
(string-to-number string)))
(defun go-clean-text-properties (string)
(set-text-properties 0 (length string) nil string) string)
(defmacro go-re-cond (string &rest body)
(declare (indent 1))
`(save-match-data
(cond ,@(mapcar
(lambda (part)
(cons (if (or (keywordp (car part)) (eq t (car part)))
(car part)
`(string-match ,(car part) ,string))
(cdr part)))
body))))
(def-edebug-spec go-re-cond (form body))
(defvar *go-partial-line* nil "Holds partial lines of input from a process.")
(defun make-go-insertion-filter (func)
(lexical-let ((func func))
(lambda (proc string)
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
(save-excursion
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point))
(let ((lines (split-string (if *go-partial-line*
(concat *go-partial-line* string)
string)
"[\n\r]")))
(if (string-match "[\n\r]$" (car (last lines)))
(setf *go-partial-line* nil)
(setf *go-partial-line* (car (last lines)))
(setf lines (butlast lines)))
(mapc (lambda (s) (funcall func proc s)) lines)))
(when moving (goto-char (process-mark proc))))))))
(defalias 'go-completing-read (if (fboundp 'org-icompleting-read)
'org-icompleting-read
'completing-read))
(provide 'go-util)
;;; go-util.el ends here

87
elpa/go-20160430.1739/go.el Normal file
View File

@ -0,0 +1,87 @@
;;; go.el --- Play GO, translate and transfer between GO back ends
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Maintainer: Eric Schulte <schulte.eric@gmail.com>
;; Version: 0.0.1
;; Package-Requires: ((emacs "24"))
;; Created: 2012-05-15
;; Keywords: game go sgf
;; URL: http://eschulte.github.io/el-go/
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A board-based interface to GO games which may be connected to a
;; number of GO back-ends through a generic API. To play a game of GO
;; against the gnugo back-end run `play-go'. Current back-ends
;; include the following.
;; - the SGF format
;; - the Go Text Protocol (GTP)
;; - TODO: the IGS protocol
;;; Code:
(let ((load-path
(cons (file-name-directory (or load-file-name (buffer-file-name)))
load-path)))
(require 'go-util "go-util.el")
(require 'go-api "go-api.el")
(require 'go-board "go-board.el")
(require 'go-board-faces "go-board-faces.el")
(require 'gtp "back-ends/gtp.el")
(require 'gnugo "back-ends/gnugo.el")
(require 'sgf "back-ends/sgf.el")
(require 'sgf2el "back-ends/sgf2el.el")
(require 'igs "back-ends/igs.el")
(require 'gtp-pipe "back-ends/gtp-pipe.el"))
(defun go-instantiate (back-end)
(interactive)
;; TODO: read and set handicap.
(let ((it (make-instance back-end))
(size (read (go-completing-read
"board size: "
(mapcar #'number-to-string '(19 13 9))))))
(go-connect it)
(setf (go-size it) size)
it))
;;;###autoload
(defun go-play ()
"Play a game of GO."
(interactive)
(let ((back-end (case (intern (go-completing-read
"play against: " '("gnugo" "person")))
(gnugo (go-instantiate 'gnugo))
(person (go-instantiate 'sgf)))))
(with-current-buffer (apply #'go-board
(cons back-end
(unless (equal (class-of back-end) 'sgf)
(list (make-instance 'sgf)))))
(unless (equal (class-of back-end) 'sgf)
(setq *autoplay* t)))))
;;;###autoload
(defun go-view-sgf (&optional file)
"View an SGF file."
(interactive "fSGF file: ")
(let* ((sgf (make-instance 'sgf :self (sgf2el-file-to-el file) :index '(0)))
(buffer (go-board sgf)))
(with-current-buffer buffer
(setf (index *back-end*) (list 0)))))
(provide 'go)
;;; go.el ends here

192
elpa/go-20160430.1739/list-buffer.el Normal file
View File

@ -0,0 +1,192 @@
;;; list-buffer.el --- view a list as a table in a buffer
;; Copyright (C) 2013 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2013-08-02
;; Version: 0.1
;; Keywords: list buffer cl
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(eval-when-compile (require 'cl))
(require 'go-util)
(defvar *buffer-list* nil
"List associated with the current list buffer.")
(defvar *buffer-headers* nil
"Headers associated with the current list buffer.")
(defvar *buffer-width* nil
"Width associated with the current list buffer.")
(defvar *enter-function* nil
"Function used to enter a list element.
The function should take two arguments, the current row and
column respectively and may access the current buffer list
through the `*buffer-list*' variable.")
(defvar *refresh-function* nil
"Function used to refresh a list element or the whole list.
The function should take two arguments, the current row and
column respectively and may access the current buffer list
through the `*buffer-list*' variable.")
(defun list-buffer-create
(buffer list &optional headers enter-function refresh-function)
(pop-to-buffer buffer)
(list-mode)
(set (make-local-variable '*buffer-width*) (window-total-width))
(set (make-local-variable '*buffer-list*) list)
(set (make-local-variable '*buffer-headers*)
(mapcar (curry #'format "%s") headers))
(set (make-local-variable '*enter-function*)
(or enter-function
(lambda (row col)
(message "enter %S" (nth col (nth row *buffer-list*))))))
(set (make-local-variable '*refresh-function*)
(or refresh-function
(lambda (row col)
(message "refresh %S" (nth col (nth row *buffer-list*))))))
;; refresh every time the buffer changes size
(set (make-local-variable 'window-size-change-functions)
(cons (lambda (b)
(when (or (not (numberp *buffer-width*))
(not (equal *buffer-width* (window-total-width))))
(set '*buffer-width* (window-total-width))
(list-buffer-refresh)))
window-size-change-functions))
(goto-char (point-min))
(list-buffer-refresh))
(defun list-format-row (widths row &optional row-num)
(cl-flet ((num (type number string)
(put-text-property 0 (length string) type number string)
string))
(let ((col 0))
(num :row row-num
(apply #'concat
(cl-mapcar
(lambda (width cell)
(prog1
(num :col col
(if (< (length cell) width)
(concat cell
(make-list (- width (length cell))
?\ ))
(concat (subseq cell 0 (- width 2)) "… ")))
(incf col)))
widths row))))))
(defun list-buffer-refresh ()
(when *buffer-list*
(let* ((start (point))
(strings (mapcar (curry #'mapcar (curry #'format "%s")) *buffer-list*))
(lengths (mapcar (curry #'mapcar #'length)
(if *buffer-headers*
(cons *buffer-headers* strings)
strings)))
(widths (apply #'cl-mapcar (compose '1+ #'max) lengths))
;; scale widths by buffer width
(widths (mapcar (compose #'floor (curry #'* (/ (window-total-width)
(float (apply #'+ widths)))))
widths)))
;; write headers
(when *buffer-headers*
(set (make-local-variable 'header-line-format)
(concat " " (list-format-row widths *buffer-headers*))))
;; write rows
(delete-region (point-min) (point-max))
(insert (mapconcat (compose (curry #'apply #'list-format-row widths) #'reverse)
(indexed strings) "\n"))
(goto-char start))))
(defun list-buffer-sort (col predicate)
(set '*buffer-list* (cl-sort *buffer-list* predicate :key (curry #'nth col)))
(list-buffer-refresh))
(defun list-current-row () (get-text-property (point) :row))
(defun list-current-col () (get-text-property (point) :col))
(defun list< (a b)
(cond
((and (numberp a) (numberp b) (< a b)))
((and (stringp a) (stringp b) (string< a b)))))
(defun list> (a b)
(cond
((and (numberp a) (numberp b) (> a b)))
((and (stringp a) (stringp b) (string> a b)))))
(defun list-up ()
(interactive)
(list-buffer-sort (get-text-property (point) :col) #'list<))
(defun list-down ()
(interactive)
(list-buffer-sort (get-text-property (point) :col) #'list>))
(defun list-enter ()
(interactive)
(funcall *enter-function* (list-current-row) (list-current-col)))
(defun list-refresh ()
(interactive)
(funcall *refresh-function* (list-current-row) (list-current-col)))
(defun list-filter ()
(interactive)
(error "not implemented."))
(defun list-move-col (direction)
(cl-flet ((col () (or (get-text-property (point) :col) start-col)))
(let ((start-col (col)))
(while (= start-col (col))
(case direction
(:forward (forward-char))
(:backward (backward-char))))
(when (eql direction :backward)
(let ((end-col (col)))
(while (= end-col (col)) (backward-char))
(forward-char))))))
(defun list-next-col () (interactive) (list-move-col :forward))
(defun list-prev-col () (interactive) (list-move-col :backward))
(defvar list-mode-map
(let ((map (make-sparse-keymap)))
;; navigation
(define-key map (kbd "j") 'next-line)
(define-key map (kbd "k") 'previous-line)
(define-key map (kbd "u") 'scroll-down-command)
(define-key map (kbd "<tab>") 'list-next-col)
(define-key map (kbd "<S-iso-lefttab>") 'list-prev-col)
;; list functions
(define-key map (kbd "<up>") 'list-up)
(define-key map (kbd "<down>") 'list-down)
(define-key map (kbd "f") 'list-filter)
(define-key map (kbd "r") 'list-refresh)
(define-key map (kbd "RET") 'list-enter)
(define-key map (kbd "q") 'bury-buffer)
map)
"Keymap for `list-mode'.")
(define-derived-mode list-mode nil "list"
"Major mode for viewing a list.")
(provide 'list-buffer)
;;; list-buffer.el ends here

BIN
elpa/go-20160430.1739/stone.wav Normal file
View File

Binary file not shown.

15
elpa/google-20140416.1048/google-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; google-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("google.el") (22490 28016 208413 956000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; google-autoloads.el ends here

1
elpa/google-20140416.1048/google-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "google" "20140416.1048" "Emacs interface to the Google API" 'nil :keywords '("comm" "processes" "tools"))

181
elpa/google-20140416.1048/google.el Normal file
View File

@ -0,0 +1,181 @@
;;; google.el --- Emacs interface to the Google API
;; Copyright (C) 2002, 2008 Edward O'Connor <ted@oconnor.cx>
;; Author: Edward O'Connor <ted@oconnor.cx>
;; Keywords: comm, processes, tools
;; Package-Version: 20140416.1048
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; You should always be able to find the latest version here:
;; <URL:http://github.com/hober/google-el/>
;; A really bare-bones first hack at Google API support for Emacs.
;; Note that you need a Google license key to use this; you can
;; get one by following the instructions here:
;; <URL:http://code.google.com/apis/ajaxsearch/signup.html>
;; Usage:
;; (require 'google)
;; (setq google-license-key "my license key" ; optional
;; google-referer "my url") ; required!
;; (google-search-video "rickroll")
;;; History:
;; 2002 or thereabouts: Initial version, which used the SOAP API.
;; 2008-04-24: Use the AJAX Search API instead of the SOAP API.
;; N.B., incompatible API changes galore!
;; 2008-05-01: Some convenience functions for parsing search result
;; blobs. Passes checkdoc now.
;;; Code:
(require 'json)
(require 'url)
(defvar url-http-end-of-headers)
(defgroup google nil
"Emacs interface to Google's AJAX Search API."
:group 'tools)
(defcustom google-license-key nil
"*Your Google license key.
This is optional. However, if you do specify it, it should correspond to
your `google-referer'."
:type '(string)
:group 'google)
(defcustom google-referer nil
"*The referer to send when performing Google searches.
Note that this is required by Google's terms of service."
:type '(string)
:group 'google)
(defun google-response (buf)
"Extract the JSON response from BUF."
(with-current-buffer buf
(setq case-fold-search nil)
(save-excursion
(goto-char (point-min))
(when (re-search-forward "charset=utf-8" nil t)
(set-buffer-multibyte t)))
(goto-char url-http-end-of-headers)
(prog1 (json-read)
(kill-buffer buf))))
(defun google-search (terms &optional start search-domain)
"Search for TERMS.
START, if non-null, is the search result number to start at.
SEARCH-DOMAIN can be one of \"web\", \"local\", \"video\",
\"blogs\", \"news\", \"books\", or \"images\"."
(let ((url-package-name "google.el")
(url-request-extra-headers
`(("Accept" . "application/json")
("Referer" . ,google-referer)))
(args `(("q" . ,terms)
("v" . "1.0"))))
(unless search-domain
(setq search-domain "web"))
(when google-license-key
(add-to-list 'args (cons "key" google-license-key)))
(when start
(add-to-list 'args (cons "start" start)))
(google-response
(url-retrieve-synchronously
(format
"http://ajax.googleapis.com/ajax/services/search/%s?%s"
search-domain
(mapconcat (lambda (cons)
(format "%s=%s"
(url-hexify-string (car cons))
(url-hexify-string (cdr cons))))
args
"&"))))))
(defmacro define-google-search-domain (domain)
"Define a google search function for DOMAIN, a keyword."
(setq domain (substring (symbol-name domain) 1))
(let ((func (intern (concat "google-search-" domain))))
`(defun ,func (terms &optional start)
,(format "Search %s with Google!
Results look like so:
\((responseStatus . N)
(responseDetails)
(responseData
(cursor
(moreResultsUrl . URL)
(currentPageIndex . N)
(estimatedResultCount . N)
(pages .
[((label . N)
(start . N))
..]))
(results .
[((content . STR)
(titleNoFormatting . STR)
(title . STR)
(cacheUrl . URL)
(visibleUrl . URL)
(url . URL)
(unescapedUrl . URL)
(GsearchResultClass . STR))
..])))
There are several utilities for extracting data from this structure; see
`google-result-field', `google-result-urls', and
`google-result-more-results-url'."
(if (string= domain "web") "the web" domain))
(google-search terms start ,domain))))
(define-google-search-domain :web)
(define-google-search-domain :local)
(define-google-search-domain :video)
(define-google-search-domain :blogs)
(define-google-search-domain :news)
(define-google-search-domain :books)
(define-google-search-domain :images)
;;; Parsing google search results
(defsubst google-result-field (key json)
"Fetch KEY's value from JSON, a parsed JSON structure."
(cdr (assoc key json)))
(defun google-result-urls (results)
"Extract a list of search result URLs from RESULTS."
(let* ((responseData (google-result-field 'responseData results))
(records (google-result-field 'results responseData)))
(mapcar (lambda (record)
(google-result-field 'url record))
records)))
(defun google-result-more-results-url (results)
"Extract the URL for more search RESULTS."
(let* ((responseData (google-result-field 'responseData results))
(cursor (google-result-field 'cursor responseData)))
(google-result-field 'moreResultsUrl cursor)))
(provide 'google)
;;; google.el ends here

22
elpa/helm-chrome-20160718.2220/helm-chrome-autoloads.el Normal file
View File

@ -0,0 +1,22 @@
;;; helm-chrome-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-chrome" "helm-chrome.el" (22490 28021
;;;;;; 832685 725000))
;;; Generated autoloads from helm-chrome.el
(autoload 'helm-chrome-bookmarks "helm-chrome" "\
Search Chrome Bookmark using `helm'.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-chrome-autoloads.el ends here

1
elpa/helm-chrome-20160718.2220/helm-chrome-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-chrome" "20160718.2220" "Helm interface for Chrome bookmarks" '((helm "1.5") (cl-lib "0.3") (emacs "24")) :url "https://github.com/kawabata/helm-chrome" :keywords '("tools"))

137
elpa/helm-chrome-20160718.2220/helm-chrome.el Normal file
View File

@ -0,0 +1,137 @@
;;; helm-chrome.el --- Helm interface for Chrome bookmarks -*- lexical-binding: t -*-
;; Filename: helm-chrome.el
;; Description: Helm interface for Chrome bookmarks
;; Author: KAWABATA, Taichi <kawabata.taichi_at_gmail.com>
;; Created: 2013-12-25
;; Version: 1.151223
;; Package-Version: 20160718.2220
;; Package-Requires: ((helm "1.5") (cl-lib "0.3") (emacs "24"))
;; Keywords: tools
;; Human-Keywords: chrome bookmarks
;; URL: https://github.com/kawabata/helm-chrome
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Helm interface for Chrome bookmarks.
;;
;; Warning: Multiple bookmarks with the same name will be overridden.
;; This restriction is for better performance. If we use Bookmark IDs with
;; candidate-transformer, then the speed would be quite slow.
;;
;; It's also possible to scan through urls of the bookmarks.
;; To do so one need to customize helm-chrome-use-urls variable
;; for the helm-chrome group or just set it's value in config file:
;; (setq helm-chrome-use-urls t).
;; Then reload bookmarks using function helm-chrome-reload-bookmarks.
;;
;; Warning: On a big number of bookmark it may be quite slow.
;;; Code:
(require 'helm)
(require 'cl-lib)
(require 'json)
(defgroup helm-chrome nil
"Helm interface for Chrome Bookmarks."
:group 'helm)
(defcustom helm-chrome-file
(car
(cl-delete-if-not
'file-exists-p
`("~/Library/Application Support/Google/Chrome/Default/Bookmarks"
"~/AppData/Local/Google/Chrome/User Data/Default/Bookmarks"
"~/.config/google-chrome/Default/Bookmarks"
"~/.config/chromium/Default/Bookmarks"
,(substitute-in-file-name
"$LOCALAPPDATA/Google/Chrome/User Data/Default/Bookmarks")
,(substitute-in-file-name
"$USERPROFILE/Local Settings/Application Data/Google/Chrome/User Data/Default/Bookmarks")
)))
"The bookmark file for Chrome."
:group 'helm-chrome
:type 'file)
(defcustom helm-chrome-use-urls nil
"Use bookmark urls as source of the data for helm"
:group 'helm-chrome
:type 'boolean)
(defvar helm-chrome--json nil)
(defvar helm-chrome--bookmarks nil)
(defun helm-chrome--add-bookmark (json)
"Add bookmarks from JSON."
(when (and (listp json) (listp (cdr json)))
(cond
((assoc 'roots json)
(dolist (item (cdr (assoc 'roots json)))
(helm-chrome--add-bookmark item)))
((equal (cdr (assoc 'type json)) "folder")
(cl-loop for item across (cdr (assoc 'children json))
do (helm-chrome--add-bookmark item)))
((equal (cdr (assoc 'type json)) "url")
(let ((helm-chrome-name
(if (and helm-chrome-use-urls
(string-prefix-p "http" (cdr (assoc 'url json))) t)
(concat (cdr (assoc 'name json)) " [" (cdr (assoc 'url json)) "]")
(cdr (assoc 'name json)))))
(puthash
helm-chrome-name
(cdr (assoc 'url json))
helm-chrome--bookmarks)))
)))
(defun helm-chrome-reload-bookmarks ()
"Reload Chrome bookmarks."
(interactive)
(unless (file-exists-p helm-chrome-file)
(error "File %s does not exist" helm-chrome-file))
(setq helm-chrome--json (json-read-file helm-chrome-file))
(setq helm-chrome--bookmarks (make-hash-table :test 'equal))
(helm-chrome--add-bookmark helm-chrome--json))
(defvar helm-chrome-source
(helm-build-in-buffer-source "Chrome::Bookmarks"
:init (lambda () (unless helm-chrome--json
(helm-chrome-reload-bookmarks)))
:data (lambda ()
(cl-loop for name being the hash-keys of helm-chrome--bookmarks
collect name))
:candidate-number-limit 9999
:coerce (lambda (candidate) (gethash candidate helm-chrome--bookmarks))
:action '(("Browse URL(s)" . (lambda (_candidate)
(mapc #'browse-url (helm-marked-candidates))))
("Show URL" . message))))
;;;###autoload
(defun helm-chrome-bookmarks ()
"Search Chrome Bookmark using `helm'."
(interactive)
(helm :sources 'helm-chrome-source
:prompt "Find Bookmark: "
:buffer "*helm chrome bookmarks*"))
(provide 'helm-chrome)
;;; helm-chrome.el ends here
;; Local Variables:
;; time-stamp-pattern: "10/Version:\\\\?[ \t]+1.%02y%02m%02d\\\\?\n"
;; End:

23
elpa/helm-company-20160516.2258/helm-company-autoloads.el Normal file
View File

@ -0,0 +1,23 @@
;;; helm-company-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-company" "helm-company.el" (22490 28021
;;;;;; 120689 316000))
;;; Generated autoloads from helm-company.el
(autoload 'helm-company "helm-company" "\
Select `company-complete' candidates by `helm'.
It is useful to narrow candidates.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-company-autoloads.el ends here

1
elpa/helm-company-20160516.2258/helm-company-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-company" "20160516.2258" "Helm interface for company-mode" '((helm "1.5.9") (company "0.6.13")) :url "https://github.com/yasuyk/helm-company")

195
elpa/helm-company-20160516.2258/helm-company.el Normal file
View File

@ -0,0 +1,195 @@
;;; helm-company.el --- Helm interface for company-mode
;; Copyright (C) 2013 Yasuyuki Oka <yasuyk@gmail.com>
;; Author: Yasuyuki Oka <yasuyk@gmail.com>
;; Version: 0.1.1
;; Package-Version: 20160516.2258
;; URL: https://github.com/yasuyk/helm-company
;; Package-Requires: ((helm "1.5.9") (company "0.6.13"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Add the following to your Emacs init file:
;;
;; (autoload 'helm-company "helm-company") ;; Not necessary if using ELPA package
;; (eval-after-load 'company
;; '(progn
;; (define-key company-mode-map (kbd "C-:") 'helm-company)
;; (define-key company-active-map (kbd "C-:") 'helm-company)))
;;; Code:
(require 'helm)
(require 'helm-multi-match)
(require 'helm-files)
(require 'helm-elisp) ;; For with-helm-show-completion
(require 'company)
(defgroup helm-company nil
"Helm interface for company-mode."
:prefix "helm-company-"
:group 'helm)
(defcustom helm-company-candidate-number-limit 300
"Limit candidate number of `helm-company'.
Set it to nil if you don't want this limit."
:group 'helm-company
:type '(choice (const :tag "Disabled" nil) integer))
(defvar helm-company-help-window nil)
(defvar helm-company-backend nil)
(defun helm-company-call-backend (&rest args)
"Bridge between helm-company and company"
(let ((company-backend helm-company-backend))
(apply 'company-call-backend args)))
(defun helm-company-init ()
"Prepare helm for company."
(helm-attrset 'company-candidates company-candidates)
(helm-attrset 'company-common company-common)
(setq helm-company-help-window nil)
(if (<= (length company-candidates) 1)
(helm-exit-minibuffer)
(setq helm-company-backend company-backend
helm-company-candidates company-candidates))
(company-abort))
(defun helm-company-action-insert (candidate)
"Insert CANDIDATE."
(delete-char (- (length (helm-attr 'company-common))))
(insert candidate)
;; for GC
(helm-attrset 'company-candidates nil))
(defun helm-company-action-show-document (candidate)
"Show the documentation of the CANDIDATE."
(interactive)
(let ((selection (cl-find-if (lambda (s) (string-match-p candidate s)) helm-company-candidates))
(buffer (helm-company-call-backend 'doc-buffer selection)))
(when buffer
(display-buffer buffer))))
(defun helm-company-show-doc-buffer (candidate)
"Temporarily show the documentation buffer for the CANDIDATE."
(interactive)
(let* ((selection (cl-find-if (lambda (s) (string-match-p candidate s)) helm-company-candidates))
(buffer (helm-company-call-backend 'doc-buffer selection)))
(when buffer
(if (and helm-company-help-window
(window-live-p helm-company-help-window))
(with-selected-window helm-company-help-window
(helm-company-display-persistent-buffer buffer))
(setq helm-company-help-window
(helm-company-display-persistent-buffer buffer))))))
(defun helm-company-find-location (candidate)
"Find location of CANDIDATE."
(interactive)
(let* ((selection (cl-find-if (lambda (s) (string-match-p candidate s)) helm-company-candidates))
(location (save-excursion (helm-company-call-backend 'location selection)))
(pos (or (cdr location) (error "No location available")))
(buffer (or (and (bufferp (car location)) (car location))
(find-file-noselect (car location) t))))
(with-selected-window (display-buffer buffer t)
(save-restriction
(widen)
(if (bufferp (car location))
(goto-char pos)
(goto-char (point-min))
(forward-line (1- pos))))
(set-window-start nil (point)))))
(defun helm-company-display-document-buffer (buffer)
"Temporarily show the documentation BUFFER."
(with-current-buffer buffer
(goto-char (point-min)))
(display-buffer buffer
'((display-buffer-same-window . t)
(display-buffer-reuse-window . t))))
(defmacro helm-company-run-action (&rest body)
`(with-helm-window
(save-selected-window
(with-helm-display-same-window
,@body))))
(defun helm-company-run-show-doc-buffer ()
"Run showing documentation action from `helm-company'."
(interactive)
(helm-company-run-action
(helm-company-show-doc-buffer (helm-get-selection))))
(defun helm-company-run-show-location ()
"Run showing location action from `helm-company'."
(interactive)
(helm-company-run-action
(helm-company-find-location (helm-get-selection))))
(defvar helm-company-map
(let ((keymap (make-sparse-keymap)))
(set-keymap-parent keymap helm-map)
(define-key keymap (kbd "M-s") 'helm-company-run-show-location)
(define-key keymap (kbd "C-s") 'helm-company-run-show-doc-buffer)
(delq nil keymap))
"Keymap used in Company sources.")
(defvar helm-company-actions
'(("Insert" . helm-company-action-insert)
("Show documentation (If available)" . helm-company-action-show-document)
("Find location (If available)" . helm-company-find-location))
"Actions for `helm-company'.")
(defcustom helm-company-fuzzy-match t
"Enable fuzzy matching for Helm Company."
:type 'boolean)
(defvar helm-source-company
(helm-build-in-buffer-source "Company"
:data (lambda ()
(helm-company-init)
(helm-attr 'company-candidates))
:fuzzy-match helm-company-fuzzy-match
:keymap helm-company-map
:persistent-action 'helm-company-show-doc-buffer
:persistent-help "Show documentation (If available)"
:action helm-company-actions)
"Helm source definition for recent files in current project.")
;;;###autoload
(defun helm-company ()
"Select `company-complete' candidates by `helm'.
It is useful to narrow candidates."
(interactive)
(unless company-candidates
(company-complete))
(when company-point
(company-complete-common)
(helm :sources 'helm-source-company
:buffer "*helm company*"
:candidate-number-limit helm-company-candidate-number-limit)))
(provide 'helm-company)
;; Local Variables:
;; coding: utf-8
;; eval: (setq byte-compile-not-obsolete-vars '(display-buffer-function))
;; eval: (checkdoc-minor-mode 1)
;; End:
;;; helm-company.el ends here

22
elpa/helm-flycheck-20160710.129/helm-flycheck-autoloads.el Normal file
View File

@ -0,0 +1,22 @@
;;; helm-flycheck-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-flycheck" "helm-flycheck.el" (22490 28020
;;;;;; 712691 375000))
;;; Generated autoloads from helm-flycheck.el
(autoload 'helm-flycheck "helm-flycheck" "\
Show flycheck errors with `helm'.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-flycheck-autoloads.el ends here

1
elpa/helm-flycheck-20160710.129/helm-flycheck-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-flycheck" "20160710.129" "Show flycheck errors with helm" '((dash "2.12.1") (flycheck "28") (helm-core "1.9.8")) :url "https://github.com/yasuyk/helm-flycheck" :keywords '("helm" "flycheck"))

197
elpa/helm-flycheck-20160710.129/helm-flycheck.el Normal file
View File

@ -0,0 +1,197 @@
;;; helm-flycheck.el --- Show flycheck errors with helm
;; Copyright (C) 2013-2016 Yasuyuki Oka <yasuyk@gmail.com>
;; Author: Yasuyuki Oka <yasuyk@gmail.com>
;; Version: 0.4
;; Package-Version: 20160710.129
;; URL: https://github.com/yasuyk/helm-flycheck
;; Package-Requires: ((dash "2.12.1") (flycheck "28") (helm-core "1.9.8"))
;; Keywords: helm, flycheck
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Installation:
;; Add the following to your Emacs init file:
;;
;; (require 'helm-flycheck) ;; Not necessary if using ELPA package
;; (eval-after-load 'flycheck
;; '(define-key flycheck-mode-map (kbd "C-c ! h") 'helm-flycheck))
;; That's all.
;;; Code:
(require 'dash)
(require 'flycheck)
(require 'helm)
(defvar helm-source-flycheck
'((name . "Flycheck")
(init . helm-flycheck-init)
(candidates . helm-flycheck-candidates)
(action-transformer helm-flycheck-action-transformer)
(multiline)
(action . (("Go to" . helm-flycheck-action-goto-error)))
(follow . 1)))
(defvar helm-flycheck-candidates nil)
(defconst helm-flycheck-status-message-no-errors
"There are no errors in the current buffer.")
(defconst helm-flycheck-status-message-syntax-checking
"Syntax checking now. Do action to reexecute `helm-flycheck'.")
(defconst helm-flycheck-status-message-checker-not-found
"A suitable syntax checker is not found. \
See Selection in flycheck manual, for more information.")
(defconst helm-flycheck-status-message-failed
"The syntax check failed. Inspect the *Messages* buffer for details.")
(defconst helm-flycheck-status-message-dubious
"The syntax check had a dubious result. \
Inspect the *Messages* buffer for details.")
(defun helm-flycheck-init ()
"Initialize `helm-source-flycheck'."
(setq helm-flycheck-candidates
(if (flycheck-has-current-errors-p)
(mapcar 'helm-flycheck-make-candidate
(sort flycheck-current-errors #'flycheck-error-<))
(list (helm-flycheck-status-message)))))
(defun helm-flycheck-status-message ()
"Return message about `flycheck' STATUS."
(cond ((equal flycheck-last-status-change 'finished)
helm-flycheck-status-message-no-errors)
((equal flycheck-last-status-change 'running)
helm-flycheck-status-message-syntax-checking)
((equal flycheck-last-status-change 'no-checker)
helm-flycheck-status-message-checker-not-found)
((equal flycheck-last-status-change 'errored)
helm-flycheck-status-message-failed)
((equal flycheck-last-status-change 'suspicious)
helm-flycheck-status-message-dubious)))
(defun helm-flycheck-make-candidate (error)
"Return a cons constructed from string of message and ERROR."
(cons (helm-flycheck-candidate-display-string error) error))
(defun helm-flycheck-candidate-display-string (error)
"Return a string of message constructed from ERROR."
(let ((face (-> error
flycheck-error-level
flycheck-error-level-error-list-face)))
(format "%5s %3s%8s %s"
(propertize (number-to-string (flycheck-error-line error)) 'font-lock-face 'flycheck-error-list-line-number)
(-if-let (column (flycheck-error-column error))
(propertize (number-to-string column) 'font-lock-face 'flycheck-error-list-column-number) "")
(propertize (symbol-name (flycheck-error-level error))
'font-lock-face face)
(or (flycheck-error-message error) ""))))
(defun helm-flycheck-action-transformer (actions candidate)
"Return modified ACTIONS if CANDIDATE is status message."
(if (stringp candidate)
(cond ((string= candidate helm-flycheck-status-message-no-errors) nil)
((string= candidate helm-flycheck-status-message-syntax-checking)
'(("Reexecute helm-flycheck" . helm-flycheck-action-reexecute)))
((string= candidate helm-flycheck-status-message-checker-not-found)
'(("Enter info of Syntax checker selection" .
helm-flycheck-action-selection-info)))
((or (string= candidate helm-flycheck-status-message-failed)
(string= candidate helm-flycheck-status-message-dubious))
'(("Switch to *Messages*" .
helm-flycheck-action-switch-to-messages-buffer))))
actions))
(defun helm-flycheck-action-goto-error (candidate)
"Visit error of CANDIDATE."
(let ((buffer (flycheck-error-buffer candidate))
(lineno (flycheck-error-line candidate))
error-pos)
(with-current-buffer buffer
(switch-to-buffer buffer)
(goto-char (point-min))
(forward-line (1- lineno))
(setq error-pos
(car
(->> (flycheck-overlays-in
(point)
(save-excursion (forward-line 1) (point)))
(-map #'overlay-start)
-uniq
(-sort #'<=))))
(goto-char error-pos)
(let ((recenter-redisplay nil))
(recenter)))))
(defun helm-flycheck-action-reexecute (candidate)
"Reexecute `helm-flycheck' without CANDIDATE."
(catch 'exit
(helm-run-after-exit 'helm-flycheck)))
(defun helm-flycheck-action-switch-to-messages-buffer (candidate)
"Switch to *Messages* buffer without CANDIDATE."
(switch-to-buffer "*Messages*"))
(defun helm-flycheck-action-selection-info (candidate)
"Enter info of flycheck syntax checker selection without CANDIDATE."
(info "(flycheck)Top > Usage > Selection"))
(defun helm-flycheck-preselect ()
"PreSelect nearest error from the current point."
(let* ((point (point))
(overlays-at-point (flycheck-overlays-at point))
candidates nearest-point)
(if overlays-at-point
(helm-flycheck-candidate-display-string
(car (flycheck-overlay-errors-at point)))
(setq candidates (->> (flycheck-overlays-in (point-min) (point-max))
(-map #'overlay-start)
-uniq))
(setq nearest-point (helm-flycheck-nearest-point point candidates))
(when nearest-point
(helm-flycheck-candidate-display-string
(car (flycheck-overlay-errors-at nearest-point)))))))
(defun helm-flycheck-nearest-point (current-point points)
"Return nearest point from CURRENT-POINT in POINTS."
(--tree-reduce-from
(if (< (abs (- current-point it)) (abs (- current-point acc)))
it acc) (car points) points))
;;;###autoload
(defun helm-flycheck ()
"Show flycheck errors with `helm'."
(interactive)
(unless flycheck-mode
(user-error "Flycheck mode not enabled"))
(helm :sources 'helm-source-flycheck
:buffer "*helm flycheck*"
:preselect (helm-flycheck-preselect)))
(provide 'helm-flycheck)
;; Local Variables:
;; coding: utf-8
;; End:
;;; helm-flycheck.el ends here

22
elpa/helm-google-20160620.1149/helm-google-autoloads.el Normal file
View File

@ -0,0 +1,22 @@
;;; helm-google-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-google" "helm-google.el" (22490 28016
;;;;;; 516712 673000))
;;; Generated autoloads from helm-google.el
(autoload 'helm-google "helm-google" "\
Preconfigured `helm' : Google search.
\(fn &optional ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-google-autoloads.el ends here

1
elpa/helm-google-20160620.1149/helm-google-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-google" "20160620.1149" "Emacs Helm Interface for quick Google searches" '((helm "0") (google "0")) :url "https://github.com/steckerhalter/helm-google" :keywords '("helm" "google" "search" "browse"))

255
elpa/helm-google-20160620.1149/helm-google.el Normal file
View File

@ -0,0 +1,255 @@
;;; helm-google.el --- Emacs Helm Interface for quick Google searches
;; Copyright (C) 2014, Steckerhalter
;; Author: steckerhalter
;; Package-Requires: ((helm "0") (google "0"))
;; Package-Version: 20160620.1149
;; URL: https://github.com/steckerhalter/helm-google
;; Keywords: helm google search browse
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Emacs Helm Interface for quick Google searches
;;; Code:
(require 'helm)
(require 'helm-net)
(require 'google)
(defgroup helm-google '()
"Customization group for `helm-google'."
:link '(url-link "http://github.com/steckerhalter/helm-google")
:group 'convenience
:group 'comm)
(defcustom helm-google-search-function 'helm-google-html-search
"The function that should be used to get the search results.
Available functions are currently `helm-google-api-search' and
`helm-google-html-search'."
:type 'symbol
:group 'helm-google)
(defcustom helm-google-tld "com"
"The TLD of the google url to be used (com, de, fr, co.uk etc.)."
:type 'string
:group 'helm-google)
(defcustom helm-google-use-regexp-parsing nil
"Force use of regexp html parsing even if libxml is available."
:type 'boolean
:group 'helm-google)
(defcustom helm-google-actions
'(("Browse URL" . browse-url)
("Browse URL with EWW" . (lambda (candidate)
(eww-browse-url
(helm-google-display-to-real candidate)))))
"List of actions for helm-google sources."
:group 'helm-google
:type '(alist :key-type string :value-type function))
(defvar helm-google-input-history nil)
(defvar helm-google-pending-query nil)
(defun helm-google-url ()
"URL to google searches.
If 'com' TLD is set use 'encrypted' subdomain to avoid country redirects."
(concat "https://"
(if (string= "com" helm-google-tld)
"encrypted"
"www")
".google."
helm-google-tld
"/search?ie=UTF-8&oe=UTF-8&q=%s"))
(defun helm-google--process-html (html)
(replace-regexp-in-string
"\n" ""
(with-temp-buffer
(insert html)
(html2text)
(buffer-substring-no-properties (point-min) (point-max)))))
(defmacro helm-google--with-buffer (buf &rest body)
(declare (doc-string 3) (indent 2))
`(with-current-buffer ,buf
(set-buffer-multibyte t)
(goto-char url-http-end-of-headers)
(prog1 ,@body
(kill-buffer ,buf))))
(defun helm-google--parse-w/regexp (buf)
(helm-google--with-buffer buf
(let (results result)
(while (re-search-forward "class=\"r\"><a href=\"/url\\?q=\\(.*?\\)&amp;sa" nil t)
(setq result (plist-put result :url (match-string-no-properties 1)))
(re-search-forward "\">\\(.*?\\)</a></h3>" nil t)
(setq result (plist-put result :title (helm-google--process-html (match-string-no-properties 1))))
(re-search-forward "class=\"st\">\\([\0-\377[:nonascii:]]*?\\)</span>" nil t)
(setq result (plist-put result :content (helm-google--process-html (match-string-no-properties 1))))
(add-to-list 'results result t)
(setq result nil))
results)))
(defun helm-google--tree-search (tree)
(pcase tree
(`(,x . ,y) (or (and (null y) nil)
(and (eql x 'div)
(string= (xml-get-attribute tree 'id) "ires")
(pcase-let* ((`(_ _ . ,ol) tree)
(`(_ _ . ,items) (car ol)))
items))
(helm-google--tree-search x)
(helm-google--tree-search y)))))
(defun helm-google--parse-w/libxml (buf)
(let* ((xml (helm-google--with-buffer buf
(libxml-parse-html-region
(point-min) (point-max))))
(items (helm-google--tree-search xml))
(get-string (lambda (element)
(mapconcat (lambda (e)
(if (listp e) (car (last e)) e))
element "")))
(fix-url (lambda (str)
(concat "https://www.google." helm-google-tld str)))
results)
(dolist (item items results)
(add-to-list 'results
(list :title (funcall get-string (cddr (assoc 'a (assoc 'h3 item))))
:cite (funcall get-string (cddr (assoc 'cite (assoc 'div (assoc 'div item)))))
:url (funcall fix-url (cdr (assoc 'href (cadr (assoc 'a (assoc 'h3 item))))))
:content (helm-google--process-html
(funcall get-string (cddr (assoc 'span (assoc 'div item))))))
t))))
(defun helm-google--parse (buf)
"Extract the search results from BUF."
(if (or helm-google-use-regexp-parsing
(not (fboundp 'libxml-parse-html-region)))
(helm-google--parse-w/regexp buf)
(helm-google--parse-w/libxml buf)))
(defun helm-google--response-buffer-from-search (text &optional search-url)
(let ((url-mime-charset-string "utf-8")
(url (format (or search-url (helm-google-url)) (url-hexify-string text))))
(url-retrieve-synchronously url t)))
(defun helm-google--search (text)
(let* ((buf (helm-google--response-buffer-from-search text))
(results (helm-google--parse buf)))
results))
(defun helm-google-html-search ()
"Get Google results by scraping the website.
This is better than using the deprecated API. It gives more
results but is tied to the html output so any change Google
makes can break the results."
(let* ((results (helm-google--search helm-pattern)))
(mapcar (lambda (result)
(let ((cite (plist-get result :cite)))
(concat
(propertize
(plist-get result :title)
'face 'font-lock-variable-name-face)
"\n"
(plist-get result :content)
"\n"
(when cite
(concat
(propertize
cite
'face 'link)
"\n"))
(propertize
(plist-get result :url)
'face (if cite 'glyphless-char 'link)))))
results)))
(defun helm-google-api-search ()
"Get Google results using the `google.el' library.
Since the API this library uses is deprecated it is not very reliable."
(let* ((results (google-search helm-pattern))
(responseData (google-result-field 'responseData results))
(records (google-result-field 'results responseData)))
(mapcar (lambda (record)
(concat
(propertize
(google-result-field 'titleNoFormatting record)
'face 'font-lock-variable-name-face)
"\n"
(replace-regexp-in-string
"\n" ""
(with-temp-buffer
(insert (google-result-field 'content record))
(html2text)
(buffer-substring-no-properties (point-min) (point-max))))
"\n"
(propertize
(url-unhex-string (google-result-field 'url record))
'face 'link)))
records)))
(defun helm-google-search ()
"Invoke the search function set by `helm-google-search-function'."
(funcall helm-google-search-function))
(defun helm-google-display-to-real (candidate)
"Retrieve the URL from the results for the action."
(car (last (split-string candidate "[\n]+"))))
(defvar helm-source-google
`((name . "Google")
(init . (lambda () (require 'google)))
(action . helm-google-actions)
(display-to-real . helm-google-display-to-real)
(candidates . helm-google-search)
(requires-pattern)
(nohighlight)
(multiline)
(volatile)))
;;;###autoload
(defun helm-google ( &optional arg)
"Preconfigured `helm' : Google search."
(interactive)
(let ((google-referer "https://github.com/steckerhalter/helm-google")
(region
(if (not arg)
(when (use-region-p)
(buffer-substring-no-properties
(region-beginning)
(region-end)))
arg))
(helm-input-idle-delay 0.3))
(helm :sources 'helm-source-google
:prompt "Google: "
:input region
:buffer "*helm google*"
:history 'helm-google-input-history)))
(add-to-list 'helm-google-suggest-actions
'("Helm-Google" . (lambda (candidate)
(helm-google candidate))))
(provide 'helm-google)
;;; helm-google.el ends here

24
elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el Normal file
View File

@ -0,0 +1,24 @@
;;; helm-spotify-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-spotify" "helm-spotify.el" (22490 28015
;;;;;; 820716 223000))
;;; Generated autoloads from helm-spotify.el
(defvar helm-source-spotify-track-search '((name . "Spotify") (volatile) (delayed) (multiline) (requires-pattern . 2) (candidates-process . helm-spotify-search) (action-transformer . helm-spotify-actions-for-track)))
(autoload 'helm-spotify "helm-spotify" "\
Bring up a Spotify search interface in helm.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-spotify-autoloads.el ends here

1
elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-spotify" "20160905.1447" "Control Spotify with Helm." '((helm "0.0.0") (multi "2.0.0")) :url "https://github.com/krisajenkins/helm-spotify" :keywords '("helm" "spotify"))

132
elpa/helm-spotify-20160905.1447/helm-spotify.el Normal file
View File

@ -0,0 +1,132 @@
;;; helm-spotify.el --- Control Spotify with Helm.
;; Copyright 2013 Kris Jenkins
;;
;; Author: Kris Jenkins <krisajenkins@gmail.com>
;; Maintainer: Kris Jenkins <krisajenkins@gmail.com>
;; Keywords: helm spotify
;; Package-Version: 20160905.1447
;; URL: https://github.com/krisajenkins/helm-spotify
;; Created: 14th October 2013
;; Version: 0.1.1
;; Package-Requires: ((helm "0.0.0") (multi "2.0.0"))
;;; Commentary:
;;
;; A search & play interface for Spotify.
;;
;; Currently supports OSX, Linux & Windows.
;;
;; (Want support for another platform? There's a guide in the github README.)
;;; Code:
;;; API Reference: https://developer.spotify.com/technologies/web-api/
(require 'url)
(require 'json)
(require 'helm)
(require 'multi)
(defun alist-get (symbols alist)
"Look up the value for the chain of SYMBOLS in ALIST."
(if symbols
(alist-get (cdr symbols)
(assoc (car symbols) alist))
(cdr alist)))
(defmulti spotify-play-href (href)
"Get the Spotify app to play the object with the given HREF."
system-type)
(defmulti-method spotify-play-href 'darwin
(href)
(shell-command (format "osascript -e 'tell application %S to play track %S'"
"Spotify"
href)))
(defmulti-method spotify-play-href 'gnu/linux
(href)
(shell-command "dbus-send --print-reply --session --type=method_call --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.Pause")
(shell-command (format "dbus-send --session --type=method_call --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.OpenUri \"string:%s\""
href)))
(defmulti-method spotify-play-href 'windows-nt
(href)
(shell-command (format "explorer %S" href)))
(defmulti-method-fallback spotify-play-href
(href)
(message "Sorry, helm-spotify does not support playing tracks on %S." system-type))
(defun spotify-play-track (track)
"Get the Spotify app to play the TRACK."
(spotify-play-href (alist-get '(uri) track)))
(defun spotify-get-track (album-href)
(let ((response (with-current-buffer
(url-retrieve-synchronously album-href)
(goto-char url-http-end-of-headers)
(json-read))))
(aref (alist-get '(tracks items) response) 0)))
(defun spotify-play-album (track)
"Get the Spotify app to play the album for this TRACK."
(let ((first-track (spotify-get-track (alist-get '(album href) track))))
(spotify-play-href (alist-get '(uri) first-track))))
(defun spotify-search (search-term)
"Search spotify for SEARCH-TERM, returning the results as a Lisp structure."
(let ((a-url (format "https://api.spotify.com/v1/search?q=%s&type=track" search-term)))
(with-current-buffer
(url-retrieve-synchronously a-url)
(goto-char url-http-end-of-headers)
(json-read))))
(defun spotify-format-track (track)
"Given a TRACK, return a a formatted string suitable for display."
(let ((track-name (alist-get '(name) track))
(track-length (/ (alist-get '(duration_ms) track) 1000))
(album-name (alist-get '(album name) track))
(artist-names (mapcar (lambda (artist)
(alist-get '(name) artist))
(alist-get '(artists) track))))
(format "%s (%dm%0.2ds)\n%s - %s"
track-name
(/ track-length 60) (mod track-length 60)
(mapconcat 'identity artist-names "/")
album-name)))
(defun spotify-search-formatted (search-term)
(mapcar (lambda (track)
(cons (spotify-format-track track) track))
(alist-get '(tracks items) (spotify-search search-term))))
(defun helm-spotify-search ()
(spotify-search-formatted helm-pattern))
(defun helm-spotify-actions-for-track (actions track)
"Return a list of helm ACTIONS available for this TRACK."
`((,(format "Play Track - %s" (alist-get '(name) track)) . spotify-play-track)
(,(format "Play Album - %s" (alist-get '(album name) track)) . spotify-play-album)
("Show Track Metadata" . pp)))
;;;###autoload
(defvar helm-source-spotify-track-search
'((name . "Spotify")
(volatile)
(delayed)
(multiline)
(requires-pattern . 2)
(candidates-process . helm-spotify-search)
(action-transformer . helm-spotify-actions-for-track)))
;;;###autoload
(defun helm-spotify ()
"Bring up a Spotify search interface in helm."
(interactive)
(helm :sources '(helm-source-spotify-track-search)
:buffer "*helm-spotify*"))
(provide 'helm-spotify)
;;; helm-spotify.el ends here

81
elpa/helm-swoop-20160619.953/helm-swoop-autoloads.el Normal file
View File

@ -0,0 +1,81 @@
;;; helm-swoop-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-swoop" "helm-swoop.el" (22490 28014 512722
;;;;;; 916000))
;;; Generated autoloads from helm-swoop.el
(autoload 'helm-swoop-back-to-last-point "helm-swoop" "\
Go back to last position where `helm-swoop' was called
\(fn &optional $CANCEL)" t nil)
(autoload 'helm-swoop "helm-swoop" "\
List the all lines to another buffer, which is able to squeeze by
any words you input. At the same time, the original buffer's cursor
is jumping line to line according to moving up and down the list.
\(fn &key $QUERY $SOURCE ($multiline current-prefix-arg))" t nil)
(autoload 'helm-swoop-from-isearch "helm-swoop" "\
Invoke `helm-swoop' from isearch.
\(fn)" t nil)
(autoload 'helm-multi-swoop "helm-swoop" "\
Usage:
M-x helm-multi-swoop
1. Select any buffers by [C-SPC] or [M-SPC]
2. Press [RET] to start helm-multi-swoop
C-u M-x helm-multi-swoop
If you have done helm-multi-swoop before, you can skip select buffers step.
Last selected buffers will be applied to helm-multi-swoop.
\(fn &optional $QUERY $BUFLIST)" t nil)
(autoload 'helm-multi-swoop-all "helm-swoop" "\
Apply all buffers to helm-multi-swoop
\(fn &optional $QUERY)" t nil)
(autoload 'helm-multi-swoop-org "helm-swoop" "\
Applies all org-mode buffers to helm-multi-swoop
\(fn &optional $QUERY)" t nil)
(autoload 'helm-multi-swoop-current-mode "helm-swoop" "\
Applies all buffers of the same mode as the current buffer to helm-multi-swoop
\(fn &optional $QUERY)" t nil)
(autoload 'helm-multi-swoop-projectile "helm-swoop" "\
Apply all opened buffers of the current project to helm-multi-swoop
\(fn &optional $QUERY)" t nil)
(autoload 'helm-swoop-without-pre-input "helm-swoop" "\
Start helm-swoop without pre input query.
\(fn)" t nil)
(autoload 'helm-swoop-symble-pre-input "helm-swoop" "\
Start helm-swoop without pre input query.
\(fn)" t nil)
(autoload 'helm-multi-swoop-edit "helm-swoop" "\
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-swoop-autoloads.el ends here

1
elpa/helm-swoop-20160619.953/helm-swoop-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-swoop" "20160619.953" "Efficiently hopping squeezed lines powered by helm interface" '((helm "1.0") (emacs "24.3")) :url "https://github.com/ShingoFukuyama/helm-swoop" :keywords '("helm" "swoop" "inner" "buffer" "search"))

1677
elpa/helm-swoop-20160619.953/helm-swoop.el Normal file
View File

File diff suppressed because it is too large Load Diff

22
elpa/helm-systemd-20160517.2333/helm-systemd-autoloads.el Normal file
View File

@ -0,0 +1,22 @@
;;; helm-systemd-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-systemd" "helm-systemd.el" (22490 28013
;;;;;; 828726 423000))
;;; Generated autoloads from helm-systemd.el
(autoload 'helm-systemd "helm-systemd" "\
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-systemd-autoloads.el ends here

1
elpa/helm-systemd-20160517.2333/helm-systemd-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-systemd" "20160517.2333" "helm's systemd interface" '((emacs "24.4") (helm "1.9.2") (with-editor "2.5.0")) :keywords '("convenience"))

298
elpa/helm-systemd-20160517.2333/helm-systemd.el Normal file
View File

@ -0,0 +1,298 @@
;;; helm-systemd.el --- helm's systemd interface -*- lexical-binding: t; -*-
;; Copyright (C) 2016
;; Author: <lompik@oriontabArch>
;; Package-Version: 20160517.2333
;; Package-X-Original-Version: 0.0.1
;; Package-Requires: ((emacs "24.4") (helm "1.9.2") (with-editor "2.5.0"))
;; Keywords: convenience
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'cl-lib)
(require 'helm)
(require 'with-editor)
(require 'subr-x)
(defvar helm-systemd-command-types '("service" "timer" "mount" "target" "socket" "scope" "device"))
(defvar helm-systemd-list-all nil)
(defvar helm-systemd-list-not-loaded nil)
(defvar helm-systemd-buffer-name "*Helm systemd log*")
(defvar helm-systemd-status-mode-hook nil )
(defconst helm-systemd-actions-list
'(("print". "Printed")
("restart". "Restarted")
("stop" ."Stopped")
("start". "Started")))
(defvar helm-systemd-status-font-lock-keywords
`(("\\(Loaded\\|Active\\|Status\\|Docs\\|Process\\|Main PID\\|Tasks\\|CGroup\\):" (1 'helm-bookmark-gnus) )
("active (running)" 0 'hi-green)
("inactive (dead)" 0 'helm-bookmark-info)
("active (exited)" 0 'helm-bookmark-info)
("[fF]ailed" 0 'diredp-executable-tag)
("─\\([0-9]+\\)" (1 'helm-bookmark-info)) ; PIDs
("[●🔜] .*" 0 'helm-buffer-file) ; command lines ●🔜
"Default expressions to highlight in `helm systemd log'."))
(define-derived-mode helm-systemd-status-mode fundamental-mode "Systemd-log"
"Major mode for viewing systemd status logs.
\\{helm-systemd-status-mode-map}"
(setq-local font-lock-defaults '(helm-systemd-status-font-lock-keywords))
(font-lock-mode t))
(add-to-list 'auto-mode-alist `(, (concat (regexp-quote helm-systemd-buffer-name) "\\'") . helm-systemd-status-mode))
(defun helm-systemd-command-line-option ()
(concat "--no-pager --no-legend -t " (car helm-systemd-command-types) (if helm-systemd-list-all " --all")))
(defvar helm-systemd-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "<C-return>") 'helm-cr-empty-string)
(define-key map (kbd "<M-RET>") 'helm-cr-empty-string)
(define-key map (kbd "C-]") 'helm-systemd-next-type)
(define-key map (kbd "C-[") 'helm-systemd-prev-type)
(delq nil map))
"Keymap for `helm-systemd'.")
(defun helm-systemd-concatspace (word-list)
"Concatenate list of string with spaces as separator"
(mapconcat 'identity
(delq nil word-list)
" "))
(defun helm-systemd-systemctl-command (&rest args)
"Construct string with: 'systemctl default-args' ARGS"
(helm-systemd-concatspace (push (concat "systemctl " (helm-systemd-command-line-option))
args) ))
(defun helm-systemd-get-canditates (sysd-options)
"Return a list of systemd service unit"
(let* ((result ())
(leftcolumnwidth
(number-to-string 25))
(hash (make-hash-table
:test 'equal))
(sysd-lu (shell-command-to-string
(helm-systemd-systemctl-command " list-units " sysd-options)))
(sysd-lu (delete ""
(split-string sysd-lu
"\n"))))
(mapc (lambda (line)
(puthash (car (split-string line)) line hash))
sysd-lu)
(if helm-systemd-list-not-loaded
(let* ((sysd-luf (shell-command-to-string
(helm-systemd-systemctl-command " list-unit-files " sysd-options)))
(sysd-luf (delete ""
(split-string sysd-luf "\n"))))
(mapc (lambda (line-luf)
(let ((unit (car
(split-string line-luf))))
(unless (gethash unit hash nil)
(puthash unit line-luf hash)))) sysd-luf)))
(let ((maxunitlength
(string-to-number leftcolumnwidth)))
(maphash (lambda (unit descr)
(setq maxunitlength
(max maxunitlength (length unit)))) hash)
(setq leftcolumnwidth
(number-to-string maxunitlength)))
(maphash (lambda (unit descr)
(let* ((unit_misc
(string-trim-left
(substring descr (length unit) (length descr))))
(formatted_output
(format
(concat "%-" leftcolumnwidth "s %s")
unit unit_misc)))
(push formatted_output result)) ) hash)
result ))
(defun helm-systemd-display (unit-command unit &optional isuser nodisplay)
(with-current-buffer (get-buffer-create helm-systemd-buffer-name)
(helm-systemd-status-mode)
(let ((command
(helm-systemd-systemctl-command (if isuser "--user") unit-command unit)))
(insert "\n🔜 " command "\n")
(if (or isuser (string= unit-command "status"))
(insert (shell-command-to-string command))
(with-temp-buffer
(cd "/sudo::/")
(setq command (shell-command-to-string (concat "sudo " command))))
(insert command)
)
(insert "\n"))
;; (propertise-sysd-buffer )
(unless nodisplay
(display-buffer (current-buffer)))))
(defun helm-systemd-next-type ()
(interactive)
(setq helm-systemd-command-types
(append (cdr helm-systemd-command-types)
(list (car helm-systemd-command-types))))
(with-helm-alive-p
(helm-force-update )))
(defun helm-systemd-prev-type ()
(interactive)
(setq helm-systemd-command-types
(append (last helm-systemd-command-types)
(remove (car (last helm-systemd-command-types))
helm-systemd-command-types)))
(with-helm-alive-p
(helm-force-update )))
(defun helm-system-persis-action (_line &optional isuser)
"Show unit status"
(let ((units (helm-marked-candidates)))
(mapc (lambda (line)
(let ((unit (car (split-string line))))
(helm-systemd-display "status" unit isuser )))
units)))
(defun helm-systemd-transformer (candidates source)
(let ((res candidates))
(unless (string= (car helm-systemd-command-types) "device")
(setq res (cl-loop for i in candidates
for split = (split-string i)
for unit = (car split)
for loaded = (nth 1 split)
for active = (nth 2 split)
for running = (nth 3 split)
for description = (if running (helm-systemd-concatspace (cl-subseq split 4)))
collect (let ((line i))
(unless (and unit loaded active running description)
line)
(if (and loaded (not (string= (car helm-systemd-command-types) "mount")))
(let* ((isenabled
(car
(split-string
(shell-command-to-string
(helm-systemd-concatspace `("systemctl" "is-enabled "
,(if (string-match "User"
(cdr (assoc 'name source)))
"--user")
,unit))))))
(propena (cond ((string= isenabled "enabled") 'helm-bookmark-info)
((string= isenabled "static") 'helm-bookmark-gnus)
(t 'helm-bookmark-gnus)))
(isenabled (format "%8s" isenabled) ))
(setq line (if active
(replace-regexp-in-string loaded (concat (propertize isenabled 'face propena) " " loaded " ") line )
(replace-regexp-in-string loaded (concat (propertize isenabled 'face propena) " ") line ))))) ;; list-units case
(if (string= running "running")
(setq line
(replace-regexp-in-string running
(propertize
running
'face
'helm-ff-directory) line )))
(if (string= running "exited")
(setq line
(replace-regexp-in-string running
(propertize
running
'face
'helm-bookmark-info) line )))
(if (string= running "failed")
(setq line
(replace-regexp-in-string running
(propertize
running
'face
'diredp-executable-tag) line )))
(if description
(setq line
(replace-regexp-in-string
(regexp-quote description) (propertize
description
'face
'helm-buffer-process) line t)))
line ))))
res))
(defmacro helm-systemd-make-actions (sysd-verb isuser)
`(lambda (_ignore)
(mapc (lambda (candidate)
(helm-systemd-display ,sysd-verb (car (split-string candidate)) ,isuser t)
(message (concat
(cdr (assoc ,sysd-verb helm-systemd-actions-list))
" "
(car (split-string candidate)))))
(helm-marked-candidates))))
(defun helm-systemd-build-source ()
(helm-build-sync-source "systemd"
:candidates (lambda ()
(reverse (helm-systemd-get-canditates "") ))
:action (helm-make-actions
"Print" (helm-systemd-make-actions "status" nil)
"Restart" (helm-systemd-make-actions "restart" nil)
"Stop" (helm-systemd-make-actions "stop" nil)
"Start" (helm-systemd-make-actions "start" nil))
:persistent-action #'helm-system-persis-action
:persistent-help "Show unit status"
:keymap helm-systemd-map
:filtered-candidate-transformer #'helm-systemd-transformer))
(defun helm-systemd-build-source-user ()
(helm-build-sync-source "Systemd User"
:candidates (lambda ()
(reverse (helm-systemd-get-canditates "--user")))
:action (helm-make-actions
"Print" (helm-systemd-make-actions "status" t)
"Restart" (helm-systemd-make-actions "restart" t)
"Stop" (helm-systemd-make-actions "stop" t)
"Start" (helm-systemd-make-actions "start" nil)
"Edit with Emacs" (lambda (candidate)
(add-to-list 'with-editor-envvars "SYSTEMD_EDITOR" t)
(with-editor-async-shell-command (concat "systemctl --user --full edit " (car (split-string candidate))) )))
:persistent-action (lambda (line) (funcall #'helm-system-persis-action line t))
:persistent-help "Show unit status"
:keymap helm-systemd-map
:filtered-candidate-transformer #'helm-systemd-transformer))
;;;###autoload
(defun helm-systemd ()
(interactive)
(helm
:sources (mapcar (lambda (func)
(funcall func))
'(helm-systemd-build-source helm-systemd-build-source-user))
:truncate-lines t
:buffer
(concat "*helm systemd*")) )
(provide 'helm-systemd)
;;; helm-systemd.el ends here

22
elpa/helm-themes-20151008.2321/helm-themes-autoloads.el Normal file
View File

@ -0,0 +1,22 @@
;;; helm-themes-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-themes" "helm-themes.el" (22490 28013
;;;;;; 420728 518000))
;;; Generated autoloads from helm-themes.el
(autoload 'helm-themes "helm-themes" "\
Theme selection with helm interface
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-themes-autoloads.el ends here

1
elpa/helm-themes-20151008.2321/helm-themes-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-themes" "20151008.2321" "Color theme selection with helm interface" '((helm-core "1.7.7")) :url "https://github.com/syohex/emacs-helm-themes")

71
elpa/helm-themes-20151008.2321/helm-themes.el Normal file
View File

@ -0,0 +1,71 @@
;;; helm-themes.el --- Color theme selection with helm interface -*- lexical-binding: t; -*-
;; Copyright (C) 2015 by Syohei YOSHIDA
;; Author: Syohei YOSHIDA <syohex@gmail.com>
;; URL: https://github.com/syohex/emacs-helm-themes
;; Package-Version: 20151008.2321
;; Version: 0.05
;; Package-Requires: ((helm-core "1.7.7"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; helm-themes.el provide theme selection with helm interface.
;; Its persistent action can set theme temporary.
;;
;;; Code:
(require 'helm)
;; Loading mutiple themes makes Emacs too slow
(defsubst helm-themes--delete-theme ()
(mapc 'disable-theme custom-enabled-themes))
(defun helm-themes--load-theme (theme-str)
(helm-themes--delete-theme)
(if (string= theme-str "default")
t
(load-theme (intern theme-str) t)))
(defun helm-themes--candidates ()
(cons 'default (custom-available-themes)))
(defvar helm-themes-source
(helm-build-sync-source "Selection Theme"
:candidates 'helm-themes--candidates
:action 'helm-themes--load-theme
:persistent-action 'helm-themes--load-theme))
;;;###autoload
(defun helm-themes ()
"Theme selection with helm interface"
(interactive)
(let ((changed nil)
(orig-theme (when custom-enabled-themes
(car custom-enabled-themes))))
(unwind-protect
(progn
(when (helm :sources helm-themes-source :buffer "*helm-themes*")
(setq changed t)))
(when (not changed)
(helm-themes--delete-theme)
(when orig-theme
(load-theme orig-theme t))))))
(provide 'helm-themes)
;;; helm-themes.el ends here

24
elpa/helm-unicode-20160715.533/helm-unicode-autoloads.el Normal file
View File

@ -0,0 +1,24 @@
;;; helm-unicode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "helm-unicode" "helm-unicode.el" (22490 28012
;;;;;; 812731 643000))
;;; Generated autoloads from helm-unicode.el
(autoload 'helm-unicode "helm-unicode" "\
Precofigured `helm' for looking up unicode characters by name.
With prefix ARG, reinitialize the cache.
\(fn ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; helm-unicode-autoloads.el ends here

1
elpa/helm-unicode-20160715.533/helm-unicode-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "helm-unicode" "20160715.533" "Helm command for unicode characters." '((helm "1.9.8") (emacs "24.4")))

72
elpa/helm-unicode-20160715.533/helm-unicode.el Normal file
View File

@ -0,0 +1,72 @@
;;; helm-unicode.el --- Helm command for unicode characters. -*- lexical-binding: t -*-
;; Copyright © 2015 Emanuel Evans
;; Version: 0.0.4
;; Package-Version: 20160715.533
;; Package-Requires: ((helm "1.9.8") (emacs "24.4"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; A helm command for looking up unicode characters by name 😉.
;;; Code:
(require 'helm)
(require 'helm-utils)
(defvar helm-unicode-names nil
"Internal cache variable for unicode characters. Should not be changed by the user.")
(defun helm-unicode-format-char-pair (char-pair)
"Formats a char pair for helm unicode search."
(let ((name (car char-pair))
(symbol (cdr char-pair)))
(format "%s %c" name symbol)))
(defun helm-unicode-build-candidates ()
"Builds the candidate list."
(sort
(mapcar 'helm-unicode-format-char-pair (ucs-names))
#'string-lessp))
(defun helm-unicode-source ()
"Builds the helm Unicode source. Initialize the lookup cache if necessary."
(unless helm-unicode-names
(setq helm-unicode-names (helm-unicode-build-candidates)))
(helm-build-sync-source "unicode-characters"
:candidates helm-unicode-names
:filtered-candidate-transformer (lambda (candidates _source) (sort candidates #'helm-generic-sort-fn))
:action '(("Insert Character" . helm-unicode-insert-char))))
(defun helm-unicode-insert-char (candidate)
"Insert CANDIDATE into the main buffer."
(insert (substring candidate -1)))
;;;###autoload
(defun helm-unicode (arg)
"Precofigured `helm' for looking up unicode characters by name.
With prefix ARG, reinitialize the cache."
(interactive "P")
(when arg (setq helm-unicode-names nil))
(helm :sources (helm-unicode-source)
:buffer "*helm-unicode-search*"))
(provide 'helm-unicode)
;;; helm-unicode.el ends here

1
elpa/let-alist-1.0.4.signed Normal file
View File

@ -0,0 +1 @@
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2015-06-12T11:05:02+0200 using DSA

50
elpa/let-alist-1.0.4/let-alist-autoloads.el Normal file
View File

@ -0,0 +1,50 @@
;;; let-alist-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "let-alist" "let-alist.el" (22490 28018 260703
;;;;;; 796000))
;;; Generated autoloads from let-alist.el
(autoload 'let-alist "let-alist" "\
Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
Dotted symbol is any symbol starting with a `.'. Only those present
in BODY are let-bound and this search is done at compile time.
For instance, the following code
(let-alist alist
(if (and .title .body)
.body
.site
.site.contents))
essentially expands to
(let ((.title (cdr (assq 'title alist)))
(.body (cdr (assq 'body alist)))
(.site (cdr (assq 'site alist)))
(.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
(if (and .title .body)
.body
.site
.site.contents))
If you nest `let-alist' invocations, the inner one can't access
the variables of the outer one. You can, however, access alists
inside the original alist by using dots inside the symbol, as
displayed in the example above.
\(fn ALIST &rest BODY)" nil t)
(put 'let-alist 'lisp-indent-function '1)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; let-alist-autoloads.el ends here

1
elpa/let-alist-1.0.4/let-alist-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "let-alist" "1.0.4" "Easily let-bind values of an assoc-list by their names" '((emacs "24.1")) :url "http://elpa.gnu.org/packages/let-alist.html" :keywords '("extensions" "lisp"))

170
elpa/let-alist-1.0.4/let-alist.el Normal file
View File

@ -0,0 +1,170 @@
;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
;; Version: 1.0.4
;; Keywords: extensions lisp
;; Prefix: let-alist
;; Separator: -
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package offers a single macro, `let-alist'. This macro takes a
;; first argument (whose value must be an alist) and a body.
;;
;; The macro expands to a let form containing body, where each dotted
;; symbol inside body is let-bound to their cdrs in the alist. Dotted
;; symbol is any symbol starting with a `.'. Only those present in
;; the body are let-bound and this search is done at compile time.
;;
;; For instance, the following code
;;
;; (let-alist alist
;; (if (and .title .body)
;; .body
;; .site
;; .site.contents))
;;
;; essentially expands to
;;
;; (let ((.title (cdr (assq 'title alist)))
;; (.body (cdr (assq 'body alist)))
;; (.site (cdr (assq 'site alist)))
;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
;; (if (and .title .body)
;; .body
;; .site
;; .site.contents))
;;
;; If you nest `let-alist' invocations, the inner one can't access
;; the variables of the outer one. You can, however, access alists
;; inside the original alist by using dots inside the symbol, as
;; displayed in the example above by the `.site.contents'.
;;
;;; Code:
(defun let-alist--deep-dot-search (data)
"Return alist of symbols inside DATA that start with a `.'.
Perform a deep search and return an alist where each car is the
symbol, and each cdr is the same symbol without the `.'."
(cond
((symbolp data)
(let ((name (symbol-name data)))
(when (string-match "\\`\\." name)
;; Return the cons cell inside a list, so it can be appended
;; with other results in the clause below.
(list (cons data (intern (replace-match "" nil nil name)))))))
((not (consp data)) nil)
(t (append (let-alist--deep-dot-search (car data))
(let-alist--deep-dot-search (cdr data))))))
(defun let-alist--access-sexp (symbol variable)
"Return a sexp used to access SYMBOL inside VARIABLE."
(let* ((clean (let-alist--remove-dot symbol))
(name (symbol-name clean)))
(if (string-match "\\`\\." name)
clean
(let-alist--list-to-sexp
(mapcar #'intern (nreverse (split-string name "\\.")))
variable))))
(defun let-alist--list-to-sexp (list var)
"Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
`(cdr (assq ',(car list)
,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
var))))
(defun let-alist--remove-dot (symbol)
"Return SYMBOL, sans an initial dot."
(let ((name (symbol-name symbol)))
(if (string-match "\\`\\." name)
(intern (replace-match "" nil nil name))
symbol)))
;;; The actual macro.
;;;###autoload
(defmacro let-alist (alist &rest body)
"Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
Dotted symbol is any symbol starting with a `.'. Only those present
in BODY are let-bound and this search is done at compile time.
For instance, the following code
(let-alist alist
(if (and .title .body)
.body
.site
.site.contents))
essentially expands to
(let ((.title (cdr (assq 'title alist)))
(.body (cdr (assq 'body alist)))
(.site (cdr (assq 'site alist)))
(.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
(if (and .title .body)
.body
.site
.site.contents))
If you nest `let-alist' invocations, the inner one can't access
the variables of the outer one. You can, however, access alists
inside the original alist by using dots inside the symbol, as
displayed in the example above."
(declare (indent 1) (debug t))
(let ((var (make-symbol "alist")))
`(let ((,var ,alist))
(let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
(delete-dups (let-alist--deep-dot-search body)))
,@body))))
;;;; ChangeLog:
;; 2015-06-11 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; * let-alist (let-alist--deep-dot-search): Fix cons
;;
;; 2015-03-07 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; let-alist: Update copyright
;;
;; 2014-12-22 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; packages/let-alist: Use `make-symbol' instead of `gensym'.
;;
;; 2014-12-20 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; packages/let-alist: Enable access to deeper alists
;;
;; 2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; let-alist.el: Add lexical binding. Version bump.
;;
;; 2014-12-11 Artur Malabarba <bruce.connor.am@gmail.com>
;;
;; let-alist: New package
;;
(provide 'let-alist)
;;; let-alist.el ends here

15
elpa/multi-20131013.844/multi-autoloads.el Normal file
View File

@ -0,0 +1,15 @@
;;; multi-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("multi.el") (22490 28015 535100 796000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; multi-autoloads.el ends here

1
elpa/multi-20131013.844/multi-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "multi" "20131013.844" "Clojure-style multi-methods for emacs lisp" '((emacs "24")) :url "http://github.com/kurisuwhyte/emacs-multi" :keywords '("multimethod" "generic" "predicate" "dispatch"))

134
elpa/multi-20131013.844/multi.el Normal file
View File

@ -0,0 +1,134 @@
;;; multi.el --- Clojure-style multi-methods for emacs lisp -*- lexical-binding: t -*-
;; Copyright (c) 2013 Christina Whyte <kurisu.whyte@gmail.com>
;; Version: 2.0.1
;; Package-Version: 20131013.844
;; Package-Requires: ((emacs "24"))
;; Keywords: multimethod generic predicate dispatch
;; Author: Christina Whyte <kurisu.whyte@gmail.com>
;; URL: http://github.com/kurisuwhyte/emacs-multi
;; This file is not part of GNU Emacs.
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
;;; Commentary
;; See README.md (or http://github.com/kurisuwhyte/emacs-multi#readme)
;;; Code:
;;;; State ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar multi/-method-branches (make-hash-table)
"A dictionary of dictionaries of branches.
Type: { Symbol → { A → (A... → B) }}
This holds the mappings of names to a mappings of premises to lambdas,
which allows a relatively efficient dispatching O(2) when applying the
multi-method.")
(defvar multi/-method-fallbacks (make-hash-table)
"A dictionary of fallbacks for each multi-method.
Type: { Symbold → (A... → B) }
This holds mappings of names to fallback method branches, which are
invoked in case none of the premises for the defined branches match.")
;;;; API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro defmulti (name arguments &optional docstring &rest forms)
"Defines a new multi-method and a dispatch function."
(declare (doc-string 3)
(debug (&define name (&rest arg) [&optional stringp] def-body))
(indent defun))
`(progn
(defun ,name (&rest args)
,(if (stringp docstring) docstring (prog1 nil (push docstring forms)))
(apply (multi/-dispatch-with ',name (lambda ,arguments ,@forms))
args))
(multi/-make-multi-method ',name)))
(defmacro defmulti-method (name premise arguments &rest forms)
"Adds a branch to a previously-defined multi-method."
(declare (debug (&define name sexp (&rest arg) def-body))
(indent defun))
`(multi/-make-multi-method-branch ',name ,premise
(lambda ,arguments ,@forms)))
(defmacro defmulti-method-fallback (name arguments &rest forms)
"Adds a fallback branch to a previously-defined multi-method.
The fallback branch will be applied if none of the premises defined
for the branches in a multi-method match the dispatch value."
`(multi/-make-multi-method-fallback ',name (lambda ,arguments ,@forms)))
(defun multi-remove-method (name premise)
"Removes the branch with the given premise from the multi-method."
(remhash premise (gethash name multi/-method-branches)))
(defun multi-remove-method-fallback (name)
"Removes the defined fallback branch for the multi-method."
(remhash name multi/-method-fallbacks))
;;;; Helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun multi/-make-multi-method (name)
(puthash name (make-hash-table :test 'equal)
multi/-method-branches))
(defun multi/-make-multi-method-branch (name premise lambda)
(puthash premise lambda
(gethash name multi/-method-branches)))
(defun multi/-make-multi-method-fallback (name lambda)
(puthash name lambda multi/-method-fallbacks))
(defun multi/-dispatch-with (name f)
(lambda (&rest args)
(let* ((premise (apply f args))
(method (gethash premise (gethash name multi/-method-branches))))
(if method (apply method args)
(apply (gethash name multi/-method-fallbacks) args)))))
;;;; Emacs stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(eval-after-load "lisp-mode"
'(progn
(font-lock-add-keywords 'emacs-lisp-mode
'(("(\\(defmulti\\|defmulti-method\\|defmulti-method-fallback\\)\\(?:\\s-\\)+\\(\\_<.*?\\_>\\)"
(1 font-lock-keyword-face)
(2 font-lock-function-name-face))))))
(provide 'multi)
;;; multi.el ends here

119
elpa/multiple-cursors-20160719.216/mc-cycle-cursors.el Normal file
View File

@ -0,0 +1,119 @@
;;; mc-cycle-cursors.el
;; Copyright (C) 2012-2016 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This scrolls the buffer to center each cursor in turn.
;; Scroll down with C-v, scroll up with M-v
;; This is nice when you have cursors that's outside of your view.
;;; Code:
(require 'multiple-cursors-core)
(defun mc/next-fake-cursor-after-point ()
(let ((pos (point))
(next-pos (1+ (point-max)))
next)
(mc/for-each-fake-cursor
(let ((cursor-pos (overlay-get cursor 'point)))
(when (and (< pos cursor-pos)
(< cursor-pos next-pos))
(setq next-pos cursor-pos)
(setq next cursor))))
next))
(defun mc/prev-fake-cursor-before-point ()
(let ((pos (point))
(prev-pos (1- (point-min)))
prev)
(mc/for-each-fake-cursor
(let ((cursor-pos (overlay-get cursor 'point)))
(when (and (> pos cursor-pos)
(> cursor-pos prev-pos))
(setq prev-pos cursor-pos)
(setq prev cursor))))
prev))
(defcustom mc/cycle-looping-behaviour 'continue
"What to do if asked to cycle beyond the last cursor or before the first cursor."
:type '(radio (const :tag "Loop around to beginning/end of document." continue)
(const :tag "Warn and then loop around." warn)
(const :tag "Signal an error." error)
(const :tag "Don't loop." stop))
:group 'multiple-cursors)
(defun mc/handle-loop-condition (error-message)
(cl-ecase mc/cycle-looping-behaviour
(error (error error-message))
(warn (message error-message))
(continue 'continue)
(stop 'stop)))
(defun mc/first-fake-cursor-after (point)
"Very similar to mc/furthest-cursor-before-point, but ignores (mark) and (point)."
(let* ((cursors (mc/all-fake-cursors))
(cursors-after-point (cl-remove-if (lambda (cursor)
(< (mc/cursor-beg cursor) point))
cursors))
(cursors-in-order (cl-sort cursors-after-point '< :key 'mc/cursor-beg)))
(car cursors-in-order)))
(defun mc/last-fake-cursor-before (point)
"Very similar to mc/furthest-cursor-before-point, but ignores (mark) and (point)."
(let* ((cursors (mc/all-fake-cursors))
(cursors-before-point (cl-remove-if (lambda (cursor)
(> (mc/cursor-end cursor) point))
cursors))
(cursors-in-order (cl-sort cursors-before-point '> :key 'mc/cursor-end)))
(car cursors-in-order)))
(cl-defun mc/cycle (next-cursor fallback-cursor loop-message)
(when (null next-cursor)
(when (eql 'stop (mc/handle-loop-condition loop-message))
(return-from mc/cycle nil))
(setf next-cursor fallback-cursor))
(mc/create-fake-cursor-at-point)
(mc/pop-state-from-overlay next-cursor)
(recenter))
(defun mc/cycle-forward ()
(interactive)
(mc/cycle (mc/next-fake-cursor-after-point)
(mc/first-fake-cursor-after (point-min))
"We're already at the last cursor."))
(defun mc/cycle-backward ()
(interactive)
(mc/cycle (mc/prev-fake-cursor-before-point)
(mc/last-fake-cursor-before (point-max))
"We're already at the last cursor"))
(define-key mc/keymap (kbd "C-v") 'mc/cycle-forward)
(define-key mc/keymap (kbd "M-v") 'mc/cycle-backward)
(provide 'mc-cycle-cursors)
;; Local Variables:
;; coding: utf-8
;; End:
;;; mc-cycle-cursors.el ends here

110
elpa/multiple-cursors-20160719.216/mc-edit-lines.el Normal file
View File

@ -0,0 +1,110 @@
;;; mc-edit-lines.el
;; Copyright (C) 2012-2016 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file contains functions to add multiple cursors to consecutive lines
;; given an active region.
;; Please see multiple-cursors.el for more commentary.
;;; Code:
(require 'multiple-cursors-core)
(defcustom mc/edit-lines-empty-lines nil
"What should be done by `mc/edit-lines' when a line is not long enough."
:type '(radio (const :tag "Pad the line with spaces." pad)
(const :tag "Ignore the line." ignore)
(const :tag "Signal an error." error)
(const :tag "Nothing. Cursor is at end of line." nil))
:group 'multiple-cursors)
;;;###autoload
(defun mc/edit-lines (&optional arg)
"Add one cursor to each line of the active region.
Starts from mark and moves in straight down or up towards the
line point is on.
What is done with lines which are not long enough is governed by
`mc/edit-lines-empty-lines'. The prefix argument ARG can be used
to override this. If ARG is a symbol (when called from Lisp),
that symbol is used instead of `mc/edit-lines-empty-lines'.
Otherwise, if ARG negative, short lines will be ignored. Any
other non-nil value will cause short lines to be padded."
(interactive "P")
(when (not (and mark-active (/= (point) (mark))))
(error "Mark a set of lines first"))
(mc/remove-fake-cursors)
(let* ((col (current-column))
(point-line (line-number-at-pos))
(mark-line (progn (exchange-point-and-mark) (line-number-at-pos)))
(direction (if (< point-line mark-line) :up :down))
(style (cond
;; called from lisp
((and arg (symbolp arg))
arg)
;; negative argument
((< (prefix-numeric-value arg) 0)
'ignore)
(arg 'pad)
(t mc/edit-lines-empty-lines))))
(deactivate-mark)
(when (and (eq direction :up) (bolp))
(previous-logical-line 1 nil)
(move-to-column col))
;; Add the cursors
(while (not (eq (line-number-at-pos) point-line))
;; Pad the line
(when (eq style 'pad)
(while (< (current-column) col)
(insert " ")))
;; Error
(when (and (eq style 'error)
(not (equal col (current-column))))
(error "Short line encountered in `mc/edit-lines'"))
;; create the cursor
(unless (and (eq style 'ignore)
(not (equal col (current-column))))
(mc/create-fake-cursor-at-point))
;; proceed to next
(if (eq direction :up)
(previous-logical-line 1 nil)
(next-logical-line 1 nil))
(move-to-column col))
(multiple-cursors-mode)))
;;;###autoload
(defun mc/edit-ends-of-lines ()
"Add one cursor to the end of each line in the active region."
(interactive)
(mc/edit-lines)
(mc/execute-command-for-all-cursors 'end-of-line))
;;;###autoload
(defun mc/edit-beginnings-of-lines ()
"Add one cursor to the beginning of each line in the active region."
(interactive)
(mc/edit-lines)
(mc/execute-command-for-all-cursors 'beginning-of-line))
(provide 'mc-edit-lines)
;;; mc-edit-lines.el ends here

107
elpa/multiple-cursors-20160719.216/mc-hide-unmatched-lines-mode.el Normal file
View File

@ -0,0 +1,107 @@
;;; mc-hide-unmatched-lines.el
;; Copyright (C) 2014 Aleksey Fedotov
;; Author: Aleksey Fedotov <lexa@cfotr.com>
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This minor mode when enabled hides all lines where no cursors (and
;; also hum/lines-to-expand below and above) To make use of this mode
;; press "C-'" while multiple-cursor-mode is active. You can still
;; edit lines while you are in mc-hide-unmatched-lines mode. To leave
;; this mode press "<return>" or "C-g"
;;
;;; Code:
(require 'multiple-cursors-core)
(require 'mc-mark-more)
(defvar hum/hide-unmatched-lines-mode-map (make-sparse-keymap)
"Keymap for hide unmatched lines is mainly for rebinding C-g")
(define-key hum/hide-unmatched-lines-mode-map (kbd "C-g") 'hum/keyboard-quit)
(define-key hum/hide-unmatched-lines-mode-map (kbd "<return>") 'hum/keyboard-quit)
(defun hum/keyboard-quit ()
"Leave hide-unmatched-lines mode"
(interactive)
(mc-hide-unmatched-lines-mode 0))
;; used only in in multiple-cursors-mode-disabled-hook
(defun hum/disable-hum-mode ()
(mc-hide-unmatched-lines-mode 0))
;;;###autoload
(define-minor-mode mc-hide-unmatched-lines-mode
"Minor mode when enabled hides all lines where no cursors (and
also hum/lines-to-expand below and above) To make use of this
mode press \"C-'\" while multiple-cursor-mode is active. You can
still edit lines while you are in mc-hide-unmatched-lines
mode. To leave this mode press <return> or \"C-g\""
nil " hu"
hum/hide-unmatched-lines-mode-map
(if mc-hide-unmatched-lines-mode
;;just in case if mc mode will be disabled while hide-unmatched-lines is active
(progn
(hum/hide-unmatched-lines)
(add-hook 'multiple-cursors-mode-disabled-hook 'hum/disable-hum-mode t t))
(progn
(hum/unhide-unmatched-lines)
(remove-hook 'multiple-cursors-mode-disabled-hook 'hum/disable-hum-mode))))
(defconst hum/invisible-overlay-name 'hum/invisible-overlay-name)
(defcustom hum/lines-to-expand 2
"How many lines below and above cursor to show"
:type '(integer)
:group 'multiple-cursors)
(defcustom hum/placeholder "..."
"Placeholder which will be placed insted of hiden text"
:type '(string)
:group 'multiple-cursors)
(defun hum/add-invisible-overlay (begin end)
(let ((overlay (make-overlay begin
end
(current-buffer)
t
nil
)))
(overlay-put overlay hum/invisible-overlay-name t)
(overlay-put overlay 'invisible t)
(overlay-put overlay 'intangible t)
(overlay-put overlay 'evaporate t)
(overlay-put overlay 'after-string hum/placeholder)))
(defun hum/hide-unmatched-lines ()
(let ((begin (point-min)))
(mc/for-each-cursor-ordered
(save-excursion
(goto-char (mc/cursor-beg cursor))
(if (< begin (line-beginning-position (- hum/lines-to-expand)))
(hum/add-invisible-overlay begin (line-end-position (- hum/lines-to-expand))))
(setq begin (line-beginning-position (+ 2 hum/lines-to-expand)))))
(hum/add-invisible-overlay begin (point-max))))
(defun hum/unhide-unmatched-lines ()
(remove-overlays nil nil hum/invisible-overlay-name t))
(provide 'mc-hide-unmatched-lines-mode)
(define-key mc/keymap (kbd "C-'") 'mc-hide-unmatched-lines-mode)

712
elpa/multiple-cursors-20160719.216/mc-mark-more.el Normal file
View File

@ -0,0 +1,712 @@
;;; mc-mark-more.el
;; Copyright (C) 2012-2016 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file contains functions to mark more parts of the buffer.
;; See ./features/mark-more.feature for examples.
;; Please see multiple-cursors.el for more commentary.
;;; Code:
(require 'multiple-cursors-core)
(require 'thingatpt)
(defun mc/cursor-end (cursor)
(if (overlay-get cursor 'mark-active)
(max (overlay-get cursor 'point)
(overlay-get cursor 'mark))
(overlay-get cursor 'point)))
(defun mc/cursor-beg (cursor)
(if (overlay-get cursor 'mark-active)
(min (overlay-get cursor 'point)
(overlay-get cursor 'mark))
(overlay-get cursor 'point)))
(defun mc/furthest-region-end ()
(let ((end (max (mark) (point))))
(mc/for-each-fake-cursor
(setq end (max end (mc/cursor-end cursor))))
end))
(defun mc/first-region-start ()
(let ((beg (min (mark) (point))))
(mc/for-each-fake-cursor
(setq beg (min beg (mc/cursor-beg cursor))))
beg))
(defun mc/furthest-cursor-before-point ()
(let ((beg (if mark-active (min (mark) (point)) (point)))
furthest)
(mc/for-each-fake-cursor
(when (< (mc/cursor-beg cursor) beg)
(setq beg (mc/cursor-beg cursor))
(setq furthest cursor)))
furthest))
(defun mc/furthest-cursor-after-point ()
(let ((end (if mark-active (max (mark) (point)) (point)))
furthest)
(mc/for-each-fake-cursor
(when (> (mc/cursor-end cursor) end)
(setq end (mc/cursor-end cursor))
(setq furthest cursor)))
furthest))
(defun mc/fake-cursor-at-point (&optional point)
"Return the fake cursor with its point right at POINT (defaults
to (point)), or nil."
(setq point (or point (point)))
(let ((cursors (mc/all-fake-cursors))
(c nil))
(catch 'found
(while (setq c (pop cursors))
(when (eq (marker-position (overlay-get c 'point))
point)
(throw 'found c))))))
(defun mc/region-strings ()
(let ((strings (list (buffer-substring-no-properties (point) (mark)))))
(mc/for-each-fake-cursor
(add-to-list 'strings (buffer-substring-no-properties
(mc/cursor-beg cursor)
(mc/cursor-end cursor))))
strings))
(defvar mc/enclose-search-term nil
"How should mc/mark-more-* search for more matches?
Match everything: nil
Match only whole words: 'words
Match only whole symbols: 'symbols
Use like case-fold-search, don't recommend setting it globally.")
(defun mc/mark-more-like-this (skip-last direction)
(let ((case-fold-search nil)
(re (regexp-opt (mc/region-strings) mc/enclose-search-term))
(point-out-of-order (cl-ecase direction
(forwards (< (point) (mark)))
(backwards (not (< (point) (mark))))))
(furthest-cursor (cl-ecase direction
(forwards (mc/furthest-cursor-after-point))
(backwards (mc/furthest-cursor-before-point))))
(start-char (cl-ecase direction
(forwards (mc/furthest-region-end))
(backwards (mc/first-region-start))))
(search-function (cl-ecase direction
(forwards 'search-forward-regexp)
(backwards 'search-backward-regexp)))
(match-point-getter (cl-ecase direction
(forwards 'match-beginning)
(backwards 'match-end))))
(if (and skip-last (not furthest-cursor))
(error "No cursors to be skipped")
(mc/save-excursion
(goto-char start-char)
(when skip-last
(mc/remove-fake-cursor furthest-cursor))
(if (funcall search-function re nil t)
(progn
(push-mark (funcall match-point-getter 0))
(when point-out-of-order
(exchange-point-and-mark))
(mc/create-fake-cursor-at-point))
(error "no more matches found."))))))
;;;###autoload
(defun mc/mark-next-like-this (arg)
"Find and mark the next part of the buffer matching the currently active region
If no region is active add a cursor on the next line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(if (< arg 0)
(let ((cursor (mc/furthest-cursor-after-point)))
(if cursor
(mc/remove-fake-cursor cursor)
(error "No cursors to be unmarked")))
(if (region-active-p)
(mc/mark-more-like-this (= arg 0) 'forwards)
(mc/mark-lines arg 'forwards)))
(mc/maybe-multiple-cursors-mode))
;;;###autoload
(defun mc/mark-next-like-this-word (arg)
"Find and mark the next part of the buffer matching the currently active region
If no region is active, mark the word at the point and find the next match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(if (< arg 0)
(let ((cursor (mc/furthest-cursor-after-point)))
(if cursor
(mc/remove-fake-cursor cursor)
(error "No cursors to be unmarked")))
(if (region-active-p)
(mc/mark-more-like-this (= arg 0) 'forwards)
(mc--select-thing-at-point 'word)
(mc/mark-more-like-this (= arg 0) 'forwards)))
(mc/maybe-multiple-cursors-mode))
(defun mc/mark-next-like-this-symbol (arg)
"Find and mark the next part of the buffer matching the currently active region
If no region is active, mark the symbol at the point and find the next match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(if (< arg 0)
(let ((cursor (mc/furthest-cursor-after-point)))
(if cursor
(mc/remove-fake-cursor cursor)
(error "No cursors to be unmarked")))
(if (region-active-p)
(mc/mark-more-like-this (= arg 0) 'forwards)
(mc--select-thing-at-point 'symbol)
(mc/mark-more-like-this (= arg 0) 'forwards)))
(mc/maybe-multiple-cursors-mode))
;;;###autoload
(defun mc/mark-next-word-like-this (arg)
"Find and mark the next word of the buffer matching the currently active region
The matching region must be a whole word to be a match
If no region is active, mark the symbol at the point and find the next match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(let ((mc/enclose-search-term 'words))
(mc/mark-next-like-this arg)))
;;;###autoload
(defun mc/mark-next-symbol-like-this (arg)
"Find and mark the next symbol of the buffer matching the currently active region
The matching region must be a whole symbol to be a match
If no region is active, mark the symbol at the point and find the next match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(let ((mc/enclose-search-term 'symbols))
(mc/mark-next-like-this arg)))
;;;###autoload
(defun mc/mark-previous-like-this (arg)
"Find and mark the previous part of the buffer matching the currently active region
If no region is active add a cursor on the previous line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(if (< arg 0)
(let ((cursor (mc/furthest-cursor-before-point)))
(if cursor
(mc/remove-fake-cursor cursor)
(error "No cursors to be unmarked")))
(if (region-active-p)
(mc/mark-more-like-this (= arg 0) 'backwards)
(mc/mark-lines arg 'backwards)))
(mc/maybe-multiple-cursors-mode))
;;;###autoload
(defun mc/mark-previous-like-this-word (arg)
"Find and mark the previous part of the buffer matching the currently active region
If no region is active, mark the word at the point and find the previous match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark previous."
(interactive "p")
(if (< arg 0)
(let ((cursor (mc/furthest-cursor-after-point)))
(if cursor
(mc/remove-fake-cursor cursor)
(error "No cursors to be unmarked")))
(if (region-active-p)
(mc/mark-more-like-this (= arg 0) 'backwards)
(mc--select-thing-at-point 'word)
(mc/mark-more-like-this (= arg 0) 'backwards)))
(mc/maybe-multiple-cursors-mode))
(defun mc/mark-previous-like-this-symbol (arg)
"Find and mark the previous part of the buffer matching the currently active region
If no region is active, mark the symbol at the point and find the previous match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark previous."
(interactive "p")
(if (< arg 0)
(let ((cursor (mc/furthest-cursor-after-point)))
(if cursor
(mc/remove-fake-cursor cursor)
(error "No cursors to be unmarked")))
(if (region-active-p)
(mc/mark-more-like-this (= arg 0) 'backwards)
(mc--select-thing-at-point 'symbol)
(mc/mark-more-like-this (= arg 0) 'backwards)))
(mc/maybe-multiple-cursors-mode))
;;;###autoload
(defun mc/mark-previous-word-like-this (arg)
"Find and mark the previous part of the buffer matching the currently active region
The matching region must be a whole word to be a match
If no region is active add a cursor on the previous line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(let ((mc/enclose-search-term 'words))
(mc/mark-previous-like-this arg)))
;;;###autoload
(defun mc/mark-previous-symbol-like-this (arg)
"Find and mark the previous part of the buffer matching the currently active region
The matching region must be a whole symbol to be a match
If no region is active add a cursor on the previous line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next."
(interactive "p")
(let ((mc/enclose-search-term 'symbols))
(mc/mark-previous-like-this arg)))
(defun mc/mark-lines (num-lines direction)
(dotimes (i (if (= num-lines 0) 1 num-lines))
(mc/save-excursion
(let ((furthest-cursor (cl-ecase direction
(forwards (mc/furthest-cursor-after-point))
(backwards (mc/furthest-cursor-before-point)))))
(when (overlayp furthest-cursor)
(goto-char (overlay-get furthest-cursor 'point))
(when (= num-lines 0)
(mc/remove-fake-cursor furthest-cursor))))
(cl-ecase direction
(forwards (next-logical-line 1 nil))
(backwards (previous-logical-line 1 nil)))
(mc/create-fake-cursor-at-point))))
;;;###autoload
(defun mc/mark-next-lines (arg)
(interactive "p")
(mc/mark-lines arg 'forwards)
(mc/maybe-multiple-cursors-mode))
;;;###autoload
(defun mc/mark-previous-lines (arg)
(interactive "p")
(mc/mark-lines arg 'backwards)
(mc/maybe-multiple-cursors-mode))
;;;###autoload
(defun mc/unmark-next-like-this ()
"Deselect next part of the buffer matching the currently active region."
(interactive)
(mc/mark-next-like-this -1))
;;;###autoload
(defun mc/unmark-previous-like-this ()
"Deselect prev part of the buffer matching the currently active region."
(interactive)
(mc/mark-previous-like-this -1))
;;;###autoload
(defun mc/skip-to-next-like-this ()
"Skip the current one and select the next part of the buffer matching the currently active region."
(interactive)
(mc/mark-next-like-this 0))
;;;###autoload
(defun mc/skip-to-previous-like-this ()
"Skip the current one and select the prev part of the buffer matching the currently active region."
(interactive)
(mc/mark-previous-like-this 0))
;;;###autoload
(defun mc/mark-all-like-this ()
"Find and mark all the parts of the buffer matching the currently active region"
(interactive)
(unless (region-active-p)
(error "Mark a region to match first."))
(mc/remove-fake-cursors)
(let ((master (point))
(case-fold-search nil)
(point-first (< (point) (mark)))
(re (regexp-opt (mc/region-strings) mc/enclose-search-term)))
(mc/save-excursion
(goto-char 0)
(while (search-forward-regexp re nil t)
(push-mark (match-beginning 0))
(when point-first (exchange-point-and-mark))
(unless (= master (point))
(mc/create-fake-cursor-at-point))
(when point-first (exchange-point-and-mark)))))
(if (> (mc/num-cursors) 1)
(multiple-cursors-mode 1)
(multiple-cursors-mode 0)))
(defun mc--select-thing-at-point (thing)
(let ((bound (bounds-of-thing-at-point thing)))
(when bound
(set-mark (car bound))
(goto-char (cdr bound))
bound)))
(defun mc--select-thing-at-point-or-bark (thing)
(unless (or (region-active-p) (mc--select-thing-at-point thing))
(error "Mark a region or set cursor on a %s." thing)))
;;;###autoload
(defun mc/mark-all-words-like-this ()
(interactive)
(mc--select-thing-at-point-or-bark 'word)
(let ((mc/enclose-search-term 'words))
(mc/mark-all-like-this)))
;;;###autoload
(defun mc/mark-all-symbols-like-this ()
(interactive)
(mc--select-thing-at-point-or-bark 'symbol)
(let ((mc/enclose-search-term 'symbols))
(mc/mark-all-like-this)))
;;;###autoload
(defun mc/mark-all-in-region (beg end &optional search)
"Find and mark all the parts in the region matching the given search"
(interactive "r")
(let ((search (or search (read-from-minibuffer "Mark all in region: ")))
(case-fold-search nil))
(if (string= search "")
(message "Mark aborted")
(progn
(mc/remove-fake-cursors)
(goto-char beg)
(while (search-forward search end t)
(push-mark (match-beginning 0))
(mc/create-fake-cursor-at-point))
(let ((first (mc/furthest-cursor-before-point)))
(if (not first)
(error "Search failed for %S" search)
(mc/pop-state-from-overlay first)))
(if (> (mc/num-cursors) 1)
(multiple-cursors-mode 1)
(multiple-cursors-mode 0))))))
;;;###autoload
(defun mc/mark-all-in-region-regexp (beg end)
"Find and mark all the parts in the region matching the given regexp."
(interactive "r")
(let ((search (read-regexp "Mark regexp in region: "))
(case-fold-search nil))
(if (string= search "")
(message "Mark aborted")
(progn
(mc/remove-fake-cursors)
(goto-char beg)
(let ((lastmatch))
(while (and (< (point) end) ; can happen because of (forward-char)
(search-forward-regexp search end t))
(push-mark (match-beginning 0))
(mc/create-fake-cursor-at-point)
(setq lastmatch (point))
(when (= (point) (match-beginning 0))
(forward-char)))
(when lastmatch (goto-char lastmatch)))
(when (> (mc/num-cursors) 0)
(goto-char (match-end 0)))
(let ((first (mc/furthest-cursor-before-point)))
(if (not first)
(error "Search failed for %S" search)
(mc/pop-state-from-overlay first)))
(if (> (mc/num-cursors) 1)
(multiple-cursors-mode 1)
(multiple-cursors-mode 0))))))
(when (not (fboundp 'set-temporary-overlay-map))
;; Backport this function from newer emacs versions
(defun set-temporary-overlay-map (map &optional keep-pred)
"Set a new keymap that will only exist for a short period of time.
The new keymap to use must be given in the MAP variable. When to
remove the keymap depends on user input and KEEP-PRED:
- if KEEP-PRED is nil (the default), the keymap disappears as
soon as any key is pressed, whether or not the key is in MAP;
- if KEEP-PRED is t, the keymap disappears as soon as a key *not*
in MAP is pressed;
- otherwise, KEEP-PRED must be a 0-arguments predicate that will
decide if the keymap should be removed (if predicate returns
nil) or kept (otherwise). The predicate will be called after
each key sequence."
(let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
(overlaysym (make-symbol "t"))
(alist (list (cons overlaysym map)))
(clearfun
`(lambda ()
(unless ,(cond ((null keep-pred) nil)
((eq t keep-pred)
`(eq this-command
(lookup-key ',map
(this-command-keys-vector))))
(t `(funcall ',keep-pred)))
(remove-hook 'pre-command-hook ',clearfunsym)
(setq emulation-mode-map-alists
(delq ',alist emulation-mode-map-alists))))))
(set overlaysym overlaysym)
(fset clearfunsym clearfun)
(add-hook 'pre-command-hook clearfunsym)
(push alist emulation-mode-map-alists))))
;;;###autoload
(defun mc/mark-more-like-this-extended ()
"Like mark-more-like-this, but then lets you adjust with arrows key.
The adjustments work like this:
<up> Mark previous like this and set direction to 'up
<down> Mark next like this and set direction to 'down
If direction is 'up:
<left> Skip past the cursor furthest up
<right> Remove the cursor furthest up
If direction is 'down:
<left> Remove the cursor furthest down
<right> Skip past the cursor furthest down
The bindings for these commands can be changed. See `mc/mark-more-like-this-extended-keymap'."
(interactive)
(mc/mmlte--down)
(set-temporary-overlay-map mc/mark-more-like-this-extended-keymap t))
(defvar mc/mark-more-like-this-extended-direction nil
"When using mc/mark-more-like-this-extended are we working on the next or previous cursors?")
(make-variable-buffer-local 'mc/mark-more-like-this-extended)
(defun mc/mmlte--message ()
(if (eq mc/mark-more-like-this-extended-direction 'up)
(message "<up> to mark previous, <left> to skip, <right> to remove, <down> to mark next")
(message "<down> to mark next, <right> to skip, <left> to remove, <up> to mark previous")))
(defun mc/mmlte--up ()
(interactive)
(mc/mark-previous-like-this 1)
(setq mc/mark-more-like-this-extended-direction 'up)
(mc/mmlte--message))
(defun mc/mmlte--down ()
(interactive)
(mc/mark-next-like-this 1)
(setq mc/mark-more-like-this-extended-direction 'down)
(mc/mmlte--message))
(defun mc/mmlte--left ()
(interactive)
(if (eq mc/mark-more-like-this-extended-direction 'down)
(mc/unmark-next-like-this)
(mc/skip-to-previous-like-this))
(mc/mmlte--message))
(defun mc/mmlte--right ()
(interactive)
(if (eq mc/mark-more-like-this-extended-direction 'up)
(mc/unmark-previous-like-this)
(mc/skip-to-next-like-this))
(mc/mmlte--message))
(defvar mc/mark-more-like-this-extended-keymap (make-sparse-keymap))
(define-key mc/mark-more-like-this-extended-keymap (kbd "<up>") 'mc/mmlte--up)
(define-key mc/mark-more-like-this-extended-keymap (kbd "<down>") 'mc/mmlte--down)
(define-key mc/mark-more-like-this-extended-keymap (kbd "<left>") 'mc/mmlte--left)
(define-key mc/mark-more-like-this-extended-keymap (kbd "<right>") 'mc/mmlte--right)
(defvar mc--restrict-mark-all-to-symbols nil)
;;;###autoload
(defun mc/mark-all-like-this-dwim (arg)
"Tries to guess what you want to mark all of.
Can be pressed multiple times to increase selection.
With prefix, it behaves the same as original `mc/mark-all-like-this'"
(interactive "P")
(if arg
(mc/mark-all-like-this)
(if (and (not (use-region-p))
(derived-mode-p 'sgml-mode)
(mc--on-tag-name-p))
(mc/mark-sgml-tag-pair)
(let ((before (mc/num-cursors)))
(unless (eq last-command 'mc/mark-all-like-this-dwim)
(setq mc--restrict-mark-all-to-symbols nil))
(unless (use-region-p)
(mc--mark-symbol-at-point)
(setq mc--restrict-mark-all-to-symbols t))
(if mc--restrict-mark-all-to-symbols
(mc/mark-all-symbols-like-this-in-defun)
(mc/mark-all-like-this-in-defun))
(when (<= (mc/num-cursors) before)
(if mc--restrict-mark-all-to-symbols
(mc/mark-all-symbols-like-this)
(mc/mark-all-like-this)))
(when (<= (mc/num-cursors) before)
(mc/mark-all-like-this))))))
;;;###autoload
(defun mc/mark-all-dwim (arg)
"Tries even harder to guess what you want to mark all of.
If the region is active and spans multiple lines, it will behave
as if `mc/mark-all-in-region'. With the prefix ARG, it will call
`mc/edit-lines' instead.
If the region is inactive or on a single line, it will behave like
`mc/mark-all-like-this-dwim'."
(interactive "P")
(if (and (use-region-p)
(not (> (mc/num-cursors) 1))
(not (= (line-number-at-pos (region-beginning))
(line-number-at-pos (region-end)))))
(if arg
(call-interactively 'mc/edit-lines)
(call-interactively 'mc/mark-all-in-region))
(progn
(setq this-command 'mc/mark-all-like-this-dwim)
(mc/mark-all-like-this-dwim arg))))
(defun mc--in-defun ()
(bounds-of-thing-at-point 'defun))
;;;###autoload
(defun mc/mark-all-like-this-in-defun ()
"Mark all like this in defun."
(interactive)
(if (mc--in-defun)
(save-restriction
(widen)
(narrow-to-defun)
(mc/mark-all-like-this))
(mc/mark-all-like-this)))
;;;###autoload
(defun mc/mark-all-words-like-this-in-defun ()
"Mark all words like this in defun."
(interactive)
(mc--select-thing-at-point-or-bark 'word)
(if (mc--in-defun)
(save-restriction
(widen)
(narrow-to-defun)
(mc/mark-all-words-like-this))
(mc/mark-all-words-like-this)))
;;;###autoload
(defun mc/mark-all-symbols-like-this-in-defun ()
"Mark all symbols like this in defun."
(interactive)
(mc--select-thing-at-point-or-bark 'symbol)
(if (mc--in-defun)
(save-restriction
(widen)
(narrow-to-defun)
(mc/mark-all-symbols-like-this))
(mc/mark-all-symbols-like-this)))
(defun mc--mark-symbol-at-point ()
"Select the symbol under cursor"
(interactive)
(when (not (use-region-p))
(let ((b (bounds-of-thing-at-point 'symbol)))
(goto-char (car b))
(set-mark (cdr b)))))
(defun mc--get-nice-sgml-context ()
(car
(last
(progn
(when (looking-at "<") (forward-char 1))
(when (looking-back ">") (forward-char -1))
(sgml-get-context)))))
(defun mc--on-tag-name-p ()
(let* ((context (save-excursion (mc--get-nice-sgml-context)))
(tag-name-len (length (aref context 4)))
(beg (aref context 2))
(end (+ beg tag-name-len (if (eq 'open (aref context 1)) 1 3))))
(and context
(>= (point) beg)
(<= (point) end))))
;;;###autoload
(defun mc/toggle-cursor-on-click (event)
"Add a cursor where you click, or remove a fake cursor that is
already there."
(interactive "e")
(mouse-minibuffer-check event)
;; Use event-end in case called from mouse-drag-region.
;; If EVENT is a click, event-end and event-start give same value.
(let ((position (event-end event)))
(if (not (windowp (posn-window position)))
(error "Position not in text area of window"))
(select-window (posn-window position))
(let ((pt (posn-point position)))
(if (numberp pt)
;; is there a fake cursor with the actual *point* right where we are?
(let ((existing (mc/fake-cursor-at-point pt)))
(if existing
(mc/remove-fake-cursor existing)
(save-excursion
(goto-char pt)
(mc/create-fake-cursor-at-point))))))
(mc/maybe-multiple-cursors-mode)))
;;;###autoload
(defalias 'mc/add-cursor-on-click 'mc/toggle-cursor-on-click)
;;;###autoload
(defun mc/mark-sgml-tag-pair ()
"Mark the tag we're in and its pair for renaming."
(interactive)
(when (not (mc--inside-tag-p))
(error "Place point inside tag to rename."))
(let ((context (mc--get-nice-sgml-context)))
(if (looking-at "</")
(setq context (car (last (sgml-get-context)))))
(goto-char (aref context 2))
(let* ((tag-name (aref context 4))
(num-chars (length tag-name))
(master-start (1+ (point)))
(mirror-end (save-excursion
(sgml-skip-tag-forward 1)
(1- (point)))))
(goto-char (- mirror-end num-chars))
(set-mark mirror-end)
(mc/create-fake-cursor-at-point)
(goto-char master-start)
(set-mark (+ (point) num-chars))))
(mc/maybe-multiple-cursors-mode))
(defun mc--inside-tag-p ()
(save-excursion
(not (null (sgml-get-context)))))
(provide 'mc-mark-more)
;;; mc-mark-more.el ends here

22
elpa/multiple-cursors-20160719.216/mc-mark-pop.el Normal file
View File

@ -0,0 +1,22 @@
;;; mc-mark-pop.el --- Pop cursors off of the mark stack
(require 'multiple-cursors-core)
;;;###autoload
(defun mc/mark-pop ()
"Add a cursor at the current point, pop off mark ring and jump
to the popped mark."
(interactive)
;; If the mark happens to be at the current point, just pop that one off.
(while (eql (mark) (point))
(pop-mark))
(mc/create-fake-cursor-at-point)
(exchange-point-and-mark)
(pop-mark)
(mc/maybe-multiple-cursors-mode))
;; A good key binding for this feature is perhaps "C-S-p" ('p' for pop).
(provide 'mc-mark-pop)
;;; mc-mark-pop.el ends here

155
elpa/multiple-cursors-20160719.216/mc-separate-operations.el Normal file
View File

@ -0,0 +1,155 @@
;;; mc-separate-operations.el - functions that work differently on each cursor
;; Copyright (C) 2012-2016 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file contains functions that work differently on each cursor,
;; instead of treating all of them the same.
;; Please see multiple-cursors.el for more commentary.
;;; Code:
(require 'multiple-cursors-core)
;;;###autoload
(defun mc/insert-numbers (arg)
"Insert increasing numbers for each cursor, starting at
`mc/insert-numbers-default' or ARG."
(interactive "P")
(setq mc--insert-numbers-number (or (and arg (prefix-numeric-value arg))
mc/insert-numbers-default))
(mc/for-each-cursor-ordered
(mc/execute-command-for-fake-cursor 'mc--insert-number-and-increase cursor)))
(defcustom mc/insert-numbers-default 0
"The default number at which to start counting for
`mc/insert-numbers'"
:type 'integer
:group 'multiple-cursors)
(defvar mc--insert-numbers-number 0)
(defun mc--insert-number-and-increase ()
(interactive)
(insert (number-to-string mc--insert-numbers-number))
(setq mc--insert-numbers-number (1+ mc--insert-numbers-number)))
(defun mc--ordered-region-strings ()
(let (strings)
(save-excursion
(mc/for-each-cursor-ordered
(setq strings (cons (buffer-substring-no-properties
(mc/cursor-beg cursor)
(mc/cursor-end cursor)) strings))))
(nreverse strings)))
;;;###autoload
(defun mc/insert-letters (arg)
"Insert increasing letters for each cursor, starting at 0 or ARG.
Where letter[0]=a letter[2]=c letter[26]=aa"
(interactive "P")
(setq mc--insert-letters-number (or (and arg (prefix-numeric-value arg))
0))
(mc/for-each-cursor-ordered
(mc/execute-command-for-fake-cursor 'mc--insert-letter-and-increase cursor)))
(defun mc--number-to-letters (number)
(let ((letter
(char-to-string
(+ (mod number 26) ?a)))
(number2 (/ number 26)))
(if (> number2 0)
(concat (mc--number-to-letters (- number2 1)) letter)
letter)))
(defvar mc--insert-letters-number 0)
(defun mc--insert-letter-and-increase ()
(interactive)
(insert (mc--number-to-letters mc--insert-letters-number))
(setq mc--insert-letters-number (1+ mc--insert-letters-number)))
(defvar mc--strings-to-replace nil)
(defun mc--replace-region-strings-1 ()
(interactive)
(delete-region (region-beginning) (region-end))
(save-excursion (insert (car mc--strings-to-replace)))
(setq mc--strings-to-replace (cdr mc--strings-to-replace)))
(defun mc--replace-region-strings ()
(mc/for-each-cursor-ordered
(mc/execute-command-for-fake-cursor 'mc--replace-region-strings-1 cursor)))
;;;###autoload
(defun mc/reverse-regions ()
(interactive)
(if (not multiple-cursors-mode)
(progn
(mc/mark-next-lines 1)
(mc/reverse-regions)
(multiple-cursors-mode 0))
(unless (use-region-p)
(mc/execute-command-for-all-cursors 'mark-sexp))
(setq mc--strings-to-replace (nreverse (mc--ordered-region-strings)))
(mc--replace-region-strings)))
;;;###autoload
(defun mc/sort-regions ()
(interactive)
(unless (use-region-p)
(mc/execute-command-for-all-cursors 'mark-sexp))
(setq mc--strings-to-replace (sort (mc--ordered-region-strings) 'string<))
(mc--replace-region-strings))
;;;###autoload
(defun mc/vertical-align (character)
"Aligns all cursors vertically with a given CHARACTER to the one with the
highest colum number (the rightest).
Might not behave as intended if more than one cursors are on the same line."
(interactive "c")
(let ((rightest-column (current-column)))
(mc/execute-command-for-all-cursors
(lambda () "get the rightest cursor"
(interactive)
(setq rightest-column (max (current-column) rightest-column))
))
(mc/execute-command-for-all-cursors
(lambda ()
(interactive)
(let ((missing-spaces (- rightest-column (current-column))))
(save-excursion (insert (make-string missing-spaces character)))
(forward-char missing-spaces)
)
))
)
)
;;;###autoload
(defun mc/vertical-align-with-space ()
"Aligns all cursors with whitespace like `mc/vertical-align' does"
(interactive)
(mc/vertical-align 32)
)
(provide 'mc-separate-operations)
;;; mc-separate-operations.el ends here

341
elpa/multiple-cursors-20160719.216/multiple-cursors-autoloads.el Normal file
View File

@ -0,0 +1,341 @@
;;; multiple-cursors-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "mc-edit-lines" "mc-edit-lines.el" (22490 32823
;;;;;; 997859 430000))
;;; Generated autoloads from mc-edit-lines.el
(autoload 'mc/edit-lines "mc-edit-lines" "\
Add one cursor to each line of the active region.
Starts from mark and moves in straight down or up towards the
line point is on.
What is done with lines which are not long enough is governed by
`mc/edit-lines-empty-lines'. The prefix argument ARG can be used
to override this. If ARG is a symbol (when called from Lisp),
that symbol is used instead of `mc/edit-lines-empty-lines'.
Otherwise, if ARG negative, short lines will be ignored. Any
other non-nil value will cause short lines to be padded.
\(fn &optional ARG)" t nil)
(autoload 'mc/edit-ends-of-lines "mc-edit-lines" "\
Add one cursor to the end of each line in the active region.
\(fn)" t nil)
(autoload 'mc/edit-beginnings-of-lines "mc-edit-lines" "\
Add one cursor to the beginning of each line in the active region.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "mc-hide-unmatched-lines-mode" "mc-hide-unmatched-lines-mode.el"
;;;;;; (22490 32824 21859 382000))
;;; Generated autoloads from mc-hide-unmatched-lines-mode.el
(autoload 'mc-hide-unmatched-lines-mode "mc-hide-unmatched-lines-mode" "\
Minor mode when enabled hides all lines where no cursors (and
also hum/lines-to-expand below and above) To make use of this
mode press \"C-'\" while multiple-cursor-mode is active. You can
still edit lines while you are in mc-hide-unmatched-lines
mode. To leave this mode press <return> or \"C-g\"
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "mc-mark-more" "mc-mark-more.el" (22490 32824
;;;;;; 45859 333000))
;;; Generated autoloads from mc-mark-more.el
(autoload 'mc/mark-next-like-this "mc-mark-more" "\
Find and mark the next part of the buffer matching the currently active region
If no region is active add a cursor on the next line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next.
\(fn ARG)" t nil)
(autoload 'mc/mark-next-like-this-word "mc-mark-more" "\
Find and mark the next part of the buffer matching the currently active region
If no region is active, mark the word at the point and find the next match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next.
\(fn ARG)" t nil)
(autoload 'mc/mark-next-word-like-this "mc-mark-more" "\
Find and mark the next word of the buffer matching the currently active region
The matching region must be a whole word to be a match
If no region is active, mark the symbol at the point and find the next match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next.
\(fn ARG)" t nil)
(autoload 'mc/mark-next-symbol-like-this "mc-mark-more" "\
Find and mark the next symbol of the buffer matching the currently active region
The matching region must be a whole symbol to be a match
If no region is active, mark the symbol at the point and find the next match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next.
\(fn ARG)" t nil)
(autoload 'mc/mark-previous-like-this "mc-mark-more" "\
Find and mark the previous part of the buffer matching the currently active region
If no region is active add a cursor on the previous line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next.
\(fn ARG)" t nil)
(autoload 'mc/mark-previous-like-this-word "mc-mark-more" "\
Find and mark the previous part of the buffer matching the currently active region
If no region is active, mark the word at the point and find the previous match
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark previous.
\(fn ARG)" t nil)
(autoload 'mc/mark-previous-word-like-this "mc-mark-more" "\
Find and mark the previous part of the buffer matching the currently active region
The matching region must be a whole word to be a match
If no region is active add a cursor on the previous line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next.
\(fn ARG)" t nil)
(autoload 'mc/mark-previous-symbol-like-this "mc-mark-more" "\
Find and mark the previous part of the buffer matching the currently active region
The matching region must be a whole symbol to be a match
If no region is active add a cursor on the previous line
With negative ARG, delete the last one instead.
With zero ARG, skip the last one and mark next.
\(fn ARG)" t nil)
(autoload 'mc/mark-next-lines "mc-mark-more" "\
\(fn ARG)" t nil)
(autoload 'mc/mark-previous-lines "mc-mark-more" "\
\(fn ARG)" t nil)
(autoload 'mc/unmark-next-like-this "mc-mark-more" "\
Deselect next part of the buffer matching the currently active region.
\(fn)" t nil)
(autoload 'mc/unmark-previous-like-this "mc-mark-more" "\
Deselect prev part of the buffer matching the currently active region.
\(fn)" t nil)
(autoload 'mc/skip-to-next-like-this "mc-mark-more" "\
Skip the current one and select the next part of the buffer matching the currently active region.
\(fn)" t nil)
(autoload 'mc/skip-to-previous-like-this "mc-mark-more" "\
Skip the current one and select the prev part of the buffer matching the currently active region.
\(fn)" t nil)
(autoload 'mc/mark-all-like-this "mc-mark-more" "\
Find and mark all the parts of the buffer matching the currently active region
\(fn)" t nil)
(autoload 'mc/mark-all-words-like-this "mc-mark-more" "\
\(fn)" t nil)
(autoload 'mc/mark-all-symbols-like-this "mc-mark-more" "\
\(fn)" t nil)
(autoload 'mc/mark-all-in-region "mc-mark-more" "\
Find and mark all the parts in the region matching the given search
\(fn BEG END &optional SEARCH)" t nil)
(autoload 'mc/mark-all-in-region-regexp "mc-mark-more" "\
Find and mark all the parts in the region matching the given regexp.
\(fn BEG END)" t nil)
(autoload 'mc/mark-more-like-this-extended "mc-mark-more" "\
Like mark-more-like-this, but then lets you adjust with arrows key.
The adjustments work like this:
<up> Mark previous like this and set direction to 'up
<down> Mark next like this and set direction to 'down
If direction is 'up:
<left> Skip past the cursor furthest up
<right> Remove the cursor furthest up
If direction is 'down:
<left> Remove the cursor furthest down
<right> Skip past the cursor furthest down
The bindings for these commands can be changed. See `mc/mark-more-like-this-extended-keymap'.
\(fn)" t nil)
(autoload 'mc/mark-all-like-this-dwim "mc-mark-more" "\
Tries to guess what you want to mark all of.
Can be pressed multiple times to increase selection.
With prefix, it behaves the same as original `mc/mark-all-like-this'
\(fn ARG)" t nil)
(autoload 'mc/mark-all-dwim "mc-mark-more" "\
Tries even harder to guess what you want to mark all of.
If the region is active and spans multiple lines, it will behave
as if `mc/mark-all-in-region'. With the prefix ARG, it will call
`mc/edit-lines' instead.
If the region is inactive or on a single line, it will behave like
`mc/mark-all-like-this-dwim'.
\(fn ARG)" t nil)
(autoload 'mc/mark-all-like-this-in-defun "mc-mark-more" "\
Mark all like this in defun.
\(fn)" t nil)
(autoload 'mc/mark-all-words-like-this-in-defun "mc-mark-more" "\
Mark all words like this in defun.
\(fn)" t nil)
(autoload 'mc/mark-all-symbols-like-this-in-defun "mc-mark-more" "\
Mark all symbols like this in defun.
\(fn)" t nil)
(autoload 'mc/toggle-cursor-on-click "mc-mark-more" "\
Add a cursor where you click, or remove a fake cursor that is
already there.
\(fn EVENT)" t nil)
(defalias 'mc/add-cursor-on-click 'mc/toggle-cursor-on-click)
(autoload 'mc/mark-sgml-tag-pair "mc-mark-more" "\
Mark the tag we're in and its pair for renaming.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "mc-mark-pop" "mc-mark-pop.el" (22490 32824
;;;;;; 13859 397000))
;;; Generated autoloads from mc-mark-pop.el
(autoload 'mc/mark-pop "mc-mark-pop" "\
Add a cursor at the current point, pop off mark ring and jump
to the popped mark.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "mc-separate-operations" "mc-separate-operations.el"
;;;;;; (22490 32824 29859 364000))
;;; Generated autoloads from mc-separate-operations.el
(autoload 'mc/insert-numbers "mc-separate-operations" "\
Insert increasing numbers for each cursor, starting at
`mc/insert-numbers-default' or ARG.
\(fn ARG)" t nil)
(autoload 'mc/insert-letters "mc-separate-operations" "\
Insert increasing letters for each cursor, starting at 0 or ARG.
Where letter[0]=a letter[2]=c letter[26]=aa
\(fn ARG)" t nil)
(autoload 'mc/reverse-regions "mc-separate-operations" "\
\(fn)" t nil)
(autoload 'mc/sort-regions "mc-separate-operations" "\
\(fn)" t nil)
(autoload 'mc/vertical-align "mc-separate-operations" "\
Aligns all cursors vertically with a given CHARACTER to the one with the
highest colum number (the rightest).
Might not behave as intended if more than one cursors are on the same line.
\(fn CHARACTER)" t nil)
(autoload 'mc/vertical-align-with-space "mc-separate-operations" "\
Aligns all cursors with whitespace like `mc/vertical-align' does
\(fn)" t nil)
;;;***
;;;### (autoloads nil "multiple-cursors-core" "multiple-cursors-core.el"
;;;;;; (22490 32823 989859 446000))
;;; Generated autoloads from multiple-cursors-core.el
(autoload 'multiple-cursors-mode "multiple-cursors-core" "\
Mode while multiple cursors are active.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "rectangular-region-mode" "rectangular-region-mode.el"
;;;;;; (22490 32824 9859 405000))
;;; Generated autoloads from rectangular-region-mode.el
(autoload 'set-rectangular-region-anchor "rectangular-region-mode" "\
Anchors the rectangular region at point.
Think of this one as `set-mark' except you're marking a rectangular region. It is
an exceedingly quick way of adding multiple cursors to multiple lines.
\(fn)" t nil)
(autoload 'rectangular-region-mode "rectangular-region-mode" "\
A mode for creating a rectangular region to edit
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil nil ("mc-cycle-cursors.el" "multiple-cursors-pkg.el"
;;;;;; "multiple-cursors.el") (22490 32824 65463 898000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; multiple-cursors-autoloads.el ends here

790
elpa/multiple-cursors-20160719.216/multiple-cursors-core.el Normal file
View File

@ -0,0 +1,790 @@
;;; multiple-cursors-core.el --- An experiment in multiple cursors for emacs.
;; Copyright (C) 2012-2016 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file contains the core functionality of multiple-cursors.
;; Please see multiple-cursors.el for more commentary.
;;; Code:
(require 'cl-lib)
(require 'rect)
(defvar mc--read-char)
(defface mc/cursor-face
'((t (:inverse-video t)))
"The face used for fake cursors"
:group 'multiple-cursors)
(defface mc/cursor-bar-face
`((t (:height 1 :background ,(face-attribute 'cursor :background))))
"The face used for fake cursors if the cursor-type is bar"
:group 'multiple-cursors)
(defface mc/region-face
'((t :inherit region))
"The face used for fake regions"
:group 'multiple-cursors)
(defmacro mc/add-fake-cursor-to-undo-list (&rest forms)
"Make sure point is in the right place when undoing"
(let ((uc (make-symbol "undo-cleaner")))
`(let ((,uc (cons 'apply (cons 'deactivate-cursor-after-undo (list id)))))
(setq buffer-undo-list (cons ,uc buffer-undo-list))
,@forms
(if (eq ,uc (car buffer-undo-list)) ;; if nothing has been added to the undo-list
(setq buffer-undo-list (cdr buffer-undo-list)) ;; then pop the cleaner right off again
(setq buffer-undo-list ;; otherwise add a function to activate this cursor
(cons (cons 'apply (cons 'activate-cursor-for-undo (list id))) buffer-undo-list))))))
(defun mc/all-fake-cursors (&optional start end)
(cl-remove-if-not 'mc/fake-cursor-p
(overlays-in (or start (point-min))
(or end (point-max)))))
(defmacro mc/for-each-fake-cursor (&rest forms)
"Runs the body for each fake cursor, bound to the name cursor"
`(mapc #'(lambda (cursor) ,@forms)
(mc/all-fake-cursors)))
(defmacro mc/save-excursion (&rest forms)
"Saves and restores all the state that multiple-cursors cares about."
(let ((cs (make-symbol "current-state")))
`(let ((,cs (mc/store-current-state-in-overlay
(make-overlay (point) (point) nil nil t))))
(overlay-put ,cs 'type 'original-cursor)
(save-excursion ,@forms)
(mc/pop-state-from-overlay ,cs))))
(defun mc--compare-by-overlay-start (o1 o2)
(< (overlay-start o1) (overlay-start o2)))
(defmacro mc/for-each-cursor-ordered (&rest forms)
"Runs the body for each cursor, fake and real, bound to the name cursor"
(let ((rci (make-symbol "real-cursor-id")))
`(let ((,rci (overlay-get (mc/create-fake-cursor-at-point) 'mc-id)))
(mapc #'(lambda (cursor)
(when (mc/fake-cursor-p cursor)
,@forms))
(sort (overlays-in (point-min) (point-max)) 'mc--compare-by-overlay-start))
(mc/pop-state-from-overlay (mc/cursor-with-id ,rci)))))
(defmacro mc/save-window-scroll (&rest forms)
"Saves and restores the window scroll position"
(let ((p (make-symbol "p"))
(s (make-symbol "start"))
(h (make-symbol "hscroll")))
`(let ((,p (set-marker (make-marker) (point)))
(,s (set-marker (make-marker) (window-start)))
(,h (window-hscroll)))
,@forms
(goto-char ,p)
(set-window-start nil ,s t)
(set-window-hscroll nil ,h)
(set-marker ,p nil)
(set-marker ,s nil))))
(defun mc/cursor-is-bar ()
"Return non-nil if the cursor is a bar."
(or (eq cursor-type 'bar)
(and (listp cursor-type)
(eq (car cursor-type) 'bar))))
(defun mc/make-cursor-overlay-at-eol (pos)
"Create overlay to look like cursor at end of line."
(let ((overlay (make-overlay pos pos nil nil nil)))
(if (mc/cursor-is-bar)
(overlay-put overlay 'before-string (propertize "|" 'face 'mc/cursor-bar-face))
(overlay-put overlay 'after-string (propertize " " 'face 'mc/cursor-face)))
overlay))
(defun mc/make-cursor-overlay-inline (pos)
"Create overlay to look like cursor inside text."
(let ((overlay (make-overlay pos (1+ pos) nil nil nil)))
(if (mc/cursor-is-bar)
(overlay-put overlay 'before-string (propertize "|" 'face 'mc/cursor-bar-face))
(overlay-put overlay 'face 'mc/cursor-face))
overlay))
(defun mc/make-cursor-overlay-at-point ()
"Create overlay to look like cursor.
Special case for end of line, because overlay over a newline
highlights the entire width of the window."
(if (eolp)
(mc/make-cursor-overlay-at-eol (point))
(mc/make-cursor-overlay-inline (point))))
(defun mc/make-region-overlay-between-point-and-mark ()
"Create overlay to look like active region."
(let ((overlay (make-overlay (mark) (point) nil nil t)))
(overlay-put overlay 'face 'mc/region-face)
(overlay-put overlay 'type 'additional-region)
overlay))
(defvar mc/cursor-specific-vars '(transient-mark-mode
kill-ring
kill-ring-yank-pointer
mark-ring
mark-active
yank-undo-function
autopair-action
autopair-wrap-action
er/history)
"A list of vars that need to be tracked on a per-cursor basis.")
(defun mc/store-current-state-in-overlay (o)
"Store relevant info about point and mark in the given overlay."
(overlay-put o 'point (set-marker (make-marker) (point)))
(overlay-put o 'mark (set-marker (make-marker) (mark)))
(dolist (var mc/cursor-specific-vars)
(when (boundp var) (overlay-put o var (symbol-value var))))
o)
(defun mc/restore-state-from-overlay (o)
"Restore point and mark from stored info in the given overlay."
(goto-char (overlay-get o 'point))
(set-marker (mark-marker) (overlay-get o 'mark))
(dolist (var mc/cursor-specific-vars)
(when (boundp var) (set var (overlay-get o var)))))
(defun mc/remove-fake-cursor (o)
"Delete overlay with state, including dependent overlays and markers."
(set-marker (overlay-get o 'point) nil)
(set-marker (overlay-get o 'mark) nil)
(mc/delete-region-overlay o)
(delete-overlay o))
(defun mc/pop-state-from-overlay (o)
"Restore the state stored in given overlay and then remove the overlay."
(mc/restore-state-from-overlay o)
(mc/remove-fake-cursor o))
(defun mc/delete-region-overlay (o)
"Remove the dependent region overlay for a given cursor overlay."
(ignore-errors
(delete-overlay (overlay-get o 'region-overlay))))
(defvar mc--current-cursor-id 0
"Var to store increasing id of fake cursors, used to keep track of them for undo.")
(defun mc/create-cursor-id ()
"Returns a unique cursor id"
(cl-incf mc--current-cursor-id))
(defvar mc--max-cursors-original nil
"This variable maintains the original maximum number of cursors.
When `mc/create-fake-cursor-at-point' is called and
`mc/max-cursors' is overridden, this value serves as a backup so
that `mc/max-cursors' can take on a new value. When
`mc/remove-fake-cursors' is called, the values are reset.")
(defcustom mc/max-cursors nil
"Safety ceiling for the number of active cursors.
If your emacs slows down or freezes when using too many cursors,
customize this value appropriately.
Cursors will be added until this value is reached, at which point
you can either temporarily override the value or abort the
operation entirely.
If this value is nil, there is no ceiling."
:type '(integer)
:group 'multiple-cursors)
(defun mc/create-fake-cursor-at-point (&optional id)
"Add a fake cursor and possibly a fake active region overlay based on point and mark.
Saves the current state in the overlay to be restored later."
(unless mc--max-cursors-original
(setq mc--max-cursors-original mc/max-cursors))
(when mc/max-cursors
(unless (< (mc/num-cursors) mc/max-cursors)
(if (yes-or-no-p (format "%d active cursors. Continue? " (mc/num-cursors)))
(setq mc/max-cursors (read-number "Enter a new, temporary maximum: "))
(mc/remove-fake-cursors)
(error "Aborted: too many cursors"))))
(let ((overlay (mc/make-cursor-overlay-at-point)))
(overlay-put overlay 'mc-id (or id (mc/create-cursor-id)))
(overlay-put overlay 'type 'fake-cursor)
(overlay-put overlay 'priority 100)
(mc/store-current-state-in-overlay overlay)
(when (use-region-p)
(overlay-put overlay 'region-overlay
(mc/make-region-overlay-between-point-and-mark)))
overlay))
(defun mc/execute-command (cmd)
"Run command, simulating the parts of the command loop that makes sense for fake cursors."
(setq this-command cmd)
(run-hooks 'pre-command-hook)
(unless (eq this-command 'ignore)
(call-interactively cmd))
(run-hooks 'post-command-hook)
(when deactivate-mark (deactivate-mark)))
(defvar mc--executing-command-for-fake-cursor nil)
(defun mc/execute-command-for-fake-cursor (cmd cursor)
(let ((mc--executing-command-for-fake-cursor t)
(id (overlay-get cursor 'mc-id))
(annoying-arrows-mode nil)
(smooth-scroll-margin 0))
(mc/add-fake-cursor-to-undo-list
(mc/pop-state-from-overlay cursor)
(ignore-errors
(mc/execute-command cmd)
(mc/create-fake-cursor-at-point id)))))
(defun mc/execute-command-for-all-fake-cursors (cmd)
"Calls CMD interactively for each cursor.
It works by moving point to the fake cursor, setting
up the proper environment, and then removing the cursor.
After executing the command, it sets up a new fake
cursor with updated info."
(mc/save-excursion
(mc/save-window-scroll
(mc/for-each-fake-cursor
(save-excursion
(mc/execute-command-for-fake-cursor cmd cursor)))))
(mc--reset-read-prompts))
(defun mc/execute-command-for-all-cursors (cmd)
"Calls CMD interactively for the real cursor and all fakes."
(call-interactively cmd)
(mc/execute-command-for-all-fake-cursors cmd))
;; Intercept some reading commands so you won't have to
;; answer them for every single cursor
(defvar mc--read-char nil)
(defvar multiple-cursors-mode nil)
(defadvice read-char (around mc-support activate)
(if (not multiple-cursors-mode)
ad-do-it
(unless mc--read-char
(setq mc--read-char ad-do-it))
(setq ad-return-value mc--read-char)))
(defvar mc--read-quoted-char nil)
(defadvice read-quoted-char (around mc-support activate)
(if (not multiple-cursors-mode)
ad-do-it
(unless mc--read-quoted-char
(setq mc--read-quoted-char ad-do-it))
(setq ad-return-value mc--read-quoted-char)))
(defun mc--reset-read-prompts ()
(setq mc--read-char nil)
(setq mc--read-quoted-char nil))
(mc--reset-read-prompts)
(defun mc/fake-cursor-p (o)
"Predicate to check if an overlay is a fake cursor"
(eq (overlay-get o 'type) 'fake-cursor))
(defun mc/cursor-with-id (id)
"Find the first cursor with the given id, or nil"
(cl-find-if #'(lambda (o) (and (mc/fake-cursor-p o)
(= id (overlay-get o 'mc-id))))
(overlays-in (point-min) (point-max))))
(defvar mc--stored-state-for-undo nil
"Variable to keep the state of the real cursor while undoing a fake one")
(defun activate-cursor-for-undo (id)
"Called when undoing to temporarily activate the fake cursor which action is being undone."
(let ((cursor (mc/cursor-with-id id)))
(when cursor
(setq mc--stored-state-for-undo (mc/store-current-state-in-overlay
(make-overlay (point) (point) nil nil t)))
(mc/pop-state-from-overlay cursor))))
(defun deactivate-cursor-after-undo (id)
"Called when undoing to reinstate the real cursor after undoing a fake one."
(when mc--stored-state-for-undo
(mc/create-fake-cursor-at-point id)
(mc/pop-state-from-overlay mc--stored-state-for-undo)
(setq mc--stored-state-for-undo nil)))
(defcustom mc/always-run-for-all nil
"Disables whitelisting and always executes commands for every fake cursor."
:type '(boolean)
:group 'multiple-cursors)
(defun mc/prompt-for-inclusion-in-whitelist (original-command)
"Asks the user, then adds the command either to the once-list or the all-list."
(let ((all-p (y-or-n-p (format "Do %S for all cursors?" original-command))))
(if all-p
(add-to-list 'mc/cmds-to-run-for-all original-command)
(add-to-list 'mc/cmds-to-run-once original-command))
(mc/save-lists)
all-p))
(defun mc/num-cursors ()
"The number of cursors (real and fake) in the buffer."
(1+ (cl-count-if 'mc/fake-cursor-p
(overlays-in (point-min) (point-max)))))
(defvar mc--this-command nil
"Used to store the original command being run.")
(make-variable-buffer-local 'mc--this-command)
(defun mc/make-a-note-of-the-command-being-run ()
"Used with pre-command-hook to store the original command being run.
Since that cannot be reliably determined in the post-command-hook.
Specifically, this-original-command isn't always right, because it could have
been remapped. And certain modes (cua comes to mind) will change their
remapping based on state. So a command that changes the state will afterwards
not be recognized through the command-remapping lookup."
(unless mc--executing-command-for-fake-cursor
(let ((cmd (or (command-remapping this-original-command)
this-original-command)))
(setq mc--this-command (and (not (eq cmd 'god-mode-self-insert))
cmd)))))
(defun mc/execute-this-command-for-all-cursors ()
"Wrap around `mc/execute-this-command-for-all-cursors-1' to protect hook."
(condition-case error
(mc/execute-this-command-for-all-cursors-1)
(error
(message "[mc] problem in `mc/execute-this-command-for-all-cursors': %s"
(error-message-string error)))))
;; execute-kbd-macro should never be run for fake cursors. The real cursor will
;; execute the keyboard macro, resulting in new commands in the command loop,
;; and the fake cursors can pick up on those instead.
(defadvice execute-kbd-macro (around skip-fake-cursors activate)
(unless mc--executing-command-for-fake-cursor
ad-do-it))
(defun mc/execute-this-command-for-all-cursors-1 ()
"Used with post-command-hook to execute supported commands for all cursors.
It uses two lists of commands to know what to do: the run-once
list and the run-for-all list. If a command is in neither of these lists,
it will prompt for the proper action and then save that preference.
Some commands are so unsupported that they are even prevented for
the original cursor, to inform about the lack of support."
(unless mc--executing-command-for-fake-cursor
(if (eq 1 (mc/num-cursors)) ;; no fake cursors? disable mc-mode
(multiple-cursors-mode 0)
(when this-original-command
(let ((original-command (or mc--this-command
(command-remapping this-original-command)
this-original-command)))
;; skip keyboard macros, since they will generate actual commands that are
;; also run in the command loop - we'll handle those later instead.
(when (functionp original-command)
;; if it's a lambda, we can't know if it's supported or not
;; - so go ahead and assume it's ok, because we're just optimistic like that
(if (or (not (symbolp original-command))
;; lambda registered by smartrep
(string-prefix-p "(" (symbol-name original-command)))
(mc/execute-command-for-all-fake-cursors original-command)
;; smartrep `intern's commands into own obarray to help
;; `describe-bindings'. So, let's re-`intern' here to
;; make the command comparable by `eq'.
(setq original-command (intern (symbol-name original-command)))
;; otherwise it's a symbol, and we can be more thorough
(if (get original-command 'mc--unsupported)
(message "%S is not supported with multiple cursors%s"
original-command
(get original-command 'mc--unsupported))
(when (and original-command
(not (memq original-command mc--default-cmds-to-run-once))
(not (memq original-command mc/cmds-to-run-once))
(or mc/always-run-for-all
(memq original-command mc--default-cmds-to-run-for-all)
(memq original-command mc/cmds-to-run-for-all)
(mc/prompt-for-inclusion-in-whitelist original-command)))
(mc/execute-command-for-all-fake-cursors original-command))))))))))
(defun mc/remove-fake-cursors ()
"Remove all fake cursors.
Do not use to conclude editing with multiple cursors. For that
you should disable multiple-cursors-mode."
(mc/for-each-fake-cursor
(mc/remove-fake-cursor cursor))
(when mc--max-cursors-original
(setq mc/max-cursors mc--max-cursors-original))
(setq mc--max-cursors-original nil))
(defun mc/keyboard-quit ()
"Deactivate mark if there are any active, otherwise exit multiple-cursors-mode."
(interactive)
(if (not (use-region-p))
(multiple-cursors-mode 0)
(deactivate-mark)))
(defvar mc/keymap nil
"Keymap while multiple cursors are active.
Main goal of the keymap is to rebind C-g and <return> to conclude
multiple cursors editing.")
(unless mc/keymap
(setq mc/keymap (make-sparse-keymap))
(define-key mc/keymap (kbd "C-g") 'mc/keyboard-quit)
(define-key mc/keymap (kbd "<return>") 'multiple-cursors-mode)
(when (fboundp 'phi-search)
(define-key mc/keymap (kbd "C-s") 'phi-search))
(when (fboundp 'phi-search-backward)
(define-key mc/keymap (kbd "C-r") 'phi-search-backward)))
(defun mc--all-equal (list)
"Are all the items in LIST equal?"
(let ((first (car list))
(all-equal t))
(while (and all-equal list)
(setq all-equal (equal first (car list)))
(setq list (cdr list)))
all-equal))
(defun mc--kill-ring-entries ()
"Return the latest kill-ring entry for each cursor.
The entries are returned in the order they are found in the buffer."
(let (entries)
(mc/for-each-cursor-ordered
(setq entries (cons (car (overlay-get cursor 'kill-ring)) entries)))
(reverse entries)))
(defun mc--maybe-set-killed-rectangle ()
"Add the latest kill-ring entry for each cursor to killed-rectangle.
So you can paste it in later with `yank-rectangle'."
(let ((entries (let (mc/max-cursors) (mc--kill-ring-entries))))
(unless (mc--all-equal entries)
(setq killed-rectangle entries))))
(defvar mc/unsupported-minor-modes '(company-mode auto-complete-mode flyspell-mode jedi-mode)
"List of minor-modes that does not play well with multiple-cursors.
They are temporarily disabled when multiple-cursors are active.")
(defvar mc/temporarily-disabled-minor-modes nil
"The list of temporarily disabled minor-modes.")
(make-variable-buffer-local 'mc/temporarily-disabled-minor-modes)
(defun mc/temporarily-disable-minor-mode (mode)
"If MODE is available and turned on, remember that and turn it off."
(when (and (boundp mode) (eval mode))
(add-to-list 'mc/temporarily-disabled-minor-modes mode)
(funcall mode -1)))
(defun mc/temporarily-disable-unsupported-minor-modes ()
(mapc 'mc/temporarily-disable-minor-mode mc/unsupported-minor-modes))
(defun mc/enable-minor-mode (mode)
(funcall mode 1))
(defun mc/enable-temporarily-disabled-minor-modes ()
(mapc 'mc/enable-minor-mode mc/temporarily-disabled-minor-modes)
(setq mc/temporarily-disabled-minor-modes nil))
(defcustom mc/mode-line
`(" mc:" (:eval (format ,(propertize "%d" 'face 'font-lock-warning-face)
(mc/num-cursors))))
"What to display in the mode line while multiple-cursors-mode is active."
:group 'multiple-cursors)
(put 'mc/mode-line 'risky-local-variable t)
;;;###autoload
(define-minor-mode multiple-cursors-mode
"Mode while multiple cursors are active."
nil mc/mode-line mc/keymap
(if multiple-cursors-mode
(progn
(mc/temporarily-disable-unsupported-minor-modes)
(add-hook 'pre-command-hook 'mc/make-a-note-of-the-command-being-run nil t)
(add-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t t)
(run-hooks 'multiple-cursors-mode-enabled-hook))
(remove-hook 'post-command-hook 'mc/execute-this-command-for-all-cursors t)
(remove-hook 'pre-command-hook 'mc/make-a-note-of-the-command-being-run t)
(setq mc--this-command nil)
(mc--maybe-set-killed-rectangle)
(mc/remove-fake-cursors)
(mc/enable-temporarily-disabled-minor-modes)
(run-hooks 'multiple-cursors-mode-disabled-hook)))
(add-hook 'after-revert-hook #'(lambda () (multiple-cursors-mode 0)))
(defun mc/maybe-multiple-cursors-mode ()
"Enable multiple-cursors-mode if there is more than one currently active cursor."
(if (> (mc/num-cursors) 1)
(multiple-cursors-mode 1)
(multiple-cursors-mode 0)))
(defmacro unsupported-cmd (cmd msg)
"Adds command to list of unsupported commands and prevents it
from being executed if in multiple-cursors-mode."
`(progn
(put (quote ,cmd) 'mc--unsupported ,msg)
(defadvice ,cmd (around unsupported-advice activate)
"command isn't supported with multiple cursors"
(unless (and multiple-cursors-mode (called-interactively-p 'any))
ad-do-it))))
;; Commands that does not work with multiple-cursors
(unsupported-cmd isearch-forward ". Feel free to add a compatible version.")
(unsupported-cmd isearch-backward ". Feel free to add a compatible version.")
;; Make sure pastes from other programs are added to all kill-rings when yanking
(defadvice current-kill (before interprogram-paste-for-all-cursors activate)
(let ((interprogram-paste (and (= n 0)
interprogram-paste-function
(funcall interprogram-paste-function))))
(when interprogram-paste
;; Add interprogram-paste to normal kill ring, just
;; like current-kill usually does for itself.
;; We have to do the work for it tho, since the funcall only returns
;; something once. It is not a pure function.
(let ((interprogram-cut-function nil))
(if (listp interprogram-paste)
(mapc 'kill-new (nreverse interprogram-paste))
(kill-new interprogram-paste))
;; And then add interprogram-paste to the kill-rings
;; of all the other cursors too.
(mc/for-each-fake-cursor
(let ((kill-ring (overlay-get cursor 'kill-ring))
(kill-ring-yank-pointer (overlay-get cursor 'kill-ring-yank-pointer)))
(if (listp interprogram-paste)
(mapc 'kill-new (nreverse interprogram-paste))
(kill-new interprogram-paste))
(overlay-put cursor 'kill-ring kill-ring)
(overlay-put cursor 'kill-ring-yank-pointer kill-ring-yank-pointer)))))))
(defvar mc/list-file (locate-user-emacs-file ".mc-lists.el")
"The position of the file that keeps track of your preferences
for running commands with multiple cursors.")
(defun mc/dump-list (list-symbol)
"Insert (setq 'LIST-SYMBOL LIST-VALUE) to current buffer."
(cl-symbol-macrolet ((value (symbol-value list-symbol)))
(insert "(setq " (symbol-name list-symbol) "\n"
" '(")
(newline-and-indent)
(set list-symbol
(sort value (lambda (x y) (string-lessp (symbol-name x)
(symbol-name y)))))
(mapc #'(lambda (cmd) (insert (format "%S" cmd)) (newline-and-indent))
value)
(insert "))")
(newline)))
(defun mc/save-lists ()
"Saves preferences for running commands with multiple cursors to `mc/list-file'"
(with-temp-file mc/list-file
(emacs-lisp-mode)
(insert ";; This file is automatically generated by the multiple-cursors extension.")
(newline)
(insert ";; It keeps track of your preferences for running commands with multiple cursors.")
(newline)
(newline)
(mc/dump-list 'mc/cmds-to-run-for-all)
(newline)
(mc/dump-list 'mc/cmds-to-run-once)))
(defvar mc/cmds-to-run-once nil
"Commands to run only once in multiple-cursors-mode.")
(defvar mc--default-cmds-to-run-once nil
"Default set of commands to run only once in multiple-cursors-mode.")
(setq mc--default-cmds-to-run-once '(mc/edit-lines
mc/edit-ends-of-lines
mc/edit-beginnings-of-lines
mc/mark-next-like-this
mc/mark-next-like-this-word
mc/mark-next-like-this-symbol
mc/mark-next-word-like-this
mc/mark-next-symbol-like-this
mc/mark-previous-like-this
mc/mark-previous-like-this-word
mc/mark-previous-like-this-symbol
mc/mark-previous-word-like-this
mc/mark-previous-symbol-like-this
mc/mark-all-like-this
mc/mark-all-words-like-this
mc/mark-all-symbols-like-this
mc/mark-more-like-this-extended
mc/mark-all-like-this-in-defun
mc/mark-all-words-like-this-in-defun
mc/mark-all-symbols-like-this-in-defun
mc/mark-all-like-this-dwim
mc/mark-all-dwim
mc/mark-sgml-tag-pair
mc/insert-numbers
mc/insert-letters
mc/sort-regions
mc/reverse-regions
mc/cycle-forward
mc/cycle-backward
mc/add-cursor-on-click
mc/mark-pop
mc/add-cursors-to-all-matches
mc/mmlte--left
mc/mmlte--right
mc/mmlte--up
mc/mmlte--down
mc/unmark-next-like-this
mc/unmark-previous-like-this
mc/skip-to-next-like-this
mc/skip-to-previous-like-this
rrm/switch-to-multiple-cursors
mc-hide-unmatched-lines-mode
hum/keyboard-quit
hum/unhide-invisible-overlays
save-buffer
ido-exit-minibuffer
exit-minibuffer
minibuffer-complete-and-exit
execute-extended-command
undo
redo
undo-tree-undo
undo-tree-redo
universal-argument
universal-argument-more
universal-argument-other-key
negative-argument
digit-argument
top-level
recenter-top-bottom
describe-mode
describe-key-1
describe-function
describe-bindings
describe-prefix-bindings
view-echo-area-messages
other-window
kill-buffer-and-window
split-window-right
split-window-below
delete-other-windows
toggle-window-split
mwheel-scroll
scroll-up-command
scroll-down-command
mouse-set-point
mouse-drag-region
quit-window
toggle-read-only
windmove-left
windmove-right
windmove-up
windmove-down))
(defvar mc--default-cmds-to-run-for-all nil
"Default set of commands that should be mirrored by all cursors")
(setq mc--default-cmds-to-run-for-all '(mc/keyboard-quit
self-insert-command
quoted-insert
previous-line
next-line
newline
newline-and-indent
open-line
delete-blank-lines
transpose-chars
transpose-lines
transpose-paragraphs
transpose-regions
join-line
right-char
right-word
forward-char
forward-word
left-char
left-word
backward-char
backward-word
forward-paragraph
backward-paragraph
upcase-word
downcase-word
capitalize-word
forward-list
backward-list
hippie-expand
hippie-expand-lines
yank
yank-pop
append-next-kill
kill-word
kill-line
kill-whole-line
backward-kill-word
backward-delete-char-untabify
delete-char delete-forward-char
delete-backward-char
py-electric-backspace
c-electric-backspace
org-delete-backward-char
cperl-electric-backspace
python-indent-dedent-line-backspace
paredit-backward-delete
autopair-backspace
just-one-space
zap-to-char
end-of-line
set-mark-command
exchange-point-and-mark
cua-set-mark
cua-replace-region
cua-delete-region
move-end-of-line
beginning-of-line
move-beginning-of-line
kill-ring-save
back-to-indentation
subword-forward
subword-backward
subword-mark
subword-kill
subword-backward-kill
subword-transpose
subword-capitalize
subword-upcase
subword-downcase
er/expand-region
er/contract-region
smart-forward
smart-backward
smart-up
smart-down))
(defvar mc/cmds-to-run-for-all nil
"Commands to run for all cursors in multiple-cursors-mode")
(load mc/list-file t) ;; load, but no errors if it does not exist yet please
(provide 'multiple-cursors-core)
;; Local Variables:
;; coding: utf-8
;; End:
;;; multiple-cursors-core.el ends here

5
elpa/multiple-cursors-20160719.216/multiple-cursors-pkg.el Normal file
View File

@ -0,0 +1,5 @@
(define-package "multiple-cursors" "20160719.216" "Multiple cursors for Emacs."
'((cl-lib "0.5")))
;; Local Variables:
;; no-byte-compile: t
;; End:

199
elpa/multiple-cursors-20160719.216/multiple-cursors.el Normal file
View File

@ -0,0 +1,199 @@
;;; multiple-cursors.el --- Multiple cursors for emacs.
;; Copyright (C) 2012-2016 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Version: 1.4.0
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Multiple cursors for Emacs. This is some pretty crazy functionality, so yes,
;; there are kinks. Don't be afraid tho, I've been using it since 2011 with
;; great success and much merriment.
;; ## Basic usage
;; Start out with:
;; (require 'multiple-cursors)
;; Then you have to set up your keybindings - multiple-cursors doesn't presume to
;; know how you'd like them laid out. Here are some examples:
;; When you have an active region that spans multiple lines, the following will
;; add a cursor to each line:
;; (global-set-key (kbd "C-S-c C-S-c") 'mc/edit-lines)
;; When you want to add multiple cursors not based on continuous lines, but based on
;; keywords in the buffer, use:
;; (global-set-key (kbd "C->") 'mc/mark-next-like-this)
;; (global-set-key (kbd "C-<") 'mc/mark-previous-like-this)
;; (global-set-key (kbd "C-c C-<") 'mc/mark-all-like-this)
;; First mark the word, then add more cursors.
;; To get out of multiple-cursors-mode, press `<return>` or `C-g`. The latter will
;; first disable multiple regions before disabling multiple cursors. If you want to
;; insert a newline in multiple-cursors-mode, use `C-j`.
;; ## Video
;; You can [watch an intro to multiple-cursors at Emacs Rocks](http://emacsrocks.com/e13.html).
;; ## Command overview
;; ### Mark one more occurrence
;; - `mc/mark-next-like-this`: Adds a cursor and region at the next part of the buffer forwards that matches the current region.
;; - `mc/mark-next-like-this-word`: Adds a cursor and region at the next part of the buffer forwards that matches the current region, if no region is selected it selects the word at the point.
;; - `mc/mark-next-like-this-symbol`: Adds a cursor and region at the next part of the buffer forwards that matches the current region, if no region is selected it selects the symbol at the point.
;; - `mc/mark-next-word-like-this`: Like `mc/mark-next-like-this` but only for whole words.
;; - `mc/mark-next-symbol-like-this`: Like `mc/mark-next-like-this` but only for whole symbols.
;; - `mc/mark-previous-like-this`: Adds a cursor and region at the next part of the buffer backwards that matches the current region.
;; - `mc/mark-previous-word-like-this`: Like `mc/mark-previous-like-this` but only for whole words.
;; - `mc/mark-previous-symbol-like-this`: Like `mc/mark-previous-like-this` but only for whole symbols.
;; - `mc/mark-more-like-this-extended`: Use arrow keys to quickly mark/skip next/previous occurances.
;; - `mc/add-cursor-on-click`: Bind to a mouse event to add cursors by clicking. See tips-section.
;; ### Mark many occurrences
;; - `mc/mark-all-like-this`: Marks all parts of the buffer that matches the current region.
;; - `mc/mark-all-words-like-this`: Like `mc/mark-all-like-this` but only for whole words.
;; - `mc/mark-all-symbols-like-this`: Like `mc/mark-all-like-this` but only for whole symbols.
;; - `mc/mark-all-in-region`: Prompts for a string to match in the region, adding cursors to all of them.
;; - `mc/mark-all-like-this-in-defun`: Marks all parts of the current defun that matches the current region.
;; - `mc/mark-all-words-like-this-in-defun`: Like `mc/mark-all-like-this-in-defun` but only for whole words.
;; - `mc/mark-all-symbols-like-this-in-defun`: Like `mc/mark-all-like-this-in-defun` but only for whole symbols.
;; - `mc/mark-all-like-this-dwim`: Tries to be smart about marking everything you want. Can be pressed multiple times.
;; ### Special
;; - `set-rectangular-region-anchor`: Think of this one as `set-mark` except you're marking a rectangular region.
;; - `mc/mark-sgml-tag-pair`: Mark the current opening and closing tag.
;; - `mc/insert-numbers`: Insert increasing numbers for each cursor, top to bottom.
;; - `mc/insert-letters`: Insert increasing letters for each cursor, top to bottom.
;; - `mc/sort-regions`: Sort the marked regions alphabetically.
;; - `mc/reverse-regions`: Reverse the order of the marked regions.
;; ## Tips and tricks
;; - To get out of multiple-cursors-mode, press `<return>` or `C-g`. The latter will
;; first disable multiple regions before disabling multiple cursors. If you want to
;; insert a newline in multiple-cursors-mode, use `C-j`.
;;
;; - Sometimes you end up with cursors outside of your view. You can
;; scroll the screen to center on each cursor with `C-v` and `M-v`.
;;
;; - Try pressing `mc/mark-next-like-this` with no region selected. It will just add a cursor
;; on the next line.
;;
;; - Try pressing `mc/mark-next-like-this-word` or
;; `mc/mark-next-like-this-symbol` with no region selected. It will
;; mark the symbol and add a cursor at the next occurance
;;
;; - Try pressing `mc/mark-all-like-this-dwim` on a tagname in html-mode.
;;
;; - Notice that the number of cursors active can be seen in the modeline.
;;
;; - If you get out of multiple-cursors-mode and yank - it will yank only
;; from the kill-ring of main cursor. To yank from the kill-rings of
;; every cursor use yank-rectangle, normally found at C-x r y.
;;
;; - You can use `mc/reverse-regions` with nothing selected and just one cursor.
;; It will then flip the sexp at point and the one below it.
;;
;; - If you would like to keep the global bindings clean, and get custom keybindings
;; when the region is active, you can try [region-bindings-mode](https://github.com/fgallina/region-bindings-mode).
;;
;; BTW, I highly recommend adding `mc/mark-next-like-this` to a key binding that's
;; right next to the key for `er/expand-region`.
;; ### Binding mouse events
;; To override a mouse event, you will likely have to also unbind the
;; `down-mouse` part of the event. Like this:
;;
;; (global-unset-key (kbd "M-<down-mouse-1>"))
;; (global-set-key (kbd "M-<mouse-1>") 'mc/add-cursor-on-click)
;;
;; Or you can do like me and find an unused, but less convenient, binding:
;;
;; (global-set-key (kbd "C-S-<mouse-1>") 'mc/add-cursor-on-click)
;; ## Unknown commands
;; Multiple-cursors uses two lists of commands to know what to do: the run-once list
;; and the run-for-all list. It comes with a set of defaults, but it would be beyond silly
;; to try and include all the known Emacs commands.
;; So that's why multiple-cursors occasionally asks what to do about a command. It will
;; then remember your choice by saving it in `~/.emacs.d/.mc-lists.el`. You can change
;; the location with:
;; (setq mc/list-file "/my/preferred/file")
;; ## Known limitations
;; * isearch-forward and isearch-backward aren't supported with multiple cursors.
;; You should feel free to add a simplified version that can work with it.
;; * Commands run with `M-x` won't be repeated for all cursors.
;; * All key bindings that refer to lambdas are always run for all cursors. If you
;; need to limit it, you will have to give it a name.
;; * Redo might screw with your cursors. Undo works very well.
;; ## Contribute
;; Yes, please do. There's a suite of tests, so remember to add tests for your
;; specific feature, or I might break it later.
;; You'll find the repo at:
;; https://github.com/magnars/multiple-cursors.el
;; To fetch the test dependencies:
;; $ cd /path/to/multiple-cursors
;; $ git submodule update --init
;; Run the tests with:
;; $ ./util/ecukes/ecukes --graphical
;; ## Contributors
;; * [Takafumi Arakaki](https://github.com/tkf) made .mc-lists.el diff friendly
;; * [Marco Baringer](https://github.com/segv) contributed looping to mc/cycle and adding cursors without region for mark-more.
;; * [Ivan Andrus](https://github.com/gvol) added showing number of cursors in mode-line
;; * [Fuco](https://github.com/Fuco1) added the first version of `mc/mark-all-like-this-dwim`
;; Thanks!
;;; Code:
(require 'mc-edit-lines)
(require 'mc-cycle-cursors)
(require 'mc-mark-more)
(require 'mc-mark-pop)
(require 'rectangular-region-mode)
(require 'mc-separate-operations)
(require 'mc-hide-unmatched-lines-mode)
(provide 'multiple-cursors)
;;; multiple-cursors.el ends here

125
elpa/multiple-cursors-20160719.216/rectangular-region-mode.el Normal file
View File

@ -0,0 +1,125 @@
;;; rectangular-region-mode.el
;; Copyright (C) 2012-2016 Magnar Sveen
;; Author: Magnar Sveen <magnars@gmail.com>
;; Keywords: editing cursors
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; (global-set-key (kbd "H-SPC") 'set-rectangular-region-anchor)
;; Think of this one as `set-mark` except you're marking a rectangular region. It is
;; an exceedingly quick way of adding multiple cursors to multiple lines.
;;; Code:
(require 'multiple-cursors-core)
(defvar rrm/anchor (make-marker)
"The position in the buffer that anchors the rectangular region.")
(defvar rectangular-region-mode-map (make-sparse-keymap)
"Keymap for rectangular region is mainly for rebinding C-g")
(define-key rectangular-region-mode-map (kbd "C-g") 'rrm/keyboard-quit)
(define-key rectangular-region-mode-map (kbd "<return>") 'rrm/switch-to-multiple-cursors)
(defvar rectangular-region-mode nil)
(defun rrm/keyboard-quit ()
"Exit rectangular-region-mode."
(interactive)
(rectangular-region-mode 0)
(rrm/remove-rectangular-region-overlays)
(deactivate-mark))
;; Bind this to a key (for instance H-SPC) to start rectangular-region-mode
;;;###autoload
(defun set-rectangular-region-anchor ()
"Anchors the rectangular region at point.
Think of this one as `set-mark' except you're marking a rectangular region. It is
an exceedingly quick way of adding multiple cursors to multiple lines."
(interactive)
(set-marker rrm/anchor (point))
(push-mark (point))
(rectangular-region-mode 1))
(defun rrm/remove-rectangular-region-overlays ()
"Remove all rectangular-region overlays."
(mc/remove-fake-cursors)
(mapc #'(lambda (o)
(when (eq (overlay-get o 'type) 'additional-region)
(delete-overlay o)))
(overlays-in (point-min) (point-max))))
(defun rrm/repaint ()
"Start from the anchor and draw a rectangle between it and point."
(if (not rectangular-region-mode)
(remove-hook 'post-command-hook 'rrm/repaint t)
;; else
(rrm/remove-rectangular-region-overlays)
(let* ((annoying-arrows-mode nil)
(point-column (current-column))
(point-line (line-number-at-pos))
(anchor-column (save-excursion (goto-char rrm/anchor) (current-column)))
(anchor-line (save-excursion (goto-char rrm/anchor) (line-number-at-pos)))
(left-column (if (< point-column anchor-column) point-column anchor-column))
(right-column (if (> point-column anchor-column) point-column anchor-column))
(navigation-step (if (< point-line anchor-line) 1 -1)))
(move-to-column anchor-column)
(set-mark (point))
(move-to-column point-column)
(mc/save-excursion
(while (not (= anchor-line (line-number-at-pos)))
(forward-line navigation-step)
(move-to-column anchor-column)
(when (= anchor-column (current-column))
(set-mark (point))
(move-to-column point-column)
(when (= point-column (current-column))
(mc/create-fake-cursor-at-point))))))))
(defun rrm/switch-to-multiple-cursors (&rest forms)
"Switch from rectangular-region-mode to multiple-cursors-mode."
(interactive)
(rectangular-region-mode 0)
(multiple-cursors-mode 1))
(defadvice er/expand-region (before switch-from-rrm-to-mc activate)
(when rectangular-region-mode
(rrm/switch-to-multiple-cursors)))
(defadvice kill-ring-save (before switch-from-rrm-to-mc activate)
(when rectangular-region-mode
(rrm/switch-to-multiple-cursors)))
;;;###autoload
(define-minor-mode rectangular-region-mode
"A mode for creating a rectangular region to edit"
nil " rr" rectangular-region-mode-map
(if rectangular-region-mode
(progn
(add-hook 'after-change-functions 'rrm/switch-to-multiple-cursors t t)
(add-hook 'post-command-hook 'rrm/repaint t t))
(remove-hook 'after-change-functions 'rrm/switch-to-multiple-cursors t)
(remove-hook 'post-command-hook 'rrm/repaint t)
(set-marker rrm/anchor nil)))
(provide 'rectangular-region-mode)
;;; rectangular-region-mode.el ends here

22
elpa/org-bullets-20140918.1137/org-bullets-autoloads.el Normal file
View File

@ -0,0 +1,22 @@
;;; org-bullets-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "org-bullets" "org-bullets.el" (22490 32823
;;;;;; 441860 562000))
;;; Generated autoloads from org-bullets.el
(autoload 'org-bullets-mode "org-bullets" "\
UTF8 Bullets for org-mode
\(fn &optional ARG)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; org-bullets-autoloads.el ends here

1
elpa/org-bullets-20140918.1137/org-bullets-pkg.el Normal file
View File

@ -0,0 +1 @@
(define-package "org-bullets" "20140918.1137" "Show bullets in org-mode as UTF-8 characters" 'nil :url "https://github.com/sabof/org-bullets")

127
elpa/org-bullets-20140918.1137/org-bullets.el Normal file
View File

@ -0,0 +1,127 @@
;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters
;;; Version: 0.2.4
;; Package-Version: 20140918.1137
;;; Author: sabof
;;; URL: https://github.com/sabof/org-bullets
;; This file is NOT part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program ; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; The project is hosted at https://github.com/sabof/org-bullets
;; The latest version, and all the relevant information can be found there.
;;; Code:
(eval-when-compile (require 'cl))
(defgroup org-bullets nil
"Display bullets as UTF-8 characters"
:group 'org-appearance)
;; A nice collection of unicode bullets:
;; http://nadeausoftware.com/articles/2007/11/latency_friendly_customized_bullets_using_unicode_characters
(defcustom org-bullets-bullet-list
'(;;; Large
"◉"
"○"
"✸"
"✿"
;; ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ☢ ❀ ◆ ◖ ▶
;;; Small
;; ► • ★ ▸
)
"This variable contains the list of bullets.
It can contain any number of symbols, which will be repeated."
:group 'org-bullets
:type '(repeat (string :tag "Bullet character")))
(defcustom org-bullets-face-name nil
"This variable allows the org-mode bullets face to be
overridden. If set to a name of a face, that face will be
used. Otherwise the face of the heading level will be used."
:group 'org-bullets
:type 'symbol)
(defvar org-bullets-bullet-map
'(keymap
(mouse-1 . org-cycle)
(mouse-2
. (lambda (e)
(interactive "e")
(mouse-set-point e)
(org-cycle))))
"Mouse events for bullets.
Should this be undesirable, one can remove them with
\(setcdr org-bullets-bullet-map nil\)")
(defun org-bullets-level-char (level)
(string-to-char
(nth (mod (1- level)
(length org-bullets-bullet-list))
org-bullets-bullet-list)))
;;;###autoload
(define-minor-mode org-bullets-mode
"UTF8 Bullets for org-mode"
nil nil nil
(let* (( keyword
`(("^\\*+ "
(0 (let* (( level (- (match-end 0) (match-beginning 0) 1))
( is-inline-task
(and (boundp 'org-inlinetask-min-level)
(>= level org-inlinetask-min-level))))
(compose-region (- (match-end 0) 2)
(- (match-end 0) 1)
(org-bullets-level-char level))
(when is-inline-task
(compose-region (- (match-end 0) 3)
(- (match-end 0) 2)
(org-bullets-level-char level)))
(when (facep org-bullets-face-name)
(put-text-property (- (match-end 0)
(if is-inline-task 3 2))
(- (match-end 0) 1)
'face
org-bullets-face-name))
(put-text-property (match-beginning 0)
(- (match-end 0) 2)
'face (list :foreground
(face-attribute
'default :background)))
(put-text-property (match-beginning 0)
(match-end 0)
'keymap
org-bullets-bullet-map)
nil))))))
(if org-bullets-mode
(progn
(font-lock-add-keywords nil keyword)
(font-lock-fontify-buffer))
(save-excursion
(goto-char (point-min))
(font-lock-remove-keywords nil keyword)
(while (re-search-forward "^\\*+ " nil t)
(decompose-region (match-beginning 0) (match-end 0)))
(font-lock-fontify-buffer))
)))
(provide 'org-bullets)
;;; org-bullets.el ends here

57
elpa/origami-20160710.958/origami-autoloads.el Normal file
View File

@ -0,0 +1,57 @@
;;; origami-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "origami" "origami.el" (22490 32822 885861
;;;;;; 693000))
;;; Generated autoloads from origami.el
(autoload 'origami-mode "origami" "\
Minor mode to selectively hide/show text in the current buffer.
With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
Lastly, the normal hook `origami-mode-hook' is run using
`run-hooks'.
Key bindings:
\\{origami-mode-map}
\(fn &optional ARG)" t nil)
(defvar global-origami-mode nil "\
Non-nil if Global-Origami mode is enabled.
See the command `global-origami-mode' for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-origami-mode'.")
(custom-autoload 'global-origami-mode "origami" nil)
(autoload 'global-origami-mode "origami" "\
Toggle Origami mode in all buffers.
With prefix ARG, enable Global-Origami mode if ARG is positive;
otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
Origami mode is enabled in all buffers where
`(lambda nil (origami-mode 1))' would do it.
See `origami-mode' for more information on Origami mode.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil nil ("origami-parsers.el" "origami-pkg.el")
;;;;;; (22490 32822 900859 998000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; origami-autoloads.el ends here

245
elpa/origami-20160710.958/origami-parsers.el Normal file
View File

@ -0,0 +1,245 @@
;;; origami-parsers.el --- Collection of parsers -*- lexical-binding: t -*-
;; Author: Greg Sexton <gregsexton@gmail.com>
;; Version: 1.0
;; Keywords: parsers
;; URL: https://github.com/gregsexton/
;; The MIT License (MIT)
;; Copyright (c) 2014 Greg Sexton
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;; THE SOFTWARE.
;;; Commentary:
;;; Code:
(require 'cl)
(require 'dash)
(defun origami-get-positions (content regex)
"Returns a list of positions where REGEX matches in CONTENT. A
position is a cons cell of the character and the numerical
position in the CONTENT."
(with-temp-buffer
(insert content)
(goto-char (point-min))
(let (acc)
(while (re-search-forward regex nil t)
(let ((match (match-string 0)))
(setq acc (cons (cons match (- (point) (length match)))
acc))))
(reverse acc))))
(defun origami-indent-parser (create)
(cl-labels ((lines (string) (origami-get-positions string ".*?\r?\n"))
(annotate-levels (lines)
(-map (lambda (line)
;; TODO: support tabs
(let ((indent (length (car (s-match "^ *" (car line)))))
(beg (cdr line))
(end (+ (cdr line) (length (car line)) -1)))
(if (s-blank? (s-trim (car line)))
'newline ;sentinel representing line break
(vector indent beg end (- end beg)))))
lines))
(indent (line) (if (eq line 'newline) -1 (aref line 0)))
(beg (line) (aref line 1))
(end (line) (aref line 2))
(offset (line) (aref line 3))
(collapse-same-level (lines)
(->>
(cdr lines)
(-reduce-from (lambda (acc line)
(cond ((and (eq line 'newline) (eq (car acc) 'newline)) acc)
((= (indent line) (indent (car acc)))
(cons (vector (indent (car acc))
(beg (car acc))
(end line)
(offset (car acc)))
(cdr acc)))
(t (cons line acc))))
(list (car lines)))
(remove 'newline)
reverse))
(create-tree (levels)
(if (null levels)
levels
(let ((curr-indent (indent (car levels))))
(->> levels
(-partition-by (lambda (l) (= (indent l) curr-indent)))
(-partition-all 2)
(-mapcat (lambda (x)
;takes care of multiple identical levels, introduced when there are newlines
(-concat
(-map 'list (butlast (car x)))
(list (cons (-last-item (car x)) (create-tree (cadr x)))))))))))
(build-nodes (tree)
(if (null tree) (cons 0 nil)
;; complexity here is due to having to find the end of the children so that the
;; parent encompasses them
(-reduce-r-from (lambda (nodes acc)
(destructuring-bind (children-end . children) (build-nodes (cdr nodes))
(let ((this-end (max children-end (end (car nodes)))))
(cons (max this-end (car acc))
(cons (funcall create
(beg (car nodes))
this-end
(offset (car nodes))
children)
(cdr acc))))))
'(0 . nil)
tree))))
(lambda (content)
(-> content
lines
annotate-levels
collapse-same-level
create-tree
build-nodes
cdr))))
(defun origami-build-pair-tree (create open close positions)
(cl-labels ((build (positions)
;; this is so horrible, but fast
(let (acc beg (should-continue t))
(while (and should-continue positions)
(cond ((equal (caar positions) open)
(if beg ;go down a level
(let* ((res (build positions))
(new-pos (car res))
(children (cdr res)))
(setq positions (cdr new-pos))
(setq acc (cons (funcall create beg (cdar new-pos) (length open) children)
acc))
(setq beg nil))
;; begin a new pair
(setq beg (cdar positions))
(setq positions (cdr positions))))
((equal (caar positions) close)
(if beg
(progn ;close with no children
(setq acc (cons (funcall create beg (cdar positions) (length close) nil)
acc))
(setq positions (cdr positions))
(setq beg nil))
(setq should-continue nil)))))
(cons positions (reverse acc)))))
(cdr (build positions))))
;;; TODO: tag these nodes? have ability to manipulate nodes that are
;;; tagged? in a scoped fashion?
(defun origami-javadoc-parser (create)
(lambda (content)
(let ((positions (->> (origami-get-positions content "/\\*\\*\\|\\*/")
(-filter (lambda (position)
(eq (get-text-property 0 'face (car position))
'font-lock-doc-face))))))
(origami-build-pair-tree create "/**" "*/" positions))))
(defun origami-c-style-parser (create)
(lambda (content)
(let ((positions (->> (origami-get-positions content "[{}]")
(remove-if (lambda (position)
(let ((face (get-text-property 0 'face (car position))))
(-any? (lambda (f)
(memq f '(font-lock-doc-face
font-lock-comment-face
font-lock-string-face)))
(if (listp face) face (list face)))))))))
(origami-build-pair-tree create "{" "}" positions))))
(defun origami-c-macro-parser (create)
(lambda (content)
(let ((positions (origami-get-positions content "#if\\|#endif")))
(origami-build-pair-tree create "#if" "#endif" positions))))
(defun origami-c-parser (create)
(let ((c-style (origami-c-style-parser create))
(macros (origami-c-macro-parser create)))
(lambda (content)
(origami-fold-children
(origami-fold-shallow-merge
(origami-fold-root-node (funcall c-style content))
(origami-fold-root-node (funcall macros content)))))))
(defun origami-java-parser (create)
(let ((c-style (origami-c-style-parser create))
(javadoc (origami-javadoc-parser create)))
(lambda (content)
(origami-fold-children
(origami-fold-shallow-merge (origami-fold-root-node (funcall c-style content))
(origami-fold-root-node (funcall javadoc content)))))))
(defun origami-lisp-parser (create regex)
(lambda (content)
(with-temp-buffer
(insert content)
(goto-char (point-min))
(beginning-of-defun -1)
(let (beg end offset acc)
(while (< (point) (point-max))
(setq beg (point))
(search-forward-regexp regex nil t)
(setq offset (- (point) beg))
(end-of-defun)
(backward-char) ;move point to one after the last paren
(setq end (1- (point))) ;don't include the last paren in the fold
(when (> offset 0)
(setq acc (cons (funcall create beg end offset nil) acc)))
(beginning-of-defun -1))
(reverse acc)))))
(defun origami-elisp-parser (create)
(origami-lisp-parser create "(def\\w*\\s-*\\(\\s_\\|\\w\\|[:?!]\\)*\\([ \\t]*(.*?)\\)?"))
(defun origami-clj-parser (create)
(origami-lisp-parser create "(def\\(\\w\\|-\\)*\\s-*\\(\\s_\\|\\w\\|[?!]\\)*\\([ \\t]*\\[.*?\\]\\)?"))
(defun origami-markers-parser (start-marker end-marker)
"Create a parser for simple start and end markers."
(let ((regex (rx-to-string `(or ,start-marker ,end-marker))))
(lambda (create)
(lambda (content)
(let ((positions (origami-get-positions content regex)))
(origami-build-pair-tree create start-marker end-marker positions))))))
(defcustom origami-parser-alist
`((java-mode . origami-java-parser)
(c-mode . origami-c-parser)
(c++-mode . origami-c-parser)
(perl-mode . origami-c-style-parser)
(cperl-mode . origami-c-style-parser)
(js-mode . origami-c-style-parser)
(js2-mode . origami-c-style-parser)
(js3-mode . origami-c-style-parser)
(go-mode . origami-c-style-parser)
(php-mode . origami-c-style-parser)
(python-mode . origami-indent-parser)
(emacs-lisp-mode . origami-elisp-parser)
(lisp-interaction-mode . origami-elisp-parser)
(clojure-mode . origami-clj-parser)
(triple-braces . ,(origami-markers-parser "{{{" "}}}")))
"alist mapping major-mode to parser function."
:type 'hook
:group 'origami)
(provide 'origami-parsers)
;;; origami-parsers.el ends here

9
elpa/origami-20160710.958/origami-pkg.el Normal file
View File

@ -0,0 +1,9 @@
(define-package "origami" "20160710.958" "Flexible text folding"
'((s "1.9.0")
(dash "2.5.0")
(emacs "24"))
:url "https://github.com/gregsexton/origami.el" :keywords
'("folding"))
;; Local Variables:
;; no-byte-compile: t
;; End:

821
elpa/origami-20160710.958/origami.el Normal file
View File

@ -0,0 +1,821 @@
;;; origami.el --- Flexible text folding -*- lexical-binding: t -*-
;; Author: Greg Sexton <gregsexton@gmail.com>
;; Version: 1.0
;; Keywords: folding
;; URL: https://github.com/gregsexton/origami.el
;; Package-Requires: ((s "1.9.0") (dash "2.5.0") (emacs "24"))
;; The MIT License (MIT)
;; Copyright (c) 2014 Greg Sexton
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
;; THE SOFTWARE.
;;; Commentary:
;;; Code:
(require 'dash)
(require 's)
(require 'cl)
(require 'origami-parsers)
;;; fold display mode and faces
(defcustom origami-fold-replacement "..."
;; TODO: this should also be specifiable as a function: folded text -> string
"Show this string instead of the folded text."
:type 'string
:group 'origami)
(defcustom origami-show-fold-header nil
"Highlight the line the fold start on."
:type 'boolean
:group 'origami)
(defface origami-fold-header-face
`((t (:box (:line-width 1 :color ,(face-attribute 'highlight :background))
:background ,(face-attribute 'highlight :background))))
"Face used to display fold headers.")
(defface origami-fold-fringe-face
'((t ()))
"Face used to display fringe contents.")
(defface origami-fold-replacement-face
'((t :inherit 'font-lock-comment-face))
"Face used to display the fold replacement text.")
(defgroup origami '((origami-fold-header-face custom-face)
(origami-fold-fringe-face custom-face)
(origami-fold-replacement-face custom-face))
"Origami: A text folding minor mode for Emacs.")
;;; overlay manipulation
(defun origami-header-overlay-range (fold-overlay)
"Given a `fold-overlay', return the range that the corresponding
header overlay should cover. Result is a cons cell of (begin . end)."
(with-current-buffer (overlay-buffer fold-overlay)
(let ((fold-begin
(save-excursion
(goto-char (overlay-start fold-overlay))
(line-beginning-position)))
(fold-end
;; Find the end of the folded region -- include the following
;; newline if possible. The header will span the entire fold.
(save-excursion
(goto-char (overlay-end fold-overlay))
(when (looking-at ".")
(forward-char 1)
(when (looking-at "\n")
(forward-char 1)))
(point))))
(cons fold-begin fold-end))))
(defun origami-header-overlay-reset-position (header-overlay)
(-when-let (fold-ov (overlay-get header-overlay 'fold-overlay))
(let ((range (origami-header-overlay-range fold-ov)))
(move-overlay header-overlay (car range) (cdr range)))))
(defun origami-header-modify-hook (header-overlay after-p b e &optional l)
(if after-p (origami-header-overlay-reset-position header-overlay)))
(defun origami-create-overlay (beg end offset buffer)
(when (> (- end beg) 0)
(let ((ov (make-overlay (+ beg offset) end buffer)))
(overlay-put ov 'creator 'origami)
(overlay-put ov 'isearch-open-invisible 'origami-isearch-show)
(overlay-put ov 'isearch-open-invisible-temporary
(lambda (ov hide-p) (if hide-p (origami-hide-overlay ov)
(origami-show-overlay ov))))
;; We create a header overlay even when disabled; this could be avoided,
;; especially if we called origami-reset for each buffer if customizations
;; changed.
(let* ((range (origami-header-overlay-range ov))
(header-ov (make-overlay (car range) (cdr range) buffer
nil))) ;; no front advance
(overlay-put header-ov 'creator 'origami)
(overlay-put header-ov 'fold-overlay ov)
(overlay-put header-ov 'modification-hooks '(origami-header-modify-hook))
(overlay-put ov 'header-ov header-ov))
ov)))
(defun origami-hide-overlay (ov)
(overlay-put ov 'invisible 'origami)
(overlay-put ov 'display origami-fold-replacement)
(overlay-put ov 'face 'origami-fold-replacement-face)
(if origami-show-fold-header
(origami-activate-header (overlay-get ov 'header-ov))))
(defun origami-show-overlay (ov)
(overlay-put ov 'invisible nil)
(overlay-put ov 'display nil)
(overlay-put ov 'face nil)
(origami-deactivate-header (overlay-get ov 'header-ov)))
(defun origami-hide-node-overlay (node)
(-when-let (ov (origami-fold-data node))
(origami-hide-overlay ov)))
(defun origami-show-node-overlay (node)
(-when-let (ov (origami-fold-data node))
(origami-show-overlay ov)))
(defun origami-activate-header (ov)
;; Reposition the header overlay. Since it extends before the folded area, it
;; may no longer cover the appropriate locations.
(origami-header-overlay-reset-position ov)
(overlay-put ov 'origami-header-active t)
(overlay-put ov 'face 'origami-fold-header-face)
(overlay-put ov 'before-string
(propertize
"…"
'display
'(left-fringe empty-line origami-fold-fringe-face))))
(defun origami-deactivate-header (ov)
(overlay-put ov 'origami-header-active nil)
(overlay-put ov 'face nil)
(overlay-put ov 'before-string nil)
(overlay-put ov 'after-string nil))
(defun origami-isearch-show (ov)
(origami-show-node (current-buffer) (point)))
(defun origami-hide-overlay-from-fold-tree-fn (node)
(origami-fold-postorder-each node 'origami-hide-node-overlay))
(defun origami-show-overlay-from-fold-tree-fn (node)
(origami-fold-postorder-each node 'origami-show-node-overlay))
(defun origami-change-overlay-from-fold-node-fn (old new)
(if (origami-fold-open? new)
(origami-show-node-overlay old)
(origami-hide-node-overlay new)))
(defun origami-remove-all-overlays (buffer)
(with-current-buffer buffer
(remove-overlays (point-min) (point-max) 'creator 'origami)))
;;; fold structure
(defun origami-fold-node (beg end offset open &optional children data)
(let ((sorted-children (-sort (lambda (a b)
(or (< (origami-fold-beg a) (origami-fold-beg b))
(and (= (origami-fold-beg a) (origami-fold-beg b))
(< (origami-fold-end a) (origami-fold-end b)))))
(remove nil children))))
;; ensure invariant: no children overlap
(when (-some? (lambda (pair)
(let ((a (car pair))
(b (cadr pair)))
(when b ;for the odd numbered case - there may be a single item
;; the < function doesn't support varargs
(or (>= (origami-fold-beg a) (origami-fold-end a))
(>= (origami-fold-end a) (origami-fold-beg b))
(>= (origami-fold-beg b) (origami-fold-end b))))))
(-partition-all-in-steps 2 1 sorted-children))
(error "Tried to construct a node where the children overlap or are not distinct regions: %s"
sorted-children))
;; ensure invariant: parent encompases children
(let ((beg-children (origami-fold-beg (car sorted-children)))
(end-children (origami-fold-end (-last-item sorted-children))))
(if (and beg-children (or (> beg beg-children) (< end end-children)))
(error "Node does not overlap children in range. beg=%s end=%s beg-children=%s end-children=%s"
beg end beg-children end-children)
(if (> (+ beg offset) end)
(error "Offset is not within the range of the node: beg=%s end=%s offset=%s" beg end offset)
(vector beg end offset open sorted-children data))))))
(defun origami-fold-root-node (&optional children)
"Create a root container node."
(origami-fold-node 1 most-positive-fixnum 0 t children 'root))
(defun origami-fold-is-root-node? (node) (eq (origami-fold-data node) 'root))
(defun origami-fold-beg (node)
(when node
(if (origami-fold-is-root-node? node)
(aref node 0)
(- (overlay-start (origami-fold-data node)) (origami-fold-offset node)))))
(defun origami-fold-end (node)
(when node
(if (origami-fold-is-root-node? node)
(aref node 1)
(overlay-end (origami-fold-data node)))))
(defun origami-fold-offset (node) (when node (aref node 2)))
(defun origami-fold-open? (node) (when node (aref node 3)))
(defun origami-fold-open-set (node value)
(when node
(if (origami-fold-is-root-node? node)
node
(origami-fold-node (origami-fold-beg node)
(origami-fold-end node)
(origami-fold-offset node)
value
(origami-fold-children node)
(origami-fold-data node)))))
(defun origami-fold-children (node) (when node (aref node 4)))
(defun origami-fold-children-set (node children)
(when node
(origami-fold-node (origami-fold-beg node)
(origami-fold-end node)
(origami-fold-offset node)
(origami-fold-open? node)
children
(origami-fold-data node))))
(defun origami-fold-data (node) (when node (aref node 5)))
;;; fold structure utils
(defun origami-fold-range-equal (a b)
(and (equal (origami-fold-beg a) (origami-fold-beg b))
(equal (origami-fold-end a) (origami-fold-end b))))
(defun origami-fold-state-equal (a b)
(equal (origami-fold-open? a) (origami-fold-open? b)))
(defun origami-fold-add-child (node new)
(origami-fold-children-set node
(cons new (origami-fold-children node))))
(defun origami-fold-replace-child (node old new)
(origami-fold-children-set node
(cons new (remove old (origami-fold-children node)))))
(defun origami-fold-assoc (path f)
"Rewrite the tree, replacing the node referenced by PATH with
F applied to the leaf."
(cdr
(-reduce-r-from (lambda (node acc)
(destructuring-bind (old-node . new-node) acc
(cons node (origami-fold-replace-child node old-node new-node))))
(let ((leaf (-last-item path))) (cons leaf (funcall f leaf)))
(butlast path))))
(defun origami-fold-diff (old new on-add on-remove on-change)
(cl-labels ((diff-children (old-children new-children)
(let ((old (car old-children))
(new (car new-children)))
(cond ((null old) (-each new-children on-add))
((null new) (-each old-children on-remove))
((and (null old) (null new)) nil)
((origami-fold-range-equal old new)
(origami-fold-diff old new on-add on-remove on-change)
(diff-children (cdr old-children) (cdr new-children)))
((<= (origami-fold-beg old) (origami-fold-beg new))
(funcall on-remove old)
(diff-children (cdr old-children) new-children))
(t (funcall on-add new)
(diff-children old-children (cdr new-children)))))))
(unless (origami-fold-range-equal old new)
(error "Precondition invalid: old must have the same range as new."))
(unless (origami-fold-state-equal old new)
(funcall on-change old new))
(diff-children (origami-fold-children old)
(origami-fold-children new))))
(defun origami-fold-postorder-each (node f)
(-each (origami-fold-children node) f)
(funcall f node))
(defun origami-fold-map (f tree)
"Map F over the tree. Replacing each node with the result of (f
node). The children cannot be manipulated using f as the map will
replace them. This cannot change the structure of the tree, just
the state of each node."
(origami-fold-children-set
(funcall f tree)
(-map (lambda (node) (origami-fold-map f node))
(origami-fold-children tree))))
(defun origami-fold-path-map (f path)
"Map F over the nodes in path. As with `origami-fold-map',
children cannot be manipulated."
(cond ((null path) nil)
((cdr path) (funcall f (origami-fold-replace-child (car path)
(cadr path)
(origami-fold-path-map f (cdr path)))))
(t (funcall f (car path)))))
(defun origami-fold-find-deepest (tree pred)
(when tree
(when (funcall pred tree)
(-if-let (child (-first pred (origami-fold-children tree)))
(cons tree (origami-fold-find-deepest child pred))
(list tree)))))
(defun origami-fold-find-path-containing-range (tree beg end)
(origami-fold-find-deepest tree
(lambda (node)
(and (>= beg (origami-fold-beg node))
(<= end (origami-fold-end node))))))
(defun origami-fold-find-path-with-range (tree beg end)
"Return the path to the most specific (deepest) node that has
exactly the range BEG-END, or null."
(-when-let (path (origami-fold-find-path-containing-range tree beg end))
(let ((last (-last-item path)))
(when (and (= beg (origami-fold-beg last))
(= end (origami-fold-end last)))
path))))
(defun origami-fold-find-path-containing (tree point)
"Return the path to the most specific (deepest) node that
contains point, or null."
(origami-fold-find-deepest tree
(lambda (node)
(and (<= (origami-fold-beg node) point)
(>= (origami-fold-end node) point)))))
(defun origami-fold-preorder-reduce (tree f initial-state)
"Reduce the tree by doing a preorder traversal. F is applied
with the current state and the current node at each iteration."
(-reduce-from (lambda (state node) (origami-fold-preorder-reduce node f state))
(funcall f initial-state tree)
(origami-fold-children tree)))
(defun origami-fold-postorder-reduce (tree f initial-state)
"Reduce the tree by doing a postorder traversal. F is applied
with the current state and the current node at each iteration."
(funcall f (-reduce-from (lambda (state node) (origami-fold-postorder-reduce node f state))
initial-state
(origami-fold-children tree))
tree))
(defun origami-fold-node-recursively-closed? (node)
(origami-fold-postorder-reduce node (lambda (acc node)
(and acc (not (origami-fold-open? node)))) t))
(defun origami-fold-node-recursively-open? (node)
(origami-fold-postorder-reduce node (lambda (acc node)
(and acc (origami-fold-open? node))) t))
(defun origami-fold-shallow-merge (tree1 tree2)
"Shallow merge the children of TREE2 in to TREE1."
(-reduce-from (lambda (tree node)
(origami-fold-assoc (origami-fold-find-path-containing-range tree
(origami-fold-beg node)
(origami-fold-end node))
(lambda (leaf)
(origami-fold-add-child leaf node))))
tree1 (origami-fold-children tree2)))
(defun origami-fold-parent (path)
(-last-item (-butlast path)))
(defun origami-fold-prev-sibling (siblings node)
(->> siblings
(-partition-in-steps 2 1)
(-drop-while (lambda (pair) (not (equal (cadr pair) node))))
caar))
(defun origami-fold-next-sibling (siblings node)
(->> siblings
(-drop-while (lambda (n) (not (equal n node))))
cadr))
;;; linear history structure
(defun origami-h-new (present)
"Create a new history structure."
(vector nil present nil))
(defun origami-h-push (h new)
"Create a new history structure with new as the present value."
(when new
(let ((past (aref h 0))
(present (aref h 1)))
(vector (cons present (-take 19 past)) new nil))))
(defun origami-h-undo (h)
(let ((past (aref h 0))
(present (aref h 1))
(future (aref h 2)))
(if (null past) h
(vector (cdr past) (car past) (cons present future)))))
(defun origami-h-redo (h)
(let ((past (aref h 0))
(present (aref h 1))
(future (aref h 2)))
(if (null future) h
(vector (cons present past) (car future) (cdr future)))))
(defun origami-h-present (h)
(when h (aref h 1)))
;;; interactive utils
(defun origami-setup-local-vars (buffer)
(with-current-buffer buffer
(set (make-local-variable 'origami-history)
(origami-h-new (origami-fold-root-node)))
(set (make-local-variable 'origami-tree-tick) 0)))
(defun origami-get-cached-tree (buffer)
(or (local-variable-p 'origami-history buffer)
(error "Necessary local variables were not available"))
(origami-h-present (buffer-local-value 'origami-history buffer)))
(defun origami-store-cached-tree (buffer tree)
(or (and (local-variable-p 'origami-history buffer)
(local-variable-p 'origami-tree-tick buffer))
(error "Necessary local variables were not available"))
(with-current-buffer buffer
(setq origami-tree-tick (buffer-modified-tick))
(setq origami-history (origami-h-push origami-history tree)))
tree)
(defun origami-update-history (buffer f)
(or (local-variable-p 'origami-history buffer)
(error "Necessary local variables were not available"))
(with-current-buffer buffer
(setq origami-history (funcall f origami-history))))
(defun origami-rebuild-tree? (buffer)
"Determines if the tree needs to be rebuilt for BUFFER since it
was last built."
(not (= (buffer-local-value 'origami-tree-tick buffer)
(buffer-modified-tick buffer))))
(defun origami-build-tree (buffer parser)
(when parser
(with-current-buffer buffer
(let ((contents (buffer-string)))
(-> parser
(funcall contents)
origami-fold-root-node)))))
(defun origami-get-parser (buffer)
(let* ((cached-tree (origami-get-cached-tree buffer))
(create (lambda (beg end offset children)
(let ((previous-fold (-last-item (origami-fold-find-path-with-range cached-tree beg end))))
(origami-fold-node beg end offset
(if previous-fold (origami-fold-open? previous-fold) t)
children
(or (-> (origami-fold-find-path-with-range
(origami-get-cached-tree buffer) beg end)
-last-item
origami-fold-data)
(origami-create-overlay beg end offset buffer)))))))
(-when-let (parser-gen (or (cdr (assoc (if (local-variable-p 'origami-fold-style)
(buffer-local-value 'origami-fold-style buffer)
(buffer-local-value 'major-mode buffer))
origami-parser-alist))
'origami-indent-parser))
(funcall parser-gen create))))
(defun origami-get-fold-tree (buffer)
"Facade. Build the tree if it hasn't already been built
otherwise fetch cached tree."
(when origami-mode
(if (origami-rebuild-tree? buffer)
(origami-build-tree buffer (origami-get-parser buffer))
(origami-get-cached-tree buffer))))
(defun origami-apply-new-tree (buffer old-tree new-tree)
(when new-tree
(origami-fold-diff old-tree new-tree
'origami-hide-overlay-from-fold-tree-fn
'origami-show-overlay-from-fold-tree-fn
'origami-change-overlay-from-fold-node-fn)))
(defun origami-search-forward-for-path (buffer point)
(let (end)
(with-current-buffer buffer
(save-excursion
(goto-char point)
(setq end (line-end-position))))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(let ((forward-node (-first (lambda (node)
(and (>= (origami-fold-beg node) point)
(<= (origami-fold-beg node) end)))
(origami-fold-children (-last-item path)))))
(if forward-node (append path (list forward-node)) path))))))
;;; commands
(defun origami-open-node (buffer point)
"Open the fold node at POINT in BUFFER. The fold node opened
will be the deepest nested at POINT."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(origami-apply-new-tree buffer tree (origami-store-cached-tree
buffer
(origami-fold-assoc path (lambda (node)
(origami-fold-open-set node t))))))))
(defun origami-open-node-recursively (buffer point)
"Open the fold node and all of its children at POINT in BUFFER.
The fold node opened will be the deepest nested at POINT."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(origami-apply-new-tree
buffer tree (origami-store-cached-tree
buffer
(origami-fold-assoc path
(lambda (node)
(origami-fold-map (lambda (node)
(origami-fold-open-set node t))
node))))))))
(defun origami-show-node (buffer point)
"Like `origami-open-node' but also opens parent fold nodes
recursively so as to ensure the position where POINT is is
visible."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(origami-apply-new-tree buffer tree (origami-store-cached-tree
buffer
(origami-fold-path-map
(lambda (node)
(origami-fold-open-set node t))
path))))))
(defun origami-close-node (buffer point)
"Close the fold node at POINT in BUFFER. The fold node closed
will be the deepest nested at POINT."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(origami-apply-new-tree buffer tree (origami-store-cached-tree
buffer
(origami-fold-assoc
path (lambda (node)
(origami-fold-open-set node nil))))))))
(defun origami-close-node-recursively (buffer point)
"Close the fold node and all of its children at POINT in BUFFER.
The fold node closed will be the deepest nested at POINT."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(origami-apply-new-tree
buffer tree (origami-store-cached-tree
buffer
(origami-fold-assoc path
(lambda (node)
(origami-fold-map (lambda (node)
(origami-fold-open-set node nil))
node))))))))
(defun origami-toggle-node (buffer point)
"Toggle the fold node at POINT in BUFFER open or closed. The
fold node opened or closed will be the deepest nested at POINT."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(origami-apply-new-tree buffer tree (origami-store-cached-tree
buffer
(origami-fold-assoc
path (lambda (node)
(origami-fold-open-set
node (not (origami-fold-open?
(-last-item path)))))))))))
(defun origami-forward-toggle-node (buffer point)
"Like `origami-toggle-node' but search forward in BUFFER for a
fold node. If a fold node is found after POINT and before the
next line break, this will be toggled. Otherwise, behave exactly
as `origami-toggle-node'."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-search-forward-for-path buffer point))
(origami-apply-new-tree buffer tree (origami-store-cached-tree
buffer
(origami-fold-assoc
path (lambda (node)
(origami-fold-open-set
node (not (origami-fold-open?
(-last-item path)))))))))))
(defun origami-recursively-toggle-node (buffer point)
"Cycle a fold node between recursively closed, open and
recursively open depending on its current state. The fold node
acted upon is searched for forward in BUFFER from POINT. If a
fold node is found after POINT and before the next line break,
this will be toggled otherwise the fold node nested deepest at
POINT will be acted upon.
This command will only work if bound to a key. For those familiar
with org-mode heading opening and collapsing, this will feel
familiar. It's easiest to grasp this just by giving it a go."
(interactive (list (current-buffer) (point)))
(-when-let (path (origami-search-forward-for-path buffer point))
(let ((node (-last-item path)))
(if (eq last-command 'origami-recursively-toggle-node)
(cond ((origami-fold-node-recursively-open? node)
(origami-close-node-recursively buffer (origami-fold-beg node)))
((origami-fold-node-recursively-closed? node)
(origami-toggle-node buffer (origami-fold-beg node)))
(t (origami-open-node-recursively buffer (origami-fold-beg node))))
(origami-forward-toggle-node buffer point)))))
(defun origami-open-all-nodes (buffer)
"Recursively open every fold node in BUFFER."
(interactive (list (current-buffer)))
(-when-let (tree (origami-get-fold-tree buffer))
(origami-apply-new-tree buffer tree (origami-store-cached-tree
buffer
(origami-fold-map
(lambda (node)
(origami-fold-open-set node t))
tree)))))
(defun origami-close-all-nodes (buffer)
"Recursively close every fold node in BUFFER."
(interactive (list (current-buffer)))
(-when-let (tree (origami-get-fold-tree buffer))
(origami-apply-new-tree buffer tree (origami-store-cached-tree
buffer
(origami-fold-map
(lambda (node)
(origami-fold-open-set node nil))
tree)))))
(defun origami-toggle-all-nodes (buffer)
"Toggle all fold nodes in the buffer recursively open or
recursively closed."
(interactive (list (current-buffer)))
(-when-let (tree (origami-get-fold-tree buffer))
;; use the first child as root is always open
(if (-> tree origami-fold-children car origami-fold-open?)
(origami-close-all-nodes buffer)
(origami-open-all-nodes buffer))))
(defun origami-show-only-node (buffer point)
"Close all fold nodes in BUFFER except for those necessary to
make POINT visible. Very useful for quickly collapsing everything
in the buffer other than what you are looking at."
(interactive (list (current-buffer) (point)))
(origami-close-all-nodes buffer)
(origami-show-node buffer point))
(defun origami-previous-fold (buffer point)
"Move point to the beginning of the fold before POINT. If POINT
is in a fold, move to the beginning of the fold that POINT is
in."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-> tree
(origami-fold-preorder-reduce (lambda (state n)
(cons (origami-fold-beg n) state)) nil)
(->> (-reduce (lambda (state pos)
(if (< state point) state pos))))
goto-char)))
(defun origami-next-fold (buffer point)
"Move point to the end of the fold after POINT. If POINT is in
a fold, move to the end of the fold that POINT is in."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-> tree
(origami-fold-postorder-reduce (lambda (state n)
(cons (origami-fold-end n) state)) nil)
(->> (-last (lambda (pos) (> pos point))))
goto-char)))
(defun origami-forward-fold (buffer point)
"Move point to the beginning of the first fold in the BUFFER
after POINT."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-> tree
(origami-fold-preorder-reduce (lambda (state n)
(cons (origami-fold-beg n) state)) nil)
(->> (-last (lambda (pos) (> pos point))))
goto-char)))
(defun origami-forward-fold-same-level (buffer point)
"Move point to the beginning of the next fold in the buffer
that is a sibling of the fold the point is currently in."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(-when-let (c (-> (origami-fold-next-sibling (origami-fold-children
(origami-fold-parent path))
(-last-item path))
origami-fold-beg))
(goto-char c)))))
(defun origami-backward-fold-same-level (buffer point)
"Move point to the beginning of the previous fold in the buffer
that is a sibling of the fold the point is currently in."
(interactive (list (current-buffer) (point)))
(-when-let (tree (origami-get-fold-tree buffer))
(-when-let (path (origami-fold-find-path-containing tree point))
(-when-let (c (-> (origami-fold-prev-sibling (origami-fold-children
(origami-fold-parent path))
(-last-item path))
origami-fold-beg))
(goto-char c)))))
(defun origami-undo (buffer)
"Undo the last folding operation applied to BUFFER. Undo
history is linear. If you undo some fold operations and then
perform a new fold operation you will lose the history of
operations undone."
(interactive (list (current-buffer)))
(let ((current-tree (origami-get-cached-tree buffer)))
(origami-update-history buffer (lambda (h) (origami-h-undo h)))
(let ((old-tree (origami-get-cached-tree buffer)))
(origami-apply-new-tree buffer current-tree old-tree))))
(defun origami-redo (buffer)
"Redo the last folding operation applied to BUFFER. You can
only redo undone operations while a new folding operation hasn't
been performed to BUFFER."
(interactive (list (current-buffer)))
(let ((current-tree (origami-get-cached-tree buffer)))
(origami-update-history buffer (lambda (h) (origami-h-redo h)))
(let ((new-tree (origami-get-cached-tree buffer)))
(origami-apply-new-tree buffer current-tree new-tree))))
(defun origami-reset (buffer)
"Remove all folds from BUFFER and reset all origami state
associated with this buffer. Useful during development or if you
uncover any bugs."
(interactive (list (current-buffer)))
(origami-setup-local-vars buffer)
(origami-remove-all-overlays buffer))
;;; minor mode
(defvar origami-mode-map
(let ((map (make-sparse-keymap)))
map)
"Keymap for `origami-mode'.")
(defcustom origami-mode-hook nil
"Hook called when origami minor mode is activated or deactivated."
:type 'hook
:group 'origami)
(defun origami-find-occurrence-show-node ()
(call-interactively 'origami-show-node))
;;;###autoload
(define-minor-mode origami-mode
"Minor mode to selectively hide/show text in the current buffer.
With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
Lastly, the normal hook `origami-mode-hook' is run using
`run-hooks'.
Key bindings:
\\{origami-mode-map}"
:group 'origami
:lighter nil
:keymap origami-mode-map
:init-value nil
(if origami-mode
(progn
(add-hook 'occur-mode-find-occurrence-hook
'origami-find-occurrence-show-node nil t)
(setq next-error-move-function (lambda (ignored pos)
(goto-char pos)
(call-interactively 'origami-show-node))))
(remove-hook 'occur-mode-find-occurrence-hook
'origami-find-occurrence-show-node t)
(setq next-error-move-function nil))
(origami-reset (current-buffer)))
;;;###autoload
(define-global-minor-mode global-origami-mode origami-mode
(lambda () (origami-mode 1)))
(provide 'origami)
;;; origami.el ends here

1
elpa/seq-2.16.signed Normal file
View File

@ -0,0 +1 @@
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2016-06-12T23:05:02+0200 using DSA

142
elpa/seq-2.16/ChangeLog Normal file
View File

@ -0,0 +1,142 @@
2016-06-12 Nicolas Petton <nicolas@petton.fr>
Update seq.el to 2.16
* packages/seq/seq-24.el:
* packages/seq/seq-25.el: Better implementation of seq-drop for lists.
* packages/seq/seq.el: Bump version number.
2016-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
* seq-24.el (seq-concatenate,seq-into,seq--make-bindings): Use _
rather than t as catch-all for pcase.
2016-03-31 Nicolas Petton <nicolas@petton.fr>
Update seq to version 2.15
* packages/seq/seq-25.el: Require cl-lib.
* packages/seq/seq.el: Bump version number.
2016-03-29 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 2.14
* packages/seq/seq.el: Bump version number.
* packages/seq/seq-24.el (seq-sort-by): New function.
* packages/seq/seq-25.el (seq-sort-by): New function.
* packages/seq/tests/seq-tests.el: Add a test for seq-sort-by.
2016-03-25 Nicolas Petton <nicolas@petton.fr>
* packages/seq/seq-25.el: Better declarations for seq--when-emacs-25-p
2016-03-25 Nicolas Petton <nicolas@petton.fr>
Split seq.el into separate files for different versions of Emacs
All functions in seq-25.el are wrapped in a `seq--when-emacs-25-p' to
make sure that the byte compiler won't emit warnings or errors when the
file is byte compiled in Emacs < 25.
* packages/seq/seq-24.el:
* packages/seq/seq-25.el: New files.
* packages/seq/seq.el: Load seq-VERSION.el based on the version of
Emacs.
* packages/seq/test/seq.el-test.el: Backport a test from seq.el in Emacs
master.
2015-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
* packages/seq: Don't define it as a :core package
Revert the removal of packages/seq/seq.el since it's different from the
one in lisp/emacs-lisp.
* .gitignore: Remove packages/seq.
* externals-list: Remove "seq" entry.
2015-11-29 Stefan Monnier <monnier@iro.umontreal.ca>
* externals-list: Add seq and python as :core packages
* .gitignore: Add packages/{seq,python}.
* packages/seq: Remove.
2015-10-20 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.11
* packages/seq/seq.el:
* packages/seq/tests/seq-tests.el: Update.
2015-09-18 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.9
* packages/seq/seq.el: Update to version 1.9.
* packages/seq/tests/seq-tests.el: Update to version 1.9.
2015-07-09 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.8
* packages/seq/seq.el: Update to version 1.8.
* packages/seq/tests/seq-tests.el: Update to version 1.8.
2015-05-15 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.7
* packages/seq/seq.el: Update to version 1.7.
* packages/seq/tests/seq-tests.el: Update to version 1.7.
2015-04-27 Nicolas Petton <nicolas@petton.fr>
* packages/seq/seq.el: Update seq.el to version 1.5.
2015-04-15 Nicolas Petton <nicolas@petton.fr>
seq.el update
* packages/seq/seq.el: Update seq.el to version 1.4
* packages/seq/tests/seq-tests.el: Update seq.el to version 1.4
2015-03-25 Nicolas Petton <nicolas@petton.fr>
Rephrases a comment in seq.el about the order of the arguments
* packages/seq/seq.el: Better comment about the order of the arguments
2015-03-09 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.3
* packages/seq/seq.el: update to version 1.3
* packages/seq/tests/seq-tests.el: update to version 1.3
2015-02-11 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.2
* package/seq/seq.el: Update to version 1.2
* packages/seq/tests/seq-tests.el: Update to version 1.2
2015-02-09 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.1.1
* package/seq/seq.el: Update to version 1.1.1
* packages/seq/tests/seq-tests.el: Update to version 1.1.1
2015-02-06 Nicolas Petton <nicolas@petton.fr>
Update seq.el to version 1.1
* packages/seq/seq.el: Update to version 1.1
* packages/seq/tests/seq-tests.el: Update to version 1.1
2015-01-14 Nicolas Petton <nicolas@petton.fr>
packages/seq: New package

464
elpa/seq-2.16/seq-24.el Normal file
View File

@ -0,0 +1,464 @@
;;; seq-24.el --- seq.el implementation for Emacs 24.x -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Sequence-manipulation functions that complement basic functions
;; provided by subr.el.
;;
;; All functions are prefixed with "seq-".
;;
;; All provided functions work on lists, strings and vectors.
;;
;; Functions taking a predicate or iterating over a sequence using a
;; function as argument take the function as their first argument and
;; the sequence as their second argument. All other functions take
;; the sequence as their first argument.
;;; Code:
(defmacro seq-doseq (spec &rest body)
"Loop over a sequence.
Similar to `dolist' but can be applied to lists, strings, and vectors.
Evaluate BODY with VAR bound to each element of SEQ, in turn.
\(fn (VAR SEQ) BODY...)"
(declare (indent 1) (debug ((symbolp form &optional form) body)))
(let ((length (make-symbol "length"))
(seq (make-symbol "seq"))
(index (make-symbol "index")))
`(let* ((,seq ,(cadr spec))
(,length (if (listp ,seq) nil (seq-length ,seq)))
(,index (if ,length 0 ,seq)))
(while (if ,length
(< ,index ,length)
(consp ,index))
(let ((,(car spec) (if ,length
(prog1 (seq-elt ,seq ,index)
(setq ,index (+ ,index 1)))
(pop ,index))))
,@body)))))
;; Implementation of `seq-let' compatible with Emacs<25.1.
(defmacro seq-let (args sequence &rest body)
"Bind the variables in ARGS to the elements of SEQUENCE then evaluate BODY.
ARGS can also include the `&rest' marker followed by a variable
name to be bound to the rest of SEQUENCE."
(declare (indent 2) (debug t))
(let ((seq-var (make-symbol "seq")))
`(let* ((,seq-var ,sequence)
,@(seq--make-bindings args seq-var))
,@body)))
(defun seq-drop (sequence n)
"Return a subsequence of SEQUENCE without its first N elements.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, SEQUENCE is returned."
(if (<= n 0)
sequence
(if (listp sequence)
(seq--drop-list sequence n)
(let ((length (seq-length sequence)))
(seq-subseq sequence (min n length) length)))))
(defun seq-take (sequence n)
"Return a subsequence of SEQUENCE with its first N elements.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, an empty sequence is
returned."
(if (listp sequence)
(seq--take-list sequence n)
(seq-subseq sequence 0 (min (max n 0) (seq-length sequence)))))
(defun seq-drop-while (predicate sequence)
"Return a sequence from the first element for which (PREDICATE element) is nil in SEQUENCE.
The result is a sequence of the same type as SEQUENCE."
(if (listp sequence)
(seq--drop-while-list predicate sequence)
(seq-drop sequence (seq--count-successive predicate sequence))))
(defun seq-take-while (predicate sequence)
"Return the successive elements for which (PREDICATE element) is non-nil in SEQUENCE.
The result is a sequence of the same type as SEQUENCE."
(if (listp sequence)
(seq--take-while-list predicate sequence)
(seq-take sequence (seq--count-successive predicate sequence))))
(defun seq-filter (predicate sequence)
"Return a list of all the elements for which (PREDICATE element) is non-nil in SEQUENCE."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall predicate elt)
elt
exclude))
sequence))))
(defun seq-map-indexed (function sequence)
"Return the result of applying FUNCTION to each element of SEQUENCE.
Unlike `seq-map', FUNCTION takes two arguments: the element of
the sequence, and its index within the sequence."
(let ((index 0))
(seq-map (lambda (elt)
(prog1
(funcall function elt index)
(setq index (1+ index))))
sequence)))
(defun seq-remove (predicate sequence)
"Return a list of all the elements for which (PREDICATE element) is nil in SEQUENCE."
(seq-filter (lambda (elt) (not (funcall predicate elt)))
sequence))
(defun seq-reduce (function sequence initial-value)
"Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
Return the result of calling FUNCTION with INITIAL-VALUE and the
first element of SEQUENCE, then calling FUNCTION with that result and
the second element of SEQUENCE, then with that result and the third
element of SEQUENCE, etc.
If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
(if (seq-empty-p sequence)
initial-value
(let ((acc initial-value))
(seq-doseq (elt sequence)
(setq acc (funcall function acc elt)))
acc)))
(defun seq-some (predicate sequence)
"Return the first value for which if (PREDICATE element) is non-nil for in SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(let ((result (funcall predicate elt)))
(when result
(throw 'seq--break result))))
nil))
(defun seq-find (predicate sequence &optional default)
"Return the first element for which (PREDICATE element) is non-nil in SEQUENCE.
If no element is found, return DEFAULT.
Note that `seq-find' has an ambiguity if the found element is
identical to DEFAULT, as it cannot be known if an element was
found or not."
(catch 'seq--break
(seq-doseq (elt sequence)
(when (funcall predicate elt)
(throw 'seq--break elt)))
default))
(defun seq-every-p (predicate sequence)
"Return non-nil if (PREDICATE element) is non-nil for all elements of the sequence SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(or (funcall predicate elt)
(throw 'seq--break nil)))
t))
(defun seq-count (predicate sequence)
"Return the number of elements for which (PREDICATE element) is non-nil in SEQUENCE."
(let ((count 0))
(seq-doseq (elt sequence)
(when (funcall predicate elt)
(setq count (+ 1 count))))
count))
(defun seq-empty-p (sequence)
"Return non-nil if the sequence SEQUENCE is empty, nil otherwise."
(if (listp sequence)
(null sequence)
(= 0 (seq-length sequence))))
(defun seq-sort (predicate sequence)
"Return a sorted sequence comparing using PREDICATE the elements of SEQUENCE.
The result is a sequence of the same type as SEQUENCE."
(if (listp sequence)
(sort (seq-copy sequence) predicate)
(let ((result (seq-sort predicate (append sequence nil))))
(seq-into result (type-of sequence)))))
(defun seq-sort-by (function pred sequence)
"Sort SEQUENCE using PRED as a comparison function.
Elements of SEQUENCE are transformed by FUNCTION before being
sorted. FUNCTION must be a function of one argument."
(seq-sort (lambda (a b)
(funcall pred
(funcall function a)
(funcall function b)))
sequence))
(defun seq-contains (sequence elt &optional testfn)
"Return the first element in SEQUENCE that equals to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-some (lambda (e)
(funcall (or testfn #'equal) elt e))
sequence))
(defun seq-position (sequence elt &optional testfn)
"Return the index of the first element in SEQUENCE that is equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(let ((index 0))
(catch 'seq--break
(seq-doseq (e sequence)
(when (funcall (or testfn #'equal) e elt)
(throw 'seq--break index))
(setq index (1+ index)))
nil)))
(defun seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
TESTFN is used to compare elements, or `equal' if TESTFN is nil."
(let ((result '()))
(seq-doseq (elt sequence)
(unless (seq-contains result elt testfn)
(setq result (cons elt result))))
(nreverse result)))
(defun seq-subseq (sequence start &optional end)
"Return the subsequence of SEQUENCE from START to END.
If END is omitted, it defaults to the length of the sequence.
If START or END is negative, it counts from the end."
(cond ((or (stringp sequence) (vectorp sequence)) (substring sequence start end))
((listp sequence)
(let (len (errtext (format "Bad bounding indices: %s, %s" start end)))
(and end (< end 0) (setq end (+ end (setq len (seq-length sequence)))))
(if (< start 0) (setq start (+ start (or len (setq len (seq-length sequence))))))
(when (> start 0)
(setq sequence (nthcdr (1- start) sequence))
(or sequence (error "%s" errtext))
(setq sequence (cdr sequence)))
(if end
(let ((res nil))
(while (and (>= (setq end (1- end)) start) sequence)
(push (pop sequence) res))
(or (= (1+ end) start) (error "%s" errtext))
(nreverse res))
(seq-copy sequence))))
(t (error "Unsupported sequence: %s" sequence))))
(defun seq-concatenate (type &rest seqs)
"Concatenate, into a sequence of type TYPE, the sequences SEQS.
TYPE must be one of following symbols: vector, string or list.
\n(fn TYPE SEQUENCE...)"
(pcase type
(`vector (apply #'vconcat seqs))
(`string (apply #'concat seqs))
(`list (apply #'append (append seqs '(nil))))
(_ (error "Not a sequence type name: %S" type))))
(defun seq-mapcat (function sequence &optional type)
"Concatenate the result of applying FUNCTION to each element of SEQUENCE.
The result is a sequence of type TYPE, or a list if TYPE is nil."
(apply #'seq-concatenate (or type 'list)
(seq-map function sequence)))
(defun seq-mapn (function sequence &rest seqs)
"Like `seq-map' but FUNCTION is mapped over all SEQS.
The arity of FUNCTION must match the number of SEQS, and the
mapping stops on the shortest sequence.
Return a list of the results.
\(fn FUNCTION SEQS...)"
(let ((result nil)
(seqs (seq-map (lambda (s) (seq-into s 'list))
(cons sequence seqs))))
(while (not (memq nil seqs))
(push (apply function (seq-map #'car seqs)) result)
(setq seqs (seq-map #'cdr seqs)))
(nreverse result)))
(defun seq-partition (sequence n)
"Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
negative integer or 0, nil is returned."
(unless (< n 1)
(let ((result '()))
(while (not (seq-empty-p sequence))
(push (seq-take sequence n) result)
(setq sequence (seq-drop sequence n)))
(nreverse result))))
(defun seq-intersection (seq1 seq2 &optional testfn)
"Return a list of the elements that appear in both SEQ1 and SEQ2.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-reduce (lambda (acc elt)
(if (seq-contains seq2 elt testfn)
(cons elt acc)
acc))
(seq-reverse seq1)
'()))
(defun seq-difference (seq1 seq2 &optional testfn)
"Return a list of the elements that appear in SEQ1 but not in SEQ2.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-reduce (lambda (acc elt)
(if (not (seq-contains seq2 elt testfn))
(cons elt acc)
acc))
(seq-reverse seq1)
'()))
(defun seq-group-by (function sequence)
"Apply FUNCTION to each element of SEQUENCE.
Separate the elements of SEQUENCE into an alist using the results as
keys. Keys are compared using `equal'."
(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 sequence)
nil))
(defalias 'seq-reverse
(if (ignore-errors (reverse [1 2]))
#'reverse
(lambda (sequence)
"Return the reversed copy of list, vector, or string SEQUENCE.
See also the function `nreverse', which is used more often."
(let ((result '()))
(seq-map (lambda (elt) (push elt result))
sequence)
(if (listp sequence)
result
(seq-into result (type-of sequence)))))))
(defun seq-into (sequence type)
"Convert the sequence SEQUENCE into a sequence of type TYPE.
TYPE can be one of the following symbols: vector, string or list."
(pcase type
(`vector (vconcat sequence))
(`string (concat sequence))
(`list (append sequence nil))
(_ (error "Not a sequence type name: %S" type))))
(defun seq-min (sequence)
"Return the smallest element of SEQUENCE.
SEQUENCE must be a sequence of numbers or markers."
(apply #'min (seq-into sequence 'list)))
(defun seq-max (sequence)
"Return the largest element of SEQUENCE.
SEQUENCE must be a sequence of numbers or markers."
(apply #'max (seq-into sequence 'list)))
(defun seq--drop-list (list n)
"Return a list from LIST without its first N elements.
This is an optimization for lists in `seq-drop'."
(nthcdr n list))
(defun seq--take-list (list n)
"Return a list from LIST made of its first N elements.
This is an optimization for lists in `seq-take'."
(let ((result '()))
(while (and list (> n 0))
(setq n (1- n))
(push (pop list) result))
(nreverse result)))
(defun seq--drop-while-list (predicate list)
"Return a list from the first element for which (PREDICATE element) is nil in LIST.
This is an optimization for lists in `seq-drop-while'."
(while (and list (funcall predicate (car list)))
(setq list (cdr list)))
list)
(defun seq--take-while-list (predicate list)
"Return the successive elements for which (PREDICATE element) is non-nil in LIST.
This is an optimization for lists in `seq-take-while'."
(let ((result '()))
(while (and list (funcall predicate (car list)))
(push (pop list) result))
(nreverse result)))
(defun seq--count-successive (predicate sequence)
"Return the number of successive elements for which (PREDICATE element) is non-nil in SEQUENCE."
(let ((n 0)
(len (seq-length sequence)))
(while (and (< n len)
(funcall predicate (seq-elt sequence n)))
(setq n (+ 1 n)))
n))
;; Helper function for the Backward-compatible version of `seq-let'
;; for Emacs<25.1.
(defun seq--make-bindings (args sequence &optional bindings)
"Return a list of bindings of the variables in ARGS to the elements of a sequence.
if BINDINGS is non-nil, append new bindings to it, and return
BINDINGS."
(let ((index 0)
(rest-marker nil))
(seq-doseq (name args)
(unless rest-marker
(pcase name
((pred seq-p)
(setq bindings (seq--make-bindings (seq--elt-safe args index)
`(seq--elt-safe ,sequence ,index)
bindings)))
(`&rest
(progn (push `(,(seq--elt-safe args (1+ index))
(seq-drop ,sequence ,index))
bindings)
(setq rest-marker t)))
(_
(push `(,name (seq--elt-safe ,sequence ,index)) bindings))))
(setq index (1+ index)))
bindings))
(defun seq--elt-safe (sequence n)
"Return element of SEQUENCE at the index N.
If no element is found, return nil."
(when (or (listp sequence)
(and (sequencep sequence)
(> (seq-length sequence) n)))
(seq-elt sequence n)))
(defun seq--activate-font-lock-keywords ()
"Activate font-lock keywords for some symbols defined in seq."
(font-lock-add-keywords 'emacs-lisp-mode
'("\\<seq-doseq\\>" "\\<seq-let\\>")))
(defalias 'seq-copy #'copy-sequence)
(defalias 'seq-elt #'elt)
(defalias 'seq-length #'length)
(defalias 'seq-do #'mapc)
(defalias 'seq-each #'seq-do)
(defalias 'seq-map #'mapcar)
(defalias 'seq-p #'sequencep)
(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
;; we automatically highlight macros.
(add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
(provide 'seq-24)
;;; seq-24.el ends here

498
elpa/seq-2.16/seq-25.el Normal file
View File

@ -0,0 +1,498 @@
;;; seq-25.el --- seq.el implementation for Emacs 25.x -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Sequence-manipulation functions that complement basic functions
;; provided by subr.el.
;;
;; All functions are prefixed with "seq-".
;;
;; All provided functions work on lists, strings and vectors.
;;
;; Functions taking a predicate or iterating over a sequence using a
;; function as argument take the function as their first argument and
;; the sequence as their second argument. All other functions take
;; the sequence as their first argument.
;;
;; seq.el can be extended to support new type of sequences. Here are
;; the generic functions that must be implemented by new seq types:
;; - `seq-elt'
;; - `seq-length'
;; - `seq-do'
;; - `seqp'
;; - `seq-subseq'
;; - `seq-into-sequence'
;; - `seq-copy'
;; - `seq-into'
;;; Code:
;; When loading seq.el in Emacs 24.x, this file gets byte-compiled, even if
;; never used. This takes care of byte-compilation warnings is emitted, by
;; emitting nil in the macro expansion in Emacs 24.x.
(defmacro seq--when-emacs-25-p (&rest body)
"Execute BODY if in Emacs>=25.x."
(declare (indent (lambda (&rest x) 0)) (debug t))
(when (version<= "25" emacs-version)
`(progn ,@body)))
(seq--when-emacs-25-p
(require 'cl-generic)
(require 'cl-lib) ;; for cl-subseq
(defmacro seq-doseq (spec &rest body)
"Loop over a sequence.
Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
Similar to `dolist' but can be applied to lists, strings, and vectors.
\(fn (VAR SEQUENCE) BODY...)"
(declare (indent 1) (debug ((symbolp form &optional form) body)))
`(seq-do (lambda (,(car spec))
,@body)
,(cadr spec)))
(pcase-defmacro seq (&rest patterns)
"Build a `pcase' pattern that matches elements of SEQUENCE.
The `pcase' pattern will match each element of PATTERNS against the
corresponding element of SEQUENCE.
Extra elements of the sequence are ignored if fewer PATTERNS are
given, and the match does not fail."
`(and (pred seqp)
,@(seq--make-pcase-bindings patterns)))
(defmacro seq-let (args sequence &rest body)
"Bind the variables in ARGS to the elements of SEQUENCE, then evaluate BODY.
ARGS can also include the `&rest' marker followed by a variable
name to be bound to the rest of SEQUENCE."
(declare (indent 2) (debug t))
`(pcase-let ((,(seq--make-pcase-patterns args) ,sequence))
,@body))
;;; Basic seq functions that have to be implemented by new sequence types
(cl-defgeneric seq-elt (sequence n)
"Return Nth element of SEQUENCE."
(elt sequence n))
;; Default gv setters for `seq-elt'.
;; It can be a good idea for new sequence implementations to provide a
;; "gv-setter" for `seq-elt'.
(cl-defmethod (setf seq-elt) (store (sequence array) n)
(aset sequence n store))
(cl-defmethod (setf seq-elt) (store (sequence cons) n)
(setcar (nthcdr n sequence) store))
(cl-defgeneric seq-length (sequence)
"Return the number of elements of SEQUENCE."
(length sequence))
(cl-defgeneric seq-do (function sequence)
"Apply FUNCTION to each element of SEQUENCE, presumably for side effects.
Return SEQUENCE."
(mapc function sequence))
(defalias 'seq-each #'seq-do)
(cl-defgeneric seqp (sequence)
"Return non-nil if SEQUENCE is a sequence, nil otherwise."
(sequencep sequence))
(cl-defgeneric seq-copy (sequence)
"Return a shallow copy of SEQUENCE."
(copy-sequence sequence))
(cl-defgeneric seq-subseq (sequence start &optional end)
"Return the sequence of elements of SEQUENCE from START to END.
END is inclusive.
If END is omitted, it defaults to the length of the sequence. If
START or END is negative, it counts from the end. Signal an
error if START or END are outside of the sequence (i.e too large
if positive or too small if negative)."
(cl-subseq sequence start end))
(cl-defgeneric seq-map (function sequence)
"Return the result of applying FUNCTION to each element of SEQUENCE."
(let (result)
(seq-do (lambda (elt)
(push (funcall function elt) result))
sequence)
(nreverse result)))
(defun seq-map-indexed (function sequence)
"Return the result of applying FUNCTION to each element of SEQUENCE.
Unlike `seq-map', FUNCTION takes two arguments: the element of
the sequence, and its index within the sequence."
(let ((index 0))
(seq-map (lambda (elt)
(prog1
(funcall function elt index)
(setq index (1+ index))))
sequence)))
;; faster implementation for sequences (sequencep)
(cl-defmethod seq-map (function (sequence sequence))
(mapcar function sequence))
(cl-defgeneric seq-mapn (function sequence &rest sequences)
"Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
The arity of FUNCTION must match the number of SEQUENCES, and the
mapping stops on the shortest sequence.
Return a list of the results.
\(fn FUNCTION SEQUENCES...)"
(let ((result nil)
(sequences (seq-map (lambda (s) (seq-into s 'list))
(cons sequence sequences))))
(while (not (memq nil sequences))
(push (apply function (seq-map #'car sequences)) result)
(setq sequences (seq-map #'cdr sequences)))
(nreverse result)))
(cl-defgeneric seq-drop (sequence n)
"Remove the first N elements of SEQUENCE and return the result.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, SEQUENCE is returned."
(if (<= n 0)
sequence
(let ((length (seq-length sequence)))
(seq-subseq sequence (min n length) length))))
(cl-defgeneric seq-take (sequence n)
"Take the first N elements of SEQUENCE and return the result.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, an empty sequence is
returned."
(seq-subseq sequence 0 (min (max n 0) (seq-length sequence))))
(cl-defgeneric seq-drop-while (pred sequence)
"Remove the successive elements of SEQUENCE for which PRED returns non-nil.
PRED is a function of one argument. The result is a sequence of
the same type as SEQUENCE."
(seq-drop sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-take-while (pred sequence)
"Take the successive elements of SEQUENCE for which PRED returns non-nil.
PRED is a function of one argument. The result is a sequence of
the same type as SEQUENCE."
(seq-take sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-empty-p (sequence)
"Return non-nil if the SEQUENCE is empty, nil otherwise."
(= 0 (seq-length sequence)))
(cl-defgeneric seq-sort (pred sequence)
"Sort SEQUENCE using PRED as comparison function.
The result is a sequence of the same type as SEQUENCE."
(let ((result (seq-sort pred (append sequence nil))))
(seq-into result (type-of sequence))))
(defun seq-sort-by (function pred sequence)
"Sort SEQUENCE using PRED as a comparison function.
Elements of SEQUENCE are transformed by FUNCTION before being
sorted. FUNCTION must be a function of one argument."
(seq-sort (lambda (a b)
(funcall pred
(funcall function a)
(funcall function b)))
sequence))
(cl-defmethod seq-sort (pred (list list))
(sort (seq-copy list) pred))
(cl-defgeneric seq-reverse (sequence)
"Return a sequence with elements of SEQUENCE in reverse order."
(let ((result '()))
(seq-map (lambda (elt)
(push elt result))
sequence)
(seq-into result (type-of sequence))))
;; faster implementation for sequences (sequencep)
(cl-defmethod seq-reverse ((sequence sequence))
(reverse sequence))
(cl-defgeneric seq-concatenate (type &rest sequences)
"Concatenate SEQUENCES into a single sequence of type TYPE.
TYPE must be one of following symbols: vector, string or list.
\n(fn TYPE SEQUENCE...)"
(apply #'cl-concatenate type (seq-map #'seq-into-sequence sequences)))
(cl-defgeneric seq-into-sequence (sequence)
"Convert SEQUENCE into a sequence.
The default implementation is to signal an error if SEQUENCE is not a
sequence, specific functions should be implemented for new types
of sequence."
(unless (sequencep sequence)
(error "Cannot convert %S into a sequence" sequence))
sequence)
(cl-defgeneric seq-into (sequence type)
"Concatenate the elements of SEQUENCE into a sequence of type TYPE.
TYPE can be one of the following symbols: vector, string or
list."
(pcase type
(`vector (vconcat sequence))
(`string (concat sequence))
(`list (append sequence nil))
(_ (error "Not a sequence type name: %S" type))))
(cl-defgeneric seq-filter (pred sequence)
"Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall pred elt)
elt
exclude))
sequence))))
(cl-defgeneric seq-remove (pred sequence)
"Return a list of all the elements for which (PRED element) is nil in SEQUENCE."
(seq-filter (lambda (elt) (not (funcall pred elt)))
sequence))
(cl-defgeneric seq-reduce (function sequence initial-value)
"Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
Return the result of calling FUNCTION with INITIAL-VALUE and the
first element of SEQUENCE, then calling FUNCTION with that result and
the second element of SEQUENCE, then with that result and the third
element of SEQUENCE, etc.
If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
(if (seq-empty-p sequence)
initial-value
(let ((acc initial-value))
(seq-doseq (elt sequence)
(setq acc (funcall function acc elt)))
acc)))
(cl-defgeneric seq-every-p (pred sequence)
"Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(or (funcall pred elt)
(throw 'seq--break nil)))
t))
(cl-defgeneric seq-some (pred sequence)
"Return the first value for which if (PRED element) is non-nil for in SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(let ((result (funcall pred elt)))
(when result
(throw 'seq--break result))))
nil))
(cl-defgeneric seq-find (pred sequence &optional default)
"Return the first element for which (PRED element) is non-nil in SEQUENCE.
If no element is found, return DEFAULT.
Note that `seq-find' has an ambiguity if the found element is
identical to DEFAULT, as it cannot be known if an element was
found or not."
(catch 'seq--break
(seq-doseq (elt sequence)
(when (funcall pred elt)
(throw 'seq--break elt)))
default))
(cl-defgeneric seq-count (pred sequence)
"Return the number of elements for which (PRED element) is non-nil in SEQUENCE."
(let ((count 0))
(seq-doseq (elt sequence)
(when (funcall pred elt)
(setq count (+ 1 count))))
count))
(cl-defgeneric seq-contains (sequence elt &optional testfn)
"Return the first element in SEQUENCE that is equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-some (lambda (e)
(funcall (or testfn #'equal) elt e))
sequence))
(cl-defgeneric seq-position (sequence elt &optional testfn)
"Return the index of the first element in SEQUENCE that is equal to ELT.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(let ((index 0))
(catch 'seq--break
(seq-doseq (e sequence)
(when (funcall (or testfn #'equal) e elt)
(throw 'seq--break index))
(setq index (1+ index)))
nil)))
(cl-defgeneric seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
TESTFN is used to compare elements, or `equal' if TESTFN is nil."
(let ((result '()))
(seq-doseq (elt sequence)
(unless (seq-contains result elt testfn)
(setq result (cons elt result))))
(nreverse result)))
(cl-defgeneric seq-mapcat (function sequence &optional type)
"Concatenate the result of applying FUNCTION to each element of SEQUENCE.
The result is a sequence of type TYPE, or a list if TYPE is nil."
(apply #'seq-concatenate (or type 'list)
(seq-map function sequence)))
(cl-defgeneric seq-partition (sequence n)
"Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
negative integer or 0, nil is returned."
(unless (< n 1)
(let ((result '()))
(while (not (seq-empty-p sequence))
(push (seq-take sequence n) result)
(setq sequence (seq-drop sequence n)))
(nreverse result))))
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
"Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-reduce (lambda (acc elt)
(if (seq-contains sequence2 elt testfn)
(cons elt acc)
acc))
(seq-reverse sequence1)
'()))
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
"Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-reduce (lambda (acc elt)
(if (not (seq-contains sequence2 elt testfn))
(cons elt acc)
acc))
(seq-reverse sequence1)
'()))
(cl-defgeneric seq-group-by (function sequence)
"Apply FUNCTION to each element of SEQUENCE.
Separate the elements of SEQUENCE into an alist using the results as
keys. Keys are compared using `equal'."
(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 sequence)
nil))
(cl-defgeneric seq-min (sequence)
"Return the smallest element of SEQUENCE.
SEQUENCE must be a sequence of numbers or markers."
(apply #'min (seq-into sequence 'list)))
(cl-defgeneric seq-max (sequence)
"Return the largest element of SEQUENCE.
SEQUENCE must be a sequence of numbers or markers."
(apply #'max (seq-into sequence 'list)))
(defun seq--count-successive (pred sequence)
"Return the number of successive elements for which (PRED element) is non-nil in SEQUENCE."
(let ((n 0)
(len (seq-length sequence)))
(while (and (< n len)
(funcall pred (seq-elt sequence n)))
(setq n (+ 1 n)))
n))
;;; Optimized implementations for lists
(cl-defmethod seq-drop ((list list) n)
"Optimized implementation of `seq-drop' for lists."
(nthcdr n list))
(cl-defmethod seq-take ((list list) n)
"Optimized implementation of `seq-take' for lists."
(let ((result '()))
(while (and list (> n 0))
(setq n (1- n))
(push (pop list) result))
(nreverse result)))
(cl-defmethod seq-drop-while (pred (list list))
"Optimized implementation of `seq-drop-while' for lists."
(while (and list (funcall pred (car list)))
(setq list (cdr list)))
list)
(cl-defmethod seq-empty-p ((list list))
"Optimized implementation of `seq-empty-p' for lists."
(null list))
(defun seq--make-pcase-bindings (args)
"Return a list of bindings of the variables in ARGS to the elements of a sequence."
(let ((bindings '())
(index 0)
(rest-marker nil))
(seq-doseq (name args)
(unless rest-marker
(pcase name
(`&rest
(progn (push `(app (pcase--flip seq-drop ,index)
,(seq--elt-safe args (1+ index)))
bindings)
(setq rest-marker t)))
(_
(push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
(setq index (1+ index)))
bindings))
(defun seq--make-pcase-patterns (args)
"Return a list of `(seq ...)' pcase patterns from the argument list ARGS."
(cons 'seq
(seq-map (lambda (elt)
(if (seqp elt)
(seq--make-pcase-patterns elt)
elt))
args)))
;; TODO: make public?
(defun seq--elt-safe (sequence n)
"Return element of SEQUENCE at the index N.
If no element is found, return nil."
(ignore-errors (seq-elt sequence n))))
(provide 'seq-25)
;;; seq-25.el ends here

16
elpa/seq-2.16/seq-autoloads.el Normal file
View File

@ -0,0 +1,16 @@
;;; seq-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil nil ("seq-24.el" "seq-25.el" "seq-pkg.el" "seq.el")
;;;;;; (22490 28017 369897 544000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; seq-autoloads.el ends here

2
elpa/seq-2.16/seq-pkg.el Normal file
View File

@ -0,0 +1,2 @@
;; Generated package description from seq.el
(define-package "seq" "2.16" "Sequence manipulation functions" 'nil :url "http://elpa.gnu.org/packages/seq.html" :keywords '("sequences"))

48
elpa/seq-2.16/seq.el Normal file
View File

@ -0,0 +1,48 @@
;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
;; Version: 2.16
;; Package: seq
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Sequence-manipulation functions that complement basic functions
;; provided by subr.el.
;;
;; All functions are prefixed with "seq-".
;;
;; All provided functions work on lists, strings and vectors.
;;
;; Functions taking a predicate or iterating over a sequence using a
;; function as argument take the function as their first argument and
;; the sequence as their second argument. All other functions take
;; the sequence as their first argument.
;;; Code:
(if (version< emacs-version "25")
(require 'seq-24)
(require 'seq-25))
(provide 'seq)
;;; seq.el ends here

354
elpa/seq-2.16/tests/seq-tests.el Normal file
View File

@ -0,0 +1,354 @@
;;; seq-tests.el --- Tests for sequences.el
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Tests for seq.el
;;; Code:
(require 'ert)
(require 'seq)
(defmacro with-test-sequences (spec &rest body)
"Successively bind VAR to a list, vector, and string built from SEQ.
Evaluate BODY for each created sequence.
\(fn (var seq) body)"
(declare (indent 1) (debug ((symbolp form) body)))
(let ((initial-seq (make-symbol "initial-seq")))
`(let ((,initial-seq ,(cadr spec)))
,@(mapcar (lambda (s)
`(let ((,(car spec) (apply (function ,s) ,initial-seq)))
,@body))
'(list vector string)))))
(defun same-contents-p (seq1 seq2)
"Return t if SEQ1 and SEQ2 have the same contents, nil otherwise."
(equal (append seq1 '()) (append seq2 '())))
(defun test-sequences-evenp (integer)
"Return t if INTEGER is even."
(eq (logand integer 1) 0))
(defun test-sequences-oddp (integer)
"Return t if INTEGER is odd."
(not (test-sequences-evenp integer)))
(ert-deftest test-seq-drop ()
(with-test-sequences (seq '(1 2 3 4))
(should (equal (seq-drop seq 0) seq))
(should (equal (seq-drop seq 1) (seq-subseq seq 1)))
(should (equal (seq-drop seq 2) (seq-subseq seq 2)))
(should (seq-empty-p (seq-drop seq 4)))
(should (seq-empty-p (seq-drop seq 10))))
(with-test-sequences (seq '())
(should (seq-empty-p (seq-drop seq 0)))
(should (seq-empty-p (seq-drop seq 1)))))
(ert-deftest test-seq-take ()
(with-test-sequences (seq '(2 3 4 5))
(should (seq-empty-p (seq-take seq 0)))
(should (= (seq-length (seq-take seq 1)) 1))
(should (= (seq-elt (seq-take seq 1) 0) 2))
(should (same-contents-p (seq-take seq 3) '(2 3 4)))
(should (equal (seq-take seq 10) seq))))
(ert-deftest test-seq-drop-while ()
(with-test-sequences (seq '(1 3 2 4))
(should (equal (seq-drop-while #'test-sequences-oddp seq)
(seq-drop seq 2)))
(should (equal (seq-drop-while #'test-sequences-evenp seq)
seq))
(should (seq-empty-p (seq-drop-while #'numberp seq))))
(with-test-sequences (seq '())
(should (seq-empty-p (seq-drop-while #'test-sequences-oddp seq)))))
(ert-deftest test-seq-take-while ()
(with-test-sequences (seq '(1 3 2 4))
(should (equal (seq-take-while #'test-sequences-oddp seq)
(seq-take seq 2)))
(should (seq-empty-p (seq-take-while #'test-sequences-evenp seq)))
(should (equal (seq-take-while #'numberp seq) seq)))
(with-test-sequences (seq '())
(should (seq-empty-p (seq-take-while #'test-sequences-oddp seq)))))
(ert-deftest test-seq-map-indexed ()
(should (equal (seq-map-indexed (lambda (elt i)
(list elt i))
nil)
nil))
(should (equal (seq-map-indexed (lambda (elt i)
(list elt i))
'(a b c d))
'((a 0) (b 1) (c 2) (d 3)))))
(ert-deftest test-seq-filter ()
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-filter #'test-sequences-evenp seq) '(6 8 10)))
(should (equal (seq-filter #'test-sequences-oddp seq) '(7 9)))
(should (equal (seq-filter (lambda (elt) nil) seq) '())))
(with-test-sequences (seq '())
(should (equal (seq-filter #'test-sequences-evenp seq) '()))))
(ert-deftest test-seq-remove ()
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-remove #'test-sequences-evenp seq) '(7 9)))
(should (equal (seq-remove #'test-sequences-oddp seq) '(6 8 10)))
(should (same-contents-p (seq-remove (lambda (elt) nil) seq) seq)))
(with-test-sequences (seq '())
(should (equal (seq-remove #'test-sequences-evenp seq) '()))))
(ert-deftest test-seq-count ()
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-count #'test-sequences-evenp seq) 3))
(should (equal (seq-count #'test-sequences-oddp seq) 2))
(should (equal (seq-count (lambda (elt) nil) seq) 0)))
(with-test-sequences (seq '())
(should (equal (seq-count #'test-sequences-evenp seq) 0))))
(ert-deftest test-seq-reduce ()
(with-test-sequences (seq '(1 2 3 4))
(should (= (seq-reduce #'+ seq 0) 10))
(should (= (seq-reduce #'+ seq 5) 15)))
(with-test-sequences (seq '())
(should (eq (seq-reduce #'+ seq 0) 0))
(should (eq (seq-reduce #'+ seq 7) 7))))
(ert-deftest test-seq-some ()
(with-test-sequences (seq '(4 3 2 1))
(should (seq-some #'test-sequences-evenp seq))
(should (seq-some #'test-sequences-oddp seq))
(should-not (seq-some (lambda (elt) (> elt 10)) seq)))
(with-test-sequences (seq '())
(should-not (seq-some #'test-sequences-oddp seq)))
(should (seq-some #'null '(1 nil 2))))
(ert-deftest test-seq-find ()
(with-test-sequences (seq '(4 3 2 1))
(should (= 4 (seq-find #'test-sequences-evenp seq)))
(should (= 3 (seq-find #'test-sequences-oddp seq)))
(should-not (seq-find (lambda (elt) (> elt 10)) seq)))
(should-not (seq-find #'null '(1 nil 2)))
(should-not (seq-find #'null '(1 nil 2) t))
(should-not (seq-find #'null '(1 2 3)))
(should (seq-find #'null '(1 2 3) 'sentinel)))
(ert-deftest test-seq-contains ()
(with-test-sequences (seq '(3 4 5 6))
(should (seq-contains seq 3))
(should-not (seq-contains seq 7)))
(with-test-sequences (seq '())
(should-not (seq-contains seq 3))
(should-not (seq-contains seq nil))))
(ert-deftest test-seq-every-p ()
(with-test-sequences (seq '(43 54 22 1))
(should (seq-every-p (lambda (elt) t) seq))
(should-not (seq-every-p #'test-sequences-oddp seq))
(should-not (seq-every-p #'test-sequences-evenp seq)))
(with-test-sequences (seq '(42 54 22 2))
(should (seq-every-p #'test-sequences-evenp seq))
(should-not (seq-every-p #'test-sequences-oddp seq)))
(with-test-sequences (seq '())
(should (seq-every-p #'identity seq))
(should (seq-every-p #'test-sequences-evenp seq))))
(ert-deftest test-seq-empty-p ()
(with-test-sequences (seq '(0))
(should-not (seq-empty-p seq)))
(with-test-sequences (seq '(0 1 2))
(should-not (seq-empty-p seq)))
(with-test-sequences (seq '())
(should (seq-empty-p seq))))
(ert-deftest test-seq-sort ()
(should (equal (seq-sort #'< "cbaf") "abcf"))
(should (equal (seq-sort #'< '(2 1 9 4)) '(1 2 4 9)))
(should (equal (seq-sort #'< [2 1 9 4]) [1 2 4 9]))
(should (equal (seq-sort #'< "") "")))
(ert-deftest test-seq-uniq ()
(with-test-sequences (seq '(2 4 6 8 6 4 3))
(should (equal (seq-uniq seq) '(2 4 6 8 3))))
(with-test-sequences (seq '(3 3 3 3 3))
(should (equal (seq-uniq seq) '(3))))
(with-test-sequences (seq '())
(should (equal (seq-uniq seq) '()))))
(ert-deftest test-seq-subseq ()
(with-test-sequences (seq '(2 3 4 5))
(should (equal (seq-subseq seq 0 4) seq))
(should (same-contents-p (seq-subseq seq 2 4) '(4 5)))
(should (same-contents-p (seq-subseq seq 1 3) '(3 4)))
(should (same-contents-p (seq-subseq seq 1 -1) '(3 4))))
(should (vectorp (seq-subseq [2 3 4 5] 2)))
(should (stringp (seq-subseq "foo" 2 3)))
(should (listp (seq-subseq '(2 3 4 4) 2 3)))
(should-error (seq-subseq '(1 2 3) 4))
(should-not (seq-subseq '(1 2 3) 3))
(should (seq-subseq '(1 2 3) -3))
(should-error (seq-subseq '(1 2 3) 1 4))
(should (seq-subseq '(1 2 3) 1 3)))
(ert-deftest test-seq-concatenate ()
(with-test-sequences (seq '(2 4 6))
(should (equal (seq-concatenate 'string seq [8]) (string 2 4 6 8)))
(should (equal (seq-concatenate 'list seq '(8 10)) '(2 4 6 8 10)))
(should (equal (seq-concatenate 'vector seq '(8 10)) [2 4 6 8 10]))
(should (equal (seq-concatenate 'vector nil '(8 10)) [8 10]))
(should (equal (seq-concatenate 'vector seq nil) [2 4 6]))))
(ert-deftest test-seq-mapcat ()
(should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)))
'(1 2 3 4 5 6)))
(should (equal (seq-mapcat #'seq-reverse '[(3 2 1) (6 5 4)])
'(1 2 3 4 5 6)))
(should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)) 'vector)
'[1 2 3 4 5 6])))
(ert-deftest test-seq-partition ()
(should (same-contents-p (seq-partition '(0 1 2 3 4 5 6 7) 3)
'((0 1 2) (3 4 5) (6 7))))
(should (same-contents-p (seq-partition '[0 1 2 3 4 5 6 7] 3)
'([0 1 2] [3 4 5] [6 7])))
(should (same-contents-p (seq-partition "Hello world" 2)
'("He" "ll" "o " "wo" "rl" "d")))
(should (equal (seq-partition '() 2) '()))
(should (equal (seq-partition '(1 2 3) -1) '())))
(ert-deftest test-seq-group-by ()
(with-test-sequences (seq '(1 2 3 4))
(should (equal (seq-group-by #'test-sequences-oddp seq)
'((t 1 3) (nil 2 4)))))
(should (equal (seq-group-by #'car '((a 1) (b 3) (c 4) (a 2)))
'((b (b 3)) (c (c 4)) (a (a 1) (a 2))))))
(ert-deftest test-seq-reverse ()
(with-test-sequences (seq '(1 2 3 4))
(should (same-contents-p (seq-reverse seq) '(4 3 2 1)))
(should (equal (type-of (seq-reverse seq))
(type-of seq)))))
(ert-deftest test-seq-into ()
(let* ((vector [1 2 3])
(list (seq-into vector 'list)))
(should (same-contents-p vector list))
(should (listp list)))
(let* ((list '(hello world))
(vector (seq-into list 'vector)))
(should (same-contents-p vector list))
(should (vectorp vector)))
(let* ((string "hello")
(list (seq-into string 'list)))
(should (same-contents-p string list))
(should (stringp string)))
(let* ((string "hello")
(vector (seq-into string 'vector)))
(should (same-contents-p string vector))
(should (stringp string)))
(let* ((list nil)
(vector (seq-into list 'vector)))
(should (same-contents-p list vector))
(should (vectorp vector))))
(ert-deftest test-seq-intersection ()
(let ((v1 [2 3 4 5])
(v2 [1 3 5 6 7]))
(should (same-contents-p (seq-intersection v1 v2)
'(3 5))))
(let ((l1 '(2 3 4 5))
(l2 '(1 3 5 6 7)))
(should (same-contents-p (seq-intersection l1 l2)
'(3 5))))
(let ((v1 [2 4 6])
(v2 [1 3 5]))
(should (seq-empty-p (seq-intersection v1 v2)))))
(ert-deftest test-seq-difference ()
(let ((v1 [2 3 4 5])
(v2 [1 3 5 6 7]))
(should (same-contents-p (seq-difference v1 v2)
'(2 4))))
(let ((l1 '(2 3 4 5))
(l2 '(1 3 5 6 7)))
(should (same-contents-p (seq-difference l1 l2)
'(2 4))))
(let ((v1 [2 4 6])
(v2 [2 4 6]))
(should (seq-empty-p (seq-difference v1 v2)))))
(ert-deftest test-seq-let ()
(with-test-sequences (seq '(1 2 3 4))
(seq-let (a b c d e) seq
(should (= a 1))
(should (= b 2))
(should (= c 3))
(should (= d 4))
(should (null e)))
(seq-let (a b &rest others) seq
(should (= a 1))
(should (= b 2))
(should (same-contents-p others (seq-drop seq 2)))))
(let ((seq '(1 (2 (3 (4))))))
(seq-let (_ (_ (_ (a)))) seq
(should (= a 4))))
(let (seq)
(seq-let (a b c) seq
(should (null a))
(should (null b))
(should (null c)))))
(ert-deftest test-seq-min-max ()
(with-test-sequences (seq '(4 5 3 2 0 4))
(should (= (seq-min seq) 0))
(should (= (seq-max seq) 5))))
(ert-deftest test-seq-position ()
(with-test-sequences (seq '(2 4 6))
(should (null (seq-position seq 1)))
(should (= (seq-position seq 4) 1)))
(let ((seq '(a b c)))
(should (null (seq-position seq 'd #'eq)))
(should (= (seq-position seq 'a #'eq) 0))
(should (null (seq-position seq (make-symbol "a") #'eq)))))
(ert-deftest test-seq-mapn ()
(should-error (seq-mapn #'identity))
(with-test-sequences (seq '(1 2 3 4 5 6 7))
(should (equal (append seq nil)
(seq-mapn #'identity seq)))
(should (equal (seq-mapn #'1+ seq)
(seq-map #'1+ seq)))
(with-test-sequences (seq-2 '(10 20 30 40 50))
(should (equal (seq-mapn #'+ seq seq-2)
'(11 22 33 44 55)))
(should (equal (seq-mapn #'+ seq seq-2 nil) nil)))))
(ert-deftest test-seq-sort-by ()
(let ((seq ["x" "xx" "xxx"]))
(should (equal (seq-sort-by #'seq-length #'> seq)
["xxx" "xx" "x"]))))
(provide 'seq-tests)
;;; seq-tests.el ends here

7
init.el
View File

@ -59,6 +59,7 @@
(setq-default magit-gerrit-remote "gerrit")
(set-face-attribute 'default t :font "Hack-10")
(set-frame-font "Hack-10" nil t)
(setq user-mail-address "gergely@polonkai.eu")
(custom-set-faces
;; custom-set-faces was added by Custom.
@ -300,3 +301,9 @@ Version 2016-02-16"
(cond
(arg-move-point (right-char)))))
(put 'downcase-region 'disabled nil)
(eval-after-load 'company
'(progn
(define-key company-mode-map (kbd "C-:") 'helm-company)
(define-key company-active-map (kbd "C-:") 'helm-company)))
(require 'xlicense)