Add new packages

This commit is contained in:
Gergely Polonkai 2016-09-15 13:54:46 +02:00
parent 697f492aba
commit b4f2fb14c0
86 changed files with 21872 additions and 0 deletions

View File

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

View File

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -0,0 +1,501 @@
;;; igs.el --- IGS GO back-end
;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte.eric@gmail.com>
;; Created: 2012-05-15
;; Version: 0.1
;; Keywords: game go sgf igs
;; This software is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Commentary:
;; http://www.pandanet.co.jp/English/commands/term/Summary.html
;; Code:
(require 'go-api)
(require 'list-buffer)
(defvar igs-ignore-shouts t
"Ignore shouts on the IGS server.")
(defvar igs-telnet-command "telnet"
"Telnet command used by igs.")
(defvar igs-server "igs.joyjoy.net"
"Address of the IGS server.")
(defvar igs-port 6969
"Port to use when connecting to an IGS server.")
(defvar igs-username "guest"
"User name to use when connecting to an IGS server.")
(defvar igs-process-name "igs"
"Name for the igs process.")
(defvar igs-server-ping-delay 300
"Minimum time between pings to remind the IGS server we're still listening.")
(defvar igs-message-types
'((:unknown . 0)
(:automat . 35) ;; Automatch announcement
(:autoask . 36) ;; Automatch accept
(:choices . 38) ;; game choices
(:clivrfy . 41) ;; Client verify message
(:beep . 2) ;; \7 telnet
(:board . 3) ;; Board being drawn
(:down . 4) ;; The server is going down
(:error . 5) ;; An error reported
(:fil . 6) ;; File being sent
(:games . 7) ;; Games listing
(:help . 8) ;; Help file
(:info . 9) ;; Generic info
(:last . 10) ;; Last command
(:kibitz . 11) ;; Kibitz strings
(:load . 12) ;; Loading a game
(:look_m . 13) ;; Look
(:message . 14) ;; Message listing
(:move . 15) ;; Move #:(B) A1
(:observe . 16) ;; Observe report
(:prompt . 1) ;; A Prompt (never)
(:refresh . 17) ;; Refresh of a board
(:saved . 18) ;; Stored command
(:say . 19) ;; Say string
(:score_m . 20) ;; Score report
(:sgf_m . 34) ;; SGF variation
(:shout . 21) ;; Shout string
(:show . 29) ;; Shout string
(:status . 22) ;; Current Game status
(:stored . 23) ;; Stored games
(:teach . 33) ;; teaching game
(:tell . 24) ;; Tell string
(:dot . 40) ;; your . string
(:thist . 25) ;; Thist report
(:tim . 26) ;; times command
(:trans . 30) ;; Translation info
(:ttt_board . 37) ;; tic tac toe
(:who . 27) ;; who command
(:undo . 28) ;; Undo report
(:user . 42) ;; Long user report
(:version . 39) ;; IGS Version
(:yell . 32))) ;; Channel yelling
(defvar *igs-instance* nil
"IGS instance associated with the current buffer.")
(defvar *igs-time-last-sent* nil
"Time stamp of the last command sent.
This is used to re-send messages to keep the IGS server from timing out.")
(defvar *igs-last-command* nil
"Last command sent to the IGS process.")
(defvar *igs-games* nil
"List holding the current games on the IGS server.")
(defvar *igs-current-game* nil
"Number of the current IGS game (may change frequently).")
;;; Class and interface
(defclass igs ()
((buffer :initarg :buffer :accessor buffer :initform nil)
;; number of an observed IGS game
(number :initarg :number :accessor number :initform nil)
(active :initarg :active :accessor active :initform t)))
(defmethod go-connect ((igs igs)) (igs-connect igs))
(defmacro with-igs (igs &rest body)
(declare (indent 1))
`(with-current-buffer (buffer ,igs) ,@body))
(defmethod go-level ((igs igs))
(signal 'unsupported-back-end-command (list igs :level)))
(defmethod set-go-level ((igs igs) level)
(signal 'unsupported-back-end-command (list igs :set-level level)))
(defmethod go-size ((igs igs))
(with-igs igs (aget (igs-current-game) :size)))
(defmethod set-go-size ((igs igs) size)
(signal 'unsupported-back-end-command (list igs :set-size size)))
(defmethod go-name ((igs igs))
(with-igs igs (let ((game (igs-current-game)))
(format "%s(%s) vs %s(%s)"
(aget game :white-name)
(aget game :white-rank)
(aget game :black-name)
(aget game :black-rank)))))
(defmethod set-go-name ((igs igs) name)
(signal 'unsupported-back-end-command (list igs :set-name name)))
(defmethod go-move ((igs igs))
(signal 'unsupported-back-end-command (list igs :move)))
(defmethod set-go-move ((igs igs) move)
(signal 'unsupported-back-end-command (list igs :set-move move)))
(defmethod go-labels ((igs igs))
(signal 'unsupported-back-end-command (list igs :labels)))
(defmethod set-go-labels ((igs igs) labels)
(signal 'unsupported-back-end-command (list igs :set-labels labels)))
(defmethod go-comment ((igs igs))
(signal 'unsupported-back-end-command (list igs :comment)))
(defmethod set-go-comment ((igs igs) comment)
(signal 'unsupported-back-end-command (list igs :set-comment comment)))
(defmethod go-alt ((igs igs))
(signal 'unsupported-back-end-command (list igs :alt)))
(defmethod set-go-alt ((igs igs) alt)
(signal 'unsupported-back-end-command (list igs :set-alt alt)))
(defmethod go-color ((igs igs))
(signal 'unsupported-back-end-command (list igs :color)))
(defmethod set-go-color ((igs igs) color)
(signal 'unsupported-back-end-command (list igs :set-color color)))
(defmethod go-player-name ((igs igs) color)
(with-igs igs (aget (igs-current-game)
(case color
(:W :white-name)
(:B :black-name)))))
(defmethod set-go-player-name ((igs igs) color name)
(signal 'unsupported-back-end-command (list igs :set-player-name color name)))
(defmethod go-player-time ((igs igs) color)
(signal 'unsupported-back-end-command (list igs :player-time color)))
(defmethod set-go-player-time ((igs igs) color time)
(signal 'unsupported-back-end-command (list igs :set-player-time color time)))
;; non setf'able generic functions
(defmethod go-undo ((igs igs))
(signal 'unsupported-back-end-command (list igs :undo)))
(defmethod go-pass ((igs igs))
(signal 'unsupported-back-end-command (list igs :pass)))
(defmethod go-resign ((igs igs))
(signal 'unsupported-back-end-command (list igs :resign)))
(defmethod go-reset ((igs igs))
(signal 'unsupported-back-end-command (list igs :reset)))
(defmethod go-quit ((igs igs))
(with-igs igs
(if (number igs)
(progn
;; TOOD: ensure still on our server-side observation list
;; (e.g., hasn't been removed after a resignation)
(when (active igs)
(igs-send (format "observe %d" (number igs))))
(setf (number igs) nil))
(igs-send "quit"))))
(defmethod go-score ((igs igs))
(signal 'unsupported-back-end-command (list igs :score)))
(defmethod go-territory ((igs igs))
(signal 'unsupported-back-end-command (list igs :territory)))
(defmethod go-dead ((igs igs))
(signal 'unsupported-back-end-command (list igs :dead)))
(defmacro igs-w-proc (proc &rest body)
(declare (indent 1))
`(with-current-buffer (process-buffer proc) ,@body))
(def-edebug-spec igs-w-proc (form body))
(defun igs-send (command)
"Send string COMMAND to the IGS process in the current buffer."
(goto-char (process-mark (get-buffer-process (current-buffer))))
(insert command)
(setq *igs-time-last-sent* (current-time))
(setq *igs-last-command* (and (string-match "^\\([^ ]*\\)" command)
(match-string 1 command)))
(comint-send-input))
(defun igs-process-filter (proc string)
(when (string-match "^\\([[:digit:]]+\\) \\(.+\\)$" string)
(let* ((number (read (match-string 1 string)))
(type (car (rassoc number igs-message-types)))
(content (match-string 2 string)))
(case type