Add new packages
This commit is contained in:
Gergely Polonkai
parent
697f492aba
commit
b4f2fb14c0
239
elpa/flycheck-20160912.814/flycheck-autoloads.el
Normal file
239
elpa/flycheck-20160912.814/flycheck-autoloads.el
Normal 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
144
elpa/flycheck-20160912.814/flycheck-buttercup.el
Normal 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
432
elpa/flycheck-20160912.814/flycheck-ert.el
Normal 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
11
elpa/flycheck-20160912.814/flycheck-pkg.el
Normal 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
9070
elpa/flycheck-20160912.814/flycheck.el
Normal file
File diff suppressed because it is too large
Load Diff
16
elpa/gnome-calendar-20140112.359/gnome-calendar-autoloads.el
Normal file
16
elpa/gnome-calendar-20140112.359/gnome-calendar-autoloads.el
Normal 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
1
elpa/gnome-calendar-20140112.359/gnome-calendar-pkg.el
Normal 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
87
elpa/gnome-calendar-20140112.359/gnome-calendar.el
Normal 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
122
elpa/go-20160430.1739/back-ends/gtp-pipe.el
Normal 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
164
elpa/go-20160430.1739/back-ends/gtp.el
Normal 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
501
elpa/go-20160430.1739/back-ends/igs.el
Normal 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
196
elpa/go-20160430.1739/back-ends/sgf.el
Normal 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
188
elpa/go-20160430.1739/back-ends/sgf2el.el
Normal 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
78
elpa/go-20160430.1739/go-api.el
Normal 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
32
elpa/go-20160430.1739/go-autoloads.el
Normal 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
177
elpa/go-20160430.1739/go-board-faces.el
Normal 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
578
elpa/go-20160430.1739/go-board.el
Normal 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
7
elpa/go-20160430.1739/go-pkg.el
Normal 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
177
elpa/go-20160430.1739/go-util.el
Normal 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
87
elpa/go-20160430.1739/go.el
Normal 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
192
elpa/go-20160430.1739/list-buffer.el
Normal 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
BIN
elpa/go-20160430.1739/stone.wav
Normal file
Binary file not shown.
15
elpa/google-20140416.1048/google-autoloads.el
Normal file
15
elpa/google-20140416.1048/google-autoloads.el
Normal 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
1
elpa/google-20140416.1048/google-pkg.el
Normal 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
181
elpa/google-20140416.1048/google.el
Normal 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
22
elpa/helm-chrome-20160718.2220/helm-chrome-autoloads.el
Normal 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
1
elpa/helm-chrome-20160718.2220/helm-chrome-pkg.el
Normal 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
137
elpa/helm-chrome-20160718.2220/helm-chrome.el
Normal 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
23
elpa/helm-company-20160516.2258/helm-company-autoloads.el
Normal 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
1
elpa/helm-company-20160516.2258/helm-company-pkg.el
Normal 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
195
elpa/helm-company-20160516.2258/helm-company.el
Normal 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
22
elpa/helm-flycheck-20160710.129/helm-flycheck-autoloads.el
Normal 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
1
elpa/helm-flycheck-20160710.129/helm-flycheck-pkg.el
Normal 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
197
elpa/helm-flycheck-20160710.129/helm-flycheck.el
Normal 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
22
elpa/helm-google-20160620.1149/helm-google-autoloads.el
Normal 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
1
elpa/helm-google-20160620.1149/helm-google-pkg.el
Normal 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
255
elpa/helm-google-20160620.1149/helm-google.el
Normal 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=\\(.*?\\)&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
24
elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el
Normal 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
1
elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el
Normal 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
132
elpa/helm-spotify-20160905.1447/helm-spotify.el
Normal 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
81
elpa/helm-swoop-20160619.953/helm-swoop-autoloads.el
Normal 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
1
elpa/helm-swoop-20160619.953/helm-swoop-pkg.el
Normal 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
1677
elpa/helm-swoop-20160619.953/helm-swoop.el
Normal file
File diff suppressed because it is too large
Load Diff
22
elpa/helm-systemd-20160517.2333/helm-systemd-autoloads.el
Normal file
22
elpa/helm-systemd-20160517.2333/helm-systemd-autoloads.el
Normal 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
1
elpa/helm-systemd-20160517.2333/helm-systemd-pkg.el
Normal 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
298
elpa/helm-systemd-20160517.2333/helm-systemd.el
Normal 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
22
elpa/helm-themes-20151008.2321/helm-themes-autoloads.el
Normal 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
1
elpa/helm-themes-20151008.2321/helm-themes-pkg.el
Normal 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
71
elpa/helm-themes-20151008.2321/helm-themes.el
Normal 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
24
elpa/helm-unicode-20160715.533/helm-unicode-autoloads.el
Normal 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
1
elpa/helm-unicode-20160715.533/helm-unicode-pkg.el
Normal 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
72
elpa/helm-unicode-20160715.533/helm-unicode.el
Normal 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
1
elpa/let-alist-1.0.4.signed
Normal 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
50
elpa/let-alist-1.0.4/let-alist-autoloads.el
Normal 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
1
elpa/let-alist-1.0.4/let-alist-pkg.el
Normal 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
170
elpa/let-alist-1.0.4/let-alist.el
Normal 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
15
elpa/multi-20131013.844/multi-autoloads.el
Normal 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
1
elpa/multi-20131013.844/multi-pkg.el
Normal 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
134
elpa/multi-20131013.844/multi.el
Normal 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
119
elpa/multiple-cursors-20160719.216/mc-cycle-cursors.el
Normal 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
110
elpa/multiple-cursors-20160719.216/mc-edit-lines.el
Normal 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
|
||||||
@ -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
712
elpa/multiple-cursors-20160719.216/mc-mark-more.el
Normal 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
22
elpa/multiple-cursors-20160719.216/mc-mark-pop.el
Normal 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
155
elpa/multiple-cursors-20160719.216/mc-separate-operations.el
Normal 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
341
elpa/multiple-cursors-20160719.216/multiple-cursors-autoloads.el
Normal 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
790
elpa/multiple-cursors-20160719.216/multiple-cursors-core.el
Normal 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
|
||||||
@ -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
199
elpa/multiple-cursors-20160719.216/multiple-cursors.el
Normal 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
125
elpa/multiple-cursors-20160719.216/rectangular-region-mode.el
Normal 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
22
elpa/org-bullets-20140918.1137/org-bullets-autoloads.el
Normal 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
1
elpa/org-bullets-20140918.1137/org-bullets-pkg.el
Normal 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
127
elpa/org-bullets-20140918.1137/org-bullets.el
Normal 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
57
elpa/origami-20160710.958/origami-autoloads.el
Normal 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
245
elpa/origami-20160710.958/origami-parsers.el
Normal 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
9
elpa/origami-20160710.958/origami-pkg.el
Normal 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
821
elpa/origami-20160710.958/origami.el
Normal 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
1
elpa/seq-2.16.signed
Normal 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
142
elpa/seq-2.16/ChangeLog
Normal 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
464
elpa/seq-2.16/seq-24.el
Normal 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
498
elpa/seq-2.16/seq-25.el
Normal 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
16
elpa/seq-2.16/seq-autoloads.el
Normal 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
2
elpa/seq-2.16/seq-pkg.el
Normal 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
48
elpa/seq-2.16/seq.el
Normal 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
354
elpa/seq-2.16/tests/seq-tests.el
Normal 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
7
init.el
@ -59,6 +59,7 @@
|
|||||||
(setq-default magit-gerrit-remote "gerrit")
|
(setq-default magit-gerrit-remote "gerrit")
|
||||||
(set-face-attribute 'default t :font "Hack-10")
|
(set-face-attribute 'default t :font "Hack-10")
|
||||||
(set-frame-font "Hack-10" nil t)
|
(set-frame-font "Hack-10" nil t)
|
||||||
|
(setq user-mail-address "gergely@polonkai.eu")
|
||||||
|
|
||||||
(custom-set-faces
|
(custom-set-faces
|
||||||
;; custom-set-faces was added by Custom.
|
;; custom-set-faces was added by Custom.
|
||||||
@ -300,3 +301,9 @@ Version 2016-02-16"
|
|||||||
(cond
|
(cond
|
||||||
(arg-move-point (right-char)))))
|
(arg-move-point (right-char)))))
|
||||||
(put 'downcase-region 'disabled nil)
|
(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)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user