From b4f2fb14c05e7a333baab8264b0c5f21f9375a74 Mon Sep 17 00:00:00 2001 From: Gergely Polonkai Date: Thu, 15 Sep 2016 13:54:46 +0200 Subject: [PATCH] Add new packages --- .../flycheck-autoloads.el | 239 + .../flycheck-buttercup.el | 144 + elpa/flycheck-20160912.814/flycheck-ert.el | 432 + elpa/flycheck-20160912.814/flycheck-pkg.el | 11 + elpa/flycheck-20160912.814/flycheck.el | 9070 +++++++++++++++++ .../gnome-calendar-autoloads.el | 16 + .../gnome-calendar-pkg.el | 1 + .../gnome-calendar.el | 87 + elpa/go-20160430.1739/back-ends/gtp-pipe.el | 122 + elpa/go-20160430.1739/back-ends/gtp.el | 164 + elpa/go-20160430.1739/back-ends/igs.el | 501 + elpa/go-20160430.1739/back-ends/sgf.el | 196 + elpa/go-20160430.1739/back-ends/sgf2el.el | 188 + elpa/go-20160430.1739/go-api.el | 78 + elpa/go-20160430.1739/go-autoloads.el | 32 + elpa/go-20160430.1739/go-board-faces.el | 177 + elpa/go-20160430.1739/go-board.el | 578 ++ elpa/go-20160430.1739/go-pkg.el | 7 + elpa/go-20160430.1739/go-util.el | 177 + elpa/go-20160430.1739/go.el | 87 + elpa/go-20160430.1739/list-buffer.el | 192 + elpa/go-20160430.1739/stone.wav | Bin 0 -> 6754 bytes elpa/google-20140416.1048/google-autoloads.el | 15 + elpa/google-20140416.1048/google-pkg.el | 1 + elpa/google-20140416.1048/google.el | 181 + .../helm-chrome-autoloads.el | 22 + .../helm-chrome-pkg.el | 1 + elpa/helm-chrome-20160718.2220/helm-chrome.el | 137 + .../helm-company-autoloads.el | 23 + .../helm-company-pkg.el | 1 + .../helm-company.el | 195 + .../helm-flycheck-autoloads.el | 22 + .../helm-flycheck-pkg.el | 1 + .../helm-flycheck.el | 197 + .../helm-google-autoloads.el | 22 + .../helm-google-pkg.el | 1 + elpa/helm-google-20160620.1149/helm-google.el | 255 + .../helm-spotify-autoloads.el | 24 + .../helm-spotify-pkg.el | 1 + .../helm-spotify.el | 132 + .../helm-swoop-autoloads.el | 81 + .../helm-swoop-20160619.953/helm-swoop-pkg.el | 1 + elpa/helm-swoop-20160619.953/helm-swoop.el | 1677 +++ .../helm-systemd-autoloads.el | 22 + .../helm-systemd-pkg.el | 1 + .../helm-systemd.el | 298 + .../helm-themes-autoloads.el | 22 + .../helm-themes-pkg.el | 1 + elpa/helm-themes-20151008.2321/helm-themes.el | 71 + .../helm-unicode-autoloads.el | 24 + .../helm-unicode-pkg.el | 1 + .../helm-unicode-20160715.533/helm-unicode.el | 72 + elpa/let-alist-1.0.4.signed | 1 + elpa/let-alist-1.0.4/let-alist-autoloads.el | 50 + elpa/let-alist-1.0.4/let-alist-pkg.el | 1 + elpa/let-alist-1.0.4/let-alist.el | 170 + elpa/multi-20131013.844/multi-autoloads.el | 15 + elpa/multi-20131013.844/multi-pkg.el | 1 + elpa/multi-20131013.844/multi.el | 134 + .../mc-cycle-cursors.el | 119 + .../mc-edit-lines.el | 110 + .../mc-hide-unmatched-lines-mode.el | 107 + .../mc-mark-more.el | 712 ++ .../mc-mark-pop.el | 22 + .../mc-separate-operations.el | 155 + .../multiple-cursors-autoloads.el | 341 + .../multiple-cursors-core.el | 790 ++ .../multiple-cursors-pkg.el | 5 + .../multiple-cursors.el | 199 + .../rectangular-region-mode.el | 125 + .../org-bullets-autoloads.el | 22 + .../org-bullets-pkg.el | 1 + elpa/org-bullets-20140918.1137/org-bullets.el | 127 + .../origami-20160710.958/origami-autoloads.el | 57 + elpa/origami-20160710.958/origami-parsers.el | 245 + elpa/origami-20160710.958/origami-pkg.el | 9 + elpa/origami-20160710.958/origami.el | 821 ++ elpa/seq-2.16.signed | 1 + elpa/seq-2.16/ChangeLog | 142 + elpa/seq-2.16/seq-24.el | 464 + elpa/seq-2.16/seq-25.el | 498 + elpa/seq-2.16/seq-autoloads.el | 16 + elpa/seq-2.16/seq-pkg.el | 2 + elpa/seq-2.16/seq.el | 48 + elpa/seq-2.16/tests/seq-tests.el | 354 + init.el | 7 + 86 files changed, 21872 insertions(+) create mode 100644 elpa/flycheck-20160912.814/flycheck-autoloads.el create mode 100644 elpa/flycheck-20160912.814/flycheck-buttercup.el create mode 100644 elpa/flycheck-20160912.814/flycheck-ert.el create mode 100644 elpa/flycheck-20160912.814/flycheck-pkg.el create mode 100644 elpa/flycheck-20160912.814/flycheck.el create mode 100644 elpa/gnome-calendar-20140112.359/gnome-calendar-autoloads.el create mode 100644 elpa/gnome-calendar-20140112.359/gnome-calendar-pkg.el create mode 100644 elpa/gnome-calendar-20140112.359/gnome-calendar.el create mode 100644 elpa/go-20160430.1739/back-ends/gtp-pipe.el create mode 100644 elpa/go-20160430.1739/back-ends/gtp.el create mode 100644 elpa/go-20160430.1739/back-ends/igs.el create mode 100644 elpa/go-20160430.1739/back-ends/sgf.el create mode 100644 elpa/go-20160430.1739/back-ends/sgf2el.el create mode 100644 elpa/go-20160430.1739/go-api.el create mode 100644 elpa/go-20160430.1739/go-autoloads.el create mode 100644 elpa/go-20160430.1739/go-board-faces.el create mode 100644 elpa/go-20160430.1739/go-board.el create mode 100644 elpa/go-20160430.1739/go-pkg.el create mode 100644 elpa/go-20160430.1739/go-util.el create mode 100644 elpa/go-20160430.1739/go.el create mode 100644 elpa/go-20160430.1739/list-buffer.el create mode 100644 elpa/go-20160430.1739/stone.wav create mode 100644 elpa/google-20140416.1048/google-autoloads.el create mode 100644 elpa/google-20140416.1048/google-pkg.el create mode 100644 elpa/google-20140416.1048/google.el create mode 100644 elpa/helm-chrome-20160718.2220/helm-chrome-autoloads.el create mode 100644 elpa/helm-chrome-20160718.2220/helm-chrome-pkg.el create mode 100644 elpa/helm-chrome-20160718.2220/helm-chrome.el create mode 100644 elpa/helm-company-20160516.2258/helm-company-autoloads.el create mode 100644 elpa/helm-company-20160516.2258/helm-company-pkg.el create mode 100644 elpa/helm-company-20160516.2258/helm-company.el create mode 100644 elpa/helm-flycheck-20160710.129/helm-flycheck-autoloads.el create mode 100644 elpa/helm-flycheck-20160710.129/helm-flycheck-pkg.el create mode 100644 elpa/helm-flycheck-20160710.129/helm-flycheck.el create mode 100644 elpa/helm-google-20160620.1149/helm-google-autoloads.el create mode 100644 elpa/helm-google-20160620.1149/helm-google-pkg.el create mode 100644 elpa/helm-google-20160620.1149/helm-google.el create mode 100644 elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el create mode 100644 elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el create mode 100644 elpa/helm-spotify-20160905.1447/helm-spotify.el create mode 100644 elpa/helm-swoop-20160619.953/helm-swoop-autoloads.el create mode 100644 elpa/helm-swoop-20160619.953/helm-swoop-pkg.el create mode 100644 elpa/helm-swoop-20160619.953/helm-swoop.el create mode 100644 elpa/helm-systemd-20160517.2333/helm-systemd-autoloads.el create mode 100644 elpa/helm-systemd-20160517.2333/helm-systemd-pkg.el create mode 100644 elpa/helm-systemd-20160517.2333/helm-systemd.el create mode 100644 elpa/helm-themes-20151008.2321/helm-themes-autoloads.el create mode 100644 elpa/helm-themes-20151008.2321/helm-themes-pkg.el create mode 100644 elpa/helm-themes-20151008.2321/helm-themes.el create mode 100644 elpa/helm-unicode-20160715.533/helm-unicode-autoloads.el create mode 100644 elpa/helm-unicode-20160715.533/helm-unicode-pkg.el create mode 100644 elpa/helm-unicode-20160715.533/helm-unicode.el create mode 100644 elpa/let-alist-1.0.4.signed create mode 100644 elpa/let-alist-1.0.4/let-alist-autoloads.el create mode 100644 elpa/let-alist-1.0.4/let-alist-pkg.el create mode 100644 elpa/let-alist-1.0.4/let-alist.el create mode 100644 elpa/multi-20131013.844/multi-autoloads.el create mode 100644 elpa/multi-20131013.844/multi-pkg.el create mode 100644 elpa/multi-20131013.844/multi.el create mode 100644 elpa/multiple-cursors-20160719.216/mc-cycle-cursors.el create mode 100644 elpa/multiple-cursors-20160719.216/mc-edit-lines.el create mode 100644 elpa/multiple-cursors-20160719.216/mc-hide-unmatched-lines-mode.el create mode 100644 elpa/multiple-cursors-20160719.216/mc-mark-more.el create mode 100644 elpa/multiple-cursors-20160719.216/mc-mark-pop.el create mode 100644 elpa/multiple-cursors-20160719.216/mc-separate-operations.el create mode 100644 elpa/multiple-cursors-20160719.216/multiple-cursors-autoloads.el create mode 100644 elpa/multiple-cursors-20160719.216/multiple-cursors-core.el create mode 100644 elpa/multiple-cursors-20160719.216/multiple-cursors-pkg.el create mode 100644 elpa/multiple-cursors-20160719.216/multiple-cursors.el create mode 100644 elpa/multiple-cursors-20160719.216/rectangular-region-mode.el create mode 100644 elpa/org-bullets-20140918.1137/org-bullets-autoloads.el create mode 100644 elpa/org-bullets-20140918.1137/org-bullets-pkg.el create mode 100644 elpa/org-bullets-20140918.1137/org-bullets.el create mode 100644 elpa/origami-20160710.958/origami-autoloads.el create mode 100644 elpa/origami-20160710.958/origami-parsers.el create mode 100644 elpa/origami-20160710.958/origami-pkg.el create mode 100644 elpa/origami-20160710.958/origami.el create mode 100644 elpa/seq-2.16.signed create mode 100644 elpa/seq-2.16/ChangeLog create mode 100644 elpa/seq-2.16/seq-24.el create mode 100644 elpa/seq-2.16/seq-25.el create mode 100644 elpa/seq-2.16/seq-autoloads.el create mode 100644 elpa/seq-2.16/seq-pkg.el create mode 100644 elpa/seq-2.16/seq.el create mode 100644 elpa/seq-2.16/tests/seq-tests.el diff --git a/elpa/flycheck-20160912.814/flycheck-autoloads.el b/elpa/flycheck-20160912.814/flycheck-autoloads.el new file mode 100644 index 0000000..981c8a0 --- /dev/null +++ b/elpa/flycheck-20160912.814/flycheck-autoloads.el @@ -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 diff --git a/elpa/flycheck-20160912.814/flycheck-buttercup.el b/elpa/flycheck-20160912.814/flycheck-buttercup.el new file mode 100644 index 0000000..92ec52c --- /dev/null +++ b/elpa/flycheck-20160912.814/flycheck-buttercup.el @@ -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 +;; 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 . + +;;; 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 diff --git a/elpa/flycheck-20160912.814/flycheck-ert.el b/elpa/flycheck-20160912.814/flycheck-ert.el new file mode 100644 index 0000000..e3b49f2 --- /dev/null +++ b/elpa/flycheck-20160912.814/flycheck-ert.el @@ -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 +;; Maintainer: Sebastian Wiesner +;; 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 . + +;;; 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 diff --git a/elpa/flycheck-20160912.814/flycheck-pkg.el b/elpa/flycheck-20160912.814/flycheck-pkg.el new file mode 100644 index 0000000..b97ff61 --- /dev/null +++ b/elpa/flycheck-20160912.814/flycheck-pkg.el @@ -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: diff --git a/elpa/flycheck-20160912.814/flycheck.el b/elpa/flycheck-20160912.814/flycheck.el new file mode 100644 index 0000000..12028ef --- /dev/null +++ b/elpa/flycheck-20160912.814/flycheck.el @@ -0,0 +1,9070 @@ +;;; flycheck.el --- On-the-fly syntax checking -*- lexical-binding: t; -*- + +;; Copyright (c) 2012-2016 Sebastian Wiesner and Flycheck contributors +;; Copyright (C) 2013, 2014 Free Software Foundation, Inc. +;; +;; Author: Sebastian Wiesner +;; Maintainer: Sebastian Wiesner +;; Clément Pit--Claudel +;; URL: http://www.flycheck.org +;; Keywords: convenience, languages, tools +;; Version: 30-cvs +;; Package-Requires: ((dash "2.12.1") (pkg-info "0.4") (let-alist "1.0.4") (seq "1.11") (emacs "24.3")) + +;; 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 . + +;;; Commentary: + +;; On-the-fly syntax checking for GNU Emacs 24. +;; +;; Flycheck is a modern on-the-fly syntax checking extension for GNU Emacs, +;; intended as replacement for the older Flymake extension which is part of GNU +;; Emacs. +;; +;; Flycheck automatically checks buffers for errors while you type, and reports +;; warnings and errors directly in the buffer and in an optional IDE-like error +;; list. +;; +;; It comes with a rich interface for custom syntax checkers and other +;; extensions, and has already many 3rd party extensions adding new features. +;; +;; Please read the online manual at http://www.flycheck.org for more +;; information. You can open the manual directly from Emacs with `M-x +;; flycheck-manual'. +;; +;; # Setup +;; +;; Flycheck works best on Unix systems. It does not officially support Windows, +;; but tries to maintain Windows compatibility and should generally work fine on +;; Windows, too. +;; +;; To enable Flycheck add the following to your init file: +;; +;; (add-hook 'after-init-hook #'global-flycheck-mode) +;; +;; Flycheck will then automatically check buffers in supported languages, as +;; long as all necessary tools are present. Use `flycheck-verify-setup' to +;; troubleshoot your Flycheck setup. + +;;; Code: + +(eval-when-compile + (require 'let-alist) ; `let-alist' + (require 'compile) ; Compile Mode integration + (require 'jka-compr) ; For JKA workarounds in `flycheck-temp-file-system' + (require 'pcase) ; `pcase-dolist' (`pcase' itself is autoloaded) + ) + +(require 'dash) + +(require 'seq) ; Sequence functions +(require 'subr-x nil 'no-error) ; Additional utilities, Emacs 24.4 and upwards +(require 'cl-lib) ; `cl-defstruct' and CL utilities +(require 'tabulated-list) ; To list errors +(require 'easymenu) ; Flycheck Mode menu definition +(require 'rx) ; Regexp fanciness in `flycheck-define-checker' +(require 'help-mode) ; `define-button-type' +(require 'find-func) ; `find-function-regexp-alist' +(require 'json) ; `flycheck-parse-tslint' + + +;; Declare a bunch of dynamic variables that we need from other modes +(defvar sh-shell) ; For shell script checker predicates +(defvar ess-language) ; For r-lintr predicate + +;; Tell the byte compiler about autoloaded functions from packages +(declare-function pkg-info-version-info "pkg-info" (package)) + + +;;; Compatibility +(eval-and-compile + (unless (fboundp 'string-suffix-p) + ;; TODO: Remove when dropping support for Emacs 24.3 and earlier + (defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) + + ;; TODO: Remove when dropping support for Emacs 24.3 and earlier + (unless (featurep 'subr-x) + ;; `subr-x' function for Emacs 24.3 and below + (defsubst string-join (strings &optional separator) + "Join all STRINGS using SEPARATOR." + (mapconcat 'identity strings separator)) + + (defsubst string-trim-left (string) + "Remove leading whitespace from STRING." + (if (string-match "\\`[ \t\n\r]+" string) + (replace-match "" t t string) + string)) + + (defsubst string-trim-right (string) + "Remove trailing whitespace from STRING." + (if (string-match "[ \t\n\r]+\\'" string) + (replace-match "" t t string) + string)) + + (defsubst string-trim (string) + "Remove leading and trailing whitespace from STRING." + (string-trim-left (string-trim-right string))) + + (defsubst string-empty-p (string) + "Check whether STRING is empty." + (string= string "")))) + + +;;; Customization +(defgroup flycheck nil + "Modern on-the-fly syntax checking for GNU Emacs." + :prefix "flycheck-" + :group 'tools + :link '(url-link :tag "Website" "http://www.flycheck.org") + :link '(url-link :tag "Github" "https://github.com/flycheck/flycheck") + :link '(custom-manual "(flycheck)Top") + :link '(info-link "(flycheck)Usage")) + +(defgroup flycheck-config-files nil + "Configuration files for on-the-fly syntax checkers." + :prefix "flycheck-" + :group 'flycheck + :link '(custom-manual "(flycheck)Syntax checker configuration files")) + +(defgroup flycheck-options nil + "Options for on-the-fly syntax checkers." + :prefix "flycheck-" + :group 'flycheck + :link '(custom-manual "(flycheck)Syntax checker options")) + +(defgroup flycheck-executables nil + "Executables of syntax checkers." + :prefix "flycheck-" + :group 'flycheck + :link '(custom-manual "(flycheck)Syntax checker executables")) + +(defgroup flycheck-faces nil + "Faces used by on-the-fly syntax checking." + :prefix "flycheck-" + :group 'flycheck + :link '(info-link "(flycheck)Error reporting")) + +(defcustom flycheck-checkers + '(ada-gnat + asciidoc + c/c++-clang + c/c++-gcc + c/c++-cppcheck + cfengine + chef-foodcritic + coffee + coffee-coffeelint + coq + css-csslint + d-dmd + elixir-dogma + emacs-lisp + emacs-lisp-checkdoc + erlang + eruby-erubis + fortran-gfortran + go-gofmt + go-golint + go-vet + go-build + go-test + go-errcheck + go-unconvert + groovy + haml + handlebars + haskell-stack-ghc + haskell-ghc + haskell-hlint + html-tidy + jade + javascript-eslint + javascript-jshint + javascript-gjslint + javascript-jscs + javascript-standard + json-jsonlint + json-python-json + less + lua-luacheck + lua + perl + perl-perlcritic + php + php-phpmd + php-phpcs + processing + puppet-parser + puppet-lint + python-flake8 + python-pylint + python-pycompile + r-lintr + racket + rpm-rpmlint + markdown-mdl + rst-sphinx + rst + ruby-rubocop + ruby-rubylint + ruby + ruby-jruby + rust-cargo + rust + scala + scala-scalastyle + scheme-chicken + scss-lint + sass/scss-sass-lint + sass + scss + sh-bash + sh-posix-dash + sh-posix-bash + sh-zsh + sh-shellcheck + slim + slim-lint + sql-sqlint + tex-chktex + tex-lacheck + texinfo + typescript-tslint + verilog-verilator + xml-xmlstarlet + xml-xmllint + yaml-jsyaml + yaml-ruby) + "Syntax checkers available for automatic selection. + +A list of Flycheck syntax checkers to choose from when syntax +checking a buffer. Flycheck will automatically select a suitable +syntax checker from this list, unless `flycheck-checker' is set, +either directly or with `flycheck-select-checker'. + +You should not need to change this variable normally. In order +to disable syntax checkers, please use +`flycheck-disabled-checkers'. This variable is intended for 3rd +party extensions to tell Flycheck about new syntax checkers. + +Syntax checkers in this list must be defined with +`flycheck-define-checker'." + :group 'flycheck + :type '(repeat (symbol :tag "Checker")) + :risky t) + +(defcustom flycheck-disabled-checkers nil + "Syntax checkers excluded from automatic selection. + +A list of Flycheck syntax checkers to exclude from automatic +selection. Flycheck will never automatically select a syntax +checker in this list, regardless of the value of +`flycheck-checkers'. + +However, syntax checkers in this list are still available for +manual selection with `flycheck-select-checker'. + +Use this variable to disable syntax checkers, instead of removing +the syntax checkers from `flycheck-checkers'. You may also use +this option as a file or directory local variable to disable +specific checkers in individual files and directories +respectively." + :group 'flycheck + :type '(repeat (symbol :tag "Checker")) + :package-version '(flycheck . "0.16") + :safe #'flycheck-symbol-list-p) +(make-variable-buffer-local 'flycheck-disabled-checkers) + +(defvar-local flycheck-checker nil + "Syntax checker to use for the current buffer. + +If unset or nil, automatically select a suitable syntax checker +from `flycheck-checkers' on every syntax check. + +If set to a syntax checker only use this syntax checker and never +select one from `flycheck-checkers' automatically. The syntax +checker is used regardless of whether it is contained in +`flycheck-checkers' or `flycheck-disabled-checkers'. If the +syntax checker is unusable in the current buffer an error is +signaled. + +A syntax checker assigned to this variable must be defined with +`flycheck-define-checker'. + +Use the command `flycheck-select-checker' to select a syntax +checker for the current buffer, or set this variable as file +local variable to always use a specific syntax checker for a +file. See Info Node `(emacs)Specifying File Variables' for more +information about file variables.") +(put 'flycheck-checker 'safe-local-variable 'flycheck-registered-checker-p) + +(defcustom flycheck-locate-config-file-functions nil + "Functions to locate syntax checker configuration files. + +Each function in this hook must accept two arguments: The value +of the configuration file variable, and the syntax checker +symbol. It must return either a string with an absolute path to +the configuration file, or nil, if it cannot locate the +configuration file. + +The functions in this hook are called in order of appearance, until a +function returns non-nil. The configuration file returned by that +function is then given to the syntax checker if it exists. + +This variable is an abnormal hook. See Info +node `(elisp)Hooks'." + :group 'flycheck + :type 'hook + :risky t) + +(defcustom flycheck-checker-error-threshold 400 + "Maximum errors allowed per syntax checker. + +The value of this variable is either an integer denoting the +maximum number of errors per syntax checker and buffer, or nil to +not limit the errors reported from a syntax checker. + +If this variable is a number and a syntax checker reports more +errors than the value of this variable, its errors are not +discarded, and not highlighted in the buffer or available in the +error list. The affected syntax checker is also disabled for +future syntax checks of the buffer." + :group 'flycheck + :type '(choice (const :tag "Do not limit reported errors" nil) + (integer :tag "Maximum number of errors")) + :risky t + :package-version '(flycheck . "0.22")) + +(defcustom flycheck-process-error-functions nil + "Functions to process errors. + +Each function in this hook must accept a single argument: A +Flycheck error to process. + +All functions in this hook are called in order of appearance, +until a function returns non-nil. Thus, a function in this hook +may return nil, to allow for further processing of the error, or +any non-nil value, to indicate that the error was fully processed +and inhibit any further processing. + +The functions are called for each newly parsed error immediately +after the corresponding syntax checker finished. At this stage, +the overlays from the previous syntax checks are still present, +and there may be further syntax checkers in the chain. + +This variable is an abnormal hook. See Info +node `(elisp)Hooks'." + :group 'flycheck + :type 'hook + :package-version '(flycheck . "0.13") + :risky t) + +(defcustom flycheck-display-errors-delay 0.9 + "Delay in seconds before displaying errors at point. + +Use floating point numbers to express fractions of seconds." + :group 'flycheck + :type 'number + :package-version '(flycheck . "0.15") + :safe #'numberp) + +(defcustom flycheck-display-errors-function #'flycheck-display-error-messages + "Function to display error messages. + +If set to a function, call the function with the list of errors +to display as single argument. Each error is an instance of the +`flycheck-error' struct. + +If set to nil, do not display errors at all." + :group 'flycheck + :type '(choice (const :tag "Display error messages" + flycheck-display-error-messages) + (const :tag "Display error messages only if no error list" + flycheck-display-error-messages-unless-error-list) + (function :tag "Error display function")) + :package-version '(flycheck . "0.13") + :risky t) + +(defcustom flycheck-help-echo-function #'flycheck-help-echo-all-error-messages + "Function to compute the contents of the error tooltips. + +If set to a function, call the function with the list of errors +to display as single argument. Each error is an instance of the +`flycheck-error' struct. The function is used to set the +help-echo property of flycheck error overlays. It should return +a string, which is displayed when the user hovers over an error +or presses \\[display-local-help]. + +If set to nil, do not show error tooltips." + :group 'flycheck + :type '(choice (const :tag "Concatenate error messages to form a tooltip" + flycheck-help-echo-all-error-messages) + (function :tag "Help echo function")) + :package-version '(flycheck . "0.25") + :risky t) + +(defcustom flycheck-command-wrapper-function #'identity + "Function to modify checker commands before execution. + +The value of this option is a function which is given a list +containing the full command of a syntax checker after +substitution through `flycheck-substitute-argument' but before +execution. The function may return a new command for Flycheck to +execute. + +The default value is `identity' which does not change the +command. You may provide your own function to run Flycheck +commands through `bundle exec', `nix-shell' or similar wrappers." + :group 'flycheck + :type '(choice (const :tag "Do not modify commands" identity) + (function :tag "Modify command with a custom function")) + :package-version '(flycheck . "0.25") + :risky t) + +(defcustom flycheck-executable-find #'executable-find + "Function to search for executables. + +The value of this option is a function which is given the name or +path of an executable and shall return the full path to the +executable, or nil if the executable does not exit. + +The default is the standard `executable-find' function which +searches `exec-path'. You can customize this option to search +for checkers in other environments such as bundle or NixOS +sandboxes." + :group 'flycheck + :type '(choice (const :tag "Search executables in `exec-path'" executable-find) + (function :tag "Search executables with a custom function")) + :package-version '(flycheck . "0.25") + :risky t) + +(defcustom flycheck-indication-mode 'left-fringe + "The indication mode for Flycheck errors and warnings. + +This variable controls how Flycheck indicates errors in buffers. +May either be `left-fringe', `right-fringe', or nil. + +If set to `left-fringe' or `right-fringe', indicate errors and +warnings via icons in the left and right fringe respectively. + +If set to nil, do not indicate errors and warnings, but just +highlight them according to `flycheck-highlighting-mode'." + :group 'flycheck + :type '(choice (const :tag "Indicate in the left fringe" left-fringe) + (const :tag "Indicate in the right fringe" right-fringe) + (const :tag "Do not indicate" nil)) + :safe #'symbolp) + +(defcustom flycheck-highlighting-mode 'symbols + "The highlighting mode for Flycheck errors and warnings. + +The highlighting mode controls how Flycheck highlights errors in +buffers. The following modes are known: + +`columns' + Highlight the error column. If the error does not have a column, + highlight the whole line. + +`symbols' + Highlight the symbol at the error column, if there is any, + otherwise behave like `columns'. This is the default. + +`sexps' + Highlight the expression at the error column, if there is + any, otherwise behave like `columns'. Note that this mode + can be *very* slow in some major modes. + +`lines' + Highlight the whole line. + +nil + Do not highlight errors at all. However, errors will still + be reported in the mode line and in error message popups, + and indicated according to `flycheck-indication-mode'." + :group 'flycheck + :type '(choice (const :tag "Highlight columns only" columns) + (const :tag "Highlight symbols" symbols) + (const :tag "Highlight expressions" sexps) + (const :tag "Highlight whole lines" lines) + (const :tag "Do not highlight errors" nil)) + :package-version '(flycheck . "0.14") + :safe #'symbolp) + +(defcustom flycheck-check-syntax-automatically '(save + idle-change + new-line + mode-enabled) + "When Flycheck should check syntax automatically. + +This variable is a list of events that may trigger syntax checks. +The following events are known: + +`save' + Check syntax immediately after the buffer was saved. + +`idle-change' + Check syntax a short time (see `flycheck-idle-change-delay') + after the last change to the buffer. + +`new-line' + Check syntax immediately after a new line was inserted into + the buffer. + +`mode-enabled' + Check syntax immediately when variable `flycheck-mode' is + non-nil. + +Flycheck performs a syntax checks only on events, which are +contained in this list. For instance, if the value of this +variable is `(mode-enabled save)', Flycheck will only check if +the mode is enabled or the buffer was saved, but never after +changes to the buffer contents. + +If nil, never check syntax automatically. In this case, use +`flycheck-buffer' to start a syntax check manually." + :group 'flycheck + :type '(set (const :tag "After the buffer was saved" save) + (const :tag "After the buffer was changed and idle" idle-change) + (const :tag "After a new line was inserted" new-line) + (const :tag "After `flycheck-mode' was enabled" mode-enabled)) + :package-version '(flycheck . "0.12") + :safe #'symbolp) + +(defcustom flycheck-idle-change-delay 0.5 + "How many seconds to wait before checking syntax automatically. + +After the buffer was changed, Flycheck will wait as many seconds +as the value of this variable before starting a syntax check. If +the buffer is modified during this time, Flycheck will wait +again. + +This variable has no effect, if `idle-change' is not contained in +`flycheck-check-syntax-automatically'." + :group 'flycheck + :type 'number + :package-version '(flycheck . "0.13") + :safe #'numberp) + +(defcustom flycheck-standard-error-navigation t + "Whether to support error navigation with `next-error'. + +If non-nil, enable navigation of Flycheck errors with +`next-error', `previous-error' and `first-error'. Otherwise, +these functions just navigate errors from compilation modes. + +Flycheck error navigation with `flycheck-next-error', +`flycheck-previous-error' and `flycheck-first-error' is always +enabled, regardless of the value of this variable. + +Note that this setting only takes effect when variable +`flycheck-mode' is non-nil. Changing it will not affect buffers +where variable `flycheck-mode' is already non-nil." + :group 'flycheck + :type 'boolean + :package-version '(flycheck . "0.15") + :safe #'booleanp) + +(define-widget 'flycheck-minimum-level 'lazy + "A radio-type choice of minimum error levels. + +See `flycheck-navigation-minimum-level' and +`flycheck-error-list-minimum-level'." + :type '(radio (const :tag "All locations" nil) + (const :tag "Informational messages" info) + (const :tag "Warnings" warning) + (const :tag "Errors" error) + (symbol :tag "Custom error level"))) + +(defcustom flycheck-navigation-minimum-level nil + "The minimum level of errors to navigate. + +If set to an error level, only navigate errors whose error level +is at least as severe as this one. If nil, navigate all errors." + :group 'flycheck + :type 'flycheck-minimum-level + :safe #'flycheck-error-level-p + :package-version '(flycheck . "0.21")) + +(defcustom flycheck-error-list-minimum-level nil + "The minimum level of errors to display in the error list. + +If set to an error level, only display errors whose error level +is at least as severe as this one in the error list. If nil, +display all errors. + +This is the default level, used when the error list is opened. +You can temporarily change the level using +\\[flycheck-error-list-set-filter], or reset it to this value +using \\[flycheck-error-list-reset-filter]." + :group 'flycheck + :type 'flycheck-minimum-level + :safe #'flycheck-error-level-p + :package-version '(flycheck . "0.24")) + +(defcustom flycheck-completing-read-function #'completing-read + "Function to read from minibuffer with completion. + +The function must be compatible to the built-in `completing-read' +function." + :group 'flycheck + :type '(choice (const :tag "Default" completing-read) + (const :tag "IDO" ido-completing-read) + (function :tag "Custom function")) + :risky t + :package-version '(flycheck . "26")) + +(defcustom flycheck-temp-prefix "flycheck" + "Prefix for temporary files created by Flycheck." + :group 'flycheck + :type 'string + :package-version '(flycheck . "0.19") + :risky t) + +(defcustom flycheck-mode-hook nil + "Hooks to run after command `flycheck-mode' is toggled." + :group 'flycheck + :type 'hook + :risky t) + +(defcustom flycheck-after-syntax-check-hook nil + "Functions to run after each syntax check. + +This hook is run after a syntax check was finished. + +At this point, *all* chained checkers were run, and all errors +were parsed, highlighted and reported. The variable +`flycheck-current-errors' contains all errors from all syntax +checkers run during the syntax check, so you can apply any error +analysis functions. + +Note that this hook does *not* run after each individual syntax +checker in the syntax checker chain, but only after the *last +checker*. + +This variable is a normal hook. See Info node `(elisp)Hooks'." + :group 'flycheck + :type 'hook + :risky t) + +(defcustom flycheck-before-syntax-check-hook nil + "Functions to run before each syntax check. + +This hook is run right before a syntax check starts. + +Error information from the previous syntax check is *not* +cleared before this hook runs. + +Note that this hook does *not* run before each individual syntax +checker in the syntax checker chain, but only before the *first +checker*. + +This variable is a normal hook. See Info node `(elisp)Hooks'." + :group 'flycheck + :type 'hook + :risky t) + +(defcustom flycheck-syntax-check-failed-hook nil + "Functions to run if a syntax check failed. + +This hook is run whenever an error occurs during Flycheck's +internal processing. No information about the error is given to +this hook. + +You should use this hook to conduct additional cleanup actions +when Flycheck failed. + +This variable is a normal hook. See Info node `(elisp)Hooks'." + :group 'flycheck + :type 'hook + :risky t) + +(defcustom flycheck-status-changed-functions nil + "Functions to run if the Flycheck status changed. + +This hook is run whenever the status of Flycheck changes. Each +hook function takes the status symbol as sinlge argument, as +given to `flycheck-report-status', which see. + +This variable is a abnormal hook. See Info +node `(elisp)Hooks'." + :group 'flycheck + :type 'hook + :risky t + :package-version '(flycheck . "0.20")) + +(defcustom flycheck-error-list-after-refresh-hook nil + "Functions to run after the error list was refreshed. + +This hook is run whenever the error list is refreshed. + +This variable is a normal hook. See Info node `(elisp)Hooks'." + :group 'flycheck + :type 'hook + :risky t + :package-version '(flycheck . "0.21")) + +(defface flycheck-error + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :underline t :inherit error)) + "Flycheck face for errors." + :package-version '(flycheck . "0.13") + :group 'flycheck-faces) + +(defface flycheck-warning + '((((supports :underline (:style wave))) + :underline (:style wave :color "DarkOrange")) + (t + :underline t :inherit warning)) + "Flycheck face for warnings." + :package-version '(flycheck . "0.13") + :group 'flycheck-faces) + +(defface flycheck-info + '((((supports :underline (:style wave))) + :underline (:style wave :color "ForestGreen")) + (t + :underline t :inherit success)) + "Flycheck face for informational messages." + :package-version '(flycheck . "0.15") + :group 'flycheck-faces) + +(defface flycheck-fringe-error + '((t :inherit error)) + "Flycheck face for fringe error indicators." + :package-version '(flycheck . "0.13") + :group 'flycheck-faces) + +(defface flycheck-fringe-warning + '((t :inherit warning)) + "Flycheck face for fringe warning indicators." + :package-version '(flycheck . "0.13") + :group 'flycheck-faces) + +(defface flycheck-fringe-info + ;; Semantically `success' is probably not the right face, but it looks nice as + ;; a base face + '((t :inherit success)) + "Flycheck face for fringe info indicators." + :package-version '(flycheck . "0.15") + :group 'flycheck-faces) + +(defface flycheck-error-list-error + '((t :inherit error)) + "Flycheck face for error messages in the error list." + :package-version '(flycheck . "0.16") + :group 'flycheck-faces) + +(defface flycheck-error-list-warning + '((t :inherit warning)) + "Flycheck face for warning messages in the error list." + :package-version '(flycheck . "0.16") + :group 'flycheck-faces) + +(defface flycheck-error-list-info + '((t :inherit success)) + "Flycheck face for info messages in the error list." + :package-version '(flycheck . "0.16") + :group 'flycheck-faces) + +;; The base faces for the following two faces are inspired by Compilation Mode +(defface flycheck-error-list-line-number + '((t :inherit font-lock-constant-face)) + "Face for line numbers in the error list." + :group 'flycheck-faces + :package-version '(flycheck . "0.16")) + +(defface flycheck-error-list-column-number + '((t :inherit font-lock-constant-face)) + "Face for line numbers in the error list." + :group 'flycheck-faces + :package-version '(flycheck . "0.16")) + +(defface flycheck-error-list-id + '((t :inherit font-lock-type-face)) + "Face for the error ID in the error list." + :group 'flycheck-faces + :package-version '(flycheck . "0.22")) + +(defface flycheck-error-list-checker-name + '((t :inherit font-lock-function-name-face)) + "Face for the syntax checker name in the error list." + :group 'flycheck-faces + :package-version '(flycheck . "0.21")) + +(defface flycheck-error-list-highlight + '((t :inherit highlight)) + "Flycheck face to highlight errors in the error list." + :package-version '(flycheck . "0.15") + :group 'flycheck-faces) + +(defvar flycheck-command-map + (let ((map (make-sparse-keymap))) + (define-key map "c" #'flycheck-buffer) + (define-key map "C" #'flycheck-clear) + (define-key map (kbd "C-c") #'flycheck-compile) + (define-key map "n" #'flycheck-next-error) + (define-key map "p" #'flycheck-previous-error) + (define-key map "l" #'flycheck-list-errors) + (define-key map (kbd "C-w") #'flycheck-copy-errors-as-kill) + (define-key map "s" #'flycheck-select-checker) + (define-key map "e" #'flycheck-set-checker-executable) + (define-key map "?" #'flycheck-describe-checker) + (define-key map "h" #'flycheck-display-error-at-point) + (define-key map "H" #'display-local-help) + (define-key map "i" #'flycheck-manual) + (define-key map "V" #'flycheck-version) + (define-key map "v" #'flycheck-verify-setup) + (define-key map "x" #'flycheck-disable-checker) + map) + "Keymap of Flycheck interactive commands.") + +(defcustom flycheck-keymap-prefix (kbd "C-c !") + "Prefix for key bindings of Flycheck. + +Changing this variable outside Customize does not have any +effect. To change the keymap prefix from Lisp, you need to +explicitly re-define the prefix key: + + (define-key flycheck-mode-map flycheck-keymap-prefix nil) + (setq flycheck-keymap-prefix (kbd \"C-c f\")) + (define-key flycheck-mode-map flycheck-keymap-prefix + flycheck-command-map) + +Please note that Flycheck's manual documents the default +keybindings. Changing this variable is at your own risk." + :group 'flycheck + :package-version '(flycheck . "0.19") + :type 'string + :risky t + :set + (lambda (variable key) + (when (and (boundp variable) (boundp 'flycheck-mode-map)) + (define-key flycheck-mode-map (symbol-value variable) nil) + (define-key flycheck-mode-map key flycheck-command-map)) + (set-default variable key))) + +(defcustom flycheck-mode-line '(:eval (flycheck-mode-line-status-text)) + "Mode line lighter for Flycheck. + +The value of this variable is a mode line template as in +`mode-line-format'. See Info Node `(elisp)Mode Line Format' for +more information. Note that it should contain a _single_ mode +line construct only. + +Customize this variable to change how Flycheck reports its status +in the mode line. You may use `flycheck-mode-line-status-text' +to obtain a human-readable status text, including an +error/warning count. + +You may also assemble your own status text. The current status +of Flycheck is available in `flycheck-last-status-change'. The +errors in the current buffer are stored in +`flycheck-current-errors', and the function +`flycheck-count-errors' may be used to obtain the number of +errors grouped by error level. + +Set this variable to nil to disable the mode line completely." + :group 'flycheck + :type 'sexp + :risky t + :package-version '(flycheck . "0.20")) + +(defcustom flycheck-mode-line-prefix "FlyC" + "Base mode line lighter for Flycheck. + +This will have an effect only with the default +`flycheck-mode-line'. + +If you've customized `flycheck-mode-line' then the customized +function must be updated to use this variable." + :group 'flycheck + :type 'string + :package-version '(flycheck . "26")) + +(defcustom flycheck-error-list-mode-line + `(,(propertized-buffer-identification "%12b") + " for buffer " + (:eval (flycheck-error-list-propertized-source-name)) + (:eval (flycheck-error-list-mode-line-filter-indicator))) + "Mode line construct for Flycheck error list. + +The value of this variable is a mode line template as in +`mode-line-format', to be used as +`mode-line-buffer-identification' in `flycheck-error-list-mode'. +See Info Node `(elisp)Mode Line Format' for more information. + +Customize this variable to change how the error list appears in +the mode line. The default shows the name of the buffer and the +name of the source buffer, i.e. the buffer whose errors are +currently listed." + :group 'flycheck + :type 'sexp + :risky t + :package-version '(flycheck . "0.20")) + +(defcustom flycheck-global-modes t + "Modes for which option `flycheck-mode' is turned on. + +If t, Flycheck Mode is turned on for all major modes. If a list, +Flycheck Mode is turned on for all `major-mode' symbols in that +list. If the `car' of the list is `not', Flycheck Mode is turned +on for all `major-mode' symbols _not_ in that list. If nil, +Flycheck Mode is never turned on by command +`global-flycheck-mode'. + +Note that Flycheck is never turned on for modes whose +`mode-class' property is `special' (see Info node `(elisp)Major +Mode Conventions'), regardless of the value of this option. + +Only has effect when variable `global-flycheck-mode' is non-nil." + :group 'flycheck + :type '(choice (const :tag "none" nil) + (const :tag "all" t) + (set :menu-tag "mode specific" :tag "modes" + :value (not) + (const :tag "Except" not) + (repeat :inline t (symbol :tag "mode")))) + :risky t + :package-version '(flycheck . "0.23")) + +;; Add built-in functions to our hooks, via `add-hook', to make sure that our +;; functions are really present, even if the variable was implicitly defined by +;; another call to `add-hook' that occurred before Flycheck was loaded. See +;; http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg01271.html for why +;; we don't initialize the hook variables right away. We append our own +;; functions, because a user likely expects that their functions come first, +;; even if the added them before Flycheck was loaded. +(dolist (hook (list #'flycheck-locate-config-file-by-path + #'flycheck-locate-config-file-ancestor-directories + #'flycheck-locate-config-file-home)) + (add-hook 'flycheck-locate-config-file-functions hook 'append)) + +(add-hook 'flycheck-process-error-functions #'flycheck-add-overlay 'append) + + +;;; Global Flycheck menu +(defvar flycheck-mode-menu-map + (easy-menu-create-menu + "Syntax Checking" + '(["Enable on-the-fly syntax checking" flycheck-mode + :style toggle :selected flycheck-mode + ;; Don't let users toggle the mode if there is no syntax checker for this + ;; buffer + :enable (or flycheck-mode (flycheck-get-checker-for-buffer))] + ["Check current buffer" flycheck-buffer flycheck-mode] + ["Clear errors in buffer" flycheck-clear t] + "---" + ["Go to next error" flycheck-next-error flycheck-mode] + ["Go to previous error" flycheck-previous-error flycheck-mode] + ["Show all errors" flycheck-list-errors flycheck-mode] + "---" + ["Copy messages at point" flycheck-copy-errors-as-kill + (flycheck-overlays-at (point))] + "---" + ["Select syntax checker" flycheck-select-checker flycheck-mode] + ["Disable syntax checker" flycheck-disable-checker flycheck-mode] + ["Set executable of syntax checker" flycheck-set-checker-executable + flycheck-mode] + "---" + ["Describe syntax checker" flycheck-describe-checker t] + ["Show Flycheck version" flycheck-version t] + ["Read the Flycheck manual" flycheck-info t])) + "Menu of command `flycheck-mode'.") + +(easy-menu-add-item nil '("Tools") flycheck-mode-menu-map "Spell Checking") + + +;;; Version information, manual and loading of Flycheck +(defun flycheck-version (&optional show-version) + "Get the Flycheck version as string. + +If called interactively or if SHOW-VERSION is non-nil, show the +version in the echo area and the messages buffer. + +The returned string includes both, the version from package.el +and the library version, if both a present and different. + +If the version number could not be determined, signal an error, +if called interactively, or if SHOW-VERSION is non-nil, otherwise +just return nil." + (interactive (list t)) + (let ((version (pkg-info-version-info 'flycheck))) + (when show-version + (message "Flycheck version: %s" version)) + version)) + +(defun flycheck-unload-function () + "Unload function for Flycheck." + (global-flycheck-mode -1) + (easy-menu-remove-item nil '("Tools") (cadr flycheck-mode-menu-map)) + (remove-hook 'kill-emacs-hook #'flycheck-global-teardown) + (setq find-function-regexp-alist + (assq-delete-all 'flycheck-checker find-function-regexp-alist))) + +;;;###autoload +(defun flycheck-manual () + "Open the Flycheck manual." + (interactive) + (browse-url "http://www.flycheck.org")) + +(define-obsolete-function-alias 'flycheck-info + 'flycheck-manual "26" "Open the Flycheck manual.") + + +;;; Utility functions +(defun flycheck-sexp-to-string (sexp) + "Convert SEXP to a string. + +Like `prin1-to-string' but ensure that the returned string +is loadable." + (let ((print-quoted t) + (print-length nil) + (print-level nil)) + (prin1-to-string sexp))) + +(defun flycheck-string-to-number-safe (string) + "Safely convert STRING to a number. + +If STRING is of string type and a numeric string, convert STRING +to a number and return it. Otherwise return nil." + (let ((number-re (rx string-start (one-or-more (any digit)) string-end))) + (when (and (stringp string) (string-match-p number-re string)) + (string-to-number string)))) + +(defun flycheck-string-list-p (obj) + "Determine if OBJ is a list of strings." + (and (listp obj) (seq-every-p #'stringp obj))) + +(defun flycheck-symbol-list-p (obj) + "Determine if OBJ is a list of symbols." + (and (listp obj) (seq-every-p #'symbolp obj))) + +(defun flycheck-same-files-p (file-a file-b) + "Determine whether FILE-A and FILE-B refer to the same file." + (let ((file-a (expand-file-name file-a)) + (file-b (expand-file-name file-b))) + ;; We must resolve symbolic links here, since some syntax checker always + ;; output canonical file names with all symbolic links resolved. However, + ;; we still do a simple path compassion first, to avoid the comparatively + ;; expensive file system call if possible. See + ;; https://github.com/flycheck/flycheck/issues/561 + (or (string= (directory-file-name file-a) (directory-file-name file-b)) + (string= (directory-file-name (file-truename file-a)) + (directory-file-name (file-truename file-b)))))) + +(defvar-local flycheck-temporaries nil + "Temporary files and directories created by Flycheck.") + +(defun flycheck-temp-dir-system () + "Create a unique temporary directory. + +Use `flycheck-temp-prefix' as prefix, and add the directory to +`flycheck-temporaries'. + +Return the path of the directory" + (let* ((tempdir (make-temp-file flycheck-temp-prefix 'directory))) + (push tempdir flycheck-temporaries) + tempdir)) + +(defun flycheck-temp-file-system (filename) + "Create a temporary file named after FILENAME. + +If FILENAME is non-nil, this function creates a temporary +directory with `flycheck-temp-dir-system', and creates a file +with the same name as FILENAME in this directory. + +Otherwise this function creates a temporary file with +`flycheck-temp-prefix' and a random suffix. The path of the file +is added to `flycheck-temporaries'. + +Add the path of the file to `flycheck-temporaries'. + +Return the path of the file." + (let ((tempfile (convert-standard-filename + (if filename + (expand-file-name (file-name-nondirectory filename) + (flycheck-temp-dir-system)) + (make-temp-file flycheck-temp-prefix))))) + (push tempfile flycheck-temporaries) + tempfile)) + +(defun flycheck-temp-file-inplace (filename) + "Create an in-place copy of FILENAME. + +Prefix the file with `flycheck-temp-prefix' and add the path of +the file to `flycheck-temporaries'. + +If FILENAME is nil, fall back to `flycheck-temp-file-system'. + +Return the path of the file." + (if filename + (let* ((tempname (format "%s_%s" + flycheck-temp-prefix + (file-name-nondirectory filename))) + (tempfile (convert-standard-filename + (expand-file-name tempname + (file-name-directory filename))))) + (push tempfile flycheck-temporaries) + tempfile) + (flycheck-temp-file-system filename))) + +(defun flycheck-save-buffer-to-file (file-name) + "Save the contents of the current buffer to FILE-NAME." + (make-directory (file-name-directory file-name) t) + (let ((jka-compr-inhibit t)) + (write-region nil nil file-name nil 0))) + +(defun flycheck-save-buffer-to-temp (temp-file-fn) + "Save buffer to temp file returned by TEMP-FILE-FN. + +Return the name of the temporary file." + (let ((filename (funcall temp-file-fn (buffer-file-name)))) + ;; Do not flush short-lived temporary files onto disk + (let ((write-region-inhibit-fsync t)) + (flycheck-save-buffer-to-file filename)) + filename)) + +(defun flycheck-prepend-with-option (option items &optional prepend-fn) + "Prepend OPTION to each item in ITEMS, using PREPEND-FN. + +Prepend OPTION to each item in ITEMS. + +ITEMS is a list of strings to pass to the syntax checker. OPTION +is the option, as string. PREPEND-FN is a function called to +prepend OPTION to each item in ITEMS. It receives the option and +a single item from ITEMS as argument, and must return a string or +a list of strings with OPTION prepended to the item. If +PREPEND-FN is nil or omitted, use `list'. + +Return a list of strings where OPTION is prepended to each item +in ITEMS using PREPEND-FN. If PREPEND-FN returns a list, it is +spliced into the resulting list." + (unless (stringp option) + (error "Option %S is not a string" option)) + (unless prepend-fn + (setq prepend-fn #'list)) + (let ((prepend + (lambda (item) + (let ((result (funcall prepend-fn option item))) + (cond + ((and (listp result) (seq-every-p #'stringp result)) result) + ((stringp result) (list result)) + (t (error "Invalid result type for option: %S" result))))))) + (apply #'append (seq-map prepend items)))) + +(defun flycheck-find-in-buffer (pattern) + "Find PATTERN in the current buffer. + +Return the result of the first matching group of PATTERN, or nil, +if PATTERN did not match." + (save-restriction + (widen) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward pattern nil 'no-error) + (match-string-no-properties 1))))) + +(defun flycheck-ephemeral-buffer-p () + "Determine whether the current buffer is an ephemeral buffer. + +See Info node `(elisp)Buffer Names' for information about +ephemeral buffers." + (string-prefix-p " " (buffer-name))) + +(defun flycheck-encrypted-buffer-p () + "Determine whether the current buffer is an encrypted file. + +See Info node `(epa)Top' for Emacs' interface to encrypted +files." + ;; The EPA file handler sets this variable locally to remember the recipients + ;; of the encrypted file for re-encryption. Hence, a local binding of this + ;; variable is a good indication that the buffer is encrypted. I haven't + ;; found any better indicator anyway. + (local-variable-p 'epa-file-encrypt-to)) + +(defun flycheck-autoloads-file-p () + "Determine whether the current buffer is a autoloads file. + +Autoloads are generated by package.el during installation." + (string-suffix-p "-autoloads.el" (buffer-name))) + +(defun flycheck-in-user-emacs-directory-p (filename) + "Whether FILENAME is in `user-emacs-directory'." + (string-prefix-p (file-name-as-directory (file-truename user-emacs-directory)) + (file-truename filename))) + +(defun flycheck-safe-delete (file-or-dir) + "Safely delete FILE-OR-DIR." + (ignore-errors + (if (file-directory-p file-or-dir) + (delete-directory file-or-dir 'recursive) + (delete-file file-or-dir)))) + +(defun flycheck-safe-delete-temporaries () + "Safely delete all temp files and directories of Flycheck. + +Safely delete all files and directories listed in +`flycheck-temporaries' and set the variable's value to nil." + (seq-do #'flycheck-safe-delete flycheck-temporaries) + (setq flycheck-temporaries nil)) + +(defun flycheck-rx-file-name (form) + "Translate the `(file-name)' FORM into a regular expression." + (let ((body (or (cdr form) '((minimal-match + (one-or-more not-newline)))))) + (rx-submatch-n `(group-n 1 ,@body)))) + +(defun flycheck-rx-message (form) + "Translate the `(message)' FORM into a regular expression." + (let ((body (or (cdr form) '((one-or-more not-newline))))) + (rx-submatch-n `(group-n 4 ,@body)))) + +(defun flycheck-rx-id (form) + "Translate the `(id)' FORM into a regular expression." + (rx-submatch-n `(group-n 5 ,@(cdr form)))) + +(defun flycheck-rx-to-string (form &optional no-group) + "Like `rx-to-string' for FORM, but with special keywords: + +`line' + matches the line number. + +`column' + matches the column number. + +`(file-name SEXP ...)' + matches the file name. SEXP describes the file name. If no + SEXP is given, use a default body of `(minimal-match + (one-or-more not-newline))'. + +`(message SEXP ...)' + matches the message. SEXP constitutes the body of the + message. If no SEXP is given, use a default body + of `(one-or-more not-newline)'. + +`(id SEXP ...)' + matches an error ID. SEXP describes the ID. + +NO-GROUP is passed to `rx-to-string'. + +See `rx' for a complete list of all built-in `rx' forms." + (let ((rx-constituents + (append + `((line . ,(rx (group-n 2 (one-or-more digit)))) + (column . ,(rx (group-n 3 (one-or-more digit)))) + (file-name flycheck-rx-file-name 0 nil) + (message flycheck-rx-message 0 nil) + (id flycheck-rx-id 0 nil)) + rx-constituents nil))) + (rx-to-string form no-group))) + +(defun flycheck-current-load-file () + "Get the source file currently being loaded. + +Always return the name of the corresponding source file, never +any byte-compiled file. + +Return nil, if the currently loaded file cannot be determined." + (-when-let* ((this-file (cond + (load-in-progress load-file-name) + ((bound-and-true-p byte-compile-current-file)) + (t (buffer-file-name)))) + ;; A best guess for the source file of a compiled library. Works + ;; well in most cases, and especially for ELPA packages + (source-file (concat (file-name-sans-extension this-file) + ".el"))) + (when (file-exists-p source-file) + source-file))) + +(defun flycheck-module-root-directory (module &optional file-name) + "Get the root directory for a MODULE in FILE-NAME. + +MODULE is a qualified module name, either a string with +components separated by a dot, or as list of components. +FILE-NAME is the name of the file or directory containing the +module as string. When nil or omitted, defaults to the return +value of function `buffer-file-name'. + +Return the root directory of the module, that is, the directory, +from which FILE-NAME can be reached by descending directories +along each part of MODULE. + +If the MODULE name does not match the directory hierarchy upwards +from FILE-NAME, return the directory containing FILE-NAME. When +FILE-NAME is nil, return `default-directory'." + (let ((file-name (or file-name (buffer-file-name))) + (module-components (if (stringp module) + (split-string module (rx ".")) + (copy-sequence module)))) + (if (and module-components file-name) + (let ((parts (nreverse module-components)) + (base-directory (directory-file-name + (file-name-sans-extension file-name)))) + (while (and parts + (string= (file-name-nondirectory base-directory) + (car parts))) + (pop parts) + (setq base-directory (directory-file-name + (file-name-directory base-directory)))) + (file-name-as-directory base-directory)) + (if file-name + (file-name-directory file-name) + (expand-file-name default-directory))))) + + +;;; Minibuffer tools +(defvar read-flycheck-checker-history nil + "`completing-read' history of `read-flycheck-checker'.") + +(defun flycheck-completing-read (prompt candidates default &optional history) + "Read a value from the minibuffer. + +Use `flycheck-completing-read-function' to read input from the +minibuffer with completion. + +Show PROMPT and read one of CANDIDATES, defaulting to DEFAULT. +HISTORY is passed to `flycheck-completing-read-function'." + (funcall flycheck-completing-read-function + prompt candidates nil 'require-match nil history default)) + +(defun read-flycheck-checker (prompt &optional default property candidates) + "Read a flycheck checker from minibuffer with PROMPT and DEFAULT. + +PROMPT is a string to show in the minibuffer as prompt. It +should end with a single space. DEFAULT is a symbol denoting the +default checker to use, if the user did not select any checker. +PROPERTY is a symbol denoting a syntax checker property. If +non-nil, only complete syntax checkers which have a non-nil value +for PROPERTY. CANDIDATES is an optional list of all syntax +checkers available for completion, defaulting to all defined +checkers. If given, PROPERTY is ignored. + +Return the checker as symbol, or DEFAULT if no checker was +chosen. If DEFAULT is nil and no checker was chosen, signal a +`user-error' if the underlying completion system does not provide +a default on its own." + (when (and default (not (flycheck-valid-checker-p default))) + (error "%S is no valid Flycheck checker" default)) + (let* ((candidates (seq-map #'symbol-name + (or candidates + (flycheck-defined-checkers property)))) + (default (and default (symbol-name default))) + (input (flycheck-completing-read + prompt candidates default + 'read-flycheck-checker-history))) + (when (string-empty-p input) + (unless default + (user-error "No syntax checker selected")) + (setq input default)) + (let ((checker (intern input))) + (unless (flycheck-valid-checker-p checker) + (error "%S is not a valid Flycheck syntax checker" checker)) + checker))) + +(defun read-flycheck-error-level (prompt) + "Read an error level from the user with PROMPT. + +Only offers level for which errors currently exist, in addition +to the default levels." + (let* ((levels (seq-map #'flycheck-error-level + (flycheck-error-list-current-errors))) + (levels-with-defaults (append '(info warning error) levels)) + (uniq-levels (seq-uniq levels-with-defaults)) + (level (flycheck-completing-read prompt uniq-levels nil))) + (and (stringp level) (intern level)))) + + +;;; Checker API +(defun flycheck-defined-checkers (&optional property) + "Find all defined syntax checkers, optionally with PROPERTY. + +PROPERTY is a symbol. If given, only return syntax checkers with +a non-nil value for PROPERTY. + +The returned list is sorted alphapetically by the symbol name of +the syntax checkers." + (let (defined-checkers) + (mapatoms (lambda (symbol) + (when (and (flycheck-valid-checker-p symbol) + (or (null property) + (flycheck-checker-get symbol property))) + (push symbol defined-checkers)))) + (sort defined-checkers #'string<))) + +(defun flycheck-registered-checker-p (checker) + "Determine whether CHECKER is registered. + +A checker is registered if it is contained in +`flycheck-checkers'." + (and (flycheck-valid-checker-p checker) + (memq checker flycheck-checkers))) + +(defun flycheck-disabled-checker-p (checker) + "Determine whether CHECKER is disabled. + +A checker is disabled if it is contained in +`flycheck-disabled-checkers'." + (memq checker flycheck-disabled-checkers)) + +(defun flycheck-possibly-suitable-checkers () + "Find possibly suitable checkers for the current buffer. + +Return a list of all syntax checkers which could possibly be +suitable for the current buffer, if any problems in their setup +were fixed. + +Currently this function collects all registered syntax checkers +whose `:modes' contain the current major mode or which do not +have any `:modes', but a `:predicate' that returns non-nil for +the current buffer." + (let (checkers) + (dolist (checker flycheck-checkers) + (when (flycheck-checker-supports-major-mode-p checker major-mode) + (push checker checkers))) + (nreverse checkers))) + + +;;; Generic syntax checkers +(defconst flycheck-generic-checker-version 2 + "The internal version of generic syntax checker declarations. + +Flycheck will not use syntax checkers whose generic version is +less than this constant.") + +(defsubst flycheck--checker-property-name (property) + "Return the SYMBOL property for checker PROPERTY." + (intern (concat "flycheck-" (symbol-name property)))) + +(defun flycheck-checker-get (checker property) + "Get the value of CHECKER's PROPERTY." + (get checker (flycheck--checker-property-name property))) + +(gv-define-setter flycheck-checker-get (value checker property) + `(setf (get ,checker (flycheck--checker-property-name ,property)) ,value)) + +(defun flycheck-validate-next-checker (next &optional strict) + "Validate NEXT checker. + +With STRICT non-nil, also check whether the syntax checker and +the error level in NEXT are valid. Otherwise just check whether +these are symbols. + +Signal an error if NEXT is not a valid entry for +`:next-checkers'." + (when (symbolp next) + (setq next (cons t next))) + (pcase next + (`(,level . ,checker) + (if strict + (progn + (unless (or (eq level t) (flycheck-error-level-p level)) + (error "%S is not a valid Flycheck error level" level)) + (unless (flycheck-valid-checker-p checker) + (error "%s is not a valid Flycheck syntax checker" checker))) + (unless (symbolp level) + (error "Error level %S must be a symbol" level)) + (unless (symbolp checker) + (error "Checker %S must be a symbol" checker)))) + (_ (error "%S must be a symbol or cons cell" next))) + t) + +(defun flycheck-define-generic-checker (symbol docstring &rest properties) + "Define SYMBOL as generic syntax checker. + +Any syntax checker defined with this macro is eligible for manual +syntax checker selection with `flycheck-select-checker'. To make +the new syntax checker available for automatic selection, it must +be registered in `flycheck-checkers'. + +DOCSTRING is the documentation of the syntax checker, for +`flycheck-describe-checker'. The following PROPERTIES constitute +a generic syntax checker. Unless otherwise noted, all properties +are mandatory. + +`:start FUNCTION' + A function to start the syntax checker. + + FUNCTION shall take two arguments and return a context + object if the checker is started successfully. Otherwise it + shall signal an error. + + The first argument is the syntax checker being started. The + second is a callback function to report state changes to + Flycheck. The callback takes two arguments STATUS DATA, + where STATUS is a symbol denoting the syntax checker status + and DATA an optional argument with additional data for the + status report. See `flycheck-report-buffer-checker-status' + for more information about STATUS and DATA. + + FUNCTION may be synchronous or asynchronous, i.e. it may + call the given callback either immediately, or at some later + point (e.g. from a process sentinel). + + A syntax checker _must_ call CALLBACK at least once with a + STATUS that finishes the current syntax checker. Otherwise + Flycheck gets stuck at the current syntax check with this + syntax checker. + + The context object returned by FUNCTION is passed to + `:interrupt'. + +`:interrupt FUNCTION' + A function to interrupt the syntax check. + + FUNCTION is called with the syntax checker and the context + object returned by the `:start' function and shall try to + interrupt the syntax check. The context may be nil, if the + syntax check is interrupted before actually started. + FUNCTION should handle this situation. + + If it cannot interrupt the syntax check, it may either + signal an error or silently ignore the attempt to interrupt + the syntax checker, depending on the severity of the + situation. + + If interrupting the syntax check failed, Flycheck will let + the syntax check continue, but ignore any status reports. + Notably, it won't highlight any errors reported by the + syntax check in the buffer. + + This property is optional. If omitted, Flycheck won't + attempt to interrupt syntax checks wit this syntax checker, + and simply ignore their results. + +`:print-doc FUNCTION' + A function to print additional documentation into the Help + buffer of this checker. + + FUNCTION is called when creating the Help buffer for the + syntax checker, with the syntax checker as single argument, + after printing the name of the syntax checker and its modes + and predicate, but before printing DOCSTRING. It may insert + additional documentation into the current buffer. + + The call occurs within `with-help-window'. Hence + `standard-output' points to the current buffer, so you may + use `princ' and friends to add content. Also, the current + buffer is put into Help mode afterwards, which automatically + turns symbols into references, if possible. + + This property is optional. If omitted, no additional + documentation is printed for this syntax checker. + +:verify FUNCTION + A function to verify the checker for the current buffer. + + FUNCTION is called with the syntax checker as single + argument, and shall return a list of + `flycheck-verification-result' objects indicating whether + the syntax checker could be used in the current buffer, and + highlighting potential setup problems. + + This property is optional. If omitted, no additional + verification occurs for this syntax checker. It is however + absolutely recommended that you add a `:verify' function to + your syntax checker, because it will help users to spot + potential setup problems. + +`:modes MODES' + A major mode symbol or a list thereof, denoting major modes + to use this syntax checker in. + + This syntax checker will only be used in buffers whose + `major-mode' is contained in MODES. + + If `:predicate' is also given the syntax checker will only + be used in buffers for which the `:predicate' returns + non-nil. + +`:predicate FUNCTION' + A function to determine whether to use the syntax checker in + the current buffer. + + FUNCTION is called without arguments and shall return + non-nil if this syntax checker shall be used to check the + current buffer. Otherwise it shall return nil. + + FUNCTION is only called in matching major modes. + + This property is optional. + +`:error-filter FUNCTION' + A function to filter the errors returned by this checker. + + FUNCTION is called with the list of `flycheck-error' objects + returned by the syntax checker and shall return another list + of `flycheck-error' objects, which is considered the final + result of this syntax checker. + + FUNCTION is free to add, remove or modify errors, whether in + place or by copying. + + This property is optional. The default filter is + `identity'. + +`:next-checkers NEXT-CHECKERS' + A list denoting syntax checkers to apply after this syntax + checker, in what we call \"chaining\" of syntax checkers. + + Each ITEM is a cons cell `(LEVEL . CHECKER)'. CHECKER is a + syntax checker to run after this syntax checker. LEVEL is + an error level. CHECKER will only be used if there are no + current errors of at least LEVEL. LEVEL may also be t, in + which case CHECKER is used regardless of the current errors. + + ITEM may also be a syntax checker symbol, which is + equivalent to `(t . ITEM)'. + + Flycheck tries all items in order of declaration, and uses + the first whose LEVEL matches and whose CHECKER is + registered and can be used for the current buffer. + + This feature is typically used to apply more than one syntax + checker to a buffer. For instance, you might first use a + compiler to check a buffer for syntax and type errors, and + then run a linting tool that checks for insecure code, or + questionable style. + + This property is optional. If omitted, it defaults to the + nil, i.e. no other syntax checkers are applied after this + syntax checker. + +`:working-directory FUNCTION' + The value of `default-directory' when invoking `:start'. + + FUNCTION is a function taking the syntax checker as sole + argument. It shall return the absolute path to an existing + directory to use as `default-directory' for `:start' or + nil to fall back to the `default-directory' of the current + buffer. + + This property is optional. If omitted invoke `:start' + from the `default-directory' of the buffer being checked. + +Signal an error, if any property has an invalid value." + (declare (indent 1) + (doc-string 2)) + (let ((start (plist-get properties :start)) + (interrupt (plist-get properties :interrupt)) + (print-doc (plist-get properties :print-doc)) + (modes (plist-get properties :modes)) + (predicate (plist-get properties :predicate)) + (verify (plist-get properties :verify)) + (filter (or (plist-get properties :error-filter) #'identity)) + (next-checkers (plist-get properties :next-checkers)) + (file (flycheck-current-load-file)) + (working-directory (plist-get properties :working-directory))) + + (unless (listp modes) + (setq modes (list modes))) + + (unless (functionp start) + (error ":start %S of syntax checker %s is not a function" symbol start)) + (unless (or (null interrupt) (functionp interrupt)) + (error ":interrupt %S of syntax checker %s is not a function" + symbol interrupt)) + (unless (or (null print-doc) (functionp print-doc)) + (error ":print-doc %S of syntax checker %s is not a function" + symbol print-doc)) + (unless (or (null verify) (functionp verify)) + (error ":verify %S of syntax checker %S is not a function" + symbol verify)) + (unless modes + (error "Missing :modes in syntax checker %s" symbol)) + (dolist (mode modes) + (unless (symbolp mode) + (error "Invalid :modes %s in syntax checker %s, %s must be a symbol" + modes symbol mode))) + (unless (or (null predicate) (functionp predicate)) + (error ":predicate %S of syntax checker %s is not a function" + symbol predicate)) + (unless (functionp filter) + (error ":error-filter %S of syntax checker %s is not a function" + symbol filter)) + (dolist (checker next-checkers) + (flycheck-validate-next-checker checker)) + + (let ((real-predicate + (lambda () + (if (flycheck-valid-checker-p symbol) + (or (null predicate) + (let ((default-directory + (flycheck-compute-working-directory symbol))) + (funcall predicate))) + (lwarn 'flycheck :warning "%S is no valid Flycheck syntax checker. +Try to reinstall the package defining this syntax checker." symbol) + nil)))) + (pcase-dolist (`(,prop . ,value) + `((start . ,start) + (interrupt . ,interrupt) + (print-doc . ,print-doc) + (modes . ,modes) + (predicate . ,real-predicate) + (verify . ,verify) + (error-filter . ,filter) + (next-checkers . ,next-checkers) + (documentation . ,docstring) + (file . ,file) + (working-directory . ,working-directory))) + (setf (flycheck-checker-get symbol prop) value))) + + ;; Track the version, to avoid breakage if the internal format changes + (setf (flycheck-checker-get symbol 'generic-checker-version) + flycheck-generic-checker-version))) + +(defun flycheck-valid-checker-p (checker) + "Check whether a CHECKER is valid. + +A valid checker is a symbol defined as syntax checker with +`flycheck-define-checker'." + (and (symbolp checker) + (= (or (get checker 'flycheck-generic-checker-version) 0) + flycheck-generic-checker-version))) + +(defun flycheck-checker-supports-major-mode-p (checker mode) + "Whether CHECKER supports the given major MODE. + +CHECKER is a syntax checker symbol and MODE a major mode symbol. +Look at the `modes' property of CHECKER to determine whether +CHECKER supports buffers in the given major MODE. + +Return non-nil if CHECKER supports MODE and nil otherwise." + (memq mode (flycheck-checker-get checker 'modes))) + +(defun flycheck-may-use-checker (checker) + "Whether a generic CHECKER may be used. + +Return non-nil if CHECKER may be used for the current buffer, and +nil otherwise." + (let ((predicate (flycheck-checker-get checker 'predicate))) + (and (flycheck-valid-checker-p checker) + (not (flycheck-disabled-checker-p checker)) + (flycheck-checker-supports-major-mode-p checker major-mode) + (funcall predicate)))) + +(defun flycheck-may-use-next-checker (next-checker) + "Determine whether NEXT-CHECKER may be used." + (when (symbolp next-checker) + (push t next-checker)) + (let ((level (car next-checker)) + (next-checker (cdr next-checker))) + (and (or (eq level t) + (flycheck-has-max-current-errors-p level)) + (flycheck-registered-checker-p next-checker) + (flycheck-may-use-checker next-checker)))) + + +;;; Help for generic syntax checkers +(define-button-type 'help-flycheck-checker-def + :supertype 'help-xref + 'help-function #'flycheck-goto-checker-definition + 'help-echo "mouse-2, RET: find Flycheck checker definition") + +(defconst flycheck-find-checker-regexp + (rx line-start (zero-or-more (syntax whitespace)) + "(" symbol-start "flycheck-define-checker" symbol-end + (eval (list 'regexp find-function-space-re)) + symbol-start + "%s" + symbol-end + (or (syntax whitespace) line-end)) + "Regular expression to find a checker definition.") + +(add-to-list 'find-function-regexp-alist + '(flycheck-checker . flycheck-find-checker-regexp)) + +(defun flycheck-goto-checker-definition (checker file) + "Go to to the definition of CHECKER in FILE." + (let ((location (find-function-search-for-symbol + checker 'flycheck-checker file))) + (pop-to-buffer (car location)) + (if (cdr location) + (goto-char (cdr location)) + (message "Unable to find checker location in file")))) + +(defun flycheck-checker-at-point () + "Return the Flycheck checker found at or before point. + +Return nil if there is no checker." + (let ((symbol (variable-at-point 'any-symbol))) + (when (flycheck-valid-checker-p symbol) + symbol))) + +(defun flycheck-describe-checker (checker) + "Display the documentation of CHECKER. + +CHECKER is a checker symbol. + +Pop up a help buffer with the documentation of CHECKER." + (interactive + (let* ((enable-recursive-minibuffers t) + (default (or (flycheck-checker-at-point) + (ignore-errors (flycheck-get-checker-for-buffer)))) + (prompt (if default + (format "Describe syntax checker (default %s): " default) + "Describe syntax checker: "))) + (list (read-flycheck-checker prompt default)))) + (unless (flycheck-valid-checker-p checker) + (user-error "You didn't specify a Flycheck syntax checker")) + (help-setup-xref (list #'flycheck-describe-checker checker) + (called-interactively-p 'interactive)) + (save-excursion + (with-help-window (help-buffer) + (let ((filename (flycheck-checker-get checker 'file)) + (modes (flycheck-checker-get checker 'modes)) + (predicate (flycheck-checker-get checker 'predicate)) + (print-doc (flycheck-checker-get checker 'print-doc)) + (next-checkers (flycheck-checker-get checker 'next-checkers))) + (princ (format "%s is a Flycheck syntax checker" checker)) + (when filename + (princ (format " in `%s'" (file-name-nondirectory filename))) + (with-current-buffer standard-output + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-flycheck-checker-def checker filename)))) + (princ ".\n\n") + + (let ((modes-start (with-current-buffer standard-output (point-max)))) + ;; Track the start of the modes documentation, to properly re-fill + ;; it later + (princ " This syntax checker checks syntax in the major mode(s) ") + (princ (string-join + (seq-map (apply-partially #'format "`%s'") modes) + ", ")) + (when predicate + (princ ", and uses a custom predicate")) + (princ ".") + (when next-checkers + (princ " It runs the following checkers afterwards:")) + (with-current-buffer standard-output + (save-excursion + (fill-region-as-paragraph modes-start (point-max)))) + (princ "\n") + + ;; Print the list of next checkers + (when next-checkers + (princ "\n") + (let ((beg-checker-list (with-current-buffer standard-output + (point)))) + (dolist (next-checker next-checkers) + (if (symbolp next-checker) + (princ (format " * `%s'\n" next-checker)) + (princ (format " * `%s' (maximum level `%s')\n" + (cdr next-checker) (car next-checker))))) + ;; + (with-current-buffer standard-output + (save-excursion + (while (re-search-backward "`\\([^`']+\\)'" + beg-checker-list t) + (when (flycheck-valid-checker-p + (intern-soft (match-string 1))) + (help-xref-button 1 'help-flycheck-checker-def checker + filename)))))))) + ;; Call the custom print-doc function of the checker, if present + (when print-doc + (funcall print-doc checker)) + ;; Ultimately, print the docstring + (princ "\nDocumentation:\n") + (princ (flycheck-checker-get checker 'documentation)))))) + + +;;; Syntax checker verification +(cl-defstruct (flycheck-verification-result + (:constructor flycheck-verification-result-new)) + "Structure for storing a single verification result. + +Slots: + +`label' + A label for this result, as string + +`message' + A message for this result, as string + +`face' + The face to use for the `message'. + + You can either use a face symbol, or a list of face symbols." + label message face) + +(defun flycheck-verify-generic-checker (checker) + "Verify a generic CHECKER in the current buffer. + +Return a list of `flycheck-verification-result' objects." + (let (results + (predicate (flycheck-checker-get checker 'predicate)) + (verify (flycheck-checker-get checker 'verify))) + (when predicate + (let ((result (funcall predicate))) + (push (flycheck-verification-result-new + :label "predicate" + :message (prin1-to-string (not (null result))) + :face (if result 'success '(bold warning))) + results))) + (append (nreverse results) + (and verify (funcall verify checker))))) + +(define-button-type 'help-flycheck-checker-doc + :supertype 'help-xref + 'help-function #'flycheck-describe-checker + 'help-echo "mouse-2, RET: describe Flycheck checker") + +(defun flycheck--verify-princ-checker (checker buffer &optional with-mm) + "Print verification result of CHECKER for BUFFER. + +When WITH-MM is given and non-nil, also include the major mode +into the verification results." + (princ " ") + (insert-button (symbol-name checker) + 'type 'help-flycheck-checker-doc + 'help-args (list checker)) + (when (with-current-buffer buffer (flycheck-disabled-checker-p checker)) + (insert (propertize " (disabled)" 'face '(bold error)))) + (princ "\n") + (let ((results (with-current-buffer buffer + (flycheck-verify-generic-checker checker)))) + (when with-mm + (with-current-buffer buffer + (let ((message-and-face + (if (flycheck-checker-supports-major-mode-p checker major-mode) + (cons (format "`%s' supported" major-mode) 'success) + (cons (format "`%s' not supported" major-mode) 'error)))) + (push (flycheck-verification-result-new + :label "major mode" + :message (car message-and-face) + :face (cdr message-and-face)) + results)))) + (let* ((label-length + (seq-max (mapcar + (lambda (res) + (length (flycheck-verification-result-label res))) + results))) + (message-column (+ 8 label-length))) + (dolist (result results) + (princ " - ") + (princ (flycheck-verification-result-label result)) + (princ ": ") + (princ (make-string (- message-column (current-column)) ?\ )) + (let ((message (flycheck-verification-result-message result)) + (face (flycheck-verification-result-face result))) + (insert (propertize message 'face face))) + (princ "\n")))) + (princ "\n")) + +(defun flycheck--verify-print-header (desc buffer) + "Print a title with DESC for BUFFER in the current buffer. + +DESC is an arbitrary string containing a description, and BUFFER +is the buffer being verified. The name and the major mode mode +of BUFFER are printed. + +DESC and information about BUFFER are printed in the current +buffer." + (princ desc) + (insert (propertize (buffer-name buffer) 'face 'bold)) + (princ " in ") + (let ((mode (buffer-local-value 'major-mode buffer))) + (insert-button (symbol-name mode) + 'type 'help-function + 'help-args (list mode))) + (princ ":\n\n")) + +(defun flycheck--verify-print-footer (buffer) + "Print a footer for BUFFER in the current buffer. + +BUFFER is the buffer being verified." + (princ "Flycheck Mode is ") + (let ((enabled (buffer-local-value 'flycheck-mode buffer))) + (insert (propertize (if enabled "enabled" "disabled") + 'face (if enabled 'success '(warning bold))))) + (princ + (with-current-buffer buffer + ;; Use key binding state in the verified buffer to print the help. + (substitute-command-keys + ". Use \\[universal-argument] \\[flycheck-disable-checker] to enable disabled checkers."))) + (save-excursion + (let ((end (point))) + (backward-paragraph) + (fill-region-as-paragraph (point) end))) + + (princ "\n\n--------------------\n\n") + (princ (format "Flycheck version: %s\n" (flycheck-version))) + (princ (format "Emacs version: %s\n" emacs-version)) + (princ (format "System: %s\n" system-configuration)) + (princ (format "Window system: %S\n" window-system))) + +(defun flycheck-verify-checker (checker) + "Check whether a CHECKER can be used in this buffer. + +Show a buffer listing possible problems that prevent CHECKER from +being used for the current buffer. + +Note: Do not use this function to check whether a syntax checker +is applicable from Emacs Lisp code. Use +`flycheck-may-use-checker' instead." + (interactive (list (read-flycheck-checker "Checker to verify: "))) + (unless (flycheck-valid-checker-p checker) + (user-error "%s is not a syntax checker" checker)) + + ;; Save the buffer to make sure that all predicates are good + (when (and (buffer-file-name) (buffer-modified-p)) + (save-buffer)) + + (let ((buffer (current-buffer))) + (with-help-window (get-buffer-create " *Flycheck checker*") + (with-current-buffer standard-output + (flycheck--verify-print-header "Syntax checker in buffer " buffer) + (flycheck--verify-princ-checker checker buffer 'with-mm) + (if (with-current-buffer buffer (flycheck-may-use-checker checker)) + (insert (propertize "Flycheck can use this syntax checker for this buffer.\n" + 'face 'success)) + (insert (propertize "Flycheck cannot use this syntax checker for this buffer.\n" + 'face 'error))) + (insert "\n") + (flycheck--verify-print-footer buffer))))) + +(defun flycheck-verify-setup () + "Check whether Flycheck can be used in this buffer. + +Display a new buffer listing all syntax checkers that could be +applicable in the current buffer. For each syntax checkers, +possible problems are shown." + (interactive) + (when (and (buffer-file-name) (buffer-modified-p)) + ;; Save the buffer + (save-buffer)) + + (let ((buffer (current-buffer)) + (checkers (flycheck-possibly-suitable-checkers))) + + ;; Now print all applicable checkers + (with-help-window (get-buffer-create " *Flycheck checkers*") + (with-current-buffer standard-output + (flycheck--verify-print-header "Syntax checkers for buffer " buffer) + (unless checkers + (insert (propertize "There are no syntax checkers for this buffer!\n\n" + 'face '(bold error)))) + (dolist (checker checkers) + (flycheck--verify-princ-checker checker buffer)) + + (-when-let (selected-checker (buffer-local-value 'flycheck-checker buffer)) + (insert (propertize "The following checker is explicitly selected for this buffer:\n\n" + 'face 'bold)) + (flycheck--verify-princ-checker selected-checker buffer 'with-mm)) + + (let ((unregistered-checkers (seq-difference (flycheck-defined-checkers) + flycheck-checkers))) + (when unregistered-checkers + (insert (propertize "\nThe following syntax checkers are not registered:\n\n" + 'face '(bold warning))) + (dolist (checker unregistered-checkers) + (princ " - ") + (princ checker) + (princ "\n")) + (princ "\nTry adding these syntax checkers to `flycheck-checkers'.\n"))) + + (flycheck--verify-print-footer buffer))))) + + +;;; Predicates for generic syntax checkers +(defun flycheck-buffer-saved-p (&optional buffer) + "Determine whether BUFFER is saved to a file. + +BUFFER is the buffer to check. If omitted or nil, use the +current buffer as BUFFER. + +Return non-nil if the BUFFER is backed by a file, and not +modified, or nil otherwise." + (and (buffer-file-name buffer) (not (buffer-modified-p buffer)))) + + +;;; Extending generic checkers +(defun flycheck-add-next-checker (checker next &optional append) + "After CHECKER add a NEXT checker. + +CHECKER is a syntax checker symbol, to which to add NEXT checker. + +NEXT is a cons cell `(LEVEL . NEXT-CHECKER)'. NEXT-CHECKER is a +symbol denoting the syntax checker to run after CHECKER. LEVEL +is an error level. NEXT-CHECKER will only be used if there is no +current error whose level is more severe than LEVEL. LEVEL may +also be t, in which case NEXT-CHECKER is used regardless of the +current errors. + +NEXT can also be a syntax checker symbol only, which is +equivalent to `(t . NEXT)'. + +NEXT-CHECKER is prepended before other next checkers, unless +APPEND is non-nil." + (unless (flycheck-valid-checker-p checker) + (error "%s is not a valid syntax checker" checker)) + (flycheck-validate-next-checker next 'strict) + (if append + (setf (flycheck-checker-get checker 'next-checkers) + (append (flycheck-checker-get checker 'next-checkers) (list next))) + (push next (flycheck-checker-get checker 'next-checkers)))) + +(defun flycheck-add-mode (checker mode) + "To CHECKER add a new major MODE. + +CHECKER and MODE are symbols denoting a syntax checker and a +major mode respectively. + +Add MODE to the `:modes' property of CHECKER, so that CHECKER +will be used in buffers with MODE." + (unless (flycheck-valid-checker-p checker) + (error "%s is not a valid syntax checker" checker)) + (unless (symbolp mode) + (error "%s is not a symbol" mode)) + (push mode (flycheck-checker-get checker 'modes))) + + +;;; Generic syntax checks +(cl-defstruct (flycheck-syntax-check + (:constructor flycheck-syntax-check-new)) + "Structure for storing syntax check state. + +Slots: + +`buffer' + The buffer being checked. + +`checker' + The syntax checker being used. + +`context' + The context object. + +`working-directory' + Working directory for the syntax checker. Serve as a value for + `default-directory' for a checker." + buffer checker context working-directory) + +(defun flycheck-syntax-check-start (syntax-check callback) + "Start a SYNTAX-CHECK with CALLBACK." + (let ((checker (flycheck-syntax-check-checker syntax-check)) + (default-directory (flycheck-syntax-check-working-directory syntax-check))) + (setf (flycheck-syntax-check-context syntax-check) + (funcall (flycheck-checker-get checker 'start) checker callback)))) + +(defun flycheck-syntax-check-interrupt (syntax-check) + "Interrupt a SYNTAX-CHECK." + (let* ((checker (flycheck-syntax-check-checker syntax-check)) + (interrupt-fn (flycheck-checker-get checker 'interrupt)) + (context (flycheck-syntax-check-context syntax-check))) + (when interrupt-fn + (funcall interrupt-fn checker context)))) + + +;;; Syntax checking mode + +(defvar flycheck-mode-map + (let ((map (make-sparse-keymap))) + (define-key map flycheck-keymap-prefix flycheck-command-map) + ;; We place the menu under a custom menu key. Since this menu key is not + ;; present in the menu of the global map, no top-level menu entry is added + ;; to the global menu bar. However, it still appears on the mode line + ;; lighter. + (define-key map [menu-bar flycheck] flycheck-mode-menu-map) + map) + "Keymap of command `flycheck-mode'.") + +(defvar-local flycheck-old-next-error-function nil + "Remember the old `next-error-function'.") + +(defconst flycheck-hooks-alist + '( + ;; Handle events that may start automatic syntax checks + (after-save-hook . flycheck-handle-save) + (after-change-functions . flycheck-handle-change) + ;; Handle events that may triggered pending deferred checks + (window-configuration-change-hook . flycheck-perform-deferred-syntax-check) + (post-command-hook . flycheck-perform-deferred-syntax-check) + ;; Teardown Flycheck whenever the buffer state is about to get lost, to + ;; clean up temporary files and directories. + (kill-buffer-hook . flycheck-teardown) + (change-major-mode-hook . flycheck-teardown) + (before-revert-hook . flycheck-teardown) + ;; Update the error list if necessary + (post-command-hook . flycheck-error-list-update-source) + (post-command-hook . flycheck-error-list-highlight-errors) + ;; Display errors. Show errors at point after commands (like movements) and + ;; when Emacs gets focus. Cancel the display timer when Emacs looses focus + ;; (as there's no need to display errors if the user can't see them), and + ;; hide the error buffer (for large error messages) if necessary. Note that + ;; the focus hooks only work on Emacs 24.4 and upwards, but since undefined + ;; hooks are perfectly ok we don't need a version guard here. They'll just + ;; not work silently. + (post-command-hook . flycheck-display-error-at-point-soon) + (focus-in-hook . flycheck-display-error-at-point-soon) + (focus-out-hook . flycheck-cancel-error-display-error-at-point-timer) + (post-command-hook . flycheck-hide-error-buffer) + ;; Immediately show error popups when navigating to an error + (next-error-hook . flycheck-display-error-at-point)) + "Hooks which Flycheck needs to hook in. + +The `car' of each pair is a hook variable, the `cdr' a function +to be added or removed from the hook variable if Flycheck mode is +enabled and disabled respectively.") + +;;;###autoload +(define-minor-mode flycheck-mode + "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}" + :init-value nil + :keymap flycheck-mode-map + :lighter flycheck-mode-line + :after-hook (flycheck-buffer-automatically 'mode-enabled 'force-deferred) + (cond + (flycheck-mode + (flycheck-clear) + + (pcase-dolist (`(,hook . ,fn) flycheck-hooks-alist) + (add-hook hook fn nil 'local)) + + (setq flycheck-old-next-error-function (if flycheck-standard-error-navigation + next-error-function + :unset)) + (when flycheck-standard-error-navigation + (setq next-error-function #'flycheck-next-error-function))) + (t + (unless (eq flycheck-old-next-error-function :unset) + (setq next-error-function flycheck-old-next-error-function)) + + (pcase-dolist (`(,hook . ,fn) flycheck-hooks-alist) + (remove-hook hook fn 'local)) + + (flycheck-teardown)))) + + +;;; Syntax checker selection for the current buffer +(defun flycheck-get-checker-for-buffer () + "Find the checker for the current buffer. + +Use the selected checker for the current buffer, if any, +otherwise search for the best checker from `flycheck-checkers'. + +Return checker if there is a checker for the current buffer, or +nil otherwise." + (if flycheck-checker + (if (flycheck-may-use-checker flycheck-checker) + flycheck-checker + (error "Flycheck cannot use %s in this buffer, type M-x flycheck-verify-setup for more details" + flycheck-checker)) + (seq-find #'flycheck-may-use-checker flycheck-checkers))) + +(defun flycheck-get-next-checker-for-buffer (checker) + "Get the checker to run after CHECKER for the current buffer." + (let ((next (seq-find #'flycheck-may-use-next-checker + (flycheck-checker-get checker 'next-checkers)))) + (when next + (if (symbolp next) next (cdr next))))) + +(defun flycheck-select-checker (checker) + "Select CHECKER for the current buffer. + +CHECKER is a syntax checker symbol (see `flycheck-checkers') or +nil. In the former case, use CHECKER for the current buffer, +otherwise deselect the current syntax checker (if any) and use +automatic checker selection via `flycheck-checkers'. + +If called interactively prompt for CHECKER. With prefix arg +deselect the current syntax checker and enable automatic +selection again. + +Set `flycheck-checker' to CHECKER and automatically start a new +syntax check if the syntax checker changed. + +CHECKER will be used, even if it is not contained in +`flycheck-checkers', or if it is disabled via +`flycheck-disabled-checkers'." + (interactive + (if current-prefix-arg + (list nil) + (list (read-flycheck-checker "Select checker: " + (flycheck-get-checker-for-buffer))))) + (when (not (eq checker flycheck-checker)) + (unless (or (not checker) (flycheck-may-use-checker checker)) + (flycheck-verify-checker checker) + (user-error "Can't use syntax checker %S in this buffer" checker)) + (setq flycheck-checker checker) + (when flycheck-mode + (flycheck-buffer)))) + +(defun flycheck-disable-checker (checker &optional enable) + "Interactively disable CHECKER for the current buffer. + +Interactively, prompt for a syntax checker to disable, and add +the syntax checker to the buffer-local value of +`flycheck-disabled-checkers'. + +With non-nil ENABLE or with prefix arg, prompt for a disabled +syntax checker and re-enable it by removing it from the +buffer-local value of `flycheck-disabled-checkers'." + (declare (interactive-only "Directly set `flycheck-disabled-checkers' instead")) + (interactive + (let* ((enable current-prefix-arg) + (candidates (if enable flycheck-disabled-checkers flycheck-checkers)) + (prompt (if enable "Enable syntax checker: " + "Disable syntax checker: "))) + (when (and enable (not candidates)) + (user-error "No syntax checkers disabled in this buffer")) + (list (read-flycheck-checker prompt nil nil candidates) enable))) + (unless checker + (user-error "No syntax checker given")) + (if enable + ;; We must use `remq' instead of `delq', because we must _not_ modify the + ;; list. Otherwise we could potentially modify the global default value, + ;; in case the list is the global default. + (when (memq checker flycheck-disabled-checkers) + (setq flycheck-disabled-checkers + (remq checker flycheck-disabled-checkers)) + (flycheck-buffer)) + (unless (memq checker flycheck-disabled-checkers) + (push checker flycheck-disabled-checkers) + (flycheck-buffer)))) + + +;;; Syntax checks for the current buffer +(defvar-local flycheck-current-syntax-check nil + "The current syntax check in the this buffer.") +(put 'flycheck-current-syntax-check 'permanent-local t) + +(defun flycheck-start-current-syntax-check (checker) + "Start a syntax check in the current buffer with CHECKER. + +Set `flycheck-current-syntax-check' accordingly." + ;; Allocate the current syntax check *before* starting it. This allows for + ;; synchronous checks, which call the status callback immediately in there + ;; start function. + (let* ((check (flycheck-syntax-check-new + :buffer (current-buffer) + :checker checker + :context nil + :working-directory (flycheck-compute-working-directory checker))) + (callback (flycheck-buffer-status-callback check))) + (setq flycheck-current-syntax-check check) + (flycheck-report-status 'running) + (flycheck-syntax-check-start check callback))) + +(defun flycheck-running-p () + "Determine whether a syntax check is running in the current buffer." + (not (null flycheck-current-syntax-check))) + +(defun flycheck-stop () + "Stop any ongoing syntax check in the current buffer." + (when (flycheck-running-p) + (flycheck-syntax-check-interrupt flycheck-current-syntax-check) + ;; Remove the current syntax check, to reset Flycheck into a non-running + ;; state, and to make `flycheck-report-buffer-checker-status' ignore any + ;; status reports from the current syntax check. + (setq flycheck-current-syntax-check nil) + (flycheck-report-status 'interrupted))) + +(defun flycheck-buffer-status-callback (syntax-check) + "Create a status callback for SYNTAX-CHECK in the current buffer." + (lambda (&rest args) + (apply #'flycheck-report-buffer-checker-status + syntax-check args))) + +(defun flycheck-buffer () + "Start checking syntax in the current buffer. + +Get a syntax checker for the current buffer with +`flycheck-get-checker-for-buffer', and start it." + (interactive) + (flycheck-clean-deferred-check) + (if flycheck-mode + (unless (flycheck-running-p) + ;; Clear error list and mark all overlays for deletion. We do not + ;; delete all overlays immediately to avoid excessive re-displays and + ;; flickering, if the same errors gets highlighted again after the check + ;; completed. + (run-hooks 'flycheck-before-syntax-check-hook) + (flycheck-clear-errors) + (flycheck-mark-all-overlays-for-deletion) + (condition-case err + (let* ((checker (flycheck-get-checker-for-buffer))) + (if checker + (flycheck-start-current-syntax-check checker) + (flycheck-clear) + (flycheck-report-status 'no-checker))) + (error + (flycheck-report-failed-syntax-check) + (signal (car err) (cdr err))))) + (user-error "Flycheck mode disabled"))) + +(defun flycheck-report-buffer-checker-status + (syntax-check status &optional data) + "In BUFFER, report a SYNTAX-CHECK STATUS with DATA. + +SYNTAX-CHECK is the `flycheck-syntax-check' which reported +STATUS. STATUS denotes the status of CHECKER, with an optional +DATA. STATUS may be one of the following symbols: + +`errored' + The syntax checker has errored. DATA is an optional error + message. + + This report finishes the current syntax check. + +`interrupted' + The syntax checker was interrupted. DATA is ignored. + + This report finishes the current syntax check. + +`finished' + The syntax checker has finished with a proper error report + for the current buffer. DATA is the (potentially empty) + list of `flycheck-error' objects reported by the syntax + check. + + This report finishes the current syntax check. + +`suspicious' + The syntax checker encountered a suspicious state, which the + user needs to be informed about. DATA is an optional + message. + +A syntax checker _must_ report a status at least once with any +symbol that finishes the current syntax checker. Otherwise +Flycheck gets stuck with the current syntax check. + +If CHECKER is not the currently used syntax checker in +`flycheck-current-syntax-check', the status report is largely +ignored. Notably, any errors reported by the checker are +discarded." + (let ((buffer (flycheck-syntax-check-buffer syntax-check))) + ;; Ignore the status report if the buffer is gone, or if this syntax check + ;; isn't the current one in buffer (which can happen if this is an old + ;; report of an interrupted syntax check, and a new syntax check was started + ;; since this check was interrupted) + (when (and (buffer-live-p buffer) + (eq syntax-check + (buffer-local-value 'flycheck-current-syntax-check buffer))) + (with-current-buffer buffer + (let ((checker (flycheck-syntax-check-checker syntax-check))) + (pcase status + ((or `errored `interrupted) + (flycheck-report-failed-syntax-check status) + (when (eq status 'errored) + ;; In case of error, show the error message + (message "Error from syntax checker %s: %s" + checker (or data "UNKNOWN!")))) + (`suspicious + (when flycheck-mode + (message "Suspicious state from syntax checker %s: %s" + checker (or data "UNKNOWN!"))) + (flycheck-report-status 'suspicious)) + (`finished + (when flycheck-mode + ;; Only report errors from the checker if Flycheck Mode is + ;; still enabled. + (flycheck-finish-current-syntax-check + data + (flycheck-syntax-check-working-directory syntax-check)))) + (_ + (error "Unknown status %s from syntax checker %s" + status checker)))))))) + +(defun flycheck-finish-current-syntax-check (errors cwd) + "Finish the current syntax-check in the current buffer with ERRORS. + +ERRORS is a list of `flycheck-error' objects reported by the +current syntax check in `flycheck-current-syntax-check'. + +Report all ERRORS and potentially start any next syntax checkers. + +If the current syntax checker reported excessive errors, it is disabled +via `flycheck-disable-excessive-checker' for subsequent syntax +checks. + +Relative file names in ERRORS will be expanded relative to CWD directory." + (let* ((syntax-check flycheck-current-syntax-check) + (checker (flycheck-syntax-check-checker syntax-check)) + (errors (flycheck-relevant-errors + (flycheck-fill-and-expand-error-file-names + (flycheck-filter-errors + (flycheck-assert-error-list-p errors) checker) + cwd)))) + (unless (flycheck-disable-excessive-checker checker errors) + (flycheck-report-current-errors errors)) + (let ((next-checker (flycheck-get-next-checker-for-buffer checker))) + (if next-checker + (flycheck-start-current-syntax-check next-checker) + (setq flycheck-current-syntax-check nil) + (flycheck-report-status 'finished) + ;; Delete overlays only after the very last checker has run, to avoid + ;; flickering on intermediate re-displays + (flycheck-delete-marked-overlays) + (flycheck-error-list-refresh) + (run-hooks 'flycheck-after-syntax-check-hook) + (when (eq (current-buffer) (window-buffer)) + (flycheck-display-error-at-point)) + ;; Immediately try to run any pending deferred syntax check, which + ;; were triggered by intermediate automatic check event, to make sure + ;; that we quickly refine outdated error information + (flycheck-perform-deferred-syntax-check))))) + +(defun flycheck-disable-excessive-checker (checker errors) + "Disable CHECKER if it reported excessive ERRORS. + +If ERRORS has more items than `flycheck-checker-error-threshold', +add CHECKER to `flycheck-disabled-checkers', and show a warning. + +Return t when CHECKER was disabled, or nil otherwise." + (when (and flycheck-checker-error-threshold + (> (length errors) flycheck-checker-error-threshold)) + ;; Disable CHECKER for this buffer (`flycheck-disabled-checkers' is a local + ;; variable). + (lwarn '(flycheck syntax-checker) :warning + "Syntax checker %s reported too many errors (%s) and is disabled." + checker (length errors)) + (push checker flycheck-disabled-checkers) + t)) + +(defun flycheck-clear (&optional shall-interrupt) + "Clear all errors in the current buffer. + +With prefix arg or SHALL-INTERRUPT non-nil, also interrupt the +current syntax check." + (interactive "P") + (when shall-interrupt + (flycheck-stop)) + (flycheck-delete-all-overlays) + (flycheck-clear-errors) + (flycheck-error-list-refresh) + (flycheck-hide-error-buffer)) + +(defun flycheck-teardown () + "Teardown Flycheck in the current buffer.. + +Completely clear the whole Flycheck state. Remove overlays, kill +running checks, and empty all variables used by Flycheck." + (flycheck-safe-delete-temporaries) + (flycheck-stop) + (flycheck-clean-deferred-check) + (flycheck-clear) + (flycheck-cancel-error-display-error-at-point-timer)) + + +;;; Automatic syntax checking in a buffer +(defun flycheck-may-check-automatically (&optional condition) + "Determine whether the buffer may be checked under CONDITION. + +Read-only buffers may never be checked automatically. + +If CONDITION is non-nil, determine whether syntax may checked +automatically according to +`flycheck-check-syntax-automatically'." + (and (not (or buffer-read-only (flycheck-ephemeral-buffer-p))) + (file-exists-p default-directory) + (or (not condition) + (memq condition flycheck-check-syntax-automatically)))) + +(defun flycheck-buffer-automatically (&optional condition force-deferred) + "Automatically check syntax at CONDITION. + +Syntax is not checked if `flycheck-may-check-automatically' +returns nil for CONDITION. + +The syntax check is deferred if FORCE-DEFERRED is non-nil, or if +`flycheck-must-defer-check' returns t." + (when (and flycheck-mode (flycheck-may-check-automatically condition)) + (if (or force-deferred (flycheck-must-defer-check)) + (flycheck-buffer-deferred) + (with-demoted-errors "Error while checking syntax automatically: %S" + (flycheck-buffer))))) + +(defvar-local flycheck-idle-change-timer nil + "Timer to mark the idle time since the last change.") + +(defun flycheck-clear-idle-change-timer () + "Clear the idle change timer." + (when flycheck-idle-change-timer + (cancel-timer flycheck-idle-change-timer) + (setq flycheck-idle-change-timer nil))) + +(defun flycheck-handle-change (beg end _len) + "Handle a buffer change between BEG and END. + +BEG and END mark the beginning and end of the change text. _LEN +is ignored. + +Start a syntax check if a new line has been inserted into the +buffer." + ;; Save and restore the match data, as recommended in (elisp)Change Hooks + (save-match-data + (when flycheck-mode + ;; The buffer was changed, thus clear the idle timer + (flycheck-clear-idle-change-timer) + (if (string-match-p (rx "\n") (buffer-substring beg end)) + (flycheck-buffer-automatically 'new-line 'force-deferred) + (setq flycheck-idle-change-timer + (run-at-time flycheck-idle-change-delay nil + #'flycheck-handle-idle-change)))))) + +(defun flycheck-handle-idle-change () + "Handle an expired idle time since the last change." + (flycheck-clear-idle-change-timer) + (flycheck-buffer-automatically 'idle-change)) + +(defun flycheck-handle-save () + "Handle a save of the buffer." + (flycheck-buffer-automatically 'save)) + + +;;; Deferred syntax checking +(defvar-local flycheck-deferred-syntax-check nil + "If non-nil, a deferred syntax check is pending.") + +(defun flycheck-must-defer-check () + "Determine whether the syntax check has to be deferred. + +A check has to be deferred if the buffer is not visible, or if the buffer is +currently being reverted. + +Return t if the check is to be deferred, or nil otherwise." + (or (not (get-buffer-window)) + ;; We defer the syntax check if Flycheck is already running, to + ;; immediately start a new syntax check after the current one finished, + ;; because the result of the current check will most likely be outdated by + ;; the time it is finished. + (flycheck-running-p) + ;; We must defer checks while a buffer is being reverted, to avoid race + ;; conditions while the buffer contents are being restored. + revert-buffer-in-progress-p)) + +(defun flycheck-deferred-check-p () + "Determine whether the current buffer has a deferred check. + +Return t if so, or nil otherwise." + flycheck-deferred-syntax-check) + +(defun flycheck-buffer-deferred () + "Defer syntax check for the current buffer." + (setq flycheck-deferred-syntax-check t)) + +(defun flycheck-clean-deferred-check () + "Clean an deferred syntax checking state." + (setq flycheck-deferred-syntax-check nil)) + +(defun flycheck-perform-deferred-syntax-check () + "Perform the deferred syntax check." + (when (flycheck-deferred-check-p) + (flycheck-clean-deferred-check) + (flycheck-buffer-automatically))) + + +;;; Syntax checking in all buffers +(defun flycheck-may-enable-mode () + "Determine whether Flycheck mode may be enabled. + +Flycheck mode is not enabled for + +- the minibuffer, +- `fundamental-mode' +- major modes whose `mode-class' property is `special', +- ephemeral buffers (see `flycheck-ephemeral-buffer-p'), +- encrypted buffers (see `flycheck-encrypted-buffer-p'), +- remote files (see `file-remote-p'), +- and major modes excluded by `flycheck-global-modes'. + +Return non-nil if Flycheck mode may be enabled, and nil +otherwise." + (and (pcase flycheck-global-modes + ;; Whether `major-mode' is disallowed by `flycheck-global-modes' + (`t t) + (`(not . ,modes) (not (memq major-mode modes))) + (modes (memq major-mode modes))) + (not (or (minibufferp) + (eq major-mode 'fundamental-mode) + (eq (get major-mode 'mode-class) 'special) + (flycheck-ephemeral-buffer-p) + (flycheck-encrypted-buffer-p) + (and (buffer-file-name) + (file-remote-p (buffer-file-name) 'method)))))) + +(defun flycheck-mode-on-safe () + "Enable command `flycheck-mode' if it is safe to do so. + +Command `flycheck-mode' is only enabled if +`flycheck-may-enable-mode' returns a non-nil result." + (when (flycheck-may-enable-mode) + (flycheck-mode))) + +;;;###autoload +(define-globalized-minor-mode global-flycheck-mode flycheck-mode + flycheck-mode-on-safe + :init-value nil + ;; Do not expose Global Flycheck Mode on customize interface, because the + ;; interaction between package.el and customize is currently broken. See + ;; https://github.com/flycheck/flycheck/issues/595 + + ;; :require 'flycheck :group + ;; 'flycheck + ) + +(defun flycheck-global-teardown () + "Teardown Flycheck in all buffers. + +Completely clear the whole Flycheck state in all buffers, stop +all running checks, remove all temporary files, and empty all +variables of Flycheck." + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when flycheck-mode + (flycheck-teardown))))) + +;; Clean up the entire state of Flycheck when Emacs is killed, to get rid of any +;; pending temporary files. +(add-hook 'kill-emacs-hook #'flycheck-global-teardown) + + +;;; Errors from syntax checks +(cl-defstruct (flycheck-error + (:constructor flycheck-error-new) + (:constructor flycheck-error-new-at (line column + &optional level message + &key checker id + (filename (buffer-file-name)) + (buffer (current-buffer))))) + "Structure representing an error reported by a syntax checker. +Slots: + +`buffer' + The buffer that the error was reported for, as buffer object. + +`checker' + The syntax checker which reported this error, as symbol. + +`filename' + The file name the error refers to, as string. + +`line' + The line number the error refers to, as number. + +`column' (optional) + The column number the error refers to, as number. + + For compatibility with external tools and unlike Emacs + itself (e.g. in Compile Mode) Flycheck uses _1-based_ + columns: The first character on a line is column 1. + + Occasionally some tools try to proactively adapt to Emacs + and emit 0-based columns automatically. In these cases, the + columns must be adjusted for Flycheck, see + `flycheck-increment-error-columns'. + +`level' + The error level, as either `warning' or `error'. + +`id' (optional) + An ID identifying the kind of error." + buffer checker filename line column message level id) + +(defmacro flycheck-error-with-buffer (err &rest forms) + "Switch to the buffer of ERR and evaluate FORMS. + +If the buffer of ERR is not live, FORMS are not evaluated." + (declare (indent 1) (debug t)) + `(when (buffer-live-p (flycheck-error-buffer ,err)) + (with-current-buffer (flycheck-error-buffer ,err) + ,@forms))) + +(defun flycheck-error-line-region (err) + "Get the line region of ERR. + +ERR is a Flycheck error whose region to get. + +Return a cons cell `(BEG . END)' where BEG is the first +non-whitespace character on the line ERR refers to, and END the +end of the line." + (flycheck-error-with-buffer err + (save-restriction + (save-excursion + (widen) + (goto-char (point-min)) + (forward-line (- (flycheck-error-line err) 1)) + ;; We are at the beginning of the line now, so move to the beginning of + ;; its indentation, similar to `back-to-indentation' + (let ((end (line-end-position))) + (skip-syntax-forward " " end) + (backward-prefix-chars) + ;; If the current line is empty, include the previous line break + ;; character(s) to have any region at all. When called with 0, + ;; `line-end-position' gives us the end of the previous line + (cons (if (eolp) (line-end-position 0) (point)) end)))))) + +(defun flycheck-error-column-region (err) + "Get the error column region of ERR. + +ERR is a Flycheck error whose region to get. + +Return a cons cell `(BEG . END)' where BEG is the character +before the error column, and END the actual error column, or nil +if ERR has no column." + (flycheck-error-with-buffer err + (save-restriction + (save-excursion + (-when-let (column (flycheck-error-column err)) + (widen) + (goto-char (point-min)) + (forward-line (- (flycheck-error-line err) 1)) + (cond + ((eobp) ; Line beyond EOF + ;; If we are at the end of the file (i.e. the line was beyond the + ;; end of the file), use the very last column in the file. + (cons (- (point-max) 1) (point-max))) + ((eolp) ; Empty line + ;; If the target line is empty, there's no column to highlight on + ;; this line, so return the last column of the previous line. + (cons (line-end-position 0) (point))) + (t + ;; The end is either the column offset of the line, or the end of + ;; the line, if the column offset points beyond the end of the + ;; line. + (let ((end (min (+ (point) column) + (+ (line-end-position) 1)))) + (cons (- end 1) end))))))))) + +(defun flycheck-error-thing-region (thing err) + "Get the region of THING at the column of ERR. + +ERR is a Flycheck error whose region to get. THING is a +understood by `thing-at-point'. + +Return a cons cell `(BEG . END)' where BEG is the beginning of +the THING at the error column, and END the end of the symbol. If +ERR has no error column, or if there is no THING at this column, +return nil." + (-when-let (column (car (flycheck-error-column-region err))) + (flycheck-error-with-buffer err + (save-excursion + (save-restriction + (widen) + (goto-char column) + (bounds-of-thing-at-point thing)))))) + +(defun flycheck-error-region-for-mode (err mode) + "Get the region of ERR for the highlighting MODE. + +ERR is a Flycheck error. MODE may be one of the following symbols: + +`columns' + Get the column region of ERR, or the line region if ERR + has no column. + +`symbols' + Get the symbol region of ERR, or the result of `columns', if + there is no sexp at the error column. + +`sexps' + Get the sexp region of ERR, or the result of `columns', if + there is no sexp at the error column. + +`lines' + Return the line region. + +Otherwise signal an error." + (pcase mode + (`columns (or (flycheck-error-column-region err) + (flycheck-error-line-region err))) + (`symbols (or (flycheck-error-thing-region 'symbol err) + (flycheck-error-region-for-mode err 'columns))) + (`sexps (or (flycheck-error-thing-region 'sexp err) + (flycheck-error-region-for-mode err 'columns))) + (`lines (flycheck-error-line-region err)) + (_ (error "Invalid mode %S" mode)))) + +(defun flycheck-error-pos (err) + "Get the buffer position of ERR. + +ERR is a Flycheck error whose position to get. + +The error position is the error column, or the first +non-whitespace character of the error line, if ERR has no error column." + (car (or (flycheck-error-column-region err) + (flycheck-error-line-region err)))) + +(defun flycheck-error-format-message-and-id (err) + "Format the message and id of ERR as human-readable string." + (let ((id (flycheck-error-id err)) + (message (flycheck-error-message err))) + (if id (format "%s [%s]" message id) message))) + +(defun flycheck-error-format (err &optional with-file-name) + "Format ERR as human-readable string, optionally WITH-FILE-NAME. + +Return a string that represents the given ERR. If WITH-FILE-NAME +is given and non-nil, include the file-name as well, otherwise +omit it." + (let* ((line (flycheck-error-line err)) + (column (flycheck-error-column err)) + (level (symbol-name (flycheck-error-level err))) + (checker (symbol-name (flycheck-error-checker err))) + (format `(,@(when with-file-name + (list (flycheck-error-filename err) ":")) + ,(number-to-string line) ":" + ,@(when column (list (number-to-string column) ":")) + ,level ": " + ,(flycheck-error-format-message-and-id err) + " (" ,checker ")"))) + (apply #'concat format))) + +(defun flycheck-error-< (err1 err2) + "Determine whether ERR1 is less than ERR2 by location. + +Compare by line numbers and then by column numbers." + (let ((line1 (flycheck-error-line err1)) + (line2 (flycheck-error-line err2))) + (if (= line1 line2) + (let ((col1 (flycheck-error-column err1)) + (col2 (flycheck-error-column err2))) + (and col2 + ;; Sort errors for the whole line first + (or (not col1) (< col1 col2)))) + (< line1 line2)))) + +(defun flycheck-error-level-< (err1 err2) + "Determine whether ERR1 is less than ERR2 by error level. + +Like `flycheck-error-<', but compares by error level severity +first. Levels of the same severity are compared by name." + (let* ((level1 (flycheck-error-level err1)) + (level2 (flycheck-error-level err2)) + (severity1 (flycheck-error-level-severity level1)) + (severity2 (flycheck-error-level-severity level2))) + (cond + ((= severity1 severity2) + (if (string= level1 level2) + (flycheck-error-< err1 err2) + (string< level1 level2))) + (t (< severity1 severity2))))) + +(defun flycheck-assert-error-list-p (errors) + "Assert that all items in ERRORS are of `flycheck-error' type. + +Signal an error if any item in ERRORS is not a `flycheck-error' +object, as by `flycheck-error-p'. Otherwise return ERRORS +again." + (unless (listp errors) + (signal 'wrong-type-argument (list 'listp errors))) + (dolist (err errors) + (unless (flycheck-error-p err) + (signal 'wrong-type-argument (list 'flycheck-error-p err)))) + errors) + + +;;; Errors in the current buffer +(defvar-local flycheck-current-errors nil + "A list of all errors and warnings in the current buffer.") + +(defun flycheck-report-current-errors (errors) + "Report ERRORS in the current buffer. + +Add ERRORS to `flycheck-current-errors' and process each error +with `flycheck-process-error-functions'." + (setq flycheck-current-errors (sort (append errors flycheck-current-errors) + #'flycheck-error-<)) + (seq-do (lambda (err) + (run-hook-with-args-until-success 'flycheck-process-error-functions + err)) + errors)) + +(defun flycheck-clear-errors () + "Remove all error information from the current buffer." + (setq flycheck-current-errors nil) + (flycheck-report-status 'not-checked)) + +(defun flycheck-fill-and-expand-error-file-names (errors cwd) + "Fill and expand file names in ERRORS. + +Expand all file names of ERRORS against the CWD directory. +If the file name of an error is nil fill in the result of +function `buffer-file-name' in the current buffer. + +Return ERRORS, modified in-place." + (seq-do (lambda (err) + (setf (flycheck-error-filename err) + (-if-let (filename (flycheck-error-filename err)) + (expand-file-name filename cwd) + (buffer-file-name)))) + errors) + errors) + +(defun flycheck-relevant-error-p (err) + "Determine whether ERR is relevant for the current buffer. + +Return t if ERR may be shown for the current buffer, or nil +otherwise." + (flycheck-error-with-buffer err + (let ((file-name (flycheck-error-filename err)) + (message (flycheck-error-message err))) + (and + (or (not file-name) (flycheck-same-files-p file-name (buffer-file-name))) + message + (not (string-empty-p message)) + (flycheck-error-line err))))) + +(defun flycheck-relevant-errors (errors) + "Filter the relevant errors from ERRORS. + +Return a list of all errors that are relevant for their +corresponding buffer." + (seq-filter #'flycheck-relevant-error-p errors)) + + +;;; Status reporting for the current buffer +(defvar-local flycheck-last-status-change 'not-checked + "The last status change in the current buffer.") + +(defun flycheck-report-failed-syntax-check (&optional status) + "Report a failed Flycheck syntax check with STATUS. + +STATUS is a status symbol for `flycheck-report-status', +defaulting to `errored'. + +Clear Flycheck state, run `flycheck-syntax-check-failed-hook' and +report an error STATUS." + (flycheck-clear) + (setq flycheck-current-syntax-check nil) + (run-hooks 'flycheck-syntax-check-failed-hook) + (flycheck-report-status (or status 'errored))) + +(defun flycheck-report-status (status) + "Report Flycheck STATUS. + +STATUS is one of the following symbols: + +`not-checked' + The current buffer was not checked. + +`no-checker' + Automatic syntax checker selection did not find a suitable + syntax checker. + +`running' + A syntax check is now running in the current buffer. + +`errored' + The current syntax check has errored. + +`finished' + The current syntax check was finished normally. + +`interrupted' + The current syntax check was interrupted. + +`suspicious' + The last syntax check had a suspicious result. + +Set `flycheck-last-status-change' and call +`flycheck-status-changed-functions' with STATUS. Afterwards +refresh the mode line." + (setq flycheck-last-status-change status) + (run-hook-with-args 'flycheck-status-changed-functions status) + (force-mode-line-update)) + +(defun flycheck-mode-line-status-text (&optional status) + "Get a text describing STATUS for use in the mode line. + +STATUS defaults to `flycheck-last-status-change' if omitted or +nil." + (let ((text (pcase (or status flycheck-last-status-change) + (`not-checked "") + (`no-checker "-") + (`running "*") + (`errored "!") + (`finished + (let-alist (flycheck-count-errors flycheck-current-errors) + (if (or .error .warning) + (format ":%s/%s" (or .error 0) (or .warning 0)) + ""))) + (`interrupted "-") + (`suspicious "?")))) + (concat " " flycheck-mode-line-prefix text))) + + +;;; Error levels +;;;###autoload +(defun flycheck-define-error-level (level &rest properties) + "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'." + (declare (indent 1)) + (setf (get level 'flycheck-error-level) t) + (setf (get level 'flycheck-error-severity) + (or (plist-get properties :severity) 0)) + (setf (get level 'flycheck-compilation-level) + (plist-get properties :compilation-level)) + (setf (get level 'flycheck-overlay-category) + (plist-get properties :overlay-category)) + (setf (get level 'flycheck-fringe-bitmap-double-arrow) + (plist-get properties :fringe-bitmap)) + (setf (get level 'flycheck-fringe-face) + (plist-get properties :fringe-face)) + (setf (get level 'flycheck-error-list-face) + (plist-get properties :error-list-face))) + +(defun flycheck-error-level-p (level) + "Determine whether LEVEL is a Flycheck error level." + (get level 'flycheck-error-level)) + +(defun flycheck-error-level-severity (level) + "Get the numeric severity of LEVEL." + (or (get level 'flycheck-error-severity) 0)) + +(defun flycheck-error-level-compilation-level (level) + "Get the compilation level for LEVEL." + (get level 'flycheck-compilation-level)) + +(defun flycheck-error-level-overlay-category (level) + "Get the overlay category for LEVEL." + (get level 'flycheck-overlay-category)) + +(defun flycheck-error-level-fringe-bitmap (level) + "Get the fringe bitmap for LEVEL." + (get level 'flycheck-fringe-bitmap-double-arrow)) + +(defun flycheck-error-level-fringe-face (level) + "Get the fringe face for LEVEL." + (get level 'flycheck-fringe-face)) + +(defun flycheck-error-level-error-list-face (level) + "Get the error list face for LEVEL." + (get level 'flycheck-error-list-face)) + +(defun flycheck-error-level-make-fringe-icon (level side) + "Create the fringe icon for LEVEL at SIDE. + +Return a propertized string that shows a fringe bitmap according +to LEVEL and the given fringe SIDE. + +LEVEL is a Flycheck error level defined with +`flycheck-define-error-level', and SIDE is either `left-fringe' +or `right-fringe'. + +Return a propertized string representing the fringe icon, +intended for use as `before-string' of an overlay to actually +show the icon." + (unless (memq side '(left-fringe right-fringe)) + (error "Invalid fringe side: %S" side)) + (propertize "!" 'display + (list side + (flycheck-error-level-fringe-bitmap level) + (flycheck-error-level-fringe-face level)))) + + +;;; Built-in error levels +(when (fboundp 'define-fringe-bitmap) + (define-fringe-bitmap 'flycheck-fringe-bitmap-double-arrow + (vector #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b10011000 + #b01101100 + #b00110110 + #b00011011 + #b00110110 + #b01101100 + #b10011000 + #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b00000000))) + +(setf (get 'flycheck-error-overlay 'face) 'flycheck-error) +(setf (get 'flycheck-error-overlay 'priority) 110) + +(flycheck-define-error-level 'error + :severity 100 + :compilation-level 2 + :overlay-category 'flycheck-error-overlay + :fringe-bitmap 'flycheck-fringe-bitmap-double-arrow + :fringe-face 'flycheck-fringe-error + :error-list-face 'flycheck-error-list-error) + +(setf (get 'flycheck-warning-overlay 'face) 'flycheck-warning) +(setf (get 'flycheck-warning-overlay 'priority) 100) + +(flycheck-define-error-level 'warning + :severity 10 + :compilation-level 1 + :overlay-category 'flycheck-warning-overlay + :fringe-bitmap 'flycheck-fringe-bitmap-double-arrow + :fringe-face 'flycheck-fringe-warning + :error-list-face 'flycheck-error-list-warning) + +(setf (get 'flycheck-info-overlay 'face) 'flycheck-info) +(setf (get 'flycheck-info-overlay 'priority) 90) + +(flycheck-define-error-level 'info + :severity -10 + :compilation-level 0 + :overlay-category 'flycheck-info-overlay + :fringe-bitmap 'flycheck-fringe-bitmap-double-arrow + :fringe-face 'flycheck-fringe-info + :error-list-face 'flycheck-error-list-info) + + +;;; Error filtering +(defun flycheck-filter-errors (errors checker) + "Filter ERRORS from CHECKER. + +Apply the error filter of CHECKER to ERRORs and return the +result. If CHECKER has no error filter, fall back to +`flycheck-sanitize-errors'." + (let ((filter (or (flycheck-checker-get checker 'error-filter) + #'flycheck-sanitize-errors))) + (funcall filter errors))) + +(defun flycheck-sanitize-errors (errors) + "Sanitize ERRORS. + +Sanitize ERRORS by trimming leading and trailing whitespace in +all error messages, and by replacing 0 columns and empty error +messages with nil. + +Returns sanitized ERRORS." + (dolist (err errors) + (flycheck-error-with-buffer err + (let ((message (flycheck-error-message err)) + (column (flycheck-error-column err)) + (id (flycheck-error-id err))) + (when message + (setq message (string-trim message)) + (setf (flycheck-error-message err) + (if (string-empty-p message) nil message))) + (when (and id (string-empty-p id)) + (setf (flycheck-error-id err) nil)) + (when (eq column 0) + (setf (flycheck-error-column err) nil))))) + errors) + +(defun flycheck-remove-error-file-names (file-name errors) + "Remove matching FILE-NAME from ERRORS. + +Use as `:error-filter' for syntax checkers that output faulty +filenames. Flycheck will later fill in the buffer file name. + +Return ERRORS." + (seq-do (lambda (err) + (when (and (flycheck-error-filename err) + (string= (flycheck-error-filename err) file-name)) + (setf (flycheck-error-filename err) nil))) + errors) + errors) + +(defun flycheck-increment-error-columns (errors &optional offset) + "Increment all columns of ERRORS by OFFSET. + +Use this as `:error-filter' if a syntax checker outputs 0-based +columns." + (seq-do (lambda (err) + (let ((column (flycheck-error-column err))) + (when column + (setf (flycheck-error-column err) + (+ column (or offset 1)))))) + errors) + errors) + +(defun flycheck-collapse-error-message-whitespace (errors) + "Collapse whitespace in all messages of ERRORS. + +Return ERRORS." + (dolist (err errors) + (-when-let (message (flycheck-error-message err)) + (setf (flycheck-error-message err) + (replace-regexp-in-string (rx (one-or-more (any space "\n" "\r"))) + " " message 'fixed-case 'literal)))) + errors) + +(defun flycheck-dedent-error-messages (errors) + "Dedent all messages of ERRORS. + +For each error in ERRORS, determine the indentation offset from +the leading whitespace of the first line, and dedent all further +lines accordingly. + +Return ERRORS, with in-place modifications." + (dolist (err errors) + (-when-let (message (flycheck-error-message err)) + (with-temp-buffer + (insert message) + ;; Determine the indentation offset + (goto-char (point-min)) + (back-to-indentation) + (let* ((indent-offset (- (point) (point-min)))) + ;; Now iterate over all lines and dedent each according to + ;; `indent-offset' + (while (not (eobp)) + (back-to-indentation) + ;; If the current line starts with sufficient whitespace, delete the + ;; indendation offset. Otherwise keep the line intact, as we might + ;; loose valuable information + (when (>= (- (point) (line-beginning-position)) indent-offset) + (delete-char (- indent-offset))) + (forward-line 1))) + (delete-trailing-whitespace (point-min) (point-max)) + (setf (flycheck-error-message err) + (buffer-substring-no-properties (point-min) (point-max)))))) + errors) + +(defun flycheck-fold-include-levels (errors sentinel-message) + "Fold levels of ERRORS from included files. + +ERRORS is a list of `flycheck-error' objects. SENTINEL-MESSAGE +is a regular expression matched against the error message to +determine whether the errror denotes errors from an included +file. Alternatively, it is a function that is given an error and +shall return non-nil, if the error denotes errors from an +included file." + (unless (or (stringp sentinel-message) (functionp sentinel-message)) + (error "Sentinel must be string or function: %S" sentinel-message)) + (let ((sentinel (if (functionp sentinel-message) + sentinel-message + (lambda (err) + (string-match-p sentinel-message + (flycheck-error-message err))))) + (remaining-errors errors)) + (while remaining-errors + (let* ((current-error (pop remaining-errors))) + (when (funcall sentinel current-error) + ;; We found an error denoting errors in the included file: + ;; 1. process all subsequent errors until faulty include file is found + ;; 2. process again all subsequent errors until an error has the + ;; current file name again + ;; 3. find the most severe error level + (let ((current-filename (flycheck-error-filename current-error)) + (current-level nil) + (faulty-include-filename nil) + (filename nil) + (done (null remaining-errors))) + + (while (not done) + (setq filename (flycheck-error-filename (car remaining-errors))) + (unless faulty-include-filename + (unless (string= filename current-filename) + (setq faulty-include-filename filename))) + + (let* ((error-in-include (pop remaining-errors)) + (in-include-level (flycheck-error-level error-in-include))) + (unless (funcall sentinel error-in-include) + ;; Ignore nested "included file" errors, we are only + ;; interested in real errors because these define our level + (when (or (not current-level) + (> (flycheck-error-level-severity in-include-level) + (flycheck-error-level-severity current-level))) + (setq current-level in-include-level)))) + + (setq done (or (null remaining-errors) + (and faulty-include-filename + (string= filename current-filename))))) + + (setf (flycheck-error-level current-error) current-level + (flycheck-error-message current-error) + (format "In include %s" faulty-include-filename)))))) + errors)) + +(defun flycheck-dequalify-error-ids (errors) + "De-qualify error ids in ERRORS. + +Remove all qualifications from error ids in ERRORS, by stripping +all leading dotted components from error IDs. For instance, if +the error ID is com.foo.E100, replace it with E100. + +This error filter is mainly useful to simplify error IDs obtained +from parsing Checkstyle XML, which frequently has very verbose +IDs, that include the name of the tool." + (seq-do (lambda (err) + (let ((id (flycheck-error-id err))) + (when id + (setf (flycheck-error-id err) + (replace-regexp-in-string + (rx string-start + (group + (optional (zero-or-more not-newline) ".")) + (one-or-more (not (any "."))) + string-end) + "" id 'fixedcase 'literal 1))))) + errors) + errors) + +(defun flycheck-remove-error-ids (errors) + "Remove all error ids from ERRORS." + (seq-do (lambda (err) (setf (flycheck-error-id err) nil)) errors) + errors) + + +;;; Error analysis +(defun flycheck-count-errors (errors) + "Count the number of ERRORS, grouped by level.. + +Return an alist, where each ITEM is a cons cell whose `car' is an +error level, and whose `cdr' is the number of errors of that +level." + (let (counts-by-level) + (dolist (err errors) + (let* ((level (flycheck-error-level err)) + (item (assq level counts-by-level))) + (if item + (cl-incf (cdr item)) + (push (cons level 1) counts-by-level)))) + counts-by-level)) + +(defun flycheck-has-max-errors-p (errors level) + "Check if there is no error in ERRORS more severe than LEVEL." + (let ((severity (flycheck-error-level-severity level))) + (seq-every-p (lambda (e) (<= (flycheck-error-level-severity + (flycheck-error-level e)) + severity)) + errors))) + +(defun flycheck-has-max-current-errors-p (level) + "Check if there is no current error more severe than LEVEL." + (flycheck-has-max-errors-p flycheck-current-errors level)) + +(defun flycheck-has-errors-p (errors level) + "Determine if there are any ERRORS with LEVEL." + (seq-some (lambda (e) (eq (flycheck-error-level e) level)) errors)) + +(defun flycheck-has-current-errors-p (&optional level) + "Determine if the current buffer has errors with LEVEL. + +If LEVEL is omitted if the current buffer has any errors at all." + (if level + (flycheck-has-errors-p flycheck-current-errors level) + (and flycheck-current-errors t))) + + +;;; Error overlays in the current buffer +(defun flycheck-add-overlay (err) + "Add overlay for ERR. + +Return the created overlay." + ;; We must have a proper error region for the sake of fringe indication, + ;; error display and error navigation, even if the highlighting is disabled. + ;; We erase the highlighting later on in this case + (pcase-let* ((`(,beg . ,end) (flycheck-error-region-for-mode + err (or flycheck-highlighting-mode 'lines))) + (overlay (make-overlay beg end)) + (level (flycheck-error-level err)) + (category (flycheck-error-level-overlay-category level))) + (unless (flycheck-error-level-p level) + (error "Undefined error level: %S" level)) + (setf (overlay-get overlay 'flycheck-overlay) t) + (setf (overlay-get overlay 'flycheck-error) err) + ;; TODO: Consider hooks to re-check if overlay contents change + (setf (overlay-get overlay 'category) category) + (unless flycheck-highlighting-mode + ;; Erase the highlighting from the overlay if requested by the user + (setf (overlay-get overlay 'face) nil)) + (when flycheck-indication-mode + (setf (overlay-get overlay 'before-string) + (flycheck-error-level-make-fringe-icon + level flycheck-indication-mode))) + (setf (overlay-get overlay 'help-echo) #'flycheck-help-echo) + overlay)) + +(defun flycheck-help-echo (_window object pos) + "Construct a tooltip message. + +Most of the actual work is done by calling +`flycheck-help-echo-function' with the appropriate list of +errors. Arguments WINDOW, OBJECT and POS are as described in +info node `(elisp)Special properties', as this function is +intended to be used as the 'help-echo property of flycheck error +overlays." + (-when-let (buf (cond ((bufferp object) object) + ((overlayp object) (overlay-buffer object)))) + (with-current-buffer buf + (-when-let* ((fn flycheck-help-echo-function) + (errs (flycheck-overlay-errors-at pos))) + (funcall fn errs))))) + +(defun flycheck-help-echo-all-error-messages (errs) + "Concatenate error messages and ids from ERRS." + (mapconcat + (lambda (err) + (when err + (if (flycheck-error-message err) + (flycheck-error-format-message-and-id err) + (format "Unknown %s" (flycheck-error-level err))))) + (reverse errs) "\n\n")) + +(defun flycheck-filter-overlays (overlays) + "Get all Flycheck overlays from OVERLAYS." + (seq-filter (lambda (o) (overlay-get o 'flycheck-overlay)) overlays)) + +(defun flycheck-overlays-at (pos) + "Get all Flycheck overlays at POS." + (flycheck-filter-overlays (overlays-at pos))) + +(defun flycheck-overlays-in (beg end) + "Get all Flycheck overlays between BEG and END." + (flycheck-filter-overlays (overlays-in beg end))) + +(defun flycheck-overlay-errors-at (pos) + "Return a list of all flycheck errors overlayed at POS." + (seq-map (lambda (o) (overlay-get o 'flycheck-error)) + (flycheck-overlays-at pos))) + +(defun flycheck-overlay-errors-in (beg end) + "Return a list of all flycheck errors overlayed between BEG and END." + (seq-map (lambda (o) (overlay-get o 'flycheck-error)) + (flycheck-overlays-in beg end))) + +(defvar-local flycheck-overlays-to-delete nil + "Overlays mark for deletion after all syntax checks completed.") +(put 'flycheck-overlays-to-delete 'permanent-local t) + +(defun flycheck-delete-all-overlays () + "Remove all flycheck overlays in the current buffer." + (flycheck-delete-marked-overlays) + (save-restriction + (widen) + (seq-do #'delete-overlay (flycheck-overlays-in (point-min) (point-max))))) + +(defun flycheck-mark-all-overlays-for-deletion () + "Mark all current overlays for deletion." + (setq flycheck-overlays-to-delete + (append (flycheck-overlays-in (point-min) (point-max)) + flycheck-overlays-to-delete))) + +(defun flycheck-delete-marked-overlays () + "Delete all overlays marked for deletion." + (seq-do #'delete-overlay flycheck-overlays-to-delete) + (setq flycheck-overlays-to-delete nil)) + + +;;; Error navigation in the current buffer +(defun flycheck-error-level-interesting-at-pos-p (pos) + "Check if error severity at POS passes `flycheck-error-level-interesting-p'." + (flycheck-error-level-interesting-p (get-char-property pos 'flycheck-error))) + +(defun flycheck-error-level-interesting-p (err) + "Check if ERR severity is >= `flycheck-navigation-minimum-level'." + (when (flycheck-error-p err) + (-if-let (min-level flycheck-navigation-minimum-level) + (<= (flycheck-error-level-severity min-level) + (flycheck-error-level-severity (flycheck-error-level err))) + t))) + +(defun flycheck-next-error-pos (n &optional reset) + "Get the position of the N-th next error. + +With negative N, get the position of the (-N)-th previous error +instead. With non-nil RESET, search from `point-min', otherwise +search from the current point. + +Return the position of the next or previous error, or nil if +there is none." + (let ((n (or n 1)) + (pos (if reset (point-min) (point)))) + (if (>= n 0) + ;; Search forwards + (while (and pos (> n 0)) + (setq n (1- n)) + (when (get-char-property pos 'flycheck-error) + ;; Move beyond from the current error if any + (setq pos (next-single-char-property-change pos 'flycheck-error))) + (while (not (or (= pos (point-max)) + (flycheck-error-level-interesting-at-pos-p pos))) + ;; Scan for the next error + (setq pos (next-single-char-property-change pos 'flycheck-error))) + (when (and (= pos (point-max)) + (not (flycheck-error-level-interesting-at-pos-p pos))) + ;; If we reached the end of the buffer, but no error, we didn't find + ;; any + (setq pos nil))) + ;; Search backwards + (while (and pos (< n 0)) + (setq n (1+ n)) + ;; Loop until we find an error. We need to check the position *before* + ;; the current one, because `previous-single-char-property-change' + ;; always moves to the position *of* the change. + (while (not (or (= pos (point-min)) + (flycheck-error-level-interesting-at-pos-p (1- pos)))) + (setq pos (previous-single-char-property-change pos 'flycheck-error))) + (when (and (= pos (point-min)) + (not (flycheck-error-level-interesting-at-pos-p pos))) + ;; We didn't find any error. + (setq pos nil)) + (when pos + ;; We found an error, so move to its beginning + (setq pos (previous-single-char-property-change pos + 'flycheck-error))))) + pos)) + +(defun flycheck-next-error-function (n reset) + "Visit the N-th error from the current point. + +N is the number of errors to advance by, where a negative N +advances backwards. With non-nil RESET, advance from the +beginning of the buffer, otherwise advance from the current +position. + +Intended for use with `next-error-function'." + (let ((pos (flycheck-next-error-pos n reset))) + (if pos + (goto-char pos) + (user-error "No more Flycheck errors")))) + +(defun flycheck-next-error (&optional n reset) + "Visit the N-th error from the current point. + +N is the number of errors to advance by, where a negative N +advances backwards. With non-nil RESET, advance from the +beginning of the buffer, otherwise advance from the current +position." + (interactive "P") + (when (consp n) + ;; Universal prefix argument means reset + (setq reset t n nil)) + (flycheck-next-error-function n reset) + (flycheck-display-error-at-point)) + +(defun flycheck-previous-error (&optional n) + "Visit the N-th previous error. + +If given, N specifies the number of errors to move backwards by. +If N is negative, move forwards instead." + (interactive "P") + (flycheck-next-error (- (or n 1)))) + +(defun flycheck-first-error (&optional n) + "Visit the N-th error from beginning of the buffer. + +If given, N specifies the number of errors to move forward from +the beginning of the buffer." + (interactive "P") + (flycheck-next-error n 'reset)) + + +;;; Listing errors in buffers +(defconst flycheck-error-list-buffer "*Flycheck errors*" + "The name of the buffer to show error lists.") + +(defvar flycheck-error-list-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "f") #'flycheck-error-list-set-filter) + (define-key map (kbd "F") #'flycheck-error-list-reset-filter) + (define-key map (kbd "n") #'flycheck-error-list-next-error) + (define-key map (kbd "p") #'flycheck-error-list-previous-error) + (define-key map (kbd "g") #'flycheck-error-list-check-source) + (define-key map (kbd "RET") #'flycheck-error-list-goto-error) + map) + "The keymap of `flycheck-error-list-mode'.") + +(defconst flycheck-error-list-format + [("Line" 5 flycheck-error-list-entry-< :right-align t) + ("Col" 3 nil :right-align t) + ("Level" 8 flycheck-error-list-entry-level-<) + ("ID" 6 t) + ("Message (Checker)" 0 t)] + "Table format for the error list.") + +(defconst flycheck-error-list-padding 1 + "Padding used in error list.") + +(defconst flycheck--error-list-msg-offset + (seq-reduce + (lambda (offset fmt) + (pcase-let* ((`(,_ ,width ,_ . ,props) fmt) + (padding (or (plist-get props :pad-right) 1))) + (+ offset width padding))) + (seq-subseq flycheck-error-list-format 0 -1) + flycheck-error-list-padding) + "Amount of space to use in `flycheck-flush-multiline-message'.") + +(define-derived-mode flycheck-error-list-mode tabulated-list-mode "Flycheck errors" + "Major mode for listing Flycheck errors. + +\\{flycheck-error-list-mode-map}" + (setq tabulated-list-format flycheck-error-list-format + ;; Sort by location initially + tabulated-list-sort-key (cons "Line" nil) + tabulated-list-padding flycheck-error-list-padding + tabulated-list-entries #'flycheck-error-list-entries + ;; `revert-buffer' updates the mode line for us, so all we need to do is + ;; set the corresponding mode line construct. + mode-line-buffer-identification flycheck-error-list-mode-line) + (tabulated-list-init-header)) + +(defvar-local flycheck-error-list-source-buffer nil + "The current source buffer of the error list.") +;; Needs to permanently local to preserve the source buffer across buffer +;; reversions +(put 'flycheck-error-list-source-buffer 'permanent-local t) + +(defun flycheck-error-list-set-source (buffer) + "Set BUFFER as the source buffer of the error list." + (when (get-buffer flycheck-error-list-buffer) + (with-current-buffer flycheck-error-list-buffer + ;; Only update the source when required + (unless (eq buffer flycheck-error-list-source-buffer) + (setq flycheck-error-list-source-buffer buffer) + (flycheck-error-list-refresh))))) + +(defun flycheck-error-list-update-source () + "Update the source buffer of the error list." + (when (not (eq (current-buffer) (get-buffer flycheck-error-list-buffer))) + ;; We must not update the source buffer, if the current buffer is the error + ;; list itself. + (flycheck-error-list-set-source (current-buffer)))) + +(defun flycheck-error-list-check-source () + "Trigger a syntax check in the source buffer of the error list." + (interactive) + (let ((buffer (get-buffer flycheck-error-list-source-buffer))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (flycheck-buffer))))) + +(define-button-type 'flycheck-error-list + 'action #'flycheck-error-list-button-goto-error + 'help-echo "mouse-2, RET: goto error") + +(defun flycheck-error-list-button-goto-error (button) + "Go to the error at BUTTON." + (flycheck-error-list-goto-error (button-start button))) + +(defsubst flycheck-error-list-make-cell (text &optional face) + "Make an error list cell with TEXT and FACE. + +If FACE is nil don't set a FACE on TEXT. If TEXT already has +face properties, do not specify a FACE. Note though, that if +TEXT gets truncated it will not inherit any previous face +properties. If you expect TEXT to be truncated in the error +list, do specify a FACE explicitly!" + (append (list text 'type 'flycheck-error-list) + (and face (list 'face face)))) + +(defsubst flycheck-error-list-make-number-cell (number face) + "Make a table cell for a NUMBER with FACE. + +Convert NUMBER to string, fontify it with FACE and return the +string with attached text properties." + (flycheck-error-list-make-cell + (if (numberp number) (number-to-string number) "") + face)) + +(defun flycheck-error-list-make-last-column (message checker) + "Compute contents of the last error list cell. + +MESSAGE and CHECKER are displayed in a single column to allow the +message to stretch arbitrarily far." + (let ((checker-name (propertize (symbol-name checker) + 'face 'flycheck-error-list-checker-name))) + (format (propertize "%s (%s)" 'face 'default) + (flycheck-flush-multiline-message message) + checker-name))) + +(defun flycheck-error-list-make-entry (error) + "Make a table cell for the given ERROR. + +Return a list with the contents of the table cell." + (let* ((level (flycheck-error-level error)) + (level-face (flycheck-error-level-error-list-face level)) + (line (flycheck-error-line error)) + (column (flycheck-error-column error)) + (message (or (flycheck-error-message error) + (format "Unknown %s" (symbol-name level)))) + (id (flycheck-error-id error)) + (checker (flycheck-error-checker error))) + (list error + (vector (flycheck-error-list-make-number-cell + line 'flycheck-error-list-line-number) + (flycheck-error-list-make-number-cell + column 'flycheck-error-list-column-number) + (flycheck-error-list-make-cell + (symbol-name (flycheck-error-level error)) level-face) + (flycheck-error-list-make-cell + (if id (format "%s" id) "") + 'flycheck-error-list-id) + (flycheck-error-list-make-cell + (flycheck-error-list-make-last-column message checker)))))) + +(defun flycheck-flush-multiline-message (msg) + "Prepare error message MSG for display in the error list. + +Prepend all lines of MSG except the first with enough space to +ensure that they line up properly once the message is displayed." + (let* ((spc-spec `(space . (:width ,flycheck--error-list-msg-offset))) + (spc (propertize " " 'display spc-spec)) + (rep (concat "\\1" spc "\\2"))) + (replace-regexp-in-string "\\([\r\n]+\\)\\(.\\)" rep msg))) + +(defun flycheck-error-list-current-errors () + "Read the list of errors in `flycheck-error-list-source-buffer'." + (when (buffer-live-p flycheck-error-list-source-buffer) + (buffer-local-value 'flycheck-current-errors + flycheck-error-list-source-buffer))) + +(defun flycheck-error-list-entries () + "Create the entries for the error list." + (-when-let* ((errors (flycheck-error-list-current-errors)) + (filtered (flycheck-error-list-apply-filter errors))) + (seq-map #'flycheck-error-list-make-entry filtered))) + +(defun flycheck-error-list-entry-< (entry1 entry2) + "Determine whether ENTRY1 is before ENTRY2 by location. + +See `flycheck-error-<'." + (flycheck-error-< (car entry1) (car entry2))) + +(defun flycheck-error-list-entry-level-< (entry1 entry2) + "Determine whether ENTRY1 is before ENTRY2 by level. + +See `flycheck-error-level-<'." + (not (flycheck-error-level-< (car entry1) (car entry2)))) + +(defvar flycheck-error-list-mode-line-map + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + #'flycheck-error-list-mouse-switch-to-source) + map) + "Keymap for error list mode line.") + +(defun flycheck-error-list-propertized-source-name () + "Get the name of the current source buffer for the mode line. + +Propertize the name of the current source buffer for use in the +mode line indication of `flycheck-error-list-mode'." + (let ((name (replace-regexp-in-string + (rx "%") "%%" + (buffer-name flycheck-error-list-source-buffer) + 'fixed-case 'literal))) + (propertize name 'face 'mode-line-buffer-id + 'mouse-face 'mode-line-highlight + 'help-echo "mouse-1: switch to source" + 'local-map flycheck-error-list-mode-line-map))) + +(defun flycheck-error-list-mouse-switch-to-source (event) + "Switch to the error list source buffer of the EVENT window." + (interactive "e") + (save-selected-window + (when (eventp event) + (select-window (posn-window (event-start event)))) + (when (buffer-live-p flycheck-error-list-source-buffer) + (switch-to-buffer flycheck-error-list-source-buffer)))) + +(defun flycheck-get-error-list-window-list (&optional all-frames) + "Get all windows displaying the error list. + +ALL-FRAMES specifies the frames to consider, as in +`get-buffer-window-list'." + (-when-let (buf (get-buffer flycheck-error-list-buffer)) + (get-buffer-window-list buf nil all-frames))) + +(defun flycheck-get-error-list-window (&optional all-frames) + "Get a window displaying the error list, or nil if none. + +ALL-FRAMES specifies the frames to consider, as in +`get-buffer-window'." + (-when-let (buf (get-buffer flycheck-error-list-buffer)) + (get-buffer-window buf all-frames))) + +(defun flycheck-error-list-recenter-at (pos) + "Recenter the error list at POS." + (dolist (window (flycheck-get-error-list-window-list t)) + (with-selected-window window + (goto-char pos) + (recenter)))) + +(defun flycheck-error-list-refresh () + "Refresh the current error list. + +Add all errors currently reported for the current +`flycheck-error-list-source-buffer', and recenter the error +list." + ;; We only refresh the error list, when it is visible in a window, and we + ;; select this window while reverting, because Tabulated List mode attempts to + ;; recenter the error at the old location, so it must have the proper window + ;; selected. + (-when-let (window (flycheck-get-error-list-window t)) + (with-selected-window window + (revert-buffer)) + (run-hooks 'flycheck-error-list-after-refresh-hook) + (let ((preserve-pos (eq (current-buffer) + (get-buffer flycheck-error-list-buffer)))) + ;; If the error list is the current buffer, don't recenter when + ;; highlighting + (flycheck-error-list-highlight-errors preserve-pos)))) + +(defun flycheck-error-list-mode-line-filter-indicator () + "Create a string representing the current error list filter." + (if flycheck-error-list-minimum-level + (format " [>= %s]" flycheck-error-list-minimum-level) + "")) + +(defun flycheck-error-list-set-filter (level) + "Restrict the error list to errors at level LEVEL or higher. + +LEVEL is either an error level symbol, or nil, to remove the filter." + (interactive + (list (read-flycheck-error-level + "Minimum error level (errors at lower levels will be hidden): "))) + (when (and level (not (flycheck-error-level-p level))) + (user-error "Invalid level: %s" level)) + (-when-let (buf (get-buffer flycheck-error-list-buffer)) + (with-current-buffer buf + (setq-local flycheck-error-list-minimum-level level)) + (flycheck-error-list-refresh) + (flycheck-error-list-recenter-at (point-min)))) + +(defun flycheck-error-list-reset-filter () + "Remove filters and show all errors in the error list." + (interactive) + (kill-local-variable 'flycheck-error-list-minimum-level)) + +(defun flycheck-error-list-apply-filter (errors) + "Filter ERRORS according to `flycheck-error-list-minimum-level'." + (-if-let* ((min-level flycheck-error-list-minimum-level) + (min-severity (flycheck-error-level-severity min-level))) + (seq-filter (lambda (err) (>= (flycheck-error-level-severity + (flycheck-error-level err)) + min-severity)) + errors) + errors)) + +(defun flycheck-error-list-goto-error (&optional pos) + "Go to the location of the error at POS in the error list. + +POS defaults to `point'." + (interactive) + (-when-let* ((error (tabulated-list-get-id pos)) + (buffer (flycheck-error-buffer error))) + (when (buffer-live-p buffer) + (if (eq (window-buffer) (get-buffer flycheck-error-list-buffer)) + ;; When called from within the error list, keep the error list, + ;; otherwise replace the current buffer. + (pop-to-buffer buffer 'other-window) + (switch-to-buffer buffer)) + (let ((pos (flycheck-error-pos error))) + (unless (eq (goto-char pos) (point)) + ;; If widening gets in the way of moving to the right place, remove it + ;; and try again + (widen) + (goto-char pos))) + ;; Re-highlight the errors + (flycheck-error-list-highlight-errors 'preserve-pos)))) + +(defun flycheck-error-list-next-error-pos (pos &optional n) + "Starting from POS get the N'th next error in the error list. + +N defaults to 1. If N is negative, search for the previous error +instead. + +Get the beginning position of the N'th next error from POS, or +nil, if there is no next error." + (let ((n (or n 1))) + (if (>= n 0) + ;; Search forward + (while (and pos (/= n 0)) + (setq n (1- n)) + (setq pos (next-single-property-change pos 'tabulated-list-id))) + ;; Search backwards + (while (/= n 0) + (setq n (1+ n)) + ;; We explicitly give the limit here to explicitly have the minimum + ;; point returned, to be able to move to the first error (which starts + ;; at `point-min') + (setq pos (previous-single-property-change pos 'tabulated-list-id + nil (point-min))))) + pos)) + +(defun flycheck-error-list-previous-error (n) + "Go to the N'th previous error in the error list." + (interactive "P") + (flycheck-error-list-next-error (- (or n 1)))) + +(defun flycheck-error-list-next-error (n) + "Go to the N'th next error in the error list." + (interactive "P") + (let ((pos (flycheck-error-list-next-error-pos (point) n))) + (when (and pos (/= pos (point))) + (goto-char pos) + (save-selected-window + ;; Keep the error list selected, so that the user can navigate errors by + ;; repeatedly pressing n/p, without having to re-select the error list + ;; window. + (flycheck-error-list-goto-error))))) + +(defvar-local flycheck-error-list-highlight-overlays nil + "Error highlight overlays in the error list buffer.") +(put 'flycheck-error-list-highlight-overlays 'permanent-local t) + +(defun flycheck-error-list-highlight-errors (&optional preserve-pos) + "Highlight errors in the error list. + +Highlight all errors in the error lists that are at point in the +source buffer, and on the same line as point. Then recenter the +error list to the highlighted error, unless PRESERVE-POS is +non-nil." + (when (get-buffer flycheck-error-list-buffer) + (let ((current-errors (flycheck-overlay-errors-in (line-beginning-position) + (line-end-position)))) + (with-current-buffer flycheck-error-list-buffer + (let ((old-overlays flycheck-error-list-highlight-overlays) + (min-point (point-max)) + (max-point (point-min))) + ;; Display the new overlays first, to avoid re-display flickering + (setq flycheck-error-list-highlight-overlays nil) + (when current-errors + (let ((next-error-pos (point-min))) + (while next-error-pos + (let* ((beg next-error-pos) + (end (flycheck-error-list-next-error-pos beg)) + (err (tabulated-list-get-id beg))) + (when (member err current-errors) + (setq min-point (min min-point beg) + max-point (max max-point beg)) + (let ((ov (make-overlay beg + ;; Extend overlay to the beginning of + ;; the next line, to highlight the + ;; whole line + (or end (point-max))))) + (push ov flycheck-error-list-highlight-overlays) + (setf (overlay-get ov 'flycheck-error-highlight-overlay) + t) + (setf (overlay-get ov 'face) + 'flycheck-error-list-highlight))) + (setq next-error-pos end))))) + ;; Delete the old overlays + (seq-do #'delete-overlay old-overlays) + (when (and (not preserve-pos) current-errors) + ;; Move point to the middle error + (goto-char (+ min-point (/ (- max-point min-point) 2))) + (beginning-of-line) + ;; And recenter the error list at this position + (flycheck-error-list-recenter-at (point)))))))) + +(defun flycheck-list-errors () + "Show the error list for the current buffer." + (interactive) + (unless flycheck-mode + (user-error "Flycheck mode not enabled")) + ;; Create and initialize the error list + (unless (get-buffer flycheck-error-list-buffer) + (with-current-buffer (get-buffer-create flycheck-error-list-buffer) + (flycheck-error-list-mode))) + (flycheck-error-list-set-source (current-buffer)) + ;; Reset the error filter + (flycheck-error-list-reset-filter) + ;; Show the error list in a window, and re-select the old window + (display-buffer flycheck-error-list-buffer) + ;; Finally, refresh the error list to show the most recent errors + (flycheck-error-list-refresh)) + +(defalias 'list-flycheck-errors 'flycheck-list-errors) + + +;;; Displaying errors in the current buffer +(defun flycheck-display-errors (errors) + "Display ERRORS using `flycheck-display-errors-function'." + (when flycheck-display-errors-function + (funcall flycheck-display-errors-function errors))) + +(defvar-local flycheck-display-error-at-point-timer nil + "Timer to automatically show the error at point in minibuffer.") + +(defun flycheck-cancel-error-display-error-at-point-timer () + "Cancel the error display timer for the current buffer." + (when flycheck-display-error-at-point-timer + (cancel-timer flycheck-display-error-at-point-timer) + (setq flycheck-display-error-at-point-timer nil))) + +(defun flycheck-display-error-at-point () + "Display the all error messages at point in minibuffer." + (interactive) + ;; This function runs from a timer, so we must take care to not ignore any + ;; errors + (with-demoted-errors "Flycheck error display error: %s" + (flycheck-cancel-error-display-error-at-point-timer) + (when flycheck-mode + (-when-let (errors (flycheck-overlay-errors-at (point))) + (flycheck-display-errors errors))))) + +(defun flycheck-display-error-at-point-soon () + "Display the first error message at point in minibuffer delayed." + (flycheck-cancel-error-display-error-at-point-timer) + (when (flycheck-overlays-at (point)) + (setq flycheck-display-error-at-point-timer + (run-at-time flycheck-display-errors-delay nil 'flycheck-display-error-at-point)))) + + +;;; Functions to display errors +(defconst flycheck-error-message-buffer "*Flycheck error messages*" + "The name of the buffer to show long error messages in.") + +(defun flycheck-error-message-buffer () + "Get the buffer object to show long error messages in. + +Get the buffer named by variable `flycheck-error-message-buffer', +or nil if the buffer does not exist." + (get-buffer flycheck-error-message-buffer)) + +(defun flycheck-may-use-echo-area-p () + "Determine whether the echo area may be used. + +The echo area may be used if the cursor is not in the echo area, +and if the echo area is not occupied by minibuffer input." + (not (or cursor-in-echo-area (active-minibuffer-window)))) + +(defun flycheck-display-error-messages (errors) + "Display the messages of ERRORS. + +Concatenate all non-nil messages of ERRORS separated by empty +lines, and display them with `display-message-or-buffer', which +shows the messages either in the echo area or in a separate +buffer, depending on the number of lines. See Info +node `(elisp)Displaying Messages' for more information. + +In the latter case, show messages in the buffer denoted by +variable `flycheck-error-message-buffer'." + (when (and errors (flycheck-may-use-echo-area-p)) + (let ((messages (seq-map #'flycheck-error-format-message-and-id errors))) + (display-message-or-buffer (string-join messages "\n\n") + flycheck-error-message-buffer + 'not-this-window)))) + +(defun flycheck-display-error-messages-unless-error-list (errors) + "Show messages of ERRORS unless the error list is visible. + +Like `flycheck-display-error-messages', but only if the error +list (see `flycheck-list-errors') is not visible in any window in +the current frame." + (unless (flycheck-get-error-list-window 'current-frame) + (flycheck-display-error-messages errors))) + +(defun flycheck-hide-error-buffer () + "Hide the Flycheck error buffer if necessary. + +Hide the error buffer if there is no error under point." + (-when-let* ((buffer (flycheck-error-message-buffer)) + (window (get-buffer-window buffer))) + (unless (flycheck-overlays-at (point)) + ;; save-selected-window prevents `quit-window' from changing the current + ;; buffer (see https://github.com/flycheck/flycheck/issues/648). + (save-selected-window + (quit-window nil window))))) + + +;;; Working with errors +(defun flycheck-copy-errors-as-kill (pos &optional formatter) + "Copy each error at POS into kill ring, using FORMATTER. + +FORMATTER is a function to turn an error into a string, +defaulting to `flycheck-error-message'. + +Interactively, use `flycheck-error-format-message-and-id' as +FORMATTER with universal prefix arg, and `flycheck-error-id' with +normal prefix arg, i.e. copy the message and the ID with +universal prefix arg, and only the id with normal prefix arg." + (interactive (list (point) + (pcase current-prefix-arg + ((pred not) #'flycheck-error-message) + ((pred consp) #'flycheck-error-format-message-and-id) + (_ #'flycheck-error-id)))) + (let ((messages (delq nil (seq-map (or formatter #'flycheck-error-message) + (flycheck-overlay-errors-at pos))))) + (when messages + (seq-do #'kill-new (reverse messages)) + (message (string-join messages "\n"))))) + + +;;; Syntax checkers using external commands +(defun flycheck-command-argument-p (arg) + "Check whether ARG is a valid command argument." + (pcase arg + ((pred stringp) t) + ((or `source `source-inplace `source-original) t) + ((or `temporary-directory `temporary-file-name) t) + (`null-device t) + (`(config-file ,option-name ,config-file-var) + (and (stringp option-name) + (symbolp config-file-var))) + (`(config-file ,option-name ,config-file-var ,prepender) + (and (stringp option-name) + (symbolp config-file-var) + (symbolp prepender))) + (`(,(or `option `option-list) ,option-name ,option-var) + (and (stringp option-name) + (symbolp option-var))) + (`(,(or `option `option-list) ,option-name ,option-var ,prepender) + (and (stringp option-name) + (symbolp option-var) + (symbolp prepender))) + (`(,(or `option `option-list) ,option-name ,option-var ,prepender ,filter) + (and (stringp option-name) + (symbolp option-var) + (symbolp prepender) + (symbolp filter))) + (`(option-flag ,option-name ,option-var) + (and (stringp option-name) + (symbolp option-var))) + (`(eval ,_) t) + (_ nil))) + +(defun flycheck-compute-working-directory (checker) + "Get the default working directory for CHECKER. + +Compute the value of `default-directory' for the invocation of +the syntax checker command, by calling the function in the +`working-directory' property of CHECKER, with CHECKER as sole +argument, and returning its value. Signal an error if the +function returns a non-existing working directory. + +If the property is undefined or if the function returns nil +return the `default-directory' of the current buffer." + (let* ((def-directory-fn (flycheck-checker-get checker 'working-directory)) + (directory (or (and def-directory-fn + (funcall def-directory-fn checker)) + ;; Default to the `default-directory' of the current + ;; buffer + default-directory))) + (unless (file-exists-p directory) + (error ":working-directory %s of syntax checker %S does not exist" + directory checker)) + directory)) + +;;;###autoload +(defun flycheck-define-command-checker (symbol docstring &rest properties) + "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." + (declare (indent 1) + (doc-string 2)) + (dolist (prop '(:start :interrupt :print-doc)) + (when (plist-get properties prop) + (error "%s not allowed in definition of command syntax checker %s" + prop symbol))) + + (unless (plist-get properties :error-filter) + ;; Default to `flycheck-sanitize-errors' as error filter + (setq properties (plist-put properties :error-filter + #'flycheck-sanitize-errors))) + (let ((verify-fn (plist-get properties :verify))) + (setq properties + (plist-put properties :verify + (lambda (checker) + (append (flycheck-verify-command-checker checker) + (and verify-fn + (funcall verify-fn checker))))))) + + (let ((command (plist-get properties :command)) + (patterns (plist-get properties :error-patterns)) + (parser (or (plist-get properties :error-parser) + #'flycheck-parse-with-patterns)) + (predicate (plist-get properties :predicate)) + (standard-input (plist-get properties :standard-input))) + (unless command + (error "Missing :command in syntax checker %s" symbol)) + (unless (stringp (car command)) + (error "Command executable for syntax checker %s must be a string: %S" + symbol (car command))) + (dolist (arg (cdr command)) + (unless (flycheck-command-argument-p arg) + (error "Invalid command argument %S in syntax checker %s" arg symbol))) + (when (and (eq parser 'flycheck-parse-with-patterns) + (not patterns)) + (error "Missing :error-patterns in syntax checker %s" symbol)) + + (setq properties + ;; Construct a predicate that checks whether the executable exists, to + ;; guard against syntax checker tools which are not installed + (plist-put properties :predicate + (lambda () + (and (flycheck-find-checker-executable symbol) + (or (not predicate) (funcall predicate)))))) + + (apply #'flycheck-define-generic-checker symbol docstring + :start #'flycheck-start-command-checker + :interrupt #'flycheck-interrupt-command-checker + :print-doc #'flycheck-command-checker-print-doc + properties) + + ;; Pre-compile all errors patterns into strings, so that we don't need to do + ;; that on each error parse + (let ((patterns (seq-map (lambda (p) + (cons (flycheck-rx-to-string `(and ,@(cdr p)) + 'no-group) + (car p))) + patterns))) + (pcase-dolist (`(,prop . ,value) + `((command . ,command) + (error-parser . ,parser) + (error-patterns . ,patterns) + (standard-input . ,standard-input))) + (setf (flycheck-checker-get symbol prop) value))))) + +(eval-and-compile + ;; Make this function available during byte-compilation, since we need it + ;; at macro expansion of `flycheck-def-executable-var'. + (defun flycheck-checker-executable-variable (checker) + "Get the executable variable of CHECKER. + +The executable variable is named `flycheck-CHECKER-executable'." + (intern (format "flycheck-%s-executable" checker)))) + +(defun flycheck-checker-default-executable (checker) + "Get the default executable of CHECKER." + (car (flycheck-checker-get checker 'command))) + +(defun flycheck-checker-executable (checker) + "Get the command executable of CHECKER. + +The executable is either the value of the variable +`flycheck-CHECKER-executable', or the default executable given in +the syntax checker definition, if the variable is nil." + (let ((var (flycheck-checker-executable-variable checker))) + (or (and (boundp var) (symbol-value var)) + (flycheck-checker-default-executable checker)))) + +(defun flycheck-find-checker-executable (checker) + "Get the full path of the executbale of CHECKER. + +Return the full absolute path to the executable of CHECKER, or +nil if the executable does not exist." + (funcall flycheck-executable-find (flycheck-checker-executable checker))) + +(defun flycheck-checker-arguments (checker) + "Get the command arguments of CHECKER." + (cdr (flycheck-checker-get checker 'command))) + +(defun flycheck-substitute-argument (arg checker) + "Substitute ARG for CHECKER. + +Return a list of real arguments for the executable of CHECKER, +substituted for the symbolic argument ARG. Single arguments, +e.g. if ARG is a literal strings, are wrapped in a list. + +ARG may be one of the following forms: + +STRING + Return ARG unchanged. + +`source', `source-inplace' + Create a temporary file to check and return its path. With + `source-inplace' create the temporary file in the same + directory as the original file. The value of + `flycheck-temp-prefix' is used as prefix of the file name. + + With `source', try to retain the non-directory component of + the buffer's file name in the temporary file. + + `source' is the preferred way to pass the input file to a + syntax checker. `source-inplace' should only be used if the + syntax checker needs other files from the source directory, + such as include files in C. + +`source-original' + Return the path of the actual file to check, or an empty + string if the buffer has no file name. + + Note that the contents of the file may not be up to date + with the contents of the buffer to check. Do not use this + as primary input to a checker, unless absolutely necessary. + + When using this symbol as primary input to the syntax + checker, add `flycheck-buffer-saved-p' to the `:predicate'. + +`temporary-directory' + Create a unique temporary directory and return its path. + +`temporary-file-name' + Return a unique temporary filename. The file is *not* + created. + + To ignore the output of syntax checkers, try `null-device' + first. + +`null-device' + Return the value of `null-device', i.e the system null + device. + + Use this option to ignore the output of a syntax checker. + If the syntax checker cannot handle the null device, or + won't write to an existing file, try `temporary-file-name' + instead. + +`(config-file OPTION VARIABLE [PREPEND-FN])' + Search the configuration file bound to VARIABLE with + `flycheck-locate-config-file' and return a list of arguments + that pass this configuration file to the syntax checker, or + nil if the configuration file was not found. + + PREPEND-FN is called with the OPTION and the located + configuration file, and should return OPTION prepended + before the file, either a string or as list. If omitted, + PREPEND-FN defaults to `list'. + +`(option OPTION VARIABLE [PREPEND-FN [FILTER]])' + Retrieve the value of VARIABLE and return a list of + arguments that pass this value as value for OPTION to the + syntax checker. + + PREPEND-FN is called with the OPTION and the value of + VARIABLE, and should return OPTION prepended before the + file, either a string or as list. If omitted, PREPEND-FN + defaults to `list'. + + FILTER is an optional function to be applied to the value of + VARIABLE before prepending. This function must return nil + or a string. In the former case, return nil. In the latter + case, return a list of arguments as described above. + +`(option-list OPTION VARIABLE [PREPEND-FN [FILTER]])' + Retrieve the value of VARIABLE, which must be a list, + and prepend OPTION before each item in this list, using + PREPEND-FN. + + PREPEND-FN is called with the OPTION and each item of the + list as second argument, and should return OPTION prepended + before the item, either as string or as list. If omitted, + PREPEND-FN defaults to `list'. + + FILTER is an optional function to be applied to each item in + the list before prepending OPTION. It shall return the + option value for each item as string, or nil, if the item is + to be ignored. + +`(option-flag OPTION VARIABLE)' + Retrieve the value of VARIABLE and return OPTION, if the + value is non-nil. Otherwise return nil. + +`(eval FORM)' + Return the result of evaluating FORM in the buffer to be + checked. FORM must either return a string or a list of + strings, or nil to indicate that nothing should be + substituted for CELL. For all other return types, signal an + error + + _No_ further substitutions are performed, neither in FORM + before it is evaluated, nor in the result of evaluating + FORM. + +In all other cases, signal an error. + +Note that substitution is *not* recursive. No symbols or cells +are substituted within the body of cells!" + (pcase arg + ((pred stringp) (list arg)) + (`source + (list (flycheck-save-buffer-to-temp #'flycheck-temp-file-system))) + (`source-inplace + (list (flycheck-save-buffer-to-temp #'flycheck-temp-file-inplace))) + (`source-original (list (or (buffer-file-name) ""))) + (`temporary-directory (list (flycheck-temp-dir-system))) + (`temporary-file-name + (let ((directory (flycheck-temp-dir-system))) + (list (make-temp-name (expand-file-name "flycheck" directory))))) + (`null-device (list null-device)) + (`(config-file ,option-name ,file-name-var) + (-when-let* ((value (symbol-value file-name-var)) + (file-name (flycheck-locate-config-file value checker))) + (flycheck-prepend-with-option option-name (list file-name)))) + (`(config-file ,option-name ,file-name-var ,prepend-fn) + (-when-let* ((value (symbol-value file-name-var)) + (file-name (flycheck-locate-config-file value checker))) + (flycheck-prepend-with-option option-name (list file-name) prepend-fn))) + (`(option ,option-name ,variable) + (-when-let (value (symbol-value variable)) + (unless (stringp value) + (error "Value %S of %S for option %s is not a string" + value variable option-name)) + (flycheck-prepend-with-option option-name (list value)))) + (`(option ,option-name ,variable ,prepend-fn) + (-when-let (value (symbol-value variable)) + (unless (stringp value) + (error "Value %S of %S for option %s is not a string" + value variable option-name)) + (flycheck-prepend-with-option option-name (list value) prepend-fn))) + (`(option ,option-name ,variable ,prepend-fn ,filter) + (-when-let (value (funcall filter (symbol-value variable))) + (unless (stringp value) + (error "Value %S of %S (filter: %S) for option %s is not a string" + value variable filter option-name)) + (flycheck-prepend-with-option option-name (list value) prepend-fn))) + (`(option-list ,option-name ,variable) + (let ((value (symbol-value variable))) + (unless (and (listp value) (seq-every-p #'stringp value)) + (error "Value %S of %S for option %S is not a list of strings" + value variable option-name)) + (flycheck-prepend-with-option option-name value))) + (`(option-list ,option-name ,variable ,prepend-fn) + (let ((value (symbol-value variable))) + (unless (and (listp value) (seq-every-p #'stringp value)) + (error "Value %S of %S for option %S is not a list of strings" + value variable option-name)) + (flycheck-prepend-with-option option-name value prepend-fn))) + (`(option-list ,option-name ,variable ,prepend-fn ,filter) + (let ((value (delq nil (seq-map filter (symbol-value variable))))) + (unless (and (listp value) (seq-every-p #'stringp value)) + (error "Value %S of %S for option %S is not a list of strings" + value variable option-name)) + (flycheck-prepend-with-option option-name value prepend-fn))) + (`(option-flag ,option-name ,variable) + (when (symbol-value variable) + (list option-name))) + (`(eval ,form) + (let ((result (eval form))) + (cond + ((and (listp result) (seq-every-p #'stringp result)) result) + ((stringp result) (list result)) + (t (error "Invalid result from evaluation of %S: %S" form result))))) + (_ (error "Unsupported argument %S" arg)))) + +(defun flycheck-checker-substituted-arguments (checker) + "Get the substituted arguments of a CHECKER. + +Substitute each argument of CHECKER using +`flycheck-substitute-argument'. This replaces any special +symbols in the command." + (apply #'append + (seq-map (lambda (arg) (flycheck-substitute-argument arg checker)) + (flycheck-checker-arguments checker)))) + +(defun flycheck--process-send-buffer-contents-chunked (process) + "Send contents of current buffer to PROCESS in small batches. + +Send the entire buffer to the standard input of PROCESS in chunks +of 4096 characters. Chunking is done in Emacs Lisp, hence this +function is probably far less efficient than +`send-process-region'. Use only when required." + (let ((from (point-min))) + (while (< from (point-max)) + (let ((to (min (+ from 4096) (point-max)))) + (process-send-region process from to) + (setq from to))))) + +(defvar flycheck-chunked-process-input + ;; Chunk process output on Windows to work around + ;; https://github.com/flycheck/flycheck/issues/794 and + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22344. The presence of + ;; `w32-pipe-buffer-size' denotes an Emacs version (> Emacs 25.1 )where pipe + ;; writes on Windows are fixed. + ;; + ;; TODO: Remove option and chunking when dropping Emacs 24 support, see + ;; https://github.com/flycheck/flycheck/issues/856 + (and (eq system-type 'windows-nt) (not (boundp 'w32-pipe-buffer-size))) + "If non-nil send process input in small chunks. + +If this variable is non-nil `flycheck-process-send-buffer' sends +buffer contents in small chunks. + +Defaults to nil, except on Windows to work around Emacs bug +#22344.") + +(defun flycheck-process-send-buffer (process) + "Send all contents of current buffer to PROCESS. + +Sends all contents of the current buffer to the standard input of +PROCESS, and terminates standard input with EOF. + +If `flycheck-chunked-process-input' is non-nil, send buffer +contents in chunks via +`flycheck--process-send-buffer-contents-chunked', which see. +Otherwise use `process-send-region' to send all contents at once +and rely on Emacs' own buffering and chunking." + (save-restriction + (widen) + (if flycheck-chunked-process-input + (flycheck--process-send-buffer-contents-chunked process) + (process-send-region process (point-min) (point-max)))) + (process-send-eof process)) + +(defun flycheck-start-command-checker (checker callback) + "Start a command CHECKER with CALLBACK." + (let (process) + (condition-case err + (let* ((program (flycheck-find-checker-executable checker)) + (args (flycheck-checker-substituted-arguments checker)) + (command (funcall flycheck-command-wrapper-function + (cons program args))) + ;; Use pipes to receive output from the syntax checker. They are + ;; more efficient and more robust than PTYs, which Emacs uses by + ;; default, and since we don't need any job control features, we + ;; can easily use pipes. + (process-connection-type nil)) + ;; We pass do not associate the process with any buffer, by + ;; passing nil for the BUFFER argument of `start-process'. + ;; Instead, we just remember the buffer being checked in a + ;; process property (see below). This neatly avoids all + ;; side-effects implied by attached a process to a buffer, which + ;; may cause conflicts with other packages. + ;; + ;; See https://github.com/flycheck/flycheck/issues/298 for an + ;; example for such a conflict. + (setq process (apply 'start-process (format "flycheck-%s" checker) + nil command)) + (setf (process-sentinel process) #'flycheck-handle-signal) + (setf (process-filter process) #'flycheck-receive-checker-output) + (set-process-query-on-exit-flag process nil) + ;; Remember the syntax checker, the buffer and the callback + (process-put process 'flycheck-checker checker) + (process-put process 'flycheck-callback callback) + (process-put process 'flycheck-buffer (current-buffer)) + ;; The default directory is bound in the `flycheck-syntax-check-start' function. + (process-put process 'flycheck-working-directory default-directory) + ;; Track the temporaries created by argument substitution in the + ;; process itself, to get rid of the global state ASAP. + (process-put process 'flycheck-temporaries flycheck-temporaries) + (setq flycheck-temporaries nil) + ;; Send the buffer to the process on standard input, if enabled. + (when (flycheck-checker-get checker 'standard-input) + (flycheck-process-send-buffer process)) + ;; Return the process. + process) + (error + ;; In case of error, clean up our resources, and report the error back to + ;; Flycheck. + (flycheck-safe-delete-temporaries) + (when process + ;; No need to explicitly delete the temporary files of the process, + ;; because deleting runs the sentinel, which will delete them anyway. + (delete-process process)) + (signal (car err) (cdr err)))))) + +(defun flycheck-interrupt-command-checker (_checker process) + "Interrupt a PROCESS." + ;; Deleting the process always triggers the sentinel, which does the cleanup + (when process + (delete-process process))) + +(defun flycheck-command-checker-print-doc (checker) + "Print additional documentation for a command CHECKER." + (let ((executable (flycheck-checker-default-executable checker)) + (config-file-var (flycheck-checker-get checker 'config-file-var)) + (option-vars (seq-sort #'string< + (flycheck-checker-get checker 'option-vars)))) + (princ "\n") + + (let ((doc-start (with-current-buffer standard-output (point-max)))) + ;; Track the start of our documentation so that we can re-indent it + ;; properly + (princ " This syntax checker executes \"") + (princ executable) + (princ "\"") + (when config-file-var + (princ ", using a configuration file from `") + (princ (symbol-name config-file-var)) + (princ "'")) + (princ ". The executable can be overridden with `") + (princ (symbol-name (flycheck-checker-executable-variable checker))) + (princ "'.") + + (with-current-buffer standard-output + (save-excursion + (fill-region-as-paragraph doc-start (point-max))))) + (princ "\n") + (when option-vars + (princ "\n This syntax checker can be configured with these options:\n\n") + (dolist (var option-vars) + (princ (format " * `%s'\n" var)))))) + +(defun flycheck-verify-command-checker (checker) + "Verify a command CHECKER in the current buffer. + +Return a list of `flycheck-verification-result' objects for +CHECKER." + (let ((executable (flycheck-find-checker-executable checker)) + (config-file-var (flycheck-checker-get checker 'config-file-var))) + `( + ,(flycheck-verification-result-new + :label "executable" + :message (if executable (format "Found at %s" executable) "Not found") + :face (if executable 'success '(bold error))) + ,@(when config-file-var + (let* ((value (symbol-value config-file-var)) + (path (and value (flycheck-locate-config-file value checker)))) + (list (flycheck-verification-result-new + :label "configuration file" + :message (if path (format "Found at %S" path) "Not found") + :face (if path 'success 'warning)))))))) + + +;;; Process management for command syntax checkers +(defun flycheck-receive-checker-output (process output) + "Receive a syntax checking PROCESS OUTPUT." + (push output (process-get process 'flycheck-pending-output))) + +(defun flycheck-get-output (process) + "Get the complete output of PROCESS." + (with-demoted-errors "Error while retrieving process output: %S" + (let ((pending-output (process-get process 'flycheck-pending-output))) + (apply #'concat (nreverse pending-output))))) + +(defun flycheck-handle-signal (process _event) + "Handle a signal from the syntax checking PROCESS. + +_EVENT is ignored." + (when (memq (process-status process) '(signal exit)) + (let ((files (process-get process 'flycheck-temporaries)) + (buffer (process-get process 'flycheck-buffer)) + (callback (process-get process 'flycheck-callback)) + (cwd (process-get process 'flycheck-working-directory))) + ;; Delete the temporary files + (seq-do #'flycheck-safe-delete files) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (condition-case err + (pcase (process-status process) + (`signal + (funcall callback 'interrupted)) + (`exit + (flycheck-finish-checker-process + (process-get process 'flycheck-checker) + (process-exit-status process) + files + (flycheck-get-output process) callback cwd))) + ((debug error) + (funcall callback 'errored (error-message-string err))))))))) + +(defun flycheck-finish-checker-process + (checker exit-status files output callback cwd) + "Finish a checker process from CHECKER with EXIT-STATUS. + +FILES is a list of files given as input to the checker. OUTPUT +is the output of the syntax checker. CALLBACK is the status +callback to use for reporting. + +Parse the OUTPUT and report an appropriate error status. + +Resolve all errors in OUTPUT using CWD as working directory." + (let ((errors (flycheck-parse-output output checker (current-buffer)))) + (when (and (/= exit-status 0) (not errors)) + ;; Warn about a suspicious result from the syntax checker. We do right + ;; after parsing the errors, before filtering, because a syntax checker + ;; might report errors from other files (e.g. includes) even if there + ;; are no errors in the file being checked. + (funcall callback 'suspicious + (format "Checker %S returned non-zero exit code %s, but no errors from \ +output: %s\nChecker definition probably flawed." checker exit-status output))) + (funcall callback 'finished + ;; Fix error file names, by substituting them backwards from the + ;; temporaries. + (seq-map (lambda (e) (flycheck-fix-error-filename e files cwd)) + errors)))) + + +;;; Executables of command checkers. +(defmacro flycheck-def-executable-var (checker default-executable) + "Define the executable variable for CHECKER. + +DEFAULT-EXECUTABLE is the default executable. It is only used in +the docstring of the variable. + +The variable is defined with `defcustom' in the +`flycheck-executables' group. It's also defined to be risky as +file-local variable, to avoid arbitrary executables being used +for syntax checking." + (let ((executable-var (flycheck-checker-executable-variable checker))) + `(progn + (defcustom ,executable-var nil + ,(format "The executable of the %s syntax checker. + +Either a string containing the name or the path of the +executable, or nil to use the default executable from the syntax +checker declaration. + +The default executable is %S." checker default-executable) + :type '(choice (const :tag "Default executable" nil) + (string :tag "Name or path")) + :group 'flycheck-executables + :risky t)))) + +(defun flycheck-set-checker-executable (checker &optional executable) + "Set the executable of CHECKER in the current buffer. + +CHECKER is a syntax checker symbol. EXECUTABLE is a string with +the name of a executable or the path to an executable file, which +is to be used as executable for CHECKER. If omitted or nil, +reset the executable of CHECKER. + +Interactively, prompt for a syntax checker and an executable +file, and set the executable of the selected syntax checker. +With prefix arg, prompt for a syntax checker only, and reset the +executable of the select checker to the default. + +Set the executable variable of CHECKER, that is, +`flycheck-CHECKER-executable' to EXECUTABLE. Signal +`user-error', if EXECUTABLE does not denote a command or an +executable file. + +This command is intended for interactive use only. In Lisp, just +`let'-bind the corresponding variable, or set it directly. Use +`flycheck-checker-executable-variable' to obtain the executable +variable symbol for a syntax checker." + (declare (interactive-only "Set the executable variable directly instead")) + (interactive + (let* ((checker (read-flycheck-checker "Syntax checker: ")) + (default-executable (flycheck-checker-default-executable checker)) + (executable (if current-prefix-arg + nil + (read-file-name "Executable: " nil default-executable + nil nil flycheck-executable-find)))) + (list checker executable))) + (when (and executable (not (funcall flycheck-executable-find executable))) + (user-error "%s is no executable" executable)) + (let ((variable (flycheck-checker-executable-variable checker))) + (set (make-local-variable variable) executable))) + + +;;; Configuration files and options for command checkers +(defun flycheck-register-config-file-var (var checkers) + "Register VAR as config file var for CHECKERS. + +CHECKERS is a single syntax checker or a list thereof." + (when (symbolp checkers) + (setq checkers (list checkers))) + (dolist (checker checkers) + (setf (flycheck-checker-get checker 'config-file-var) var))) + +;;;###autoload +(defmacro flycheck-def-config-file-var (symbol checker &optional file-name + &rest custom-args) + "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'." + ;; FIXME: We should allow multiple config files per checker as well as + ;; multiple checkers per config file + (declare (indent 3)) + `(progn + (defcustom ,symbol ,file-name + ,(format "Configuration file for `%s'. + +If set to a string, locate the configuration file using the +functions from `flycheck-locate-config-file-functions'. If the +file is found pass it to the syntax checker as configuration +file. + +If no configuration file is found, or if this variable is set to +nil, invoke the syntax checker without a configuration file. + +Use this variable as file-local variable if you need a specific +configuration file a buffer." checker) + :type '(choice (const :tag "No configuration file" nil) + (string :tag "File name or path")) + :group 'flycheck-config-files + ,@custom-args) + (flycheck-register-config-file-var ',symbol ',checker))) + +(defun flycheck-locate-config-file (filename checker) + "Locate the configuration file FILENAME for CHECKER. + +Locate the configuration file using +`flycheck-locate-config-file-functions'. + +Return the absolute path of the configuration file, or nil if no +configuration file was found." + (-when-let (filepath (run-hook-with-args-until-success + 'flycheck-locate-config-file-functions + filename checker)) + (when (file-exists-p filepath) + filepath))) + +(defun flycheck-locate-config-file-by-path (filepath _checker) + "Locate a configuration file by a FILEPATH. + +If FILEPATH is a contains a path separator, expand it against the +default directory and return it if it points to an existing file. +Otherwise return nil. + +_CHECKER is ignored." + ;; If the path is just a plain file name, skip it. + (unless (string= (file-name-nondirectory filepath) filepath) + (let ((file-name (expand-file-name filepath))) + (and (file-exists-p file-name) file-name)))) + +(defun flycheck-locate-config-file-ancestor-directories (filename _checker) + "Locate a configuration FILENAME in ancestor directories. + +If the current buffer has a file name, search FILENAME in the +directory of the current buffer and all ancestors thereof (see +`locate-dominating-file'). If the file is found, return its +absolute path. Otherwise return nil. + +_CHECKER is ignored." + (-when-let* ((basefile (buffer-file-name)) + (directory (locate-dominating-file basefile filename))) + (expand-file-name filename directory))) + +(defun flycheck-locate-config-file-home (filename _checker) + "Locate a configuration FILENAME in the home directory. + +Return the absolute path, if FILENAME exists in the user's home +directory, or nil otherwise." + (let ((path (expand-file-name filename "~"))) + (when (file-exists-p path) + path))) + +(seq-do (apply-partially #'custom-add-frequent-value + 'flycheck-locate-config-file-functions) + '(flycheck-locate-config-file-by-path + flycheck-locate-config-file-ancestor-directories + flycheck-locate-config-file-home)) + +(defun flycheck-register-option-var (var checkers) + "Register an option VAR with CHECKERS. + +VAR is an option symbol, and CHECKERS a syntax checker symbol or +a list thereof. Register VAR with all CHECKERS so that it +appears in the help output." + (when (symbolp checkers) + (setq checkers (list checkers))) + (dolist (checker checkers) + (cl-pushnew var (flycheck-checker-get checker 'option-vars)))) + +;;;###autoload +(defmacro flycheck-def-option-var (symbol init-value checkers docstring + &rest custom-args) + "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'." + (declare (indent 3) + (doc-string 4)) + `(progn + (defcustom ,symbol ,init-value + ,(concat docstring " + +This variable is an option for the following syntax checkers: + +" + (mapconcat (lambda (c) (format " - `%s'" c)) + (if (symbolp checkers) (list checkers) checkers) + "\n")) + :group 'flycheck-options + ,@custom-args) + (flycheck-register-option-var ',symbol ',checkers))) + +(defun flycheck-option-int (value) + "Convert an integral option VALUE to a string. + +If VALUE is nil, return nil. Otherwise return VALUE converted to +a string." + (and value (number-to-string value))) + +(defun flycheck-option-symbol (value) + "Convert a symbol option VALUE to string. + +If VALUE is nil return nil. Otherwise return VALUE converted to +a string." + (and value (symbol-name value))) + +(defun flycheck-option-comma-separated-list (value &optional separator filter) + "Convert VALUE into a list separated by SEPARATOR. + +SEPARATOR is a string to separate items in VALUE, defaulting to +\",\". FILTER is an optional function, which takes a single +argument and returns either a string or nil. + +If VALUE is a list, apply FILTER to each item in VALUE, remove +all nil items, and return a single string of all remaining items +separated by SEPARATOR. + +Otherwise, apply FILTER to VALUE and return the result. +SEPARATOR is ignored in this case." + (let ((filter (or filter #'identity)) + (separator (or separator ","))) + (if (listp value) + (-when-let (value (delq nil (seq-map filter value))) + (string-join value separator)) + (funcall filter value)))) + +(defmacro flycheck-def-args-var (symbol checkers &rest custom-args) + "Define SYMBOL as argument variable for CHECKERS. + +SYMBOL is declared as customizable, risky and buffer-local +variable using `defcustom' to provide an option for arbitrary +arguments for the given syntax CHECKERS (either a single checker +or a list of checkers). CUSTOM-ARGS is forwarded to `defcustom'. + +Use the `eval' form to splice this variable into the +`:command'." + (declare (indent 2)) + `(flycheck-def-option-var ,symbol nil ,checkers + "A list of additional command line arguments. + +The value of this variable is a list of strings with additional +command line arguments." + :risky t + :type '(repeat (string :tag "Argument")) + ,@custom-args)) + + +;;; Command syntax checkers as compile commands +(defun flycheck-checker-pattern-to-error-regexp (pattern) + "Convert PATTERN into an error regexp for compile.el. + +Return a list representing PATTERN, suitable as element in +`compilation-error-regexp-alist'." + (let* ((regexp (car pattern)) + (level (cdr pattern)) + (level-no (flycheck-error-level-compilation-level level))) + (list regexp 1 2 3 level-no))) + +(defun flycheck-checker-compilation-error-regexp-alist (checker) + "Convert error patterns of CHECKER for use with compile.el. + +Return an alist of all error patterns of CHECKER, suitable for +use with `compilation-error-regexp-alist'." + (seq-map #'flycheck-checker-pattern-to-error-regexp + (flycheck-checker-get checker 'error-patterns))) + +(defun flycheck-checker-shell-command (checker) + "Get a shell command for CHECKER. + +Perform substitution in the arguments of CHECKER, but with +`flycheck-substitute-shell-argument'. + +Return the command of CHECKER as single string, suitable for +shell execution." + ;; Note: Do NOT use `combine-and-quote-strings' here. Despite it's name it + ;; does not properly quote shell arguments, and actually breaks for special + ;; characters. See https://github.com/flycheck/flycheck/pull/522 + (let* ((args (apply #'append + (seq-map (lambda (arg) + (if (memq arg '(source source-inplace source-original)) + (list (buffer-file-name)) + (flycheck-substitute-argument arg checker))) + (flycheck-checker-arguments checker)))) + (command (mapconcat + #'shell-quote-argument + (funcall flycheck-command-wrapper-function + (cons (flycheck-checker-executable checker) args)) + " "))) + (if (flycheck-checker-get checker 'standard-input) + ;; If the syntax checker expects the source from standard input add an + ;; appropriate shell redirection + (concat command " < " (shell-quote-argument (buffer-file-name))) + command))) + +(defun flycheck-compile-name (_name) + "Get a name for a Flycheck compilation buffer. + +_NAME is ignored." + (format "*Flycheck %s*" (buffer-file-name))) + +(defun flycheck-compile (checker) + "Run CHECKER via `compile'. + +CHECKER must be a valid syntax checker. Interactively, prompt +for a syntax checker to run. + +Instead of highlighting errors in the buffer, this command pops +up a separate buffer with the entire output of the syntax checker +tool, just like `compile' (\\[compile])." + (interactive + (let ((default (flycheck-get-checker-for-buffer))) + (list (read-flycheck-checker "Run syntax checker as compile command: " + (when (flycheck-checker-get default 'command) + default) + 'command)))) + (unless (flycheck-valid-checker-p checker) + (user-error "%S is not a valid syntax checker" checker)) + (unless (buffer-file-name) + (user-error "Cannot compile buffers without backing file")) + (unless (flycheck-may-use-checker checker) + (user-error "Cannot use syntax checker %S in this buffer" checker)) + (unless (flycheck-checker-executable checker) + (user-error "Cannot run checker %S as shell command" checker)) + (let* ((default-directory (flycheck-compute-working-directory checker)) + (command (flycheck-checker-shell-command checker)) + (buffer (compilation-start command nil #'flycheck-compile-name))) + (with-current-buffer buffer + (setq-local compilation-error-regexp-alist + (flycheck-checker-compilation-error-regexp-alist checker))))) + + +;;; General error parsing for command checkers +(defun flycheck-parse-output (output checker buffer) + "Parse OUTPUT from CHECKER in BUFFER. + +OUTPUT is a string with the output from the checker symbol +CHECKER. BUFFER is the buffer which was checked. + +Return the errors parsed with the error patterns of CHECKER." + (funcall (flycheck-checker-get checker 'error-parser) output checker buffer)) + +(defun flycheck-fix-error-filename (err buffer-files cwd) + "Fix the file name of ERR from BUFFER-FILES. + +Resolves error file names relative to CWD directory. + +Make the file name of ERR absolute. If the absolute file name of +ERR is in BUFFER-FILES, replace it with the return value of the +function `buffer-file-name'." + (flycheck-error-with-buffer err + (-when-let (filename (flycheck-error-filename err)) + (when (seq-some (apply-partially #'flycheck-same-files-p + (expand-file-name filename cwd)) + buffer-files) + (let ((new-filename (buffer-file-name))) + (setf (flycheck-error-filename err) new-filename) + (when new-filename + (setf (flycheck-error-message err) + (replace-regexp-in-string + (regexp-quote filename) + new-filename + (flycheck-error-message err) + 'fixed-case + 'literal))))))) + err) + + +;;; Error parsers for command syntax checkers +(defun flycheck-parse-xml-region (beg end) + "Parse the xml region between BEG and END. + +Wrapper around `xml-parse-region' which transforms the return +value of this function into one compatible to +`libxml-parse-xml-region' by simply returning the first element +from the node list." + (car (xml-parse-region beg end))) + +(defvar flycheck-xml-parser + (if (fboundp 'libxml-parse-xml-region) + 'libxml-parse-xml-region 'flycheck-parse-xml-region) + "Parse an xml string from a region. + +Use libxml if Emacs is built with libxml support. Otherwise fall +back to `xml-parse-region', via `flycheck-parse-xml-region'.") + +(defun flycheck-parse-xml-string (xml) + "Parse an XML string. + +Return the document tree parsed from XML in the form `(ROOT ATTRS +BODY...)'. ROOT is a symbol identifying the name of the root +element. ATTRS is an alist of the attributes of the root node. +BODY is zero or more body elements, either as strings (in case of +text nodes) or as XML nodes, in the same for as the root node." + (with-temp-buffer + (insert xml) + (funcall flycheck-xml-parser (point-min) (point-max)))) + +(defun flycheck-parse-checkstyle (output checker buffer) + "Parse Checkstyle errors from OUTPUT. + +Parse Checkstyle-like XML output. Use this error parser for +checkers that have an option to output errors in this format. + +CHECKER and BUFFER denoted the CHECKER that returned OUTPUT and +the BUFFER that was checked respectively. + +See URL `http://checkstyle.sourceforge.net/' for information +about Checkstyle." + (pcase (flycheck-parse-xml-string output) + (`(checkstyle ,_ . ,file-nodes) + (let (errors) + (dolist (node file-nodes) + (pcase node + (`(file ,file-attrs . ,error-nodes) + (dolist (node error-nodes) + (pcase node + (`(error ,error-attrs . ,_) + (let-alist error-attrs + (push (flycheck-error-new-at + (flycheck-string-to-number-safe .line) + (flycheck-string-to-number-safe .column) + (pcase .severity + (`"error" 'error) + (`"warning" 'warning) + (`"info" 'info) + ;; Default to error for unknown .severity + (_ 'error)) + .message + :checker checker :id .source + :buffer buffer + :filename (cdr (assq 'name file-attrs))) + errors)))))))) + (nreverse errors))))) + +(defun flycheck-parse-cppcheck (output checker buffer) + "Parse Cppcheck errors from OUTPUT. + +Parse Cppcheck XML v2 output. + +CHECKER and BUFFER denoted the CHECKER that returned OUTPUT and +the BUFFER that was checked respectively. + +See URL `http://cppcheck.sourceforge.net/' for more information +about Cppcheck." + (pcase (flycheck-parse-xml-string output) + (`(results ,_ . ,body) + (let (errors) + (dolist (node body) + (pcase node + (`(errors ,_ . ,error-nodes) + (dolist (node error-nodes) + (pcase node + (`(error ,error-attrs . ,loc-nodes) + (let ((id (cdr (assq 'id error-attrs))) + (message (cdr (assq 'verbose error-attrs))) + (level (pcase (cdr (assq 'severity error-attrs)) + (`"error" 'error) + (`"style" 'info) + (`"information" 'info) + (_ 'warning)))) + (dolist (node loc-nodes) + (pcase node + (`(location ,loc-attrs . ,_) + (let-alist loc-attrs + (push (flycheck-error-new-at + (flycheck-string-to-number-safe .line) + nil + level message + :id id + :checker checker + :buffer buffer + :filename .file) + errors)))))))))))) + (nreverse errors))))) + +(defun flycheck-parse-phpmd (output checker buffer) + "Parse phpmd errors from OUTPUT. + +CHECKER and BUFFER denoted the CHECKER that returned OUTPUT and +the BUFFER that was checked respectively. + +See URL `http://phpmd.org/' for more information about phpmd." + (pcase (flycheck-parse-xml-string output) + (`(pmd ,_ . ,body) + (let (errors) + (dolist (node body) + (pcase node + (`(file ,file-attrs . ,violation-nodes) + (let ((filename (cdr (assq 'name file-attrs)))) + (dolist (node violation-nodes) + (pcase node + (`(violation ,vio-attrs ,(and message (pred stringp))) + (let-alist vio-attrs + ;; TODO: Map priority to an error level? + ;; TODO: Respect endline + (push + (flycheck-error-new-at + (flycheck-string-to-number-safe .beginline) + nil + 'warning (string-trim message) + :id .rule + :checker checker + :buffer buffer + :filename filename) + errors))))))))) + (nreverse errors))))) + +(defun flycheck-parse-tslint (output checker buffer) + "Parse TSLint errors from JSON OUTPUT. + +CHECKER and BUFFER denoted the CHECKER that returned OUTPUT and +the BUFFER that was checked respectively. + +See URL `https://palantir.github.io/tslint/' for more information +about TSLint." + (let ((json-array-type 'list)) + (seq-map (lambda (message) + (let-alist message + (flycheck-error-new-at + (+ 1 .startPosition.line) + (+ 1 .startPosition.character) + 'warning .failure + :id .ruleName + :checker checker + :buffer buffer + :filename .name))) + ;; Don't try to parse empty output as JSON + (and (not (string-empty-p output)) + (json-read-from-string output))))) + +(defun flycheck-parse-rust (output checker buffer) + "Parse rust errors from OUTPUT and return a list of `flycheck-error'. + +CHECKER and BUFFER denote the CHECKER that returned OUTPUT and +the BUFFER that was checked respectively. + +The expected format for OUTPUT is a mix of plain text lines and +JSON lines. This function ignores the plain text lines and +parses only JSON lines. Each JSON line is expected to be a JSON +object that corresponds to a diagnostic from the compiler. The +expected diagnostic format is described there: + +https://github.com/rust-lang/rust/blob/master/src/libsyntax/json.rs#L67-L139" + (let* ((json-array-type 'list) + (json-false nil) + ;; Skip the plain text lines in OUTPUT, keep the JSON lines. + (json-lines (seq-filter (lambda (line) + (string-match-p "^{" line)) + (split-string output "\n"))) + ;; Each JSON line is a JSON object. + (diagnostics (seq-map #'json-read-from-string json-lines)) + (errors)) + ;; The diagnostic format is described in the link above. The gist of it is + ;; that each diagnostic can have several causes in the source text; these + ;; causes are represented by spans. The diagnostic has a message and a + ;; level (error, warning), while the spans have a filename, line, column, + ;; and an optional label. The primary span points to the root cause of the + ;; error in the source text, while non-primary spans point to related + ;; causes. In addition, each diagnostic can also have children diagnostics + ;; that are used to provide additional information through their message + ;; field, but do not seem to contain any spans (yet). + ;; + ;; We first iterate over diagnostics and their spans to turn every span into + ;; a flycheck error object, that we collect into the `errors' list. + (dolist (diagnostic diagnostics) + (let ((error-message) + (error-level) + (error-code) + (primary-filename) + (primary-line) + (primary-column) + (spans) + (children)) + + ;; Nested `let-alist' cause compilation warnings, hence we `setq' all + ;; these values here first to avoid nesting. + (let-alist diagnostic + (setq error-message .message + error-level (pcase .level + (`"error" 'error) + (`"warning" 'warning) + (_ 'error)) + ;; The 'code' field of the diagnostic contains the actual error + ;; code and an optional explanation that we ignore + error-code .code.code + spans .spans + children .children)) + + (dolist (span spans) + (let-alist span + ;; Children lack any filename/line/column information, so we use + ;; those from the primary span + (when .is_primary + (setq primary-filename .file_name + primary-line .line_start + primary-column .column_start)) + (push + (flycheck-error-new-at + .line_start + .column_start + ;; Non-primary spans are used for notes + (if .is_primary error-level 'info) + (if .is_primary + ;; Primary spans may have labels with additional information + (concat error-message (when .label + (format " (%s)" .label))) + .label) + :id error-code + :checker checker + :buffer buffer + :filename .file_name) + errors))) + + ;; Then we turn children messages into flycheck errors pointing to the + ;; location of the primary span. According to the format, children + ;; may contain spans, but they do not seem to use them in practice. + (dolist (child children) + (let-alist child + (push + (flycheck-error-new-at + primary-line + primary-column + 'info + .message + :id error-code + :checker checker + :buffer buffer + :filename primary-filename) + errors))))) + (nreverse errors))) + + +;;; Error parsing with regular expressions +(defun flycheck-get-regexp (patterns) + "Create a single regular expression from PATTERNS." + (rx-to-string `(or ,@(seq-map (lambda (p) (list 'regexp (car p))) patterns)) + 'no-group)) + +(defun flycheck-tokenize-output-with-patterns (output patterns) + "Tokenize OUTPUT with PATTERNS. + +Split the output into error tokens, using all regular expressions +from the error PATTERNS. An error token is simply a string +containing a single error from OUTPUT. Such a token can then be +parsed into a structured error by applying the PATTERNS again, +see `flycheck-parse-errors-with-patterns'. + +Return a list of error tokens." + (let ((regexp (flycheck-get-regexp patterns)) + (last-match 0) + errors) + (while (string-match regexp output last-match) + (push (match-string 0 output) errors) + (setq last-match (match-end 0))) + (reverse errors))) + +(defun flycheck-try-parse-error-with-pattern (err pattern checker) + "Try to parse a single ERR with a PATTERN for CHECKER. + +Return the parsed error if PATTERN matched ERR, or nil +otherwise." + (let ((regexp (car pattern)) + (level (cdr pattern))) + (when (string-match regexp err) + (let ((filename (match-string 1 err)) + (line (match-string 2 err)) + (column (match-string 3 err)) + (message (match-string 4 err)) + (id (match-string 5 err))) + (flycheck-error-new-at + (flycheck-string-to-number-safe line) + (flycheck-string-to-number-safe column) + level + (unless (string-empty-p message) message) + :id (unless (string-empty-p id) id) + :checker checker + :filename (if (or (null filename) (string-empty-p filename)) + (buffer-file-name) + filename)))))) + +(defun flycheck-parse-error-with-patterns (err patterns checker) + "Parse a gle ERR with error PATTERNS for CHECKER. + +Apply each pattern in PATTERNS to ERR, in the given order, and +return the first parsed error." + ;; Try to parse patterns in the order of declaration to make sure that the + ;; first match wins. + (let (parsed-error) + (while (and patterns + (not (setq parsed-error + (flycheck-try-parse-error-with-pattern + err (car patterns) checker)))) + (setq patterns (cdr patterns))) + parsed-error)) + +(defun flycheck-parse-with-patterns (output checker buffer) + "Parse OUTPUT from CHECKER with error patterns. + +Uses the error patterns of CHECKER to tokenize the output and +tries to parse each error token with all patterns, in the order +of declaration. Hence an error is never matched twice by two +different patterns. The pattern declared first always wins. + +_BUFFER is ignored. + +Return a list of parsed errors and warnings (as `flycheck-error' +objects)." + (with-current-buffer buffer + (let ((patterns (flycheck-checker-get checker 'error-patterns))) + (seq-map (lambda (err) + (flycheck-parse-error-with-patterns err patterns checker)) + (flycheck-tokenize-output-with-patterns output patterns))))) + + +;;; Convenience definition of command-syntax checkers +(defmacro flycheck-define-checker (symbol docstring &rest properties) + "Define SYMBOL as command syntax checker with DOCSTRING and PROPERTIES. + +Like `flycheck-define-command-checker', but PROPERTIES must not +be quoted. Also, implicitly define the executable variable for +SYMBOL with `flycheck-def-executable-var'." + (declare (indent 1) + (doc-string 2)) + (let ((command (plist-get properties :command)) + (parser (plist-get properties :error-parser)) + (filter (plist-get properties :error-filter)) + (predicate (plist-get properties :predicate)) + (verify-fn (plist-get properties :verify))) + + `(progn + (flycheck-def-executable-var ,symbol ,(car command)) + + (flycheck-define-command-checker ',symbol + ,docstring + :command ',command + ,@(when parser + `(:error-parser #',parser)) + :error-patterns ',(plist-get properties :error-patterns) + ,@(when filter + `(:error-filter #',filter)) + :modes ',(plist-get properties :modes) + ,@(when predicate + `(:predicate #',predicate)) + :next-checkers ',(plist-get properties :next-checkers) + ,@(when verify-fn + `(:verify #',verify-fn)) + :standard-input ',(plist-get properties :standard-input) + :working-directory ',(plist-get properties :working-directory))))) + + +;;; Built-in checkers +(flycheck-def-args-var flycheck-gnat-args ada-gnat + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gnat-include-path nil ada-gnat + "A list of include directories for GNAT. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of gcc. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gnat-language-standard "2012" ada-gnat + "The language standard to use in GNAT. + +The value of this variable is either a string denoting a language +standard, or nil, to use the default standard. When non-nil, pass +the language standard via the `-std' option." + :type '(choice (const :tag "Default standard" nil) + (string :tag "Language standard")) + :safe #'stringp + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gnat-warnings + '("wa") ada-gnat + "A list of additional Ada warnings to enable in GNAT. + +The value of this variable is a list of strings, where each +string is the name of a warning category to enable. By default, +most optional warnings are recommended, as in `-gnata'. + +Refer to Info Node `(gnat_ugn_unw)Warning Message Control' for +more information about GNAT warnings." + :type '(repeat :tag "Warnings" (string :tag "Warning name")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-define-checker ada-gnat + "An Ada syntax checker using GNAT. + +Uses the GNAT compiler from GCC. See URL +`http://libre.adacore.com/tools/gnat-gpl-edition/'." + :command ("gnatmake" + "-c" ; Just compile, don't bind + "-f" ; Force re-compilation + "-u" ; Compile the main file only + "-gnatf" ; Full error information + "-gnatef" ; Full source file name + "-D" temporary-directory + (option-list "-gnat" flycheck-gnat-warnings concat) + (option-list "-I" flycheck-gnat-include-path concat) + (option "-gnat" flycheck-gnat-language-standard concat) + (eval flycheck-gnat-args) + source) + :error-patterns + ((error line-start + (message "In file included from") " " (file-name) ":" line ":" + column ":" + line-end) + (info line-start (file-name) ":" line ":" column + ": note: " (message) line-end) + (warning line-start (file-name) ":" line ":" column + ": warning: " (message) line-end) + (error line-start (file-name) ":" line ":" column ;no specific error prefix in Ada + ": " (message) line-end)) + :modes ada-mode) + +(flycheck-define-checker asciidoc + "A AsciiDoc syntax checker using the AsciiDoc compiler. + +See URL `http://www.methods.co.nz/asciidoc'." + :command ("asciidoc" "-o" null-device "-") + :standard-input t + :error-patterns + ((error line-start + "asciidoc: ERROR: : Line " line ": " (message) + line-end) + (warning line-start + "asciidoc: WARNING: : Line " line ": " (message) + line-end) + (info line-start + "asciidoc: DEPRECATED: : Line " line ": " (message) + line-end)) + :modes adoc-mode) + +(flycheck-def-args-var flycheck-clang-args c/c++-clang + :package-version '(flycheck . "0.22")) + +(flycheck-def-option-var flycheck-clang-blocks nil c/c++-clang + "Enable blocks in Clang. + +When non-nil, enable blocks in Clang with `-fblocks'. See URL +`http://clang.llvm.org/docs/BlockLanguageSpec.html' for more +information about blocks." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-clang-definitions nil c/c++-clang + "Additional preprocessor definitions for Clang. + +The value of this variable is a list of strings, where each +string is an additional definition to pass to Clang, via the `-D' +option." + :type '(repeat (string :tag "Definition")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.15")) + +(flycheck-def-option-var flycheck-clang-include-path nil c/c++-clang + "A list of include directories for Clang. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of Clang. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.14")) + +(flycheck-def-option-var flycheck-clang-includes nil c/c++-clang + "A list of additional include files for Clang. + +The value of this variable is a list of strings, where each +string is a file to include before syntax checking. Relative +paths are relative to the file being checked." + :type '(repeat (file :tag "Include file")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.15")) + +(flycheck-def-option-var flycheck-clang-language-standard nil c/c++-clang + "The language standard to use in Clang. + +The value of this variable is either a string denoting a language +standard, or nil, to use the default standard. When non-nil, +pass the language standard via the `-std' option." + :type '(choice (const :tag "Default standard" nil) + (string :tag "Language standard")) + :safe #'stringp + :package-version '(flycheck . "0.15")) +(make-variable-buffer-local 'flycheck-clang-language-standard) + +(flycheck-def-option-var flycheck-clang-ms-extensions nil c/c++-clang + "Whether to enable Microsoft extensions to C/C++ in Clang. + +When non-nil, enable Microsoft extensions to C/C++ via +`-fms-extensions'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.16")) + +(flycheck-def-option-var flycheck-clang-no-exceptions nil c/c++-clang + "Whether to disable exceptions in Clang. + +When non-nil, disable exceptions for syntax checks, via +`-fno-exceptions'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-clang-no-rtti nil c/c++-clang + "Whether to disable RTTI in Clang. + +When non-nil, disable RTTI for syntax checks, via `-fno-rtti'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.15")) + +(flycheck-def-option-var flycheck-clang-pedantic nil c/c++-clang + "Whether to warn about language extensions in Clang. + +For ISO C, follows the version specified by any -std option used. +When non-nil, disable non-ISO extensions to C/C++ via +`-pedantic'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.23")) + +(flycheck-def-option-var flycheck-clang-pedantic-errors nil c/c++-clang + "Whether to error on language extensions in Clang. + +For ISO C, follows the version specified by any -std option used. +When non-nil, disable non-ISO extensions to C/C++ via +`-pedantic-errors'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.23")) + +(flycheck-def-option-var flycheck-clang-standard-library nil c/c++-clang + "The standard library to use for Clang. + +The value of this variable is the name of a standard library as +string, or nil to use the default standard library. + +Refer to the Clang manual at URL +`http://clang.llvm.org/docs/UsersManual.html' for more +information about the standard library." + :type '(choice (const "libc++") + (const :tag "GNU libstdc++" "libstdc++") + (string :tag "Library name")) + :safe #'stringp + :package-version '(flycheck . "0.15")) + +(flycheck-def-option-var flycheck-clang-warnings '("all" "extra") c/c++-clang + "A list of additional warnings to enable in Clang. + +The value of this variable is a list of strings, where each string +is the name of a warning category to enable. By default, all +recommended warnings and some extra warnings are enabled (as by +`-Wall' and `-Wextra' respectively). + +Refer to the Clang manual at URL +`http://clang.llvm.org/docs/UsersManual.html' for more +information about warnings." + :type '(choice (const :tag "No additional warnings" nil) + (repeat :tag "Additional warnings" + (string :tag "Warning name"))) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.14")) + +(defun flycheck-c/c++-quoted-include-directory () + "Get the directory for quoted includes. + +C/C++ compiles typicall look up includes with quotation marks in +the directory of the file being compiled. However, since +Flycheck uses temporary copies for syntax checking, it needs to +explicitly determine the directory for quoted includes. + +This function determines the directory by looking at function +`buffer-file-name', or if that is nil, at `default-directory'." + (-if-let (fn (buffer-file-name)) + (file-name-directory fn) + ;; If the buffer has no file name, fall back to its default directory + default-directory)) + +(flycheck-define-checker c/c++-clang + "A C/C++ syntax checker using Clang. + +See URL `http://clang.llvm.org/'." + :command ("clang" + "-fsyntax-only" + "-fno-color-diagnostics" ; Do not include color codes in output + "-fno-caret-diagnostics" ; Do not visually indicate the source + ; location + "-fno-diagnostics-show-option" ; Do not show the corresponding + ; warning group + "-iquote" (eval (flycheck-c/c++-quoted-include-directory)) + (option "-std=" flycheck-clang-language-standard concat) + (option-flag "-pedantic" flycheck-clang-pedantic) + (option-flag "-pedantic-errors" flycheck-clang-pedantic-errors) + (option "-stdlib=" flycheck-clang-standard-library concat) + (option-flag "-fms-extensions" flycheck-clang-ms-extensions) + (option-flag "-fno-exceptions" flycheck-clang-no-exceptions) + (option-flag "-fno-rtti" flycheck-clang-no-rtti) + (option-flag "-fblocks" flycheck-clang-blocks) + (option-list "-include" flycheck-clang-includes) + (option-list "-W" flycheck-clang-warnings concat) + (option-list "-D" flycheck-clang-definitions concat) + (option-list "-I" flycheck-clang-include-path) + (eval flycheck-clang-args) + "-x" (eval + (pcase major-mode + (`c++-mode "c++") + (`c-mode "c"))) + ;; Read from standard input + "-") + :standard-input t + :error-patterns + ((error line-start + (message "In file included from") " " (or "" (file-name)) + ":" line ":" line-end) + (info line-start (or "" (file-name)) ":" line ":" column + ": note: " (optional (message)) line-end) + (warning line-start (or "" (file-name)) ":" line ":" column + ": warning: " (optional (message)) line-end) + (error line-start (or "" (file-name)) ":" line ":" column + ": " (or "fatal error" "error") ": " (optional (message)) line-end)) + :error-filter + (lambda (errors) + (let ((errors (flycheck-sanitize-errors errors))) + (dolist (err errors) + ;; Clang will output empty messages for #error/#warning pragmas without + ;; messages. We fill these empty errors with a dummy message to get + ;; them past our error filtering + (setf (flycheck-error-message err) + (or (flycheck-error-message err) "no message"))) + (flycheck-fold-include-levels errors "In file included from"))) + :modes (c-mode c++-mode) + :next-checkers ((warning . c/c++-cppcheck))) + +(flycheck-def-args-var flycheck-gcc-args c/c++-gcc + :package-version '(flycheck . "0.22")) + +(flycheck-def-option-var flycheck-gcc-definitions nil c/c++-gcc + "Additional preprocessor definitions for GCC. + +The value of this variable is a list of strings, where each +string is an additional definition to pass to GCC, via the `-D' +option." + :type '(repeat (string :tag "Definition")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gcc-include-path nil c/c++-gcc + "A list of include directories for GCC. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of gcc. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gcc-includes nil c/c++-gcc + "A list of additional include files for GCC. + +The value of this variable is a list of strings, where each +string is a file to include before syntax checking. Relative +paths are relative to the file being checked." + :type '(repeat (file :tag "Include file")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gcc-language-standard nil c/c++-gcc + "The language standard to use in GCC. + +The value of this variable is either a string denoting a language +standard, or nil, to use the default standard. When non-nil, +pass the language standard via the `-std' option." + :type '(choice (const :tag "Default standard" nil) + (string :tag "Language standard")) + :safe #'stringp + :package-version '(flycheck . "0.20")) +(make-variable-buffer-local 'flycheck-gcc-language-standard) + +(flycheck-def-option-var flycheck-gcc-no-exceptions nil c/c++-gcc + "Whether to disable exceptions in GCC. + +When non-nil, disable exceptions for syntax checks, via +`-fno-exceptions'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gcc-no-rtti nil c/c++-gcc + "Whether to disable RTTI in GCC. + +When non-nil, disable RTTI for syntax checks, via `-fno-rtti'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gcc-openmp nil c/c++-gcc + "Whether to enable OpenMP in GCC. + +When non-nil, enable OpenMP for syntax checkers, via +`-fopenmp'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.21")) + +(flycheck-def-option-var flycheck-gcc-pedantic nil c/c++-gcc + "Whether to warn about language extensions in GCC. + +For ISO C, follows the version specified by any -std option used. +When non-nil, disable non-ISO extensions to C/C++ via +`-pedantic'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.23")) + +(flycheck-def-option-var flycheck-gcc-pedantic-errors nil c/c++-gcc + "Whether to error on language extensions in GCC. + +For ISO C, follows the version specified by any -std option used. +When non-nil, disable non-ISO extensions to C/C++ via +`-pedantic-errors'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.23")) + +(flycheck-def-option-var flycheck-gcc-warnings '("all" "extra") c/c++-gcc + "A list of additional warnings to enable in GCC. + +The value of this variable is a list of strings, where each string +is the name of a warning category to enable. By default, all +recommended warnings and some extra warnings are enabled (as by +`-Wall' and `-Wextra' respectively). + +Refer to the gcc manual at URL +`https://gcc.gnu.org/onlinedocs/gcc/' for more information about +warnings." + :type '(choice (const :tag "No additional warnings" nil) + (repeat :tag "Additional warnings" + (string :tag "Warning name"))) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-define-checker c/c++-gcc + "A C/C++ syntax checker using GCC. + +Requires GCC 4.8 or newer. See URL `https://gcc.gnu.org/'." + :command ("gcc" + "-fshow-column" + "-fno-diagnostics-show-caret" ; Do not visually indicate the source location + "-fno-diagnostics-show-option" ; Do not show the corresponding + ; warning group + "-iquote" (eval (flycheck-c/c++-quoted-include-directory)) + (option "-std=" flycheck-gcc-language-standard concat) + (option-flag "-pedantic" flycheck-gcc-pedantic) + (option-flag "-pedantic-errors" flycheck-gcc-pedantic-errors) + (option-flag "-fno-exceptions" flycheck-gcc-no-exceptions) + (option-flag "-fno-rtti" flycheck-gcc-no-rtti) + (option-flag "-fopenmp" flycheck-gcc-openmp) + (option-list "-include" flycheck-gcc-includes) + (option-list "-W" flycheck-gcc-warnings concat) + (option-list "-D" flycheck-gcc-definitions concat) + (option-list "-I" flycheck-gcc-include-path) + (eval flycheck-gcc-args) + "-x" (eval + (pcase major-mode + (`c++-mode "c++") + (`c-mode "c"))) + ;; GCC performs full checking only when actually compiling, so + ;; `-fsyntax-only' is not enough. Just let it generate assembly + ;; code. + "-S" "-o" null-device + ;; Read from standard input + "-") + :standard-input t + :error-patterns + ((error line-start + (message "In file included from") " " (or "" (file-name)) + ":" line ":" column ":" line-end) + (info line-start (or "" (file-name)) ":" line ":" column + ": note: " (message) line-end) + (warning line-start (or "" (file-name)) ":" line ":" column + ": warning: " (message) line-end) + (error line-start (or "" (file-name)) ":" line ":" column + ": " (or "fatal error" "error") ": " (message) line-end)) + :error-filter + (lambda (errors) + (flycheck-fold-include-levels (flycheck-sanitize-errors errors) + "In file included from")) + :modes (c-mode c++-mode) + :next-checkers ((warning . c/c++-cppcheck))) + +(flycheck-def-option-var flycheck-cppcheck-checks '("style") c/c++-cppcheck + "Enabled checks for Cppcheck. + +The value of this variable is a list of strings, where each +string is the name of an additional check to enable. By default, +all coding style checks are enabled. + +See section \"Enable message\" in the Cppcheck manual at URL +`http://cppcheck.sourceforge.net/manual.pdf', and the +documentation of the `--enable' option for more information, +including a list of supported checks." + :type '(repeat :tag "Additional checks" + (string :tag "Check name")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.14")) + +(flycheck-def-option-var flycheck-cppcheck-standards nil c/c++-cppcheck + "The standards to use in cppcheck. + +The value of this variable is either a list of strings denoting +the standards to use, or nil to pass nothing to cppcheck. When +non-nil, pass the standards via one or more `--std=' options." + :type '(choice (const :tag "Default" nil) + (repeat :tag "Custom standards" + (string :tag "Standard name"))) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "28")) +(make-variable-buffer-local 'flycheck-cppcheck-standards) + +(flycheck-def-option-var flycheck-cppcheck-suppressions nil c/c++-cppcheck + "The suppressions to use in cppcheck. + +The value of this variable is either a list of strings denoting +the suppressions to use, or nil to pass nothing to cppcheck. +When non-nil, pass the suppressions via one or more `--suppress=' +options." + :type '(choice (const :tag "Default" nil) + (repeat :tag "Additional suppressions" + (string :tag "Suppression"))) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "28")) + +(flycheck-def-option-var flycheck-cppcheck-inconclusive nil c/c++-cppcheck + "Whether to enable Cppcheck inconclusive checks. + +When non-nil, enable Cppcheck inconclusive checks. This allows Cppcheck to +report warnings it's not certain of, but it may result in false positives. + +This will have no effect when using Cppcheck 1.53 and older." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.19")) + +(flycheck-def-option-var flycheck-cppcheck-include-path nil c/c++-cppcheck + "A list of include directories for cppcheck. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of cppcheck. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-define-checker c/c++-cppcheck + "A C/C++ checker using cppcheck. + +See URL `http://cppcheck.sourceforge.net/'." + :command ("cppcheck" "--quiet" "--xml-version=2" "--inline-suppr" + (option "--enable=" flycheck-cppcheck-checks concat + flycheck-option-comma-separated-list) + (option-flag "--inconclusive" flycheck-cppcheck-inconclusive) + (option-list "-I" flycheck-cppcheck-include-path) + (option-list "--std=" flycheck-cppcheck-standards concat) + (option-list "--suppress=" flycheck-cppcheck-suppressions concat) + "-x" (eval + (pcase major-mode + (`c++-mode "c++") + (`c-mode "c"))) + source) + :error-parser flycheck-parse-cppcheck + :modes (c-mode c++-mode)) + +(flycheck-define-checker cfengine + "A CFEngine syntax checker using cf-promises. + +See URL `https://cfengine.com/'." + :command ("cf-promises" "-Wall" "-f" + ;; We must stay in the same directory to resolve @include + source-inplace) + :error-patterns + ((warning line-start (file-name) ":" line ":" column + ": warning: " (message) line-end) + (error line-start (file-name) ":" line ":" column + ": error: " (message) line-end)) + :modes (cfengine-mode cfengine3-mode)) + +(flycheck-def-option-var flycheck-foodcritic-tags nil chef-foodcritic + "A list of tags to select for Foodcritic. + +The value of this variable is a list of strings where each string +is a tag expression describing Foodcritic rules to enable or +disable, via the `--tags' option. To disable a tag, prefix it +with `~'." + :type '(repeat :tag "Tags" (string :tag "Tag expression")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.23")) + +(flycheck-define-checker chef-foodcritic + "A Chef cookbooks syntax checker using Foodcritic. + +See URL `http://www.foodcritic.io'." + ;; Use `source-inplace' to allow resource discovery with relative paths. + ;; foodcritic interprets these as relative to the source file, so we need to + ;; stay within the source tree. See + ;; https://github.com/flycheck/flycheck/pull/556 + :command ("foodcritic" + (option-list "--tags" flycheck-foodcritic-tags) + source-inplace) + :error-patterns + ((error line-start (message) ": " (file-name) ":" line line-end)) + :modes (enh-ruby-mode ruby-mode) + :predicate + (lambda () + (let ((parent-dir (file-name-directory + (directory-file-name + (expand-file-name default-directory))))) + (or + ;; Chef CookBook + ;; http://docs.opscode.com/chef/knife.html#id38 + (locate-dominating-file parent-dir "recipes") + ;; Knife Solo + ;; http://matschaffer.github.io/knife-solo/#label-Init+command + (locate-dominating-file parent-dir "cookbooks"))))) + +(flycheck-define-checker coffee + "A CoffeeScript syntax checker using coffee. + +See URL `http://coffeescript.org/'." + ;; --print suppresses generation of compiled .js files + :command ("coffee" "--compile" "--print" "--stdio") + :standard-input t + :error-patterns + ((error line-start "[stdin]:" line ":" column + ": error: " (message) line-end)) + :modes coffee-mode + :next-checkers ((warning . coffee-coffeelint))) + +(flycheck-def-config-file-var flycheck-coffeelintrc coffee-coffeelint + ".coffeelint.json" + :safe #'stringp) + +(flycheck-define-checker coffee-coffeelint + "A CoffeeScript style checker using coffeelint. + +See URL `http://www.coffeelint.org/'." + :command + ("coffeelint" + (config-file "--file" flycheck-coffeelintrc) + "--stdin" "--reporter" "checkstyle") + :standard-input t + :error-parser flycheck-parse-checkstyle + :error-filter (lambda (errors) + (flycheck-remove-error-file-names + "stdin" (flycheck-remove-error-ids + (flycheck-sanitize-errors errors)))) + :modes coffee-mode) + +(flycheck-define-checker coq + "A Coq syntax checker using the Coq compiler. + +See URL `https://coq.inria.fr/'." + ;; We use coqtop in batch mode, because coqc is picky about file names. + :command ("coqtop" "-batch" "-load-vernac-source" source) + :error-patterns + ((error line-start "File \"" (file-name) "\", line " line + ;; TODO: Parse the end column, once Flycheck supports that + ", characters " column "-" (one-or-more digit) ":\n" + (or "Syntax error:" "Error:") + ;; Most Coq error messages span multiple lines, and end with a dot. + ;; There are simple one-line messages, too, though. + (message (or (and (one-or-more (or not-newline "\n")) ".") + (one-or-more not-newline))) + line-end)) + :error-filter + (lambda (errors) + (dolist (err (flycheck-sanitize-errors errors)) + (setf (flycheck-error-message err) + (replace-regexp-in-string (rx (1+ (syntax whitespace)) line-end) + "" (flycheck-error-message err) + 'fixedcase 'literal))) + (flycheck-increment-error-columns errors)) + :modes coq-mode) + +(flycheck-define-checker css-csslint + "A CSS syntax and style checker using csslint. + +See URL `https://github.com/CSSLint/csslint'." + :command ("csslint" "--format=checkstyle-xml" source) + :error-parser flycheck-parse-checkstyle + :error-filter flycheck-dequalify-error-ids + :modes css-mode) + +(defconst flycheck-d-module-re + (rx "module" (one-or-more (syntax whitespace)) + (group (one-or-more (not (syntax whitespace)))) + (zero-or-more (syntax whitespace)) + ";") + "Regular expression to match a D module declaration.") + +(defun flycheck-d-base-directory () + "Get the relative base directory path for this module." + (let* ((file-name (buffer-file-name)) + (module-file (if (string= (file-name-nondirectory file-name) + "package.d") + (directory-file-name (file-name-directory file-name)) + file-name))) + (flycheck-module-root-directory + (flycheck-find-in-buffer flycheck-d-module-re) + module-file))) + +(flycheck-def-option-var flycheck-dmd-include-path nil d-dmd + "A list of include directories for dmd. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of dmd. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.18")) + +(flycheck-def-args-var flycheck-dmd-args d-dmd + :package-version '(flycheck . "0.24")) + +(flycheck-define-checker d-dmd + "A D syntax checker using the DMD compiler. + +Requires DMD 2.066 or newer. See URL `http://dlang.org/'." + :command ("dmd" + "-debug" ; Compile in debug mode + "-o-" ; Don't generate an object file + "-vcolumns" ; Add columns in output + "-wi" ; Compilation will continue even if there are warnings + (eval (concat "-I" (flycheck-d-base-directory))) + (option-list "-I" flycheck-dmd-include-path concat) + (eval flycheck-dmd-args) + source) + :error-patterns + ((error line-start + (file-name) "(" line "," column "): Error: " (message) + line-end) + (warning line-start (file-name) "(" line "," column "): " + (or "Warning" "Deprecation") ": " (message) line-end) + (info line-start (file-name) "(" line "," column "): " + (one-or-more " ") (message) line-end)) + :modes d-mode) + +(defun flycheck-elixir--find-default-directory (_checker) + "Come up with a suitable default directory to run CHECKER in. + +This will either be the directory that contains `mix.exs' or, +if no such file is found in the directory hierarchy, the directory +of the current file." + (or + (and + buffer-file-name + (locate-dominating-file buffer-file-name "mix.exs")) + default-directory)) + +(defun flycheck-elixir--parse-dogma-json (output checker buffer) + "Parse Dogma errors from JSON OUTPUT. + +CHECKER and BUFFER denote the CHECKER that returned OUTPUT and +the BUFFER that was checked respectively. + +See URL `https://github.com/lpil/dogma' for more information +about dogma." + (let* ((json-object-type 'alist) + (json-array-type 'list) + (dogma-json-output + (car (cdr (assq 'files (json-read-from-string output))))) + (dogma-errors-list (cdr (assq 'errors dogma-json-output))) + (dogma-filename (cdr (assq 'path dogma-json-output))) + errors) + (dolist (emessage dogma-errors-list) + (let-alist emessage + (push (flycheck-error-new-at + .line + 1 + 'error .message + :id .rule + :checker checker + :buffer buffer + :filename dogma-filename) + errors))) + (nreverse errors))) + +(defun flycheck-elixir--check-for-dogma () + "Check if `dogma' is installed. + +Check by looking for deps/dogma in this directory or a parent to +handle umbrella apps. +Used as a predicate for enabling the checker." + (and buffer-file-name + (locate-dominating-file buffer-file-name "deps/dogma"))) + +(flycheck-define-checker elixir-dogma + "An Elixir syntax checker using the Dogma analysis tool. + +See URL `https://github.com/lpil/dogma/'." + :command ("mix" "dogma" "--format=json" source) + :error-parser flycheck-elixir--parse-dogma-json + :working-directory flycheck-elixir--find-default-directory + :predicate flycheck-elixir--check-for-dogma + :modes elixir-mode) + +(defconst flycheck-this-emacs-executable + (concat invocation-directory invocation-name) + "The path to the currently running Emacs executable.") + +(defconst flycheck-emacs-args '("-Q" "--batch") + "Common arguments to Emacs invocations.") + +(defmacro flycheck-prepare-emacs-lisp-form (&rest body) + "Prepare BODY for use as check form in a subprocess." + (declare (indent 0)) + `(flycheck-sexp-to-string + '(progn + (defvar jka-compr-inhibit) + (unwind-protect + ;; Flycheck inhibits compression of temporary files, thus we + ;; must not attempt to decompress. + (let ((jka-compr-inhibit t)) + ;; Strip option-argument separator from arguments, if present + (when (equal (car command-line-args-left) "--") + (setq command-line-args-left (cdr command-line-args-left))) + ,@body) + ;; Prevent Emacs from processing the arguments on its own, see + ;; https://github.com/flycheck/flycheck/issues/319 + (setq command-line-args-left nil))))) + +(defconst flycheck-emacs-lisp-check-form + (flycheck-prepare-emacs-lisp-form + ;; Keep track of the generated bytecode files, to delete them after byte + ;; compilation. + (defvar flycheck-byte-compiled-files nil) + (let ((byte-compile-dest-file-function + (lambda (source) + (let ((temp-file (make-temp-file (file-name-nondirectory source)))) + (push temp-file flycheck-byte-compiled-files) + temp-file)))) + (unwind-protect + (byte-compile-file (car command-line-args-left)) + (mapc (lambda (f) (ignore-errors (delete-file f))) + flycheck-byte-compiled-files))))) + +(flycheck-def-option-var flycheck-emacs-lisp-load-path nil emacs-lisp + "Load path to use in the Emacs Lisp syntax checker. + +When set to `inherit', use the `load-path' of the current Emacs +session during syntax checking. + +When set to a list of strings, add each directory in this list to +the `load-path' before invoking the byte compiler. Relative +paths in this list are expanded against the `default-directory' +of the buffer to check. + +When nil, do not explicitly set the `load-path' during syntax +checking. The syntax check only uses the built-in `load-path' of +Emacs in this case. + +Note that changing this variable can lead to wrong results of the +syntax check, e.g. if an unexpected version of a required library +is used." + :type '(choice (const :tag "Inherit current `load-path'" inherit) + (repeat :tag "Load path" directory)) + :risky t + :package-version '(flycheck . "0.14")) + +(flycheck-def-option-var flycheck-emacs-lisp-initialize-packages + 'auto emacs-lisp + "Whether to initialize packages in the Emacs Lisp syntax checker. + +When nil, never initialize packages. When `auto', initialize +packages only when checking `user-init-file' or files from +`user-emacs-directory'. For any other non-nil value, always +initialize packages. + +When initializing packages is enabled the `emacs-lisp' syntax +checker calls `package-initialize' before byte-compiling the file +to be checked. It also sets `package-user-dir' according to +`flycheck-emacs-lisp-package-user-dir'." + :type '(choice (const :tag "Do not initialize packages" nil) + (const :tag "Initialize packages for configuration only" auto) + (const :tag "Always initialize packages" t)) + :risky t + :package-version '(flycheck . "0.14")) + +(defconst flycheck-emacs-lisp-package-initialize-form + (flycheck-sexp-to-string + '(with-demoted-errors "Error during package initialization: %S" + (package-initialize))) + "Form used to initialize packages.") + +(defun flycheck-option-emacs-lisp-package-initialize (value) + "Option VALUE filter for `flycheck-emacs-lisp-initialize-packages'." + (let ((shall-initialize + (if (eq value 'auto) + (or (flycheck-in-user-emacs-directory-p (buffer-file-name)) + ;; `user-init-file' is nil in non-interactive sessions. Now, + ;; no user would possibly use Flycheck in a non-interactive + ;; session, but our unit tests run non-interactively, so we + ;; have to handle this case anyway + (and user-init-file + (flycheck-same-files-p (buffer-file-name) + user-init-file))) + value))) + (when shall-initialize + ;; If packages shall be initialized, return the corresponding form, + ;; otherwise make Flycheck ignore the option by returning nil. + flycheck-emacs-lisp-package-initialize-form))) + +(flycheck-def-option-var flycheck-emacs-lisp-package-user-dir nil emacs-lisp + "Package directory for the Emacs Lisp syntax checker. + +If set to a string set `package-user-dir' to the value of this +variable before initializing packages. If set to nil just inherit +the value of `package-user-dir' from the running Emacs session. + +This variable has no effect, if +`flycheck-emacs-lisp-initialize-packages' is nil." + :type '(choice (const :tag "Default package directory" nil) + (directory :tag "Custom package directory")) + :risky t + :package-version '(flycheck . "0.14")) + +(defun flycheck-option-emacs-lisp-package-user-dir (value) + "Option VALUE filter for `flycheck-emacs-lisp-package-user-dir'." + ;; Inherit the package directory from our Emacs session + (let ((value (or value (bound-and-true-p package-user-dir)))) + (when value + (flycheck-sexp-to-string `(setq package-user-dir ,value))))) + +(flycheck-define-checker emacs-lisp + "An Emacs Lisp syntax checker using the Emacs Lisp Byte compiler. + +See Info Node `(elisp)Byte Compilation'." + :command ("emacs" (eval flycheck-emacs-args) + (eval + (let ((path (pcase flycheck-emacs-lisp-load-path + (`inherit load-path) + (p (seq-map #'expand-file-name p))))) + (flycheck-prepend-with-option "--directory" path))) + (option "--eval" flycheck-emacs-lisp-package-user-dir nil + flycheck-option-emacs-lisp-package-user-dir) + (option "--eval" flycheck-emacs-lisp-initialize-packages nil + flycheck-option-emacs-lisp-package-initialize) + "--eval" (eval flycheck-emacs-lisp-check-form) + "--" + source-inplace) + :error-patterns + ((error line-start (file-name) ":" line ":" column ":Error:" + (message (zero-or-more not-newline) + (zero-or-more "\n " (zero-or-more not-newline))) + line-end) + (warning line-start (file-name) ":" line ":" column ":Warning:" + (message (zero-or-more not-newline) + (zero-or-more "\n " (zero-or-more not-newline))) + line-end)) + :error-filter + (lambda (errors) + (flycheck-collapse-error-message-whitespace + (flycheck-sanitize-errors errors))) + :modes (emacs-lisp-mode lisp-interaction-mode) + :predicate + (lambda () + (and + ;; Ensure that we only check buffers with a backing file. For buffers + ;; without a backing file we cannot guarantee that file names in error + ;; messages are properly resolved, because `byte-compile-file' emits file + ;; names *relative to the directory of the checked file* instead of the + ;; working directory. Hence our backwards-substitution will fail, because + ;; the checker process has a different base directory to resolve relative + ;; file names than the Flycheck code working on the buffer to check. + (buffer-file-name) + ;; Do not check buffers which should not be byte-compiled. The checker + ;; process will refuse to compile these, which would confuse Flycheck + (not (bound-and-true-p no-byte-compile)) + ;; Do not check buffers used for autoloads generation during package + ;; installation. These buffers are too short-lived for being checked, and + ;; doing so causes spurious errors. See + ;; https://github.com/flycheck/flycheck/issues/45 and + ;; https://github.com/bbatsov/prelude/issues/248. We must also not check + ;; compilation buffers, but as these are ephemeral, Flycheck won't check + ;; them anyway. + (not (flycheck-autoloads-file-p)))) + :next-checkers (emacs-lisp-checkdoc)) + +(defconst flycheck-emacs-lisp-checkdoc-form + (flycheck-prepare-emacs-lisp-form + (unless (require 'elisp-mode nil 'no-error) + ;; TODO: Fallback for Emacs 24, remove when dropping support for 24 + (require 'lisp-mode)) + (require 'checkdoc) + + (let ((source (car command-line-args-left)) + ;; Remember the default directory of the process + (process-default-directory default-directory)) + ;; Note that we deliberately use our custom approach even despite of + ;; `checkdoc-file' which was added to Emacs 25.1. While it's conceptually + ;; the better thing, its implementation has too many flaws to be of use + ;; for us. + (with-temp-buffer + (insert-file-contents source 'visit) + (setq buffer-file-name source) + ;; And change back to the process default directory to make file-name + ;; back-substutition work + (setq default-directory process-default-directory) + (with-demoted-errors "Error in checkdoc: %S" + ;; Checkdoc needs the Emacs Lisp syntax table and comment syntax to + ;; parse sexps and identify docstrings correctly; see + ;; https://github.com/flycheck/flycheck/issues/833 + (delay-mode-hooks (emacs-lisp-mode)) + (setq delayed-mode-hooks nil) + (checkdoc-current-buffer t) + (with-current-buffer checkdoc-diagnostic-buffer + (princ (buffer-substring-no-properties (point-min) (point-max))) + (kill-buffer))))))) + +(defconst flycheck-emacs-lisp-checkdoc-variables + '(checkdoc-symbol-words + checkdoc-arguments-in-order-flag + checkdoc-force-history-flag + checkdoc-permit-comma-termination-flag + checkdoc-force-docstrings-flag + checkdoc-package-keywords-flag + checkdoc-spellcheck-documentation-flag + checkdoc-verb-check-experimental-flag + checkdoc-max-keyref-before-warn) + "Variables inherited by the checkdoc subprocess.") + +(defun flycheck-emacs-lisp-checkdoc-variables-form () + "Make a sexp to pass relevant variables to a checkdoc subprocess. + +Variables are taken from `flycheck-emacs-lisp-checkdoc-variables'." + `(progn + ,@(seq-map (lambda (opt) `(setq-default ,opt ,(symbol-value opt))) + (seq-filter #'boundp flycheck-emacs-lisp-checkdoc-variables)))) + +(flycheck-define-checker emacs-lisp-checkdoc + "An Emacs Lisp style checker using CheckDoc. + +The checker runs `checkdoc-current-buffer'." + :command ("emacs" (eval flycheck-emacs-args) + "--eval" (eval (flycheck-sexp-to-string + (flycheck-emacs-lisp-checkdoc-variables-form))) + "--eval" (eval flycheck-emacs-lisp-checkdoc-form) + "--" source) + :error-patterns + ((warning line-start (file-name) ":" line ": " (message) line-end)) + :modes (emacs-lisp-mode) + :predicate + (lambda () + ;; Do not check Autoloads, Cask/Carton and dir-locals files. These files + ;; really don't need to follow Checkdoc conventions. + (not (or (flycheck-autoloads-file-p) + (and (buffer-file-name) + (member (file-name-nondirectory (buffer-file-name)) + '("Cask" "Carton" ".dir-locals.el"))))))) + +(dolist (checker '(emacs-lisp emacs-lisp-checkdoc)) + (setf (car (flycheck-checker-get checker 'command)) + flycheck-this-emacs-executable)) + +(flycheck-def-option-var flycheck-erlang-include-path nil erlang + "A list of include directories for Erlang. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of erlc. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-def-option-var flycheck-erlang-library-path nil erlang + "A list of library directories for Erlang. + +The value of this variable is a list of strings, where each +string is a directory to add to the library path of erlc. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Library directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-define-checker erlang + "An Erlang syntax checker using the Erlang interpreter. + +See URL `http://www.erlang.org/'." + :command ("erlc" + "-o" temporary-directory + (option-list "-I" flycheck-erlang-include-path) + (option-list "-pa" flycheck-erlang-library-path) + "-Wall" + source) + :error-patterns + ((warning line-start (file-name) ":" line ": Warning:" (message) line-end) + (error line-start (file-name) ":" line ": " (message) line-end)) + :modes erlang-mode) + +(flycheck-define-checker eruby-erubis + "A eRuby syntax checker using the `erubis' command. + +See URL `http://www.kuwata-lab.com/erubis/'." + :command ("erubis" "-z" source) + :error-patterns + ((error line-start (file-name) ":" line ": " (message) line-end)) + :modes (html-erb-mode rhtml-mode)) + +(flycheck-def-args-var flycheck-gfortran-args fortran-gfortran + :package-version '(flycheck . "0.22")) + +(flycheck-def-option-var flycheck-gfortran-include-path nil fortran-gfortran + "A list of include directories for GCC Fortran. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of gcc. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gfortran-language-standard "f95" fortran-gfortran + "The language standard to use in GFortran. + +The value of this variable is either a string denoting a language +standard, or nil, to use the default standard. When non-nil, +pass the language standard via the `-std' option." + :type '(choice (const :tag "Default standard" nil) + (string :tag "Language standard")) + :safe #'stringp + :package-version '(flycheck . "0.20")) + +(flycheck-def-option-var flycheck-gfortran-layout nil fortran-gfortran + "The source code layout to use in GFortran. + +The value of this variable is one of the following symbols: + +nil + Let gfortran determine the layout from the extension + +`free' + Use free form layout + + +`fixed' + Use fixed form layout + +In any other case, an error is signaled." + :type '(choice (const :tag "Guess layout from extension" nil) + (const :tag "Free form layout" free) + (const :tag "Fixed form layout" fixed)) + :safe (lambda (value) (or (not value) (memq value '(free fixed)))) + :package-version '(flycheck . "0.20")) + +(defun flycheck-option-gfortran-layout (value) + "Option VALUE filter for `flycheck-gfortran-layout'." + (pcase value + (`nil nil) + (`free "free-form") + (`fixed "fixed-form") + (_ (error "Invalid value for flycheck-gfortran-layout: %S" value)))) + +(flycheck-def-option-var flycheck-gfortran-warnings '("all" "extra") + fortran-gfortran + "A list of warnings for GCC Fortran. + +The value of this variable is a list of strings, where each string +is the name of a warning category to enable. By default, all +recommended warnings and some extra warnings are enabled (as by +`-Wall' and `-Wextra' respectively). + +Refer to the gfortran manual at URL +`https://gcc.gnu.org/onlinedocs/gfortran/' for more information +about warnings" + :type '(choice (const :tag "No additional warnings" nil) + (repeat :tag "Additional warnings" + (string :tag "Warning name"))) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.20")) + +(flycheck-define-checker fortran-gfortran + "An Fortran syntax checker using GCC. + +Uses GCC's Fortran compiler gfortran. See URL +`https://gcc.gnu.org/onlinedocs/gfortran/'." + :command ("gfortran" + "-fsyntax-only" + "-fshow-column" + "-fno-diagnostics-show-caret" ; Do not visually indicate the source location + "-fno-diagnostics-show-option" ; Do not show the corresponding + ; warning group + ;; Fortran has similar include processing as C/C++ + "-iquote" (eval (flycheck-c/c++-quoted-include-directory)) + (option "-std=" flycheck-gfortran-language-standard concat) + (option "-f" flycheck-gfortran-layout concat + flycheck-option-gfortran-layout) + (option-list "-W" flycheck-gfortran-warnings concat) + (option-list "-I" flycheck-gfortran-include-path concat) + (eval flycheck-gfortran-args) + source) + :error-patterns + ((error line-start (file-name) ":" line (or ":" ".") column (or ": " ":\n") + (or (= 3 (zero-or-more not-newline) "\n") "") + (or "Error" "Fatal Error") ": " + (message) line-end) + (warning line-start (file-name) ":" line (or ":" ".") column (or ": " ":\n") + (or (= 3 (zero-or-more not-newline) "\n") "") + "Warning: " (message) line-end)) + :modes (fortran-mode f90-mode)) + +(flycheck-define-checker go-gofmt + "A Go syntax and style checker using the gofmt utility. + +See URL `https://golang.org/cmd/gofmt/'." + :command ("gofmt") + :standard-input t + :error-patterns + ((error line-start ":" line ":" column ": " (message) line-end)) + :modes go-mode + :next-checkers ((warning . go-golint) + ;; Fall back, if go-golint doesn't exist + (warning . go-vet) + ;; Fall back, if go-vet doesn't exist + (warning . go-build) (warning . go-test) + (warning . go-errcheck) + (warning . go-unconvert))) + +(flycheck-define-checker go-golint + "A Go style checker using Golint. + +See URL `https://github.com/golang/lint'." + :command ("golint" source) + :error-patterns + ((warning line-start (file-name) ":" line ":" column ": " (message) line-end)) + :modes go-mode + :next-checkers (go-vet + ;; Fall back, if go-vet doesn't exist + go-build go-test go-errcheck go-unconvert)) + +(flycheck-def-option-var flycheck-go-vet-print-functions nil go-vet + "A list of print-like functions for `go tool vet'. + +Go vet will check these functions for format string problems and +issues, such as a mismatch between the number of formats used, +and the number of arguments given. + +Each entry is in the form Name:N where N is the zero-based +argument position of the first argument involved in the print: +either the format or the first print argument for non-formatted +prints. For example, if you have Warn and Warnf functions that +take an io.Writer as their first argument, like Fprintf, +-printfuncs=Warn:1,Warnf:1 " + :type '(repeat :tag "print-like functions" + (string :tag "function")) + :safe #'flycheck-string-list-p) + +(flycheck-def-option-var flycheck-go-vet-shadow nil go-vet + "Whether to check for shadowed variables with `go tool vet'. + +When non-nil check for shadowed variables. When `strict' check +more strictly, which can very noisy. When nil do not check for +shadowed variables. + +This option requires Go 1.6 or newer." + :type '(choice (const :tag "Do not check for shadowed variables" nil) + (const :tag "Check for shadowed variables" t) + (const :tag "Strictly check for shadowed variables" strict))) + +(flycheck-define-checker go-vet + "A Go syntax checker using the `go tool vet' command. + +See URL `https://golang.org/cmd/go/' and URL +`https://golang.org/cmd/vet/'." + :command ("go" "tool" "vet" "-all" + (option "-printfuncs=" flycheck-go-vet-print-functions concat + flycheck-option-comma-separated-list) + (option-flag "-shadow" flycheck-go-vet-shadow) + (eval (when (eq flycheck-go-vet-shadow 'strict) "-shadowstrict")) + source) + :error-patterns + ((warning line-start (file-name) ":" line ": " (message) line-end)) + :modes go-mode + ;; We must explicitly check whether the "vet" tool is available + :predicate (lambda () + (let ((go (flycheck-checker-executable 'go-vet))) + (member "vet" (ignore-errors (process-lines go "tool"))))) + :next-checkers (go-build + go-test + ;; Fall back if `go build' or `go test' can be used + go-errcheck + go-unconvert) + :verify (lambda (_) + (let* ((go (flycheck-checker-executable 'go-vet)) + (have-vet (member "vet" (ignore-errors + (process-lines go "tool"))))) + (list + (flycheck-verification-result-new + :label "go tool vet" + :message (if have-vet "present" "missing") + :face (if have-vet 'success '(bold error))))))) + +(flycheck-def-option-var flycheck-go-build-install-deps nil (go-build go-test) + "Whether to install dependencies in `go build' and `go test'. + +If non-nil automatically install dependencies with `go build' +while syntax checking." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.25")) + +(flycheck-def-option-var flycheck-go-build-tags nil go-build + "A list of tags for `go build'. + +Each item is a string with a tag to be given to `go build'." + :type '(repeat (string :tag "Tag")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.25")) + +(flycheck-define-checker go-build + "A Go syntax and type checker using the `go build' command. + +Requires Go 1.6 or newer. See URL `https://golang.org/cmd/go'." + :command ("go" "build" + (option-flag "-i" flycheck-go-build-install-deps) + ;; multiple tags are listed as "dev debug ..." + (option-list "-tags=" flycheck-go-build-tags concat) + "-o" null-device) + :error-patterns + ((error line-start (file-name) ":" line ":" + (optional column ":") " " + (message (one-or-more not-newline) + (zero-or-more "\n\t" (one-or-more not-newline))) + line-end) + ;; Catch error message about multiple packages in a directory, which doesn't + ;; follow the standard error message format. + (info line-start + (message "can't load package: package " + (one-or-more (not (any ?: ?\n))) + ": found packages " + (one-or-more not-newline)) + line-end)) + :error-filter + (lambda (errors) + (dolist (error errors) + (unless (flycheck-error-line error) + ;; Flycheck ignores errors without line numbers, but the error + ;; message about multiple packages in a directory doesn't come with a + ;; line number, so inject a fake one. + (setf (flycheck-error-line error) 1))) + errors) + :modes go-mode + :predicate (lambda () + (and (flycheck-buffer-saved-p) + (not (string-suffix-p "_test.go" (buffer-file-name))))) + :next-checkers ((warning . go-errcheck) + (warning . go-unconvert))) + +(flycheck-define-checker go-test + "A Go syntax and type checker using the `go test' command. + +Requires Go 1.6 or newer. See URL `https://golang.org/cmd/go'." + :command ("go" "test" + (option-flag "-i" flycheck-go-build-install-deps) + "-c" "-o" null-device) + :error-patterns + ((error line-start (file-name) ":" line ": " + (message (one-or-more not-newline) + (zero-or-more "\n\t" (one-or-more not-newline))) + line-end)) + :modes go-mode + :predicate + (lambda () (and (flycheck-buffer-saved-p) + (string-suffix-p "_test.go" (buffer-file-name)))) + :next-checkers ((warning . go-errcheck) + (warning . go-unconvert))) + +(flycheck-define-checker go-errcheck + "A Go checker for unchecked errors. + +Requires errcheck newer than commit 8515d34 (Aug 28th, 2015). + +See URL `https://github.com/kisielk/errcheck'." + :command ("errcheck" "-abspath" ".") + :error-patterns + ((warning line-start + (file-name) ":" line ":" column (or (one-or-more "\t") ": " ":\t") + (message) + line-end)) + :error-filter + (lambda (errors) + (let ((errors (flycheck-sanitize-errors errors))) + (dolist (err errors) + (-when-let (message (flycheck-error-message err)) + ;; Improve the messages reported by errcheck to make them more clear. + (setf (flycheck-error-message err) + (format "Ignored `error` returned from `%s`" message))))) + errors) + :modes go-mode + :predicate (lambda () (flycheck-buffer-saved-p)) + :next-checkers ((warning . go-unconvert))) + +(flycheck-define-checker go-unconvert + "A Go checker looking for unnecessary type conversions. + +See URL `https://github.com/mdempsky/unconvert'." + :command ("unconvert" ".") + :error-patterns + ((warning line-start (file-name) ":" line ":" column ": " (message) line-end)) + :modes go-mode + :predicate (lambda () (flycheck-buffer-saved-p))) + +(flycheck-define-checker groovy + "A groovy syntax checker using groovy compiler API. + +See URL `http://www.groovy-lang.org'." + :command ("groovy" "-e" + "import org.codehaus.groovy.control.* + +file = new File(args[0]) +unit = new CompilationUnit() +unit.addSource(file) + +try { + unit.compile(Phases.CONVERSION) +} catch (MultipleCompilationErrorsException e) { + e.errorCollector.write(new PrintWriter(System.out, true), null) +} +" + source) + :error-patterns + ((error line-start (file-name) ": " line ":" (message) + " @ line " line ", column " column "." line-end)) + :modes groovy-mode) + +(flycheck-define-checker haml + "A Haml syntax checker using the Haml compiler. + +See URL `http://haml.info'." + :command ("haml" "-c" "--stdin") + :standard-input t + :error-patterns + ((error line-start "Syntax error on line " line ": " (message) line-end)) + :modes haml-mode) + +(flycheck-define-checker handlebars + "A Handlebars syntax checker using the Handlebars compiler. + +See URL `http://handlebarsjs.com/'." + :command ("handlebars" "-i-") + :standard-input t + :error-patterns + ((error line-start + "Error: Parse error on line " line ":" (optional "\r") "\n" + (zero-or-more not-newline) "\n" (zero-or-more not-newline) "\n" + (message) line-end)) + :modes (handlebars-mode handlebars-sgml-mode web-mode) + :predicate + (lambda () + (if (eq major-mode 'web-mode) + ;; Check if this is a handlebars file since web-mode does not store the + ;; non-canonical engine name + (let* ((regexp-alist (bound-and-true-p web-mode-engine-file-regexps)) + (pattern (cdr (assoc "handlebars" regexp-alist)))) + (and pattern (buffer-file-name) + (string-match-p pattern (buffer-file-name)))) + t))) + +(defconst flycheck-haskell-module-re + (rx line-start (zero-or-more (or "\n" (any space))) + "module" (one-or-more (or "\n" (any space))) + (group (one-or-more (not (any space "(" "\n"))))) + "Regular expression for a Haskell module name.") + +(flycheck-def-args-var flycheck-ghc-args (haskell-stack-ghc haskell-ghc) + :package-version '(flycheck . "0.22")) + +(flycheck-def-option-var flycheck-ghc-stack-use-nix nil haskell-stack-ghc + "Whether to enable nix support in stack. + +When non-nil, stack will append '--nix' flag to any call." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "26")) + +(flycheck-def-option-var flycheck-ghc-no-user-package-database nil haskell-ghc + "Whether to disable the user package database in GHC. + +When non-nil, disable the user package database in GHC, via +`-no-user-package-db'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.16")) + +(flycheck-def-option-var flycheck-ghc-package-databases nil haskell-ghc + "Additional module databases for GHC. + +The value of this variable is a list of strings, where each +string is a directory of a package database. Each package +database is given to GHC via `-package-db'." + :type '(repeat (directory :tag "Package database")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.16")) + +(flycheck-def-option-var flycheck-ghc-search-path nil + (haskell-stack-ghc haskell-ghc) + "Module search path for (Stack) GHC. + +The value of this variable is a list of strings, where each +string is a directory containing Haskell modules. Each directory +is added to the GHC search path via `-i'." + :type '(repeat (directory :tag "Module directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.16")) + +(flycheck-def-option-var flycheck-ghc-language-extensions nil + (haskell-stack-ghc haskell-ghc) + "Language extensions for (Stack) GHC. + +The value of this variable is a list of strings, where each +string is a Haskell language extension, as in the LANGUAGE +pragma. Each extension is enabled via `-X'." + :type '(repeat (string :tag "Language extension")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.19")) + +(defvar flycheck-haskell-ghc-cache-directory nil + "The cache directory for `ghc' output.") + +(defun flycheck-haskell-ghc-cache-directory () + "Get the cache location for `ghc' output. + +If no cache directory exists yet, create one and return it. +Otherwise return the previously used cache directory." + (setq flycheck-haskell-ghc-cache-directory + (or flycheck-haskell-ghc-cache-directory + (make-temp-file "flycheck-haskell-ghc-cache" 'directory)))) + +(defun flycheck-haskell--find-default-directory (checker) + "Come up with a suitable default directory for Haskell to run CHECKER in. + +In case of `haskell-stack-ghc' checker it is directory with +stack.yaml file. If there's no stack.yaml file in any parent +directory, it will be the directory that \"stack path --project-root\" +command returns. + +For all other checkers, it is the closest parent directory that +contains a cabal file." + (pcase checker + (`haskell-stack-ghc + (or + (locate-dominating-file (buffer-file-name) "stack.yaml") + (when (executable-find "stack") + (let* ((stack-output + (process-lines "stack" "path" "--project-root")) + (stack-dir (car stack-output))) + (when (and stack-dir + (file-directory-p stack-dir)) + stack-dir))))) + (_ + (locate-dominating-file + (file-name-directory (buffer-file-name)) + (lambda (dir) + (directory-files dir + nil ;; use full paths + ".+\\.cabal\\'" + t ;; do not sort result + )))))) + +(flycheck-define-checker haskell-stack-ghc + "A Haskell syntax and type checker using `stack ghc'. + +See URL `https://github.com/commercialhaskell/stack'." + :command ("stack" + (option-flag "--nix" flycheck-ghc-stack-use-nix) + "ghc" "--" "-Wall" "-no-link" + "-outputdir" (eval (flycheck-haskell-ghc-cache-directory)) + (option-list "-X" flycheck-ghc-language-extensions concat) + (option-list "-i" flycheck-ghc-search-path concat) + (eval (concat + "-i" + (flycheck-module-root-directory + (flycheck-find-in-buffer flycheck-haskell-module-re)))) + (eval flycheck-ghc-args) + "-x" (eval + (pcase major-mode + (`haskell-mode "hs") + (`literate-haskell-mode "lhs"))) + source) + :error-patterns + ((warning line-start (file-name) ":" line ":" column ":" + (or " " "\n ") "Warning:" (optional "\n") + (message + (one-or-more " ") (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + line-end) + (error line-start (file-name) ":" line ":" column ":" (optional " error:") + (or (message (one-or-more not-newline)) + (and "\n" + (message + (one-or-more " ") (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))))) + line-end)) + :error-filter + (lambda (errors) + (flycheck-sanitize-errors (flycheck-dedent-error-messages errors))) + :modes (haskell-mode literate-haskell-mode) + :next-checkers ((warning . haskell-hlint)) + :working-directory flycheck-haskell--find-default-directory) + +(flycheck-define-checker haskell-ghc + "A Haskell syntax and type checker using ghc. + +See URL `https://www.haskell.org/ghc/'." + :command ("ghc" "-Wall" "-no-link" + "-outputdir" (eval (flycheck-haskell-ghc-cache-directory)) + (option-flag "-no-user-package-db" + flycheck-ghc-no-user-package-database) + (option-list "-package-db" flycheck-ghc-package-databases) + (option-list "-i" flycheck-ghc-search-path concat) + ;; Include the parent directory of the current module tree, to + ;; properly resolve local imports + (eval (concat + "-i" + (flycheck-module-root-directory + (flycheck-find-in-buffer flycheck-haskell-module-re)))) + (option-list "-X" flycheck-ghc-language-extensions concat) + (eval flycheck-ghc-args) + "-x" (eval + (pcase major-mode + (`haskell-mode "hs") + (`literate-haskell-mode "lhs"))) + source) + :error-patterns + ((warning line-start (file-name) ":" line ":" column ":" + (or " " "\n ") "Warning:" (optional "\n") + (message + (one-or-more " ") (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + line-end) + (error line-start (file-name) ":" line ":" column ":" (optional " error:") + (or (message (one-or-more not-newline)) + (and "\n" + (message + (one-or-more " ") (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))))) + line-end)) + :error-filter + (lambda (errors) + (flycheck-sanitize-errors (flycheck-dedent-error-messages errors))) + :modes (haskell-mode literate-haskell-mode) + :next-checkers ((warning . haskell-hlint)) + :working-directory flycheck-haskell--find-default-directory) + +(flycheck-def-config-file-var flycheck-hlintrc haskell-hlint "HLint.hs" + :safe #'stringp) + +(flycheck-def-args-var flycheck-hlint-args haskell-hlint + :package-version '(flycheck . "0.25")) + +(flycheck-def-option-var flycheck-hlint-language-extensions + nil haskell-hlint + "Extensions list to enable for hlint. + +The value of this variable is a list of strings, where each +string is a name of extension to enable in +hlint (e.g. \"QuasiQuotes\")." + :type '(repeat :tag "Extensions" (string :tag "Extension")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-def-option-var flycheck-hlint-ignore-rules + nil haskell-hlint + "Ignore rules list for hlint checks. + +The value of this variable is a list of strings, where each +string is an ignore rule (e.g. \"Use fmap\")." + :type '(repeat :tag "Ignore rules" (string :tag "Ignore rule")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-def-option-var flycheck-hlint-hint-packages + nil haskell-hlint + "Hint packages to include for hlint checks. + +The value of this variable is a list of strings, where each +string is a default hint package (e.g. (\"Generalise\" +\"Default\" \"Dollar\"))." + :type '(repeat :tag "Hint packages" (string :tag "Hint package")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-define-checker haskell-hlint + "A Haskell style checker using hlint. + +See URL `https://github.com/ndmitchell/hlint'." + :command ("hlint" + (option-list "-X" flycheck-hlint-language-extensions concat) + (option-list "-i=" flycheck-hlint-ignore-rules concat) + (option-list "-h" flycheck-hlint-hint-packages concat) + (config-file "-h" flycheck-hlintrc) + (eval flycheck-hlint-args) + source-inplace) + :error-patterns + ((info line-start + (file-name) ":" line ":" column + ": Suggestion: " + (message (one-or-more (and (one-or-more (not (any ?\n))) ?\n))) + line-end) + (warning line-start + (file-name) ":" line ":" column + ": Warning: " + (message (one-or-more (and (one-or-more (not (any ?\n))) ?\n))) + line-end) + (error line-start + (file-name) ":" line ":" column + ": Error: " + (message (one-or-more (and (one-or-more (not (any ?\n))) ?\n))) + line-end)) + :modes (haskell-mode literate-haskell-mode)) + +(flycheck-def-config-file-var flycheck-tidyrc html-tidy ".tidyrc" + :safe #'stringp) + +(flycheck-define-checker html-tidy + "A HTML syntax and style checker using Tidy. + +See URL `https://github.com/htacg/tidy-html5'." + :command ("tidy" (config-file "-config" flycheck-tidyrc) "-e" "-q") + :standard-input t + :error-patterns + ((error line-start + "line " line + " column " column + " - Error: " (message) line-end) + (warning line-start + "line " line + " column " column + " - Warning: " (message) line-end)) + :modes (html-mode nxhtml-mode)) + +(flycheck-define-checker jade + "A Jade syntax checker using the Jade compiler. + +See URL `http://jade-lang.com'." + :command ("jade") + :standard-input t + :error-patterns + ((error line-start + "Error: Jade:" line (zero-or-more not-newline) "\n" + (one-or-more (and (zero-or-more not-newline) "|" + (zero-or-more not-newline) "\n")) + (zero-or-more not-newline) "\n" (message) line-end)) + :modes jade-mode) + +(flycheck-def-config-file-var flycheck-jshintrc javascript-jshint ".jshintrc" + :safe #'stringp) + +(flycheck-def-option-var flycheck-jshint-extract-javascript nil + javascript-jshint + "Whether jshint should extract Javascript from HTML. + +If nil no extract rule is given to jshint. If `auto' only +extract Javascript if a HTML file is detected. If `always' or +`never' extract Javascript always or never respectively. + +Refer to the jshint manual at the URL +`http://jshint.com/docs/cli/#flags' for more information." + :type + '(choice (const :tag "No extraction rule" nil) + (const :tag "Try to extract Javascript when detecting HTML files" + auto) + (const :tag "Always try to extract Javascript" always) + (const :tag "Never try to extract Javascript" never)) + :safe #'symbolp + :package-version '(flycheck . "26")) + +(flycheck-define-checker javascript-jshint + "A Javascript syntax and style checker using jshint. + +See URL `http://www.jshint.com'." + :command ("jshint" "--reporter=checkstyle" + "--filename" source-original + (config-file "--config" flycheck-jshintrc) + (option "--extract=" flycheck-jshint-extract-javascript + concat flycheck-option-symbol) + "-") + :standard-input t + :error-parser flycheck-parse-checkstyle + :error-filter + (lambda (errors) + (flycheck-remove-error-file-names + "stdin" (flycheck-dequalify-error-ids errors))) + :modes (js-mode js2-mode js3-mode) + :next-checkers ((warning . javascript-jscs))) + +(flycheck-def-option-var flycheck-eslint-rules-directories nil javascript-eslint + "A list of directories with custom rules for ESLint. + +The value of this variable is a list of strings, where each +string is a directory with custom rules for ESLint. + +Refer to the ESLint manual at URL +`https://github.com/eslint/eslint/tree/master/docs/command-line-interface#--rulesdir' +for more information about the custom directories." + :type '(repeat (directory :tag "Custom rules directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "29")) + +(flycheck-def-config-file-var flycheck-eslintrc javascript-eslint nil + :safe #'stringp + :package-version '(flycheck . "0.20")) + +(flycheck-define-checker javascript-eslint + "A Javascript syntax and style checker using eslint. + +See URL `https://github.com/eslint/eslint'." + :command ("eslint" "--format=checkstyle" + (config-file "--config" flycheck-eslintrc) + (option-list "--rulesdir" flycheck-eslint-rules-directories) + "--stdin" "--stdin-filename" source-original) + :standard-input t + :error-parser flycheck-parse-checkstyle + :error-filter (lambda (errors) + (seq-do (lambda (err) + ;; Parse error ID from the error message + (setf (flycheck-error-message err) + (replace-regexp-in-string + (rx " (" + (group (one-or-more (not (any ")")))) + ")" string-end) + (lambda (s) + (setf (flycheck-error-id err) + (match-string 1 s)) + "") + (flycheck-error-message err)))) + (flycheck-sanitize-errors errors)) + errors) + :modes (js-mode js-jsx-mode js2-mode js2-jsx-mode js3-mode) + :next-checkers ((warning . javascript-jscs))) + +(flycheck-def-config-file-var flycheck-gjslintrc javascript-gjslint ".gjslintrc" + :safe #'stringp) + +(flycheck-define-checker javascript-gjslint + "A Javascript syntax and style checker using Closure Linter. + +See URL `https://developers.google.com/closure/utilities'." + :command ("gjslint" "--unix_mode" + (config-file "--flagfile" flycheck-gjslintrc) + source) + :error-patterns ((warning + line-start (file-name) ":" line ":(" + (id (one-or-more digit)) ") " (message) line-end)) + :modes (js-mode js2-mode js3-mode) + :next-checkers ((warning . javascript-jscs))) + +(defun flycheck-parse-jscs (output checker buffer) + "Parse JSCS OUTPUT from CHECKER and BUFFER. + +Like `flycheck-parse-checkstyle', but catches errors about no +configuration found and prevents to be reported as a suspicious +error." + (if (string-match-p (rx string-start "No configuration found") output) + (let ((message "No JSCS configuration found. Set `flycheck-jscsrc' for JSCS")) + (list (flycheck-error-new-at 1 nil 'warning message + :checker checker + :buffer buffer + :filename (buffer-file-name buffer)))) + (flycheck-parse-checkstyle output checker buffer))) + +(flycheck-def-config-file-var flycheck-jscsrc javascript-jscs ".jscsrc" + :safe #'stringp + :package-version '(flycheck . "0.24")) + +(flycheck-define-checker javascript-jscs + "A Javascript style checker using JSCS. + +See URL `http://www.jscs.info'." + :command ("jscs" "--reporter=checkstyle" + (config-file "--config" flycheck-jscsrc) + "-") + :standard-input t + :error-parser flycheck-parse-jscs + :error-filter (lambda (errors) + (flycheck-remove-error-ids + (flycheck-sanitize-errors + (flycheck-remove-error-file-names "input" errors)))) + :modes (js-mode js-jsx-mode js2-mode js2-jsx-mode js3-mode)) + +(flycheck-define-checker javascript-standard + "A Javascript code and style checker for the (Semi-)Standard Style. + +This checker works with `standard' and `semistandard', defaulting +to the former. To use it with the latter, set +`flycheck-javascript-standard-executable' to `semistandard'. + +See URL `https://github.com/feross/standard' and URL +`https://github.com/Flet/semistandard'." + :command ("standard" "--stdin") + :standard-input t + :error-patterns + ((error line-start " :" line ":" column ":" (message) line-end)) + :modes (js-mode js-jsx-mode js2-mode js2-jsx-mode js3-mode)) + +(flycheck-define-checker json-jsonlint + "A JSON syntax and style checker using jsonlint. + +See URL `https://github.com/zaach/jsonlint'." + ;; We can't use standard input for jsonlint, because it doesn't output errors + ;; anymore when using -c -q with standard input :/ + :command ("jsonlint" "-c" "-q" source) + :error-patterns + ((error line-start + (file-name) + ": line " line + ", col " column ", " + (message) line-end)) + :error-filter + (lambda (errors) + (flycheck-sanitize-errors (flycheck-increment-error-columns errors))) + :modes json-mode) + +(flycheck-define-checker json-python-json + "A JSON syntax checker using Python json.tool module. + +See URL `https://docs.python.org/3.5/library/json.html#command-line-interface'." + :command ("python" "-m" "json.tool" source + ;; Send the pretty-printed output to the null device + null-device) + :error-patterns + ((error line-start + (message) ": line " line " column " column + ;; Ignore the rest of the line which shows the char position. + (one-or-more not-newline) + line-end)) + :modes json-mode) + +(flycheck-define-checker less + "A LESS syntax checker using lessc. + +Requires lessc 1.4 or newer. + +See URL `http://lesscss.org'." + :command ("lessc" "--lint" "--no-color" + "-") + :standard-input t + :error-patterns + ((error line-start (one-or-more word) ":" + (message) + " in - on line " line + ", column " column ":" + line-end)) + :modes less-css-mode) + +(flycheck-define-checker lua-luacheck + "A Lua syntax checker using luacheck. + +See URL `https://github.com/mpeterv/luacheck'." + :command ("luacheck" + "--formatter" "plain" + "--codes" ; Show warning codes + "--no-color" + "--filename" source-original + ;; Read from standard input + "-") + :standard-input t + :error-patterns + ((warning line-start + (optional (file-name)) + ":" line ":" column + ": (" (id "W" (one-or-more digit)) ") " + (message) line-end) + (error line-start + (optional (file-name)) + ":" line ":" column ":" + ;; `luacheck' before 0.11.0 did not output codes for errors, hence + ;; the ID is optional here + (optional " (" (id "E" (one-or-more digit)) ") ") + (message) line-end)) + :modes lua-mode) + +(flycheck-define-checker lua + "A Lua syntax checker using the Lua compiler. + +See URL `http://www.lua.org/'." + :command ("luac" "-p" "-") + :standard-input t + :error-patterns + ((error line-start + ;; Skip the name of the luac executable. + (minimal-match (zero-or-more not-newline)) + ": stdin:" line ": " (message) line-end)) + :modes lua-mode) + +(flycheck-def-option-var flycheck-perl-include-path nil perl + "A list of include directories for Perl. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of Perl. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-define-checker perl + "A Perl syntax checker using the Perl interpreter. + +See URL `https://www.perl.org'." + :command ("perl" "-w" "-c" + (option-list "-I" flycheck-perl-include-path)) + :standard-input t + :error-patterns + ((error line-start (minimal-match (message)) + " at - line " line + (or "." (and ", " (zero-or-more not-newline))) line-end)) + :modes (perl-mode cperl-mode) + :next-checkers (perl-perlcritic)) + +(flycheck-def-option-var flycheck-perlcritic-severity nil perl-perlcritic + "The message severity for Perl Critic. + +The value of this variable is a severity level as integer, for +the `--severity' option to Perl Critic." + :type '(integer :tag "Severity level") + :safe #'integerp + :package-version '(flycheck . "0.18")) + +(flycheck-def-config-file-var flycheck-perlcriticrc perl-perlcritic + ".perlcriticrc" + :safe #'stringp + :package-version '(flycheck . "26")) + +(flycheck-define-checker perl-perlcritic + "A Perl syntax checker using Perl::Critic. + +See URL `https://metacpan.org/pod/Perl::Critic'." + :command ("perlcritic" "--no-color" "--verbose" "%f/%l/%c/%s/%p/%m (%e)\n" + (config-file "--profile" flycheck-perlcriticrc) + (option "--severity" flycheck-perlcritic-severity nil + flycheck-option-int)) + :standard-input t + :error-patterns + ((info line-start + "STDIN/" line "/" column "/" (any "1") "/" + (id (one-or-more (not (any "/")))) "/" (message) + line-end) + (warning line-start + "STDIN/" line "/" column "/" (any "234") "/" + (id (one-or-more (not (any "/")))) "/" (message) + line-end) + (error line-start + "STDIN/" line "/" column "/" (any "5") "/" + (id (one-or-more (not (any "/")))) "/" (message) + line-end)) + :modes (cperl-mode perl-mode)) + +(flycheck-define-checker php + "A PHP syntax checker using the PHP command line interpreter. + +See URL `http://php.net/manual/en/features.commandline.php'." + :command ("php" "-l" "-d" "error_reporting=E_ALL" "-d" "display_errors=1" + "-d" "log_errors=0" source) + :error-patterns + ((error line-start (or "Parse" "Fatal" "syntax") " error" (any ":" ",") " " + (message) " in " (file-name) " on line " line line-end)) + :modes (php-mode php+-mode) + :next-checkers ((warning . php-phpmd) + (warning . php-phpcs))) + +(flycheck-def-option-var flycheck-phpmd-rulesets + '("cleancode" "codesize" "controversial" "design" "naming" "unusedcode") + php-phpmd + "The rule sets for PHP Mess Detector. + +Set default rule sets and custom rule set files. + +See section \"Using multiple rule sets\" in the PHP Mess Detector +manual at URL `https://phpmd.org/documentation/index.html'." + :type '(repeat :tag "rule sets" + (string :tag "A filename or rule set")) + :safe #'flycheck-string-list-p) + +(flycheck-define-checker php-phpmd + "A PHP style checker using PHP Mess Detector. + +See URL `https://phpmd.org/'." + :command ("phpmd" source "xml" + (eval (flycheck-option-comma-separated-list + flycheck-phpmd-rulesets))) + :error-parser flycheck-parse-phpmd + :modes (php-mode php+-mode) + :next-checkers (php-phpcs)) + +(flycheck-def-option-var flycheck-phpcs-standard nil php-phpcs + "The coding standard for PHP CodeSniffer. + +When nil, use the default standard from the global PHP +CodeSniffer configuration. When set to a string, pass the string +to PHP CodeSniffer which will interpret it as name as a standard, +or as path to a standard specification." + :type '(choice (const :tag "Default standard" nil) + (string :tag "Standard name or file")) + :safe #'stringp) + +(flycheck-define-checker php-phpcs + "A PHP style checker using PHP Code Sniffer. + +Needs PHP Code Sniffer 2.6 or newer. + +See URL `http://pear.php.net/package/PHP_CodeSniffer/'." + :command ("phpcs" "--report=checkstyle" + (option "--standard=" flycheck-phpcs-standard concat) + ;; Pass original file name to phpcs. We need to concat explicitly + ;; here, because phpcs really insists to get option and argument as + ;; a single command line argument :| + (eval (when (buffer-file-name) + (concat "--stdin-path=" (buffer-file-name))))) + :standard-input t + :error-parser flycheck-parse-checkstyle + :error-filter + (lambda (errors) + (flycheck-sanitize-errors + (flycheck-remove-error-file-names "STDIN" errors))) + :modes (php-mode php+-mode) + ;; phpcs seems to choke on empty standard input, hence skip phpcs if the + ;; buffer is empty, see https://github.com/flycheck/flycheck/issues/907 + :predicate (lambda () (> (buffer-size) 0))) + +(flycheck-define-checker processing + "Processing command line tool. + +See https://github.com/processing/processing/wiki/Command-Line" + :command ("processing-java" "--force" + ;; Don't change the order of these arguments, processing is pretty + ;; picky + (eval (concat "--sketch=" (file-name-directory (buffer-file-name)))) + (eval (concat "--output=" (flycheck-temp-dir-system))) + "--build") + :error-patterns + ((error line-start (file-name) ":" line ":" column + (zero-or-more (or digit ":")) (message) line-end)) + :modes processing-mode + ;; This syntax checker needs a file name + :predicate (lambda () (buffer-file-name))) + +(flycheck-define-checker puppet-parser + "A Puppet DSL syntax checker using puppet's own parser. + +See URL `https://puppet.com/'." + :command ("puppet" "parser" "validate" "--color=false") + :standard-input t + :error-patterns + ( + ;; Patterns for Puppet 4 + (error line-start "Error: Could not parse for environment " + (one-or-more (in "a-z" "0-9" "_")) ":" + (message) " at line " line ":" column line-end) + ;; Errors from Puppet < 4 + (error line-start "Error: Could not parse for environment " + (one-or-more (in "a-z" "0-9" "_")) ":" + (message (minimal-match (one-or-more anything))) + " at line " line line-end) + (error line-start + ;; Skip over the path of the Puppet executable + (minimal-match (zero-or-more not-newline)) + ": Could not parse for environment " (one-or-more word) + ": " (message (minimal-match (zero-or-more anything))) + " at " (file-name "/" (zero-or-more not-newline)) ":" line line-end)) + :modes puppet-mode + :next-checkers ((warning . puppet-lint))) + +(flycheck-def-config-file-var flycheck-puppet-lint-rc puppet-lint + ".puppet-lint.rc" + :safe #'stringp + :package-version '(flycheck . "26")) + +(flycheck-def-option-var flycheck-puppet-lint-disabled-checks nil puppet-lint + "Disabled checkers for `puppet-lint'. + +The value of this variable is a list of strings, where each +string is the name of a check to disable (e.g. \"80chars\" or +\"double_quoted_strings\"). + +See URL `http://puppet-lint.com/checks/' for a list of all checks +and their names." + :type '(repeat (string :tag "Check Name")) + :package-version '(flycheck . "26")) + +(defun flycheck-puppet-lint-disabled-arg-name (check) + "Create an argument to disable a puppetlint CHECK." + (concat "--no-" check "-check")) + +(flycheck-define-checker puppet-lint + "A Puppet DSL style checker using puppet-lint. + +See URL `http://puppet-lint.com/'." + ;; We must check the original file, because Puppetlint is quite picky on the + ;; names of files and there place in the directory structure, to comply with + ;; Puppet's autoload directory layout. For instance, a class foo::bar is + ;; required to be in a file foo/bar.pp. Any other place, such as a Flycheck + ;; temporary file will cause an error. + :command ("puppet-lint" + (config-file "--config" flycheck-puppet-lint-rc) + "--log-format" + "%{path}:%{line}:%{kind}: %{message} (%{check})" + (option-list "" flycheck-puppet-lint-disabled-checks concat + flycheck-puppet-lint-disabled-arg-name) + source-original) + :error-patterns + ((warning line-start (file-name) ":" line ":warning: " (message) line-end) + (error line-start (file-name) ":" line ":error: " (message) line-end)) + :modes puppet-mode + ;; Since we check the original file, we can only use this syntax checker if + ;; the buffer is actually linked to a file, and if it is not modified. + :predicate flycheck-buffer-saved-p) + +(flycheck-def-config-file-var flycheck-flake8rc python-flake8 ".flake8rc" + :safe #'stringp) + +(flycheck-def-option-var flycheck-flake8-error-level-alist + '(("^E9.*$" . error) ; Syntax errors from pep8 + ("^F82.*$" . error) ; undefined variables from pyflakes + ("^F83.*$" . error) ; Duplicate arguments from flake8 + ("^D.*$" . info) ; Docstring issues from flake8-pep257 + ("^N.*$" . info) ; Naming issues from pep8-naming + ) + python-flake8 + "An alist mapping flake8 error IDs to Flycheck error levels. + +Each item in this list is a cons cell `(PATTERN . LEVEL)' where +PATTERN is a regular expression matched against the error ID, and +LEVEL is a Flycheck error level symbol. + +Each PATTERN is matched in the order of appearance in this list +against the error ID. If it matches the ID, the level of the +corresponding error is set to LEVEL. An error that is not +matched by any PATTERN defaults to warning level. + +The default value of this option matches errors from flake8 +itself and from the following flake8 plugins: + +- pep8-naming +- flake8-pep257 + +You may add your own mappings to this option in order to support +further flake8 plugins." + :type '(repeat (cons (regexp :tag "Error ID pattern") + (symbol :tag "Error level"))) + :package-version '(flycheck . "0.22")) + +(flycheck-def-option-var flycheck-flake8-maximum-complexity nil python-flake8 + "The maximum McCabe complexity of methods. + +If nil, do not check the complexity of methods. If set to an +integer, report any complexity greater than the value of this +variable as warning. + +If set to an integer, this variable overrules any similar setting +in the configuration file denoted by `flycheck-flake8rc'." + :type '(choice (const :tag "Do not check McCabe complexity" nil) + (integer :tag "Maximum complexity")) + :safe #'integerp) + +(flycheck-def-option-var flycheck-flake8-maximum-line-length nil python-flake8 + "The maximum length of lines. + +If set to an integer, the value of this variable denotes the +maximum length of lines, overruling any similar setting in the +configuration file denoted by `flycheck-flake8rc'. An error will +be reported for any line longer than the value of this variable. + +If set to nil, use the maximum line length from the configuration +file denoted by `flycheck-flake8rc', or the PEP 8 recommendation +of 79 characters if there is no configuration with this setting." + :type '(choice (const :tag "Default value") + (integer :tag "Maximum line length in characters")) + :safe #'integerp) + +(defun flycheck-flake8-fix-error-level (err) + "Fix the error level of ERR. + +Update the error level of ERR according to +`flycheck-flake8-error-level-alist'." + (pcase-dolist (`(,pattern . ,level) flycheck-flake8-error-level-alist) + (when (string-match-p pattern (flycheck-error-id err)) + (setf (flycheck-error-level err) level))) + err) + +(flycheck-define-checker python-flake8 + "A Python syntax and style checker using Flake8. + +Requires Flake8 3.0 or newer. See URL +`https://flake8.readthedocs.io/'." + :command ("flake8" + "--format=default" + "--stdin-display-name" source-original + (config-file "--config" flycheck-flake8rc) + (option "--max-complexity" flycheck-flake8-maximum-complexity nil + flycheck-option-int) + (option "--max-line-length" flycheck-flake8-maximum-line-length nil + flycheck-option-int) + "-") + :standard-input t + :error-filter (lambda (errors) + (let ((errors (flycheck-sanitize-errors errors))) + (seq-do #'flycheck-flake8-fix-error-level errors) + errors)) + :error-patterns + ((warning line-start + (file-name) ":" line ":" (optional column ":") " " + (id (one-or-more (any alpha)) (one-or-more digit)) " " + (message (one-or-more not-newline)) + line-end)) + :modes python-mode) + +(flycheck-def-config-file-var flycheck-pylintrc python-pylint + ".pylintrc" + :safe #'stringp) + +(flycheck-def-option-var flycheck-pylint-use-symbolic-id t python-pylint + "Whether to use pylint message symbols or message codes. + +A pylint message has both an opaque identifying code (such as `F0401') and a +more meaningful symbolic code (such as `import-error'). This option governs +which should be used and reported to the user." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.25")) + +(flycheck-define-checker python-pylint + "A Python syntax and style checker using Pylint. + +This syntax checker requires Pylint 1.0 or newer. + +See URL `https://www.pylint.org/'." + ;; -r n disables the scoring report + :command ("pylint" "-r" "n" + "--msg-template" + (eval (if flycheck-pylint-use-symbolic-id + "{path}:{line}:{column}:{C}:{symbol}:{msg}" + "{path}:{line}:{column}:{C}:{msg_id}:{msg}")) + (config-file "--rcfile" flycheck-pylintrc) + ;; Need `source-inplace' for relative imports (e.g. `from .foo + ;; import bar'), see https://github.com/flycheck/flycheck/issues/280 + source-inplace) + :error-filter + (lambda (errors) + (flycheck-sanitize-errors (flycheck-increment-error-columns errors))) + :error-patterns + ((error line-start (file-name) ":" line ":" column ":" + (or "E" "F") ":" + (id (one-or-more (not (any ":")))) ":" + (message) line-end) + (warning line-start (file-name) ":" line ":" column ":" + (or "W" "R") ":" + (id (one-or-more (not (any ":")))) ":" + (message) line-end) + (info line-start (file-name) ":" line ":" column ":" + "C:" (id (one-or-more (not (any ":")))) ":" + (message) line-end)) + :modes python-mode) + +(flycheck-define-checker python-pycompile + "A Python syntax checker using Python's builtin compiler. + +See URL `https://docs.python.org/3.4/library/py_compile.html'." + :command ("python" "-m" "py_compile" source) + :error-patterns + ;; Python 2.7 + ((error line-start " File \"" (file-name) "\", line " line "\n" + (>= 2 (zero-or-more not-newline) "\n") + "SyntaxError: " (message) line-end) + (error line-start "Sorry: IndentationError: " + (message) "(" (file-name) ", line " line ")" + line-end) + ;; 2.6 + (error line-start "SyntaxError: ('" (message (one-or-more (not (any "'")))) + "', ('" (file-name (one-or-more (not (any "'")))) "', " + line ", " column ", " (one-or-more not-newline) line-end)) + :modes python-mode) + +(flycheck-def-option-var flycheck-lintr-caching t r-lintr + "Whether to enable caching in lintr. + +By default, lintr caches all expressions in a file and re-checks +only those that have changed. Setting this option to nil +disables caching in case there are problems." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.23")) + +(flycheck-def-option-var flycheck-lintr-linters "default_linters" r-lintr + "Linters to use with lintr. + +The value of this variable is a string containing an R +expression, which selects linters for lintr." + :type 'string + :risky t + :package-version '(flycheck . "0.23")) + +(defun flycheck-r-has-lintr (R) + "Whether R has installed the `lintr' library." + (with-temp-buffer + (let ((process-environment (append '("LC_ALL=C") process-environment))) + (call-process R nil t nil + "--slave" "--restore" "--no-save" "-e" + "library('lintr')") + (goto-char (point-min)) + (not (re-search-forward "there is no package called 'lintr'" nil 'no-error))))) + +(flycheck-define-checker r-lintr + "An R style and syntax checker using the lintr package. + +See URL `https://github.com/jimhester/lintr'." + :command ("R" "--slave" "--restore" "--no-save" "-e" + (eval (concat + "library(lintr);" + "try(lint(commandArgs(TRUE)" + ", cache=" (if flycheck-lintr-caching "TRUE" "FALSE") + ", " flycheck-lintr-linters + "))")) + "--args" source) + :error-patterns + ((info line-start (file-name) ":" line ":" column ": style: " (message) + line-end) + (warning line-start (file-name) ":" line ":" column ": warning: " (message) + line-end) + (error line-start (file-name) ":" line ":" column ": error: " (message) + line-end)) + :modes ess-mode + :predicate + ;; Don't check ESS files which do not contain R, and make sure that lintr is + ;; actually available + (lambda () + (and (equal ess-language "S") + (flycheck-r-has-lintr (flycheck-checker-executable 'r-lintr)))) + :verify (lambda (checker) + (let ((has-lintr (flycheck-r-has-lintr + (flycheck-checker-executable checker)))) + (list + (flycheck-verification-result-new + :label "lintr library" + :message (if has-lintr "present" "missing") + :face (if has-lintr 'success '(bold error))))))) + +(defun flycheck-racket-has-expand-p (checker) + "Whether the executable of CHECKER provides the `expand' command." + (let ((raco (flycheck-find-checker-executable checker))) + (when raco + (with-temp-buffer + (call-process raco nil t nil "expand") + (goto-char (point-min)) + (not (looking-at-p (rx bol (1+ not-newline) + "Unrecognized command: expand" + eol))))))) + +(flycheck-define-checker racket + "A Racket syntax checker with `raco expand'. + +The `compiler-lib' racket package is required for this syntax +checker. + +See URL `https://racket-lang.org/'." + :command ("raco" "expand" source-inplace) + :predicate + (lambda () + (and (or (not (eq major-mode 'scheme-mode)) + ;; In `scheme-mode' we must check the current Scheme implementation + ;; being used + (and (boundp 'geiser-impl--implementation) + (eq geiser-impl--implementation 'racket))) + (flycheck-racket-has-expand-p 'racket))) + :verify + (lambda (checker) + (let ((has-expand (flycheck-racket-has-expand-p checker)) + (in-scheme-mode (eq major-mode 'scheme-mode)) + (geiser-impl (bound-and-true-p geiser-impl--implementation))) + (list + (flycheck-verification-result-new + :label "compiler-lib package" + :message (if has-expand "present" "missing") + :face (if has-expand 'success '(bold error))) + (flycheck-verification-result-new + :label "Geiser Implementation" + :message (cond + ((not in-scheme-mode) "Using Racket Mode") + ((eq geiser-impl 'racket) "Racket") + (geiser-impl (format "Other: %s" geiser-impl)) + (t "Geiser not active")) + :face (cond + ((or (not in-scheme-mode) (eq geiser-impl 'racket)) 'success) + (t '(bold error))))))) + :error-filter + (lambda (errors) + (flycheck-sanitize-errors (flycheck-increment-error-columns errors))) + :error-patterns + ((error line-start (file-name) ":" line ":" column ":" (message) line-end)) + :modes (racket-mode scheme-mode)) + +(flycheck-define-checker rpm-rpmlint + "A RPM SPEC file syntax checker using rpmlint. + +See URL `https://sourceforge.net/projects/rpmlint/'." + :command ("rpmlint" source) + :error-patterns + ((error line-start + (file-name) ":" (optional line ":") " E: " (message) + line-end) + (warning line-start + (file-name) ":" (optional line ":") " W: " (message) + line-end)) + :error-filter + ;; Add fake line numbers if they are missing in the lint output + (lambda (errors) + (dolist (err errors) + (unless (flycheck-error-line err) + (setf (flycheck-error-line err) 1))) + errors) + :modes (sh-mode rpm-spec-mode) + :predicate (lambda () (or (not (eq major-mode 'sh-mode)) + ;; In `sh-mode', we need the proper shell + (eq sh-shell 'rpm)))) + +(flycheck-def-option-var flycheck-markdown-mdl-rules nil markdown-mdl + "Rules to enable for mdl. + +The value of this variable is a list of strings each of which is +the name of a rule to enable. + +By default all rules are enabled. + +See URL +`https://github.com/mivok/markdownlint/blob/master/docs/configuration.md'." + :type '(repeat :tag "Enabled rules" + (string :tag "rule name")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "27")) + +(flycheck-def-option-var flycheck-markdown-mdl-tags nil markdown-mdl + "Rule tags to enable for mdl. + +The value of this variable is a list of strings each of which is +the name of a rule tag. Only rules with these tags are enabled. + +By default all rules are enabled. + +See URL +`https://github.com/mivok/markdownlint/blob/master/docs/configuration.md'." + :type '(repeat :tag "Enabled tags" + (string :tag "tag name")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "27")) + +(flycheck-def-config-file-var flycheck-markdown-mdl-style markdown-mdl nil + :safe #'stringp + :package-version '(flycheck . "27")) + +(flycheck-define-checker markdown-mdl + "Markdown checker using mdl. + +See URL `https://github.com/mivok/markdownlint'." + :command ("mdl" + (config-file "--style" flycheck-markdown-mdl-style) + (option "--tags=" flycheck-markdown-mdl-rules concat + flycheck-option-comma-separated-list) + (option "--rules=" flycheck-markdown-mdl-rules concat + flycheck-option-comma-separated-list)) + :standard-input t + :error-patterns + ((error line-start + (file-name) ":" line ": " (id (one-or-more alnum)) " " (message) + line-end)) + :error-filter + (lambda (errors) + (flycheck-sanitize-errors + (flycheck-remove-error-file-names "(stdin)" errors))) + :modes (markdown-mode gfm-mode)) + +(defun flycheck-locate-sphinx-source-directory () + "Locate the Sphinx source directory for the current buffer. + +Return the source directory, or nil, if the current buffer is not +part of a Sphinx project." + (-when-let* ((filename (buffer-file-name)) + (dir (locate-dominating-file filename "conf.py"))) + (expand-file-name dir))) + +(flycheck-define-checker rst + "A ReStructuredText (RST) syntax checker using Docutils. + +See URL `http://docutils.sourceforge.net/'." + ;; We need to use source-inplace to properly resolve relative paths in + ;; include:: directives + :command ("rst2pseudoxml.py" "--report=2" "--halt=5" + ;; Read from standard input and throw output away + "-" null-device) + :standard-input t + :error-patterns + ((warning line-start ":" line ": (WARNING/2) " (message) line-end) + (error line-start ":" line + ": (" (or "ERROR/3" "SEVERE/4") ") " + (message) line-end)) + :modes rst-mode) + +(flycheck-def-option-var flycheck-sphinx-warn-on-missing-references t rst-sphinx + "Whether to warn about missing references in Sphinx. + +When non-nil (the default), warn about all missing references in +Sphinx via `-n'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.17")) + +(flycheck-define-checker rst-sphinx + "A ReStructuredText (RST) syntax checker using Sphinx. + +Requires Sphinx 1.2 or newer. See URL `http://sphinx-doc.org'." + :command ("sphinx-build" "-b" "pseudoxml" + "-q" "-N" ; Reduced output and no colors + (option-flag "-n" flycheck-sphinx-warn-on-missing-references) + (eval (flycheck-locate-sphinx-source-directory)) + temporary-directory ; Redirect the output to a temporary + ; directory + source-original) ; Sphinx needs the original document + :error-patterns + ((warning line-start (file-name) ":" line ": WARNING: " (message) line-end) + (error line-start + (file-name) ":" line + ": " (or "ERROR" "SEVERE") ": " + (message) line-end)) + :modes rst-mode + :predicate (lambda () (and (flycheck-buffer-saved-p) + (flycheck-locate-sphinx-source-directory)))) + +(flycheck-def-config-file-var flycheck-rubocoprc ruby-rubocop ".rubocop.yml" + :safe #'stringp) + +(flycheck-def-option-var flycheck-rubocop-lint-only nil ruby-rubocop + "Whether to only report code issues in Rubocop. + +When non-nil, only report code issues in Rubocop, via `--lint'. +Otherwise report style issues as well." + :safe #'booleanp + :type 'boolean + :package-version '(flycheck . "0.16")) + +(flycheck-define-checker ruby-rubocop + "A Ruby syntax and style checker using the RuboCop tool. + +You need at least RuboCop 0.34 for this syntax checker. + +See URL `http://batsov.com/rubocop/'." + :command ("rubocop" "--display-cop-names" "--format" "emacs" + ;; Explicitly disable caching to prevent Rubocop 0.35.1 and earlier + ;; from caching standard input. Later versions of Rubocop + ;; automatically disable caching with --stdin, see + ;; https://github.com/flycheck/flycheck/issues/844 and + ;; https://github.com/bbatsov/rubocop/issues/2576 + "--cache" "false" + (config-file "--config" flycheck-rubocoprc) + (option-flag "--lint" flycheck-rubocop-lint-only) + ;; Rubocop takes the original file name as argument when reading + ;; from standard input + "--stdin" source-original) + :standard-input t + :error-patterns + ((info line-start (file-name) ":" line ":" column ": C: " + (optional (id (one-or-more (not (any ":")))) ": ") (message) line-end) + (warning line-start (file-name) ":" line ":" column ": W: " + (optional (id (one-or-more (not (any ":")))) ": ") (message) + line-end) + (error line-start (file-name) ":" line ":" column ": " (or "E" "F") ": " + (optional (id (one-or-more (not (any ":")))) ": ") (message) + line-end)) + :modes (enh-ruby-mode ruby-mode) + :next-checkers ((warning . ruby-rubylint))) + +;; Default to `nil' to let Rubylint find its configuration file by itself, and +;; to maintain backwards compatibility with older Rubylint and Flycheck releases +(flycheck-def-config-file-var flycheck-rubylintrc ruby-rubylint nil + :safe #'stringp) + +(flycheck-define-checker ruby-rubylint + "A Ruby syntax and code analysis checker using ruby-lint. + +Requires ruby-lint 2.0.2 or newer. See URL +`https://github.com/YorickPeterse/ruby-lint'." + :command ("ruby-lint" "--presenter=syntastic" + (config-file "--config" flycheck-rubylintrc) + source) + ;; Ruby Lint can't read from standard input + :error-patterns + ((info line-start + (file-name) ":I:" line ":" column ": " (message) line-end) + (warning line-start + (file-name) ":W:" line ":" column ": " (message) line-end) + (error line-start + (file-name) ":E:" line ":" column ": " (message) line-end)) + :modes (enh-ruby-mode ruby-mode)) + +(flycheck-define-checker ruby + "A Ruby syntax checker using the standard Ruby interpreter. + +Please note that the output of different Ruby versions and +implementations varies wildly. This syntax checker supports +current versions of MRI and JRuby, but may break when used with +other implementations or future versions of these +implementations. + +Please consider using `ruby-rubocop' or `ruby-rubylint' instead. + +See URL `https://www.ruby-lang.org/'." + :command ("ruby" "-w" "-c") + :standard-input t + :error-patterns + ;; These patterns support output from JRuby, too, to deal with RVM or Rbenv + ((error line-start "SyntaxError in -:" line ": " (message) line-end) + (warning line-start "-:" line ":" (optional column ":") + " warning: " (message) line-end) + (error line-start "-:" line ": " (message) line-end)) + :modes (enh-ruby-mode ruby-mode) + :next-checkers ((warning . ruby-rubylint))) + +(flycheck-define-checker ruby-jruby + "A Ruby syntax checker using the JRuby interpreter. + +This syntax checker is very primitive, and may break on future +versions of JRuby. + +Please consider using `ruby-rubocop' or `ruby-rubylint' instead. + +See URL `http://jruby.org/'." + :command ("jruby" "-w" "-c") + :standard-input t + :error-patterns + ((error line-start "SyntaxError in -:" line ": " (message) line-end) + (warning line-start "-:" line " warning: " (message) line-end) + (error line-start "-:" line ": " (message) line-end)) + :modes (enh-ruby-mode ruby-mode) + :next-checkers ((warning . ruby-rubylint))) + +(flycheck-def-args-var flycheck-cargo-rustc-args (rust-cargo) + :package-version '(flycheck . "30")) + +(flycheck-def-args-var flycheck-rust-args (rust-cargo rust) + :package-version '(flycheck . "0.24")) + +(flycheck-def-option-var flycheck-rust-check-tests t (rust-cargo rust) + "Whether to check test code in Rust. + +When non-nil, `rustc' is passed the `--test' flag, which will +check any code marked with the `#[cfg(test)]' attribute and any +functions marked with `#[test]'. Otherwise, `rustc' is not passed +`--test' and test code will not be checked. Skipping `--test' is +necessary when using `#![no_std]', because compiling the test +runner requires `std'." + :type 'boolean + :safe #'booleanp + :package-version '("flycheck" . "0.19")) + +(flycheck-def-option-var flycheck-rust-crate-root nil rust + "A path to the crate root for the current buffer. + +The value of this variable is either a string with the path to +the crate root for the current buffer, or nil if the current buffer +is a crate. A relative path is relative to the current buffer. + +If this variable is non nil the current buffer will only be checked +if it is not modified, i.e. after it has been saved." + :type 'string + :package-version '(flycheck . "0.20") + :safe #'stringp) +(make-variable-buffer-local 'flycheck-rust-crate-root) + +(flycheck-def-option-var flycheck-rust-crate-type "lib" (rust-cargo rust) + "The type of the Rust Crate to check. + +The value of this variable is a string denoting the crate type, +for the `--crate-type' flag." + :type 'string + :safe #'stringp + :package-version '(flycheck . "0.20")) +(make-variable-buffer-local 'flycheck-rust-crate-type) + +(flycheck-def-option-var flycheck-rust-binary-name nil rust-cargo + "The name of the binary to pass to `cargo rustc --bin'. + +The value of this variable is a string denoting the name of the +binary to build: Either the name of the crate, or the name of one +of the files under `src/bin'. + +This variable is used only when `flycheck-rust-crate-type' is +`bin', and is only useful for crates with multiple targets." + :type 'string + :safe #'stringp + :package-version '(flycheck . "28")) +(make-variable-buffer-local 'flycheck-rust-binary-name) + +(flycheck-def-option-var flycheck-rust-library-path nil (rust-cargo rust) + "A list of library directories for Rust. + +The value of this variable is a list of strings, where each +string is a directory to add to the library path of Rust. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Library directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.18")) + +(flycheck-define-checker rust-cargo + "A Rust syntax checker using Cargo. + +This syntax checker needs Rust 1.7 or newer, and Cargo with the +rustc command. See URL `https://www.rust-lang.org'." + :command ("cargo" "rustc" + (eval (cond + ((string= flycheck-rust-crate-type "lib") "--lib") + (flycheck-rust-binary-name + (list "--bin" flycheck-rust-binary-name)))) + (eval flycheck-cargo-rustc-args) + "--" "-Z" "no-trans" + ;; Passing the "unstable-options" flag may raise an error in the + ;; future. For the moment, we need it to access JSON output in all + ;; rust versions >= 1.7. + "-Z" "unstable-options" + "--error-format=json" + (option-flag "--test" flycheck-rust-check-tests) + (option-list "-L" flycheck-rust-library-path concat) + (eval flycheck-rust-args)) + :error-parser flycheck-parse-rust + :modes rust-mode + :predicate (lambda () + ;; Since we build the entire project with cargo rustc we require + ;; that the buffer is saved. And of course, we also need a Cargo + ;; file :) + (and (flycheck-buffer-saved-p) + (locate-dominating-file (buffer-file-name) "Cargo.toml")))) + +(flycheck-define-checker rust + "A Rust syntax checker using Rust compiler. + +This syntax checker needs Rust 1.7 or newer. See URL +`https://www.rust-lang.org'." + :command ("rustc" "-Z" "no-trans" + (option "--crate-type" flycheck-rust-crate-type) + ;; Passing the "unstable-options" flag may raise an error in the + ;; future. For the moment, we need it to access JSON output in all + ;; rust versions >= 1.7. + "-Z" "unstable-options" + "--error-format=json" + (option-flag "--test" flycheck-rust-check-tests) + (option-list "-L" flycheck-rust-library-path concat) + (eval flycheck-rust-args) + (eval (or flycheck-rust-crate-root + (flycheck-substitute-argument 'source-inplace 'rust)))) + :error-parser flycheck-parse-rust + :modes rust-mode + :predicate (lambda () + (and (not flycheck-rust-crate-root) (flycheck-buffer-saved-p)))) + +(defvar flycheck-sass-scss-cache-directory nil + "The cache directory for `sass' and `scss'.") + +(defun flycheck-sass-scss-cache-location () + "Get the cache location for `sass' and `scss'. + +If no cache directory exists yet, create one and return it. +Otherwise return the previously used cache directory." + (setq flycheck-sass-scss-cache-directory + (or flycheck-sass-scss-cache-directory + (make-temp-file "flycheck-sass-scss-cache" 'directory)))) + +(flycheck-def-option-var flycheck-sass-compass nil sass + "Whether to enable the Compass CSS framework. + +When non-nil, enable the Compass CSS framework, via `--compass'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.16")) + +(flycheck-define-checker sass + "A Sass syntax checker using the Sass compiler. + +See URL `http://sass-lang.com'." + :command ("sass" + "--cache-location" (eval (flycheck-sass-scss-cache-location)) + (option-flag "--compass" flycheck-sass-compass) + "--check" "--stdin") + :standard-input t + :error-patterns + ((error line-start + (or "Syntax error: " "Error: ") + (message (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + (optional "\r") "\n" (one-or-more " ") "on line " line + " of standard input" + line-end) + (warning line-start + "WARNING: " + (message (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + (optional "\r") "\n" (one-or-more " ") "on line " line + " of " (one-or-more not-newline) + line-end)) + :modes sass-mode) + +(flycheck-def-config-file-var flycheck-sass-lintrc sass/scss-sass-lint ".sass-lint.yml" + :safe #'stringp + :package-version '(flycheck . "30")) + +(flycheck-define-checker sass/scss-sass-lint + "A SASS/SCSS syntax checker using sass-Lint. + +See URL `https://github.com/sasstools/sass-lint'." + :command ("sass-lint" + "--verbose" + "--no-exit" + "--format" "Checkstyle" + (config-file "--config" flycheck-sass-lintrc) + source) + :standard-input nil + :error-parser flycheck-parse-checkstyle + :modes (sass-mode scss-mode)) + +(flycheck-define-checker scala + "A Scala syntax checker using the Scala compiler. + +See URL `http://www.scala-lang.org/'." + :command ("scalac" "-Ystop-after:parser" source) + :error-patterns + ((error line-start (file-name) ":" line ": error: " (message) line-end)) + :modes scala-mode + :next-checkers ((warning . scala-scalastyle))) + +(flycheck-def-config-file-var flycheck-scalastylerc scala-scalastyle nil + :safe #'stringp + :package-version '(flycheck . "0.20")) + +(flycheck-define-checker scala-scalastyle + "A Scala style checker using scalastyle. + +Note that this syntax checker is not used if +`flycheck-scalastylerc' is nil or refers to a non-existing file. + +See URL `http://www.scalastyle.org'." + :command ("scalastyle" + (config-file "-c" flycheck-scalastylerc) + source) + :error-patterns + ((error line-start "error file=" (file-name) " message=" + (message) " line=" line (optional " column=" column) line-end) + (warning line-start "warning file=" (file-name) " message=" + (message) " line=" line (optional " column=" column) line-end)) + :error-filter (lambda (errors) + (flycheck-sanitize-errors + (flycheck-increment-error-columns errors))) + :modes scala-mode + :predicate + ;; Inhibit this syntax checker if the JAR or the configuration are unset or + ;; missing + (lambda () (and flycheck-scalastylerc + (flycheck-locate-config-file flycheck-scalastylerc + 'scala-scalastyle))) + :verify (lambda (checker) + (let ((config-file (and flycheck-scalastylerc + (flycheck-locate-config-file + flycheck-scalastylerc checker)))) + (list + (flycheck-verification-result-new + :label "Configuration file" + :message (cond + ((not flycheck-scalastylerc) + "`flycheck-scalastyletrc' not set") + ((not config-file) + (format "file %s not found" flycheck-scalastylerc)) + (t (format "found at %s" config-file))) + :face (cond + ((not flycheck-scalastylerc) '(bold warning)) + ((not config-file) '(bold error)) + (t 'success))))))) + +(flycheck-define-checker scheme-chicken + "A CHICKEN Scheme syntax checker using the CHICKEN compiler `csc'. + +See URL `http://call-cc.org/'." + :command ("csc" "-analyze-only" "-local" source) + :error-patterns + ((info line-start + "Note: " (zero-or-more not-newline) ":\n" + (one-or-more (any space)) "(" (file-name) ":" line ") " (message) + line-end) + (warning line-start + "Warning: " (zero-or-more not-newline) ":\n" + (one-or-more (any space)) "(" (file-name) ":" line ") " (message) + line-end) + (error line-start + "Error: " (zero-or-more not-newline) ":\n" + (one-or-more (any space)) "(" (file-name) ":" line ") " (message) + line-end)) + :predicate + (lambda () + ;; In `scheme-mode' we must check the current Scheme implementation + ;; being used + (and (boundp 'geiser-impl--implementation) + (eq geiser-impl--implementation 'chicken))) + :verify + (lambda (_checker) + (let ((geiser-impl (bound-and-true-p geiser-impl--implementation))) + (list + (flycheck-verification-result-new + :label "Geiser Implementation" + :message (cond + ((eq geiser-impl 'chicken) "Chicken Scheme") + (geiser-impl (format "Other: %s" geiser-impl)) + (t "Geiser not active")) + :face (cond + ((eq geiser-impl 'chicken) 'success) + (t '(bold error))))))) + :modes scheme-mode) + +(defconst flycheck-scss-lint-checkstyle-re + (rx "cannot load such file" (1+ not-newline) "scss_lint_reporter_checkstyle") + "Regular expression to parse missing checkstyle error.") + +(defun flycheck-parse-scss-lint (output checker buffer) + "Parse SCSS-Lint OUTPUT from CHECKER and BUFFER. + +Like `flycheck-parse-checkstyle', but catches errors about +missing checkstyle reporter from SCSS-Lint." + (if (string-match-p flycheck-scss-lint-checkstyle-re output) + (list (flycheck-error-new-at + 1 nil 'error "Checkstyle reporter for SCSS-Lint missing. +Please run gem install scss_lint_reporter_checkstyle" + :checker checker + :buffer buffer + :filename (buffer-file-name buffer))) + (flycheck-parse-checkstyle output checker buffer))) + +(flycheck-def-config-file-var flycheck-scss-lintrc scss-lint ".scss-lint.yml" + :safe #'stringp + :package-version '(flycheck . "0.23")) + +(flycheck-define-checker scss-lint + "A SCSS syntax checker using SCSS-Lint. + +Needs SCSS-Lint 0.43.2 or newer. + +See URL `https://github.com/brigade/scss-lint'." + :command ("scss-lint" + "--require=scss_lint_reporter_checkstyle" + "--format=Checkstyle" + (config-file "--config" flycheck-scss-lintrc) + "--stdin-file-path" source-original "-") + :standard-input t + ;; We cannot directly parse Checkstyle XML, since for some mysterious reason + ;; SCSS-Lint doesn't have a built-in Checkstyle reporter, and instead ships it + ;; as an addon which might not be installed. We use a custom error parser to + ;; check whether the addon is missing and turn that into a special kind of + ;; Flycheck error. + :error-parser flycheck-parse-scss-lint + :modes scss-mode + :verify (lambda (checker) + (let* ((executable (flycheck-find-checker-executable checker)) + (reporter-missing + (and executable + (with-temp-buffer + (call-process executable nil t nil + "--require=scss_lint_reporter_checkstyle") + (goto-char (point-min)) + (re-search-forward + flycheck-scss-lint-checkstyle-re + nil 'no-error))))) + (when executable + (list + (flycheck-verification-result-new + :label "checkstyle reporter" + :message (if reporter-missing + "scss_lint_reporter_checkstyle missing" + "present") + :face (if reporter-missing + '(bold error) + 'success))))))) + +(flycheck-def-option-var flycheck-scss-compass nil scss + "Whether to enable the Compass CSS framework. + +When non-nil, enable the Compass CSS framework, via `--compass'." + :type 'boolean + :safe #'booleanp + :package-version '(flycheck . "0.16")) + +(flycheck-define-checker scss + "A SCSS syntax checker using the SCSS compiler. + +See URL `http://sass-lang.com'." + :command ("scss" + "--cache-location" (eval (flycheck-sass-scss-cache-location)) + (option-flag "--compass" flycheck-scss-compass) + "--check" "--stdin") + :standard-input t + :error-patterns + ((error line-start + (or "Syntax error: " "Error: ") + (message (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + (optional "\r") "\n" (one-or-more " ") "on line " line + " of standard input" + line-end) + (warning line-start + "WARNING: " + (message (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + (optional "\r") "\n" (one-or-more " ") "on line " line + " of an unknown file" + line-end)) + :modes scss-mode) + +(flycheck-define-checker sh-bash + "A Bash syntax checker using the Bash shell. + +See URL `http://www.gnu.org/software/bash/'." + :command ("bash" "--norc" "-n" "--") + :standard-input t + :error-patterns + ((error line-start + ;; The name/path of the bash executable + (one-or-more (not (any ":"))) ":" + ;; A label "line", possibly localized + (one-or-more (not (any digit))) + line (zero-or-more " ") ":" (zero-or-more " ") + (message) line-end)) + :modes sh-mode + :predicate (lambda () (eq sh-shell 'bash)) + :next-checkers ((warning . sh-shellcheck))) + +(flycheck-define-checker sh-posix-dash + "A POSIX Shell syntax checker using the Dash shell. + +See URL `http://gondor.apana.org.au/~herbert/dash/'." + :command ("dash" "-n") + :standard-input t + :error-patterns + ((error line-start (one-or-more (not (any ":"))) ": " line ": " (message))) + :modes sh-mode + :predicate (lambda () (eq sh-shell 'sh)) + :next-checkers ((warning . sh-shellcheck))) + +(flycheck-define-checker sh-posix-bash + "A POSIX Shell syntax checker using the Bash shell. + +See URL `http://www.gnu.org/software/bash/'." + :command ("bash" "--posix" "--norc" "-n" "--") + :standard-input t + :error-patterns + ((error line-start + ;; The name/path of the bash executable + (one-or-more (not (any ":"))) ":" + ;; A label "line", possibly localized + (one-or-more (not (any digit))) + line (zero-or-more " ") ":" (zero-or-more " ") + (message) line-end)) + :modes sh-mode + :predicate (lambda () (eq sh-shell 'sh)) + :next-checkers ((warning . sh-shellcheck))) + +(flycheck-define-checker sh-zsh + "A Zsh syntax checker using the Zsh shell. + +See URL `http://www.zsh.org/'." + :command ("zsh" "--no-exec" "--no-globalrcs" "--no-rcs" source) + :error-patterns + ((error line-start (file-name) ":" line ": " (message) line-end)) + :modes sh-mode + :predicate (lambda () (eq sh-shell 'zsh)) + :next-checkers ((warning . sh-shellcheck))) + +(defconst flycheck-shellcheck-supported-shells '(bash ksh88 sh) + "Shells supported by ShellCheck.") + +(flycheck-def-option-var flycheck-shellcheck-excluded-warnings nil sh-shellcheck + "A list of excluded warnings for ShellCheck. + +The value of this variable is a list of strings, where each +string is a warning code to be excluded from ShellCheck reports. +By default, no warnings are excluded." + :type '(repeat :tag "Excluded warnings" + (string :tag "Warning code")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.21")) + +(flycheck-define-checker sh-shellcheck + "A shell script syntax and style checker using Shellcheck. + +See URL `https://github.com/koalaman/shellcheck/'." + :command ("shellcheck" + "--format" "checkstyle" + "--shell" (eval (symbol-name sh-shell)) + (option "--exclude" flycheck-shellcheck-excluded-warnings list + flycheck-option-comma-separated-list) + "-") + :standard-input t + :error-parser flycheck-parse-checkstyle + :error-filter + (lambda (errors) + (flycheck-remove-error-file-names + "-" (flycheck-dequalify-error-ids errors))) + :modes sh-mode + :predicate (lambda () (memq sh-shell flycheck-shellcheck-supported-shells)) + :verify (lambda (_) + (let ((supports-shell (memq sh-shell + flycheck-shellcheck-supported-shells))) + (list + (flycheck-verification-result-new + :label (format "Shell %s supported" sh-shell) + :message (if supports-shell "yes" "no") + :face (if supports-shell 'success '(bold warning))))))) + +(flycheck-define-checker slim + "A Slim syntax checker using the Slim compiler. + +See URL `http://slim-lang.com'." + :command ("slimrb" "--compile") + :standard-input t + :error-patterns + ((error line-start + "Slim::Parser::SyntaxError:" (message) (optional "\r") "\n " + "STDIN, Line " line (optional ", Column " column) + line-end)) + :modes slim-mode + :next-checkers ((warning . slim-lint))) + +(flycheck-define-checker slim-lint + "A Slim linter. + +See URL `https://github.com/sds/slim-lint'." + :command ("slim-lint" "--reporter=checkstyle" source) + :error-parser flycheck-parse-checkstyle + :modes slim-mode) + +(flycheck-define-checker sql-sqlint + "A SQL syntax checker using the sqlint tool. + +See URL `https://github.com/purcell/sqlint'." + :command ("sqlint") + :standard-input t + :error-patterns + ((warning line-start "stdin:" line ":" column ":WARNING " + (message (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + line-end) + (error line-start "stdin:" line ":" column ":ERROR " + (message (one-or-more not-newline) + (zero-or-more "\n" + (one-or-more " ") + (one-or-more not-newline))) + line-end)) + :modes (sql-mode)) + +(flycheck-def-config-file-var flycheck-chktexrc tex-chktex ".chktexrc" + :safe #'stringp) + +(flycheck-define-checker tex-chktex + "A TeX and LaTeX syntax and style checker using chktex. + +See URL `http://www.nongnu.org/chktex/'." + :command ("chktex" + (config-file "--localrc" flycheck-chktexrc) + ;; Compact error messages, and no version information, and execute + ;; \input statements + "--verbosity=0" "--quiet" "--inputfiles") + :standard-input t + :error-patterns + ((warning line-start "stdin:" line ":" column ":" + (id (one-or-more digit)) ":" (message) line-end)) + :error-filter + (lambda (errors) + (flycheck-sanitize-errors (flycheck-increment-error-columns errors))) + :modes (latex-mode plain-tex-mode)) + +(flycheck-define-checker tex-lacheck + "A LaTeX syntax and style checker using lacheck. + +See URL `http://www.ctan.org/pkg/lacheck'." + :command ("lacheck" source-inplace) + :error-patterns + ((warning line-start + "\"" (file-name) "\", line " line ": " (message) + line-end)) + :modes latex-mode) + +(flycheck-define-checker texinfo + "A Texinfo syntax checker using makeinfo. + +See URL `http://www.gnu.org/software/texinfo/'." + :command ("makeinfo" "-o" null-device "-") + :standard-input t + :error-patterns + ((warning line-start + "-:" line (optional ":" column) ": " "warning: " (message) + line-end) + (error line-start + "-:" line (optional ":" column) ": " (message) + line-end)) + :modes texinfo-mode) + +(flycheck-def-config-file-var flycheck-typescript-tslint-config + typescript-tslint "tslint.json" + :safe #'stringp + :package-version '(flycheck . "27")) + +(flycheck-def-option-var flycheck-typescript-tslint-rulesdir + nil typescript-tslint + "The directory of custom rules for TSLint. + +The value of this variable is either a string containing the path +to a directory with custom rules, or nil, to not give any custom +rules to TSLint. + +Refer to the TSLint manual at URL +`http://palantir.github.io/tslint/usage/cli/' +for more information about the custom directory." + :type '(choice (const :tag "No custom rules directory" nil) + (directory :tag "Custom rules directory")) + :safe #'stringp + :package-version '(flycheck . "27")) + +(flycheck-define-checker typescript-tslint + "TypeScript style checker using TSLint. + +Note that this syntax checker is not used if +`flycheck-typescript-tslint-config' is nil or refers to a +non-existing file. + +See URL `https://github.com/palantir/tslint'." + :command ("tslint" "--format" "json" + (config-file "--config" flycheck-typescript-tslint-config) + (option "--rules-dir" flycheck-typescript-tslint-rulesdir) + source) + :error-parser flycheck-parse-tslint + :modes (typescript-mode)) + +(flycheck-def-option-var flycheck-verilator-include-path nil verilog-verilator + "A list of include directories for Verilator. + +The value of this variable is a list of strings, where each +string is a directory to add to the include path of Verilator. +Relative paths are relative to the file being checked." + :type '(repeat (directory :tag "Include directory")) + :safe #'flycheck-string-list-p + :package-version '(flycheck . "0.24")) + +(flycheck-define-checker verilog-verilator + "A Verilog syntax checker using the Verilator Verilog HDL simulator. + +See URL `http://www.veripool.org/wiki/verilator'." + :command ("verilator" "--lint-only" "-Wall" + (option-list "-I" flycheck-verilator-include-path concat) + source) + :error-patterns + ((warning line-start "%Warning-" (zero-or-more not-newline) ": " + (file-name) ":" line ": " (message) line-end) + (error line-start "%Error: " (file-name) ":" + line ": " (message) line-end)) + :modes verilog-mode) + +(flycheck-define-checker xml-xmlstarlet + "A XML syntax checker and validator using the xmlstarlet utility. + +See URL `http://xmlstar.sourceforge.net/'." + ;; Validate standard input with verbose error messages, and do not dump + ;; contents to standard output + :command ("xmlstarlet" "val" "--err" "--quiet" "-") + :standard-input t + :error-patterns + ((error line-start "-:" line "." column ": " (message) line-end)) + :modes (xml-mode nxml-mode)) + +(flycheck-define-checker xml-xmllint + "A XML syntax checker and validator using the xmllint utility. + +The xmllint is part of libxml2, see URL +`http://www.xmlsoft.org/'." + :command ("xmllint" "--noout" "-") + :standard-input t + :error-patterns + ((error line-start "-:" line ": " (message) line-end)) + :modes (xml-mode nxml-mode)) + +(flycheck-define-checker yaml-jsyaml + "A YAML syntax checker using JS-YAML. + +See URL `https://github.com/nodeca/js-yaml'." + :command ("js-yaml") + :standard-input t + :error-patterns + ((error line-start + (or "JS-YAML" "YAMLException") ": " + (message) " at line " line ", column " column ":" + line-end)) + :modes yaml-mode) + +(flycheck-define-checker yaml-ruby + "A YAML syntax checker using Ruby's YAML parser. + +This syntax checker uses the YAML parser from Ruby's standard +library. + +See URL `http://www.ruby-doc.org/stdlib-2.0.0/libdoc/yaml/rdoc/YAML.html'." + :command ("ruby" "-ryaml" "-e" "begin; + YAML.load(STDIN); \ + rescue Exception => e; \ + STDERR.puts \"stdin:#{e}\"; \ + end") + :standard-input t + :error-patterns + ((error line-start "stdin:" (zero-or-more not-newline) ":" (message) + "at line " line " column " column line-end)) + :modes yaml-mode) + +(provide 'flycheck) + +;; Local Variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; flycheck.el ends here diff --git a/elpa/gnome-calendar-20140112.359/gnome-calendar-autoloads.el b/elpa/gnome-calendar-20140112.359/gnome-calendar-autoloads.el new file mode 100644 index 0000000..f055072 --- /dev/null +++ b/elpa/gnome-calendar-20140112.359/gnome-calendar-autoloads.el @@ -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 diff --git a/elpa/gnome-calendar-20140112.359/gnome-calendar-pkg.el b/elpa/gnome-calendar-20140112.359/gnome-calendar-pkg.el new file mode 100644 index 0000000..2d289bf --- /dev/null +++ b/elpa/gnome-calendar-20140112.359/gnome-calendar-pkg.el @@ -0,0 +1 @@ +(define-package "gnome-calendar" "20140112.359" "Integration with the GNOME Shell calendar" 'nil :keywords '("gnome" "calendar")) diff --git a/elpa/gnome-calendar-20140112.359/gnome-calendar.el b/elpa/gnome-calendar-20140112.359/gnome-calendar.el new file mode 100644 index 0000000..00aaff4 --- /dev/null +++ b/elpa/gnome-calendar-20140112.359/gnome-calendar.el @@ -0,0 +1,87 @@ +;;; gnome-calendar.el --- Integration with the GNOME Shell calendar + +;; Copyright (C) 2013-2014 Nicolas Petton +;; +;; Author: Nicolas Petton +;; 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 diff --git a/elpa/go-20160430.1739/back-ends/gtp-pipe.el b/elpa/go-20160430.1739/back-ends/gtp-pipe.el new file mode 100644 index 0000000..dfcb055 --- /dev/null +++ b/elpa/go-20160430.1739/back-ends/gtp-pipe.el @@ -0,0 +1,122 @@ +;;; gtp-pipe.el --- GTP backend through a pipe + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;;; 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 diff --git a/elpa/go-20160430.1739/back-ends/gtp.el b/elpa/go-20160430.1739/back-ends/gtp.el new file mode 100644 index 0000000..a4070c5 --- /dev/null +++ b/elpa/go-20160430.1739/back-ends/gtp.el @@ -0,0 +1,164 @@ +;;; gtp.el --- GTP GO back-end + +;; Copyright (C) 2008 2012 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;; 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 diff --git a/elpa/go-20160430.1739/back-ends/igs.el b/elpa/go-20160430.1739/back-ends/igs.el new file mode 100644 index 0000000..9230214 --- /dev/null +++ b/elpa/go-20160430.1739/back-ends/igs.el @@ -0,0 +1,501 @@ +;;; igs.el --- IGS GO back-end + +;; Copyright (C) 2012-2013 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;; 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 diff --git a/elpa/go-20160430.1739/back-ends/sgf.el b/elpa/go-20160430.1739/back-ends/sgf.el new file mode 100644 index 0000000..97de806 --- /dev/null +++ b/elpa/go-20160430.1739/back-ends/sgf.el @@ -0,0 +1,196 @@ +;;; sgf.el --- SGF GO back end + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;; 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 diff --git a/elpa/go-20160430.1739/back-ends/sgf2el.el b/elpa/go-20160430.1739/back-ends/sgf2el.el new file mode 100644 index 0000000..e8f9038 --- /dev/null +++ b/elpa/go-20160430.1739/back-ends/sgf2el.el @@ -0,0 +1,188 @@ +;;; sgf2el.el --- conversion between sgf and emacs-lisp + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;;; 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 diff --git a/elpa/go-20160430.1739/go-api.el b/elpa/go-20160430.1739/go-api.el new file mode 100644 index 0000000..130b91d --- /dev/null +++ b/elpa/go-20160430.1739/go-api.el @@ -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 +;; 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 . + +;;; 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 diff --git a/elpa/go-20160430.1739/go-autoloads.el b/elpa/go-20160430.1739/go-autoloads.el new file mode 100644 index 0000000..bdf31e9 --- /dev/null +++ b/elpa/go-20160430.1739/go-autoloads.el @@ -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 diff --git a/elpa/go-20160430.1739/go-board-faces.el b/elpa/go-20160430.1739/go-board-faces.el new file mode 100644 index 0000000..6eb390f --- /dev/null +++ b/elpa/go-20160430.1739/go-board-faces.el @@ -0,0 +1,177 @@ +;;; go-board-faces.el -- Color for GO boards + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;;; 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 "" (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 "") 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 + "" + (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 diff --git a/elpa/go-20160430.1739/go-board.el b/elpa/go-20160430.1739/go-board.el new file mode 100644 index 0000000..61e4343 --- /dev/null +++ b/elpa/go-20160430.1739/go-board.el @@ -0,0 +1,578 @@ +;;; go-board.el --- Smart Game Format GO board visualization + +;; Copyright (C) 2012-2013 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;;; 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 "") '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 "") 'go-board-next) + (define-key map (kbd "") '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 diff --git a/elpa/go-20160430.1739/go-pkg.el b/elpa/go-20160430.1739/go-pkg.el new file mode 100644 index 0000000..fc9dd2e --- /dev/null +++ b/elpa/go-20160430.1739/go-pkg.el @@ -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: diff --git a/elpa/go-20160430.1739/go-util.el b/elpa/go-20160430.1739/go-util.el new file mode 100644 index 0000000..aff1672 --- /dev/null +++ b/elpa/go-20160430.1739/go-util.el @@ -0,0 +1,177 @@ +;;; go-util.el --- utility functions for GO functions + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; 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 . + +;;; 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 diff --git a/elpa/go-20160430.1739/go.el b/elpa/go-20160430.1739/go.el new file mode 100644 index 0000000..b90170f --- /dev/null +++ b/elpa/go-20160430.1739/go.el @@ -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 +;; Maintainer: Eric Schulte +;; 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 . + +;;; 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 diff --git a/elpa/go-20160430.1739/list-buffer.el b/elpa/go-20160430.1739/list-buffer.el new file mode 100644 index 0000000..850c586 --- /dev/null +++ b/elpa/go-20160430.1739/list-buffer.el @@ -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 +;; 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 . + +;;; 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 "") 'list-next-col) + (define-key map (kbd "") 'list-prev-col) + ;; list functions + (define-key map (kbd "") 'list-up) + (define-key map (kbd "") '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 diff --git a/elpa/go-20160430.1739/stone.wav b/elpa/go-20160430.1739/stone.wav new file mode 100644 index 0000000000000000000000000000000000000000..253078fb94cf407c8805e9b4968ff60760943b90 GIT binary patch literal 6754 zcmW+)1#lJD*T1s*q7Xw0ArJyZiv~%HTOcVUSO^f@0u*FA-0026_s=Wbd ze;5D+0>QAsQwBG6-jVqjYSK@94C;a1U=0~;)ulbqT1ilHh5xbpMhoqjQI#9w0A(k> zWgabEpudvH!e$lFb0#2o6uDLa( zsBQWF&F^>I8#AzCm%Pen+HS!+qwZi=m9}qt)oKw+{yCShW8T?K=yejG&*wLYn@}w7 z?y_j>%D9UM-9Lo>T=A~jqx8c^r6k;Me7(r_d2QxIDfZI`l}=4P)$(DO*{Jf}dYd8x z6sth`^pXBm<)fD(*7qhrt`EuTVgv^|DZ)=Kfkl^`5dpG`bPa?E&7t0 z_W^``8yIKw4e1b9acJ?hobt~{xOaz?)~nm-w<;~zs@&b@XPq2>wfo1bfejnQwtd)q zX81hb`{UFX+g|nkIJ0PnwvWD*vdT88)TK&(*gRojL3-}r57s^odONVFk-Zwku;JRN z{3CBOa$Y`K|M2#cmv7PveC#I5oWMC{>iYc1dza>XuALXJMfn3GbN^g_)!nm3?H1||?dF%o3Q7j$pZp5- zpYc}zkf7E6QHYg9zfXM~`Y!hCcx$mxNj=gX1^(z; z%0miIy!C1s_Mj5Gi+J8)@62!m2J0oueXDqV?-JIytUjXN=i!VyN`N0Xv55| z{Eo6c_)d6n^|jTSg}p#=`BQV!@Adv?KyLEqt9lZeBi6+p_Q`5xXxcI_c83>D&%cq^ zE5CX1dCi~BhW$|?Xa}0%bFS!+9^r$km9LcKd(D&mGU4u^YdN=;JQ@F?z1wRK;1k(@ zRuf(ER4G|iSf^mtmnB~g6?`d<(+1k>SVP{8>gF!(o`-pIv~$KU##qnLg39mS=Jw5Q z@HFoA*e}ntb0Aj&s*fUzrQi}{&YYn{$TZ^Sqru0%UU=mBPo@(v9+qHWZ0R3@& zREBJJUoYsAKc{$xRYnZ;9q+eNy@D!{Jv#B8)l{<`2?Jw=2=!0D)G~F0s+INiKPfA4 zB}pOzj8U7EwaPuINGp6_?rO-R;ASCLL+Xc=3#t(Kyd3HlE7&+TE?MWD>68 zTP}EWxtir#1qJvn7ptO2=)M&0doZwBkQo#atcKJLyH-A;VrKb@A&2}wC<#)ylIpiP zXl+b=s&+s%4H!^=r3isJ_S4pZdI;p`M<*&1>X+H z@~N%n%Twii>5TXa=fRC&3|ImW;$cz?^`y^GzaqaFzZE_+)hn_gwUBEn;p$E`U7fEM zsam{67LQ=vn3YM(!J4oQ=4-GCrGX3g>t5xE0337iz1%Lza<^4 zpRCQq;{EU}agDeJM}re2$a-R2F&dh?OlUo{_K@woDIOyEDu?7LVk=aIi*zPgLJ#s1 z7>&0e$`eSUdEBUNOCUuouL`bF%4P8;o{Rq!7D(4*KV_fXSZ*udmSdG5WxrI2JAt7j z)Qr@TzRl=td+27qi`Qdr`?}f87^64PC+R(n`c?yq;W?qI94q^YwV_S!nZ1o^MzV>m zOXh6jp!UwQ$i1j^d&%))wRm9hxYEhmb-NIB5Hf|%s4shM9XF5JV?ctG=(Ec&!S{q5 z29vD@-qodpORu;Wc&}-xdcOYJm|#VbigXo8wZ`h_JaO(6_YhC2_px`6cZGM6R>qX* zI7o#(k|7SqA9y-Rv|5>Y#xi5F{;Ri-`(nw$lAEQ((@;NcEHPVJOYNyNl2_r~$y;q< z@wNQyFMSGwy<5m+)J3c%R>mDb8(PV_q@}p`7bh2eE($1>yl-@B#@KJ{AIK)+CQWF4 zdW5X7v&}bpPtD_Pt}E8>)E_R#RPczE7}$& z^k6S)faeG`q%ra}xuN`x^o@8?=p}xU8milUCi?mMH}@OmldgVL9;i=!w)ySwYvI#c zK8{bKHsV;y zDHRm#oM;W4iiYFe;srTM(Zx-04Y^=+(<>M+Ov74Xd5u;2BYmiKgw=CU+eJ>0#t7+X zFiZzo{BL%ER;GW^tvm)D5FUyF;z+cCy|K<3P0Zya3&zQ+&n=$~>T&ToY{mbj*GabZ zLf1T^XRek&GVy&i+Bej-L@1$ejT|jUUvE{XUub1g&FJsmU$nbWD(R_V8jV-U+tjD3 zsP2~6i!)INw$IePCp;Up>UJ(TCI%_P!mrwJX|( ztn*e4(%50nLFtK{DW-vUW`TQA@vP!S?#aeG`Ww0-HkO0re6gL-1Kr|&4r0vWdIguh zsD;zKsVq&Ltqhje2`Ww$ev(J3UFGH=QhQSH;?s%Gv4vl}Z^)l;u@EXXm3@?^N(1?z zkO6kuqqUBun~OV^me*%d8?6yf3b}9%H+d3%A}@7yR>Or@O7-p96!QYRgEvVRr2b-r z5GrsXU7RmOz>egsKGHi>>tqe#^Kh|{fcNtYcDz~5yls6Zh_$9~tsrBN_EOtquBUBb z3QouO&`&4>|0E4mhq|yb9-Xm2YD2Y+)^hkpUhe9nOhbR!e!9Ol%~(wmz&sR)F;2rx z#C`HIHAQVJEdZy@=ANKZ?k+ZdW;M_#bcP3#95dA#L?3~4v;&T2nbvp4BK^JoS>L7& z@jNNL`DsU6L`^;172t=i(eJB_H?s-P_ndFz9Y>QzZcg_kCpMR zn`)#K1AMGJ?;vk)qcR-?$Kh~%4<MCWZ9#^R%2nri#Vk68N#Ev09ahqVnhwK?C zB|BMfFd4L9gRH-`QQqEqiQN*u6#9x;$itYu%@)~f$c0};3k_%7B>D(*EuDm}ip`~# z!Uot2tb%)m{qh2(fiwZe5^R1o9^3VRub?}6y&A_t1xx~QXp0amy%ic7xhndu2LWsiC4rT@uv7ph{01}Bsj`l zARDZOUKor9pnkZ&SWofyDe(Q*cdKiI^a^HD&2pQ)tOZWJ+p%MO7)-;O7^g_C6Rz)E zPWF+qaV?n6#*#>Tg8hirN89E3zI6jm`w#S4CdsG;pT){^&Qm~BPy-miKo`Y+%1iZ; zI!T!#Z5Cqje3S(rfG&I@ePV~(_idB5ginR9@!bzb8UId2$ z#xwbT)|Vi2t+%y1(4FMnV_sp=_@ua0%ttnBYQHyT8sp7PR<3o|wDtAc3GKcylk5hS zg$QYiG+bPU=fQjYPZq-fTS3>6AM9wWhsEsY>>})j&!K@}5&fTi-X1}x^R1vE*vej! zLOYD)l4Ke{%aCBZ#0n;j*hsJoMnPX5O)6T!)=82G8%Xuld}X63!fcvH6Jd~4M@>|E z;*MmP*4fd)es%?rhN4gxrz?8Qe@9_bFQuj86>p=CU;xkOB_IZV3(ByXcwl*{$x1mOP1MgvzxJ2pJIHlbQ%lJ1AiXiydP}1jc^;$>NL3A4g4>!V_2#BlXd8+L4D1SP-Faq6z6OfIcisR)Z zWuP)&HpRBWXVf2EK@YK8NE0K(3-~15!Vw!zDZR*lL}6loIZYX@B*;Z#v9L$DCEOFf z6`rC2a19XP9<)a&5&sbz3k9$&n9mcyR~Uyk;U#DR=*K>gbtImyV@G)~SkH&EFd9eZ zkt_7NlK~Io--I24i9e%XU@pH*lWo!Ltfy-cdb%;)szrvA32KsSstc)9d;*i{eA7>#q219ltu5>l8X~<@O4TFk&x$Ffif%j|eFcm8 zE_R4r<-fz*_=xz8Tw4iM3)Bg&Xx9g2jx-dv1(#`8qLR<#2t#n9li*KC9%;BVRO}*r zkE75VFq+FOlKRuj^b@NHYQh?50RAW}l6J}mBtyi9(8jVjuQV62H>r5Jzwoqq?{dQ-?m>6PQ!Q%*a~Bubt0q@Qi@m>f8s02ZL@_@&-m5M zwNuzn&huP24Soba0SsdKdwRo8HIM2O^kB0UDd8HLC5#qE;~9>>v~tihO{^fc!$ZJe z+Q^<{h1;jdESAgnfMB={&O=-9U?D;ng$DA+wr1SZ|1{$5MeI9x0KG%0$PNF4HBqAT z{{c+meML!#%JZT8mzyQe>e<_&lC2lo6xF>%xEdD{6)OP#*+wDJ~}_OAF;l<&C^Z zYA2k72lz&I(!oeP{D?XUy+u)KCs8N4G!r^H4sr^W#f$MdhsRZM8Y+gfU<=p*X23ou z46ne+creNVKkyn%rzcr3*ar!EhU*K#!g)Lj|A<#%KVgM%Sy&=yI0bX`5G{53&%WR| zn?;AxP3$)?6qUpM(Kc|E{YgDEme+8yhK^eb$M9VApR=+>r_<-uWTU__I1BAZF{nGV z`5<i<5$2exDv+0P#6rOVWM-_2!_LIuoe{HD)0~g%D!XQoxD%!1m6rkV$2PNG>?!R<~4d9FUHMX9vAVH)u=}zK_FUhr|NMrhv?F1gU42?wp!mdsZ831lMJ@#Xo zNuJy5ZI!g77ApXU&}00aa1CEaOJO1y#ILX!Y%aUOI`EHt4QL22z(^E}R1^b0^H}zp z)FiXW-*hGa-l_drv;`%jE@(X3iPBMXG!OpbaD4&WOuv#$Qh~N$UmeAmg2xHJ3UBcr zs5NwR#+I;OSP@&y%YvUl4yXcC9p}l0H{g2bZa&O{RS|~)un&);XYDq26;ez;@`i9A zoD5#E%5=NE#tO6=SUz?-+0Fg{bBH_uqVlGSWI=!`nzj<`4a7cAt5 z*lc!*Rp)8k=Kli+;9m3{Hjsj{fyVFh24IJyNPYN5`rh`lf3Z8#!`uz0<3cO>$0p0Qd6QK!sP}VYCZ( z7bXdx@HG?*@AK` zc~551YU~zk!;`s}1+o_oyKY%CtZP=9J%hBT`{)Adc53UjTaZTdcUA$Eh0WnwFpjr% zw5~0kMW4|S=F9HT#dI{?K;1Nv&1CJ^d8f}lPo9&dbgAHw<4pRVT>yzF zz(M~RmWU-qzc9}^xBB1<-^7PIR|1#~ zFQ80ZUhv}O&fKdqj>i-6xA=Q>&pF*?%)>5$Wq78vTS-!vD~F{O!YlL%PJt3^?qp04 zT|s|fCEOp~#p%L0;WQ4!?@%>77I(mNP#o+6T;MafiyDa&<+n-=HC{O@S;8iKAI(P1 z&^~w={O;^$K7RzZpen)#;l0DsA;K@t_!(4&TE2upa!%o3Vu?#ZIv2lEo|o z)OK{L78(TK0|oAIbS(l+g(JWOUc^dRJD$P)9n?;9xb_&Ya(ulFPJm%Nl%BJj+iUI3 zL}0V{evkrB!Vj + +;; Author: Edward O'Connor +;; 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: + +;; + +;; 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: + +;; + +;; 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 diff --git a/elpa/helm-chrome-20160718.2220/helm-chrome-autoloads.el b/elpa/helm-chrome-20160718.2220/helm-chrome-autoloads.el new file mode 100644 index 0000000..00dcaee --- /dev/null +++ b/elpa/helm-chrome-20160718.2220/helm-chrome-autoloads.el @@ -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 diff --git a/elpa/helm-chrome-20160718.2220/helm-chrome-pkg.el b/elpa/helm-chrome-20160718.2220/helm-chrome-pkg.el new file mode 100644 index 0000000..3e0cc16 --- /dev/null +++ b/elpa/helm-chrome-20160718.2220/helm-chrome-pkg.el @@ -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")) diff --git a/elpa/helm-chrome-20160718.2220/helm-chrome.el b/elpa/helm-chrome-20160718.2220/helm-chrome.el new file mode 100644 index 0000000..2186755 --- /dev/null +++ b/elpa/helm-chrome-20160718.2220/helm-chrome.el @@ -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 +;; 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 . + +;;; 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: diff --git a/elpa/helm-company-20160516.2258/helm-company-autoloads.el b/elpa/helm-company-20160516.2258/helm-company-autoloads.el new file mode 100644 index 0000000..4aca470 --- /dev/null +++ b/elpa/helm-company-20160516.2258/helm-company-autoloads.el @@ -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 diff --git a/elpa/helm-company-20160516.2258/helm-company-pkg.el b/elpa/helm-company-20160516.2258/helm-company-pkg.el new file mode 100644 index 0000000..ed39187 --- /dev/null +++ b/elpa/helm-company-20160516.2258/helm-company-pkg.el @@ -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") diff --git a/elpa/helm-company-20160516.2258/helm-company.el b/elpa/helm-company-20160516.2258/helm-company.el new file mode 100644 index 0000000..c8f8b5a --- /dev/null +++ b/elpa/helm-company-20160516.2258/helm-company.el @@ -0,0 +1,195 @@ +;;; helm-company.el --- Helm interface for company-mode + +;; Copyright (C) 2013 Yasuyuki Oka + +;; Author: Yasuyuki Oka +;; 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 . + +;;; 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 diff --git a/elpa/helm-flycheck-20160710.129/helm-flycheck-autoloads.el b/elpa/helm-flycheck-20160710.129/helm-flycheck-autoloads.el new file mode 100644 index 0000000..79c6b15 --- /dev/null +++ b/elpa/helm-flycheck-20160710.129/helm-flycheck-autoloads.el @@ -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 diff --git a/elpa/helm-flycheck-20160710.129/helm-flycheck-pkg.el b/elpa/helm-flycheck-20160710.129/helm-flycheck-pkg.el new file mode 100644 index 0000000..3bb8b96 --- /dev/null +++ b/elpa/helm-flycheck-20160710.129/helm-flycheck-pkg.el @@ -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")) diff --git a/elpa/helm-flycheck-20160710.129/helm-flycheck.el b/elpa/helm-flycheck-20160710.129/helm-flycheck.el new file mode 100644 index 0000000..20870c1 --- /dev/null +++ b/elpa/helm-flycheck-20160710.129/helm-flycheck.el @@ -0,0 +1,197 @@ +;;; helm-flycheck.el --- Show flycheck errors with helm + +;; Copyright (C) 2013-2016 Yasuyuki Oka + +;; Author: Yasuyuki Oka +;; 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 . + +;;; 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 diff --git a/elpa/helm-google-20160620.1149/helm-google-autoloads.el b/elpa/helm-google-20160620.1149/helm-google-autoloads.el new file mode 100644 index 0000000..27ec8cb --- /dev/null +++ b/elpa/helm-google-20160620.1149/helm-google-autoloads.el @@ -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 diff --git a/elpa/helm-google-20160620.1149/helm-google-pkg.el b/elpa/helm-google-20160620.1149/helm-google-pkg.el new file mode 100644 index 0000000..2482f9e --- /dev/null +++ b/elpa/helm-google-20160620.1149/helm-google-pkg.el @@ -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")) diff --git a/elpa/helm-google-20160620.1149/helm-google.el b/elpa/helm-google-20160620.1149/helm-google.el new file mode 100644 index 0000000..40a8202 --- /dev/null +++ b/elpa/helm-google-20160620.1149/helm-google.el @@ -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 . + +;;; 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\">\\(.*?\\)" 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:]]*?\\)" 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 diff --git a/elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el b/elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el new file mode 100644 index 0000000..7af5ef4 --- /dev/null +++ b/elpa/helm-spotify-20160905.1447/helm-spotify-autoloads.el @@ -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 diff --git a/elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el b/elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el new file mode 100644 index 0000000..aac0eb1 --- /dev/null +++ b/elpa/helm-spotify-20160905.1447/helm-spotify-pkg.el @@ -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")) diff --git a/elpa/helm-spotify-20160905.1447/helm-spotify.el b/elpa/helm-spotify-20160905.1447/helm-spotify.el new file mode 100644 index 0000000..7f57a0f --- /dev/null +++ b/elpa/helm-spotify-20160905.1447/helm-spotify.el @@ -0,0 +1,132 @@ +;;; helm-spotify.el --- Control Spotify with Helm. +;; Copyright 2013 Kris Jenkins +;; +;; Author: Kris Jenkins +;; Maintainer: Kris Jenkins +;; 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 diff --git a/elpa/helm-swoop-20160619.953/helm-swoop-autoloads.el b/elpa/helm-swoop-20160619.953/helm-swoop-autoloads.el new file mode 100644 index 0000000..1fcd261 --- /dev/null +++ b/elpa/helm-swoop-20160619.953/helm-swoop-autoloads.el @@ -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 diff --git a/elpa/helm-swoop-20160619.953/helm-swoop-pkg.el b/elpa/helm-swoop-20160619.953/helm-swoop-pkg.el new file mode 100644 index 0000000..ecc0042 --- /dev/null +++ b/elpa/helm-swoop-20160619.953/helm-swoop-pkg.el @@ -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")) diff --git a/elpa/helm-swoop-20160619.953/helm-swoop.el b/elpa/helm-swoop-20160619.953/helm-swoop.el new file mode 100644 index 0000000..9ec40e6 --- /dev/null +++ b/elpa/helm-swoop-20160619.953/helm-swoop.el @@ -0,0 +1,1677 @@ +;;; helm-swoop.el --- Efficiently hopping squeezed lines powered by helm interface -*- coding: utf-8; lexical-binding: t -*- + +;; Copyright (C) 2013 by Shingo Fukuyama + +;; Version: 1.7.2 +;; Package-Version: 20160619.953 +;; Author: Shingo Fukuyama - http://fukuyama.co +;; URL: https://github.com/ShingoFukuyama/helm-swoop +;; Created: Oct 24 2013 +;; Keywords: helm swoop inner buffer search +;; Package-Requires: ((helm "1.0") (emacs "24.3")) + +;; 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 2 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. + +;;; Commentary: + +;; 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. + +;; Example config +;; ---------------------------------------------------------------- +;; ;; helm from https://github.com/emacs-helm/helm +;; (require 'helm) + +;; ;; Locate the helm-swoop folder to your path +;; ;; This line is unnecessary if you get this program from MELPA +;; (add-to-list 'load-path "~/.emacs.d/elisp/helm-swoop") + +;; (require 'helm-swoop) + +;; ;; Change keybinds to whatever you like :) +;; (global-set-key (kbd "M-i") 'helm-swoop) +;; (global-set-key (kbd "M-I") 'helm-swoop-back-to-last-point) +;; (global-set-key (kbd "C-c M-i") 'helm-multi-swoop) +;; (global-set-key (kbd "C-x M-i") 'helm-multi-swoop-all) + +;; ;; When doing isearch, hand the word over to helm-swoop +;; (define-key isearch-mode-map (kbd "M-i") 'helm-swoop-from-isearch) +;; (define-key helm-swoop-map (kbd "M-i") 'helm-multi-swoop-all-from-helm-swoop) + +;; ;; Save buffer when helm-multi-swoop-edit complete +;; (setq helm-multi-swoop-edit-save t) + +;; ;; If this value is t, split window inside the current window +;; (setq helm-swoop-split-with-multiple-windows nil) + +;; ;; Split direction. 'split-window-vertically or 'split-window-horizontally +;; (setq helm-swoop-split-direction 'split-window-vertically) + +;; ;; If nil, you can slightly boost invoke speed in exchange for text color +;; (setq helm-swoop-speed-or-color nil) + +;; ;; Go to the opposite side of line from the end or beginning of line +;; (setq helm-swoop-move-to-line-cycle t) + +;; ;; Optional face for line numbers +;; ;; Face name is `helm-swoop-line-number-face` +;; (setq helm-swoop-use-line-number-face t) + +;; ---------------------------------------------------------------- + +;; * `M-x helm-swoop` when region active +;; * `M-x helm-swoop` when the cursor is at any symbol +;; * `M-x helm-swoop` when the cursor is not at any symbol +;; * `M-3 M-x helm-swoop` or `C-u 5 M-x helm-swoop` multi separated line culling +;; * `M-x helm-multi-swoop` multi-occur like feature +;; * `M-x helm-multi-swoop-all` apply all buffers +;; * `C-u M-x helm-multi-swoop` apply last selected buffers from the second time +;; * `M-x helm-swoop-same-face-at-point` list lines have the same face at the cursor is on +;; * During isearch `M-i` to hand the word over to helm-swoop +;; * During helm-swoop `M-i` to hand the word over to helm-multi-swoop-all +;; * While doing `helm-swoop` press `C-c C-e` to edit mode, apply changes to original buffer by `C-x C-s` + +;; Helm Swoop Edit +;; While doing helm-swoop, press keybind [C-c C-e] to move to edit buffer. +;; Edit the list and apply by [C-x C-s]. If you'd like to cancel, [C-c C-g] + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-grep) + +(declare-function migemo-search-pattern-get "migemo") +(declare-function projectile-buffers-with-file-or-process "projectile") +(declare-function projectile-project-buffers "projectile") +(defvar projectile-buffers-filter-function) + +;;; @ helm-swoop ---------------------------------------------- + +(defgroup helm-swoop nil + "Open helm-swoop." + :prefix "helm-swoop-" :group 'helm) + +(defface helm-swoop-target-line-face + '((t (:background "#e3e300" :foreground "#222222"))) + "Face for helm-swoop target line" + :group 'helm-swoop) +(defface helm-swoop-target-line-block-face + '((t (:background "#cccc00" :foreground "#222222"))) + "Face for target line" + :group 'helm-swoop) +(defface helm-swoop-target-word-face + '((t (:background "#7700ff" :foreground "#ffffff"))) + "Face for target word" + :group 'helm-swoop) +(defface helm-swoop-line-number-face + '((t (:foreground "#999999"))) + "Face for line numbers" + :group 'helm-swoop) + +(defcustom helm-swoop-speed-or-color nil + "If nil, you can slightly boost invoke speed in exchange for text color" + :group 'helm-swoop :type 'boolean) +(defcustom helm-swoop-use-line-number-face nil + "Use face to line numbers on helm-swoop buffer" + :group 'helm-swoop :type 'boolean) +(defcustom helm-swoop-split-with-multiple-windows nil + "Split window when having multiple windows open" + :group 'helm-swoop :type 'boolean) +(defcustom helm-swoop-move-to-line-cycle t + "Return to the opposite side of line" + :group 'helm-swoop :type 'boolean) +(defcustom helm-swoop-split-direction 'split-window-vertically + "Split direction" + :type '(choice (const :tag "vertically" split-window-vertically) + (const :tag "horizontally" split-window-horizontally)) + :group 'helm-swoop) +(defcustom helm-swoop-use-fuzzy-match nil + "If t, use fuzzy matching functions as well as exact matches." + :group 'helm-swoop :type 'boolean) + +(defvar helm-swoop-split-window-function + (lambda ($buf) + (if helm-swoop-split-with-multiple-windows + (funcall helm-swoop-split-direction) + (when (one-window-p) + (funcall helm-swoop-split-direction))) + (other-window 1) + (switch-to-buffer $buf)) + "Change the way to split window only when `helm-swoop' is calling") + +(defvar helm-swoop-candidate-number-limit 19999) +(defvar helm-swoop-buffer "*Helm Swoop*") +(defvar helm-swoop-prompt "Swoop: ") +(defvar helm-swoop-last-point nil) +(defvar helm-swoop-invisible-targets nil) +(defvar helm-swoop-last-line-info nil) + +;; Buffer local variables +(defvar helm-swoop-list-cache) +(defvar helm-swoop-pattern) ; Keep helm-pattern value +(defvar helm-swoop-last-query) ; Last search query for resume +(defvar-local helm-swoop-last-prefix-number 1) ; For multiline highlight + +;; Global variables +(defvar helm-swoop-synchronizing-window nil + "Window object where `helm-swoop' called from") +(defvar helm-swoop-target-buffer nil + "Buffer object where `helm-swoop' called from") +(defvar helm-swoop-line-overlay nil + "Overlay object to indicate other window's line") + +(defvar helm-swoop-map + (let (($map (make-sparse-keymap))) + (set-keymap-parent $map helm-map) + (define-key $map (kbd "C-c C-e") 'helm-swoop-edit) + (define-key $map (kbd "M-i") 'helm-multi-swoop-all-from-helm-swoop) + (define-key $map (kbd "C-w") 'helm-swoop-yank-thing-at-point) + (define-key $map (kbd "^") 'helm-swoop-caret-match) + (delq nil $map)) + "Keymap for helm-swoop") + +(defvar helm-multi-swoop-map + (let (($map (make-sparse-keymap))) + (set-keymap-parent $map helm-map) + (define-key $map (kbd "C-c C-e") 'helm-multi-swoop-edit) + (delq nil $map))) + +(defvar helm-c-source-swoop-match-functions + '(helm-mm-exact-match + helm-mm-match + helm-mm-3-migemo-match)) + +(defvar helm-c-source-swoop-search-functions + '(helm-mm-exact-search + helm-mm-search + helm-candidates-in-buffer-search-default-fn + helm-mm-3-migemo-search)) + +(defun helm-swoop-match-functions () + (if helm-swoop-use-fuzzy-match + (append helm-c-source-swoop-match-functions '(helm-fuzzy-match)) + helm-c-source-swoop-match-functions)) + +(defun helm-swoop-search-functions () + (if helm-swoop-use-fuzzy-match + (append helm-c-source-swoop-search-functions '(helm-fuzzy-search)) + helm-c-source-swoop-search-functions)) + +(defcustom helm-swoop-pre-input-function + (lambda () (thing-at-point 'symbol)) + "This function can pre-input keywords when helm-swoop invoked" + :group 'helm-swoop :type 'function) + +(defun helm-swoop-pre-input-optimize ($query) + (when $query + (let (($regexp (list '("\+" . "\\\\+") + '("\*" . "\\\\*") + '("\#" . "\\\\#")))) + (mapc (lambda ($r) + (setq $query (replace-regexp-in-string (car $r) (cdr $r) $query))) + $regexp) + $query))) + +(defsubst helm-swoop--goto-line ($line) + (goto-char (point-min)) + (forward-line (1- $line))) + +(defsubst helm-swoop--recenter () + (recenter (/ (window-height) 2))) + +(defsubst helm-swoop--key-of-function ($function &optional $mode-map) + (edmacro-format-keys (car (where-is-internal $function $mode-map)))) + +(defsubst helm-swoop--delete-overlay ($identity &optional $beg $end) + (or $beg (setq $beg (point-min))) + (or $end (setq $end (point-max))) + (overlay-recenter $end) + (mapc (lambda ($o) + (if (overlay-get $o $identity) + (delete-overlay $o))) + (overlays-in $beg $end))) + +(defsubst helm-swoop--get-string-at-line () + (buffer-substring-no-properties (point-at-bol) (point-at-eol))) + +(defsubst helm-swoop--buffer-substring ($point-min $point-max) + (if helm-swoop-speed-or-color + (let (($content (buffer-substring $point-min $point-max))) + (with-temp-buffer + (let ((inhibit-read-only t)) + (insert $content) + (remove-text-properties (point-min) (point-max) '(read-only t)) + (setq $content (buffer-substring (point-min) (point-max))))) + $content) + (buffer-substring-no-properties $point-min $point-max))) + +;;;###autoload +(defun helm-swoop-back-to-last-point (&optional $cancel) + "Go back to last position where `helm-swoop' was called" + (interactive) + (if helm-swoop-last-point + (let (($po (point))) + (switch-to-buffer (cdr helm-swoop-last-point)) + (goto-char (car helm-swoop-last-point)) + (unless $cancel + (setq helm-swoop-last-point + (cons $po (buffer-name (current-buffer)))))))) + +(defun helm-swoop--split-lines-by ($string $regexp $step) + "split-string by $step for multiline" + (or $step (setq $step 1)) + (let (($from1 0) ;; last match point + ($from2 0) ;; last substring point + $list + ($i 1)) ;; from line 1 + (while (string-match $regexp $string $from1) + (setq $i (1+ $i)) + (if (eq 0 (% $i $step)) + (progn + (setq $list (cons (substring $string $from2 (match-beginning 0)) + $list)) + (setq $from2 (match-end 0)) + (setq $from1 (match-end 0))) + (setq $from1 (match-end 0)))) + (setq $list (cons (substring $string $from2) $list)) + (nreverse $list))) + +(defun helm-swoop--target-line-overlay-move (&optional $buf) + "Add color to the target line" + (move-overlay + helm-swoop-line-overlay + (progn + (search-backward + "\n" nil t (% (line-number-at-pos) helm-swoop-last-prefix-number)) + (goto-char (point-at-bol))) + ;; For multiline highlight + (save-excursion + (goto-char (point-at-bol)) + (or (re-search-forward "\n" nil t helm-swoop-last-prefix-number) + ;; For the end of buffer error + (point-max))) + $buf) + (helm-swoop--unveil-invisible-overlay)) + +(defun helm-swoop--validate-regexp (regexp) + (condition-case nil + (progn + (string-match-p regexp "") + t) + (invalid-regexp nil))) + +(defun helm-swoop--target-word-overlay ($identity &optional $threshold) + (interactive) + (or $threshold (setq $threshold 2)) + (save-excursion + (let (($pat (split-string helm-pattern " ")) + $o) + (mapc (lambda ($wd) + (when (and (helm-swoop--validate-regexp $wd) (< $threshold (length $wd))) + (goto-char (point-min)) + ;; Optional require migemo.el + (if (and (featurep 'migemo) helm-migemo-mode) + (setq $wd (migemo-search-pattern-get $wd))) + ;; For caret begging match + (if (string-match "^\\^\\[0\\-9\\]\\+\\.\\(.+\\)" $wd) + (setq $wd (concat "^" (match-string 1 $wd)))) + (overlay-recenter (point-max)) + (let (finish) + (while (and (not finish) (re-search-forward $wd nil t)) + (if (= (match-beginning 0) (match-end 0)) + (forward-char 1) + (setq $o (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put $o 'face 'helm-swoop-target-word-face) + (overlay-put $o $identity t)) + (when (eobp) + (setq finish t)))))) + $pat)))) + +(defun helm-swoop--restore-unveiled-overlay () + (when helm-swoop-invisible-targets + (mapc (lambda ($ov) (overlay-put (car $ov) 'invisible (cdr $ov))) + helm-swoop-invisible-targets) + (setq helm-swoop-invisible-targets nil))) + +(defun helm-swoop--unveil-invisible-overlay () + "Show hidden text temporarily to view it during helm-swoop. +This function needs to call after latest helm-swoop-line-overlay set." + (helm-swoop--restore-unveiled-overlay) + (mapc (lambda ($ov) + (let (($type (overlay-get $ov 'invisible))) + (when $type + (overlay-put $ov 'invisible nil) + (setq helm-swoop-invisible-targets + (cons (cons $ov $type) helm-swoop-invisible-targets))))) + (overlays-in (overlay-start helm-swoop-line-overlay) + (overlay-end helm-swoop-line-overlay)))) + +;; helm action ------------------------------------------------ + +(defadvice helm-next-line (around helm-swoop-next-line disable) + (let ((helm-move-to-line-cycle-in-source t)) + ad-do-it + (when (called-interactively-p 'any) + (helm-swoop--move-line-action)))) + +(defadvice helm-previous-line (around helm-swoop-previous-line disable) + (let ((helm-move-to-line-cycle-in-source t)) + ad-do-it + (when (called-interactively-p 'any) + (helm-swoop--move-line-action)))) + +(defadvice helm-toggle-visible-mark (around helm-swoop-toggle-visible-mark disable) + (let ((helm-move-to-line-cycle-in-source t)) + ad-do-it + (when (called-interactively-p 'any) + (helm-swoop--move-line-action)))) + +(defun helm-swoop--move-line-action () + (with-helm-window + (let* (($key (helm-swoop--get-string-at-line)) + ($num (when (string-match "^[0-9]+" $key) + (string-to-number (match-string 0 $key))))) + ;; Synchronizing line position + (when (and $key $num) + (with-selected-window helm-swoop-synchronizing-window + (progn + (helm-swoop--goto-line $num) + (with-current-buffer helm-swoop-target-buffer + (delete-overlay helm-swoop-line-overlay) + (helm-swoop--target-line-overlay-move)) + (helm-swoop--recenter))) + (setq helm-swoop-last-line-info + (cons helm-swoop-target-buffer $num)))))) + +(defun helm-swoop--nearest-line ($target $list) + "Return the nearest number of $target out of $list." + (when (and $target $list) + (let ($result) + (cl-labels ((filter ($fn $elem $list) + (let ($r) + (mapc (lambda ($e) + (if (funcall $fn $elem $e) + (setq $r (cons $e $r)))) + $list) $r))) + (if (eq 1 (length $list)) + (setq $result (car $list)) + (let* (($lts (filter '> $target $list)) + ($gts (filter '< $target $list)) + ($lt (if $lts (apply 'max $lts))) + ($gt (if $gts (apply 'min $gts))) + ($ltg (if $lt (- $target $lt))) + ($gtg (if $gt (- $gt $target)))) + (setq $result + (cond ((memq $target $list) $target) + ((and (not $lt) (not $gt)) nil) + ((not $gtg) $lt) + ((not $ltg) $gt) + ((eq $ltg $gtg) $gt) + ((< $ltg $gtg) $lt) + ((> $ltg $gtg) $gt) + (t 1)))))) + $result))) + +(defun helm-swoop--keep-nearest-position () + (with-helm-window + (let (($p (point-min)) $list $bound + $nearest-line $target-point + ($buf (rx-to-string (buffer-name (car helm-swoop-last-line-info)) t))) + (save-excursion + (goto-char $p) + (while (if $p (setq $p (re-search-forward (concat "^" $buf "$") nil t))) + (when (get-text-property (point-at-bol) 'helm-header) + (forward-char 1) + (setq $bound (next-single-property-change (point) 'helm-header)) + (while (re-search-forward "^[0-9]+" $bound t) + (setq $list (cons + (string-to-number (match-string 0)) + $list))) + (setq $nearest-line (helm-swoop--nearest-line + (cdr helm-swoop-last-line-info) + $list)) + (goto-char $p) + (re-search-forward (concat "^" + (number-to-string $nearest-line) + "\\s-") $bound t) + (setq $target-point (point)) + (setq $p nil)))) + (when $target-point + (goto-char $target-point) + (helm-mark-current-line) + (if (equal helm-swoop-buffer (buffer-name (current-buffer))) + (helm-swoop--move-line-action) + (helm-multi-swoop--move-line-action)))))) + +(defun helm-swoop--pattern-match () + "Overlay target words" + (with-helm-window + (setq helm-swoop-pattern helm-pattern) + (when (< 2 (length helm-pattern)) + (helm-swoop--delete-overlay 'target-buffer) + (helm-swoop--target-word-overlay 'target-buffer) + (with-selected-window helm-swoop-synchronizing-window + (helm-swoop--delete-overlay 'target-buffer) + (helm-swoop--target-word-overlay 'target-buffer))))) + +(defun helm-swoop-flash-word ($match-beg $match-end) + (interactive) + (unwind-protect + (let (($o (make-overlay $match-beg $match-end))) + (when $o + (overlay-put $o 'face 'helm-swoop-target-word-face) + (overlay-put $o 'helm-swoop-overlay-word-frash t))) + (run-with-idle-timer + 0.6 nil (lambda () (helm-swoop--delete-overlay 'helm-swoop-overlay-word-frash))))) + +;; core ------------------------------------------------ + +(defun helm-swoop--get-content ($buffer &optional $linum) + "Get the whole content in buffer and add line number at the head. +If $linum is number, lines are separated by $linum" + (let (($buf (get-buffer $buffer))) + (when $buf + (with-current-buffer $buf + (let (($bufstr (helm-swoop--buffer-substring (point-min) (point-max))) + $return) + (with-temp-buffer + (insert $bufstr) + (goto-char (point-min)) + (let (($i 1)) + (insert (format "%s " $i)) + (while (re-search-forward "\n" nil t) + (cl-incf $i) + (if helm-swoop-use-line-number-face + (insert (propertize (format "%s" $i) 'font-lock-face 'helm-swoop-line-number-face) " ") + (insert (format "%s " $i)))) + ;; Delete empty lines + (unless $linum + (goto-char (point-min)) + (while (re-search-forward "^[0-9]+\\s-*$" nil t) + (replace-match "")))) + (setq $return (helm-swoop--buffer-substring (point-min) (point-max)))) + $return))))) + +(defun helm-c-source-swoop () + `((name . ,(buffer-name helm-swoop-target-buffer)) + (candidates . ,(if helm-swoop-list-cache + (progn + (helm-swoop--split-lines-by + helm-swoop-list-cache "\n" helm-swoop-last-prefix-number)) + (helm-swoop--split-lines-by + (setq helm-swoop-list-cache + (helm-swoop--get-content helm-swoop-target-buffer t)) + "\n" helm-swoop-last-prefix-number))) + (get-line . ,(if helm-swoop-speed-or-color + 'helm-swoop--buffer-substring + 'buffer-substring-no-properties)) + (keymap . ,helm-swoop-map) + (header-line . "[C-c C-e] Edit mode, [M-i] apply all buffers") + (action . (("Go to Line" + . (lambda ($line) + (helm-swoop--goto-line + (when (string-match "^[0-9]+" $line) + (string-to-number (match-string 0 $line)))) + (let (($regex + (mapconcat 'identity + (split-string helm-pattern " ") + "\\|"))) + (when (or (and (and (featurep 'migemo) helm-migemo-mode) + (migemo-forward $regex nil t)) + (re-search-forward $regex nil t)) + (helm-swoop-flash-word (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0)))) + (helm-swoop--recenter))))) + ,(if (and helm-swoop-last-prefix-number + (> helm-swoop-last-prefix-number 1)) + '(multiline)) + (match . ,(helm-swoop-match-functions)) + (search . ,(helm-swoop-search-functions)))) + +(defun helm-c-source-multi-swoop ($buf $func $action $multiline) + `((name . ,$buf) + (candidates . ,(funcall $func)) + (action . ,$action) + (header-line . ,(concat $buf " [C-c C-e] Edit mode")) + (keymap . ,helm-multi-swoop-map) + (requires-pattern . 2) + ,(if (and $multiline + (> $multiline 1)) + '(multiline)) + (match . ,(helm-swoop-match-functions)) + (search . ,(helm-swoop-search-functions)))) + +(defun helm-swoop--set-prefix ($multiline) + ;; Enable scrolling margin + (setq helm-swoop-last-prefix-number + (or $multiline 1))) ;; $multiline is for resume + +;; Delete cache when modified file is saved +(defun helm-swoop--clear-cache () + (if (boundp 'helm-swoop-list-cache) (setq helm-swoop-list-cache nil))) +(add-hook 'after-save-hook 'helm-swoop--clear-cache) + +(defadvice narrow-to-region (around helm-swoop-advice-narrow-to-region activate) + (helm-swoop--clear-cache) + ad-do-it) +(defadvice narrow-to-defun (around helm-swoop-advice-narrow-to-defun activate) + (helm-swoop--clear-cache) + ad-do-it) +(defadvice narrow-to-page (around helm-swoop-advice-narrow-to-page activate) + (helm-swoop--clear-cache) + ad-do-it) +(defadvice widen (around helm-swoop-advice-widen activate) + (helm-swoop--clear-cache) + ad-do-it) + +(defun helm-swoop--restore () + (when (= 1 helm-exit-status) + (helm-swoop-back-to-last-point t) + (helm-swoop--restore-unveiled-overlay)) + (setq helm-swoop-invisible-targets nil) + (ad-disable-advice 'helm-next-line 'around 'helm-swoop-next-line) + (ad-activate 'helm-next-line) + (ad-disable-advice 'helm-previous-line 'around 'helm-swoop-previous-line) + (ad-activate 'helm-previous-line) + (ad-disable-advice 'helm-toggle-visible-mark 'around 'helm-swoop-toggle-visible-mark) + (ad-activate 'helm-toggle-visible-mark) + (ad-disable-advice 'helm-move--next-line-fn 'around + 'helm-multi-swoop-next-line-cycle) + (ad-activate 'helm-move--next-line-fn) + (ad-disable-advice 'helm-move--previous-line-fn 'around + 'helm-multi-swoop-previous-line-cycle) + (ad-activate 'helm-move--previous-line-fn) + (remove-hook 'helm-update-hook 'helm-swoop--pattern-match) + (remove-hook 'helm-after-update-hook 'helm-swoop--keep-nearest-position) + (setq helm-swoop-last-query helm-swoop-pattern) + (mapc (lambda ($ov) + (when (or (eq 'helm-swoop-target-line-face (overlay-get $ov 'face)) + (eq 'helm-swoop-target-line-block-face + (overlay-get $ov 'face))) + (delete-overlay $ov))) + (overlays-in (point-min) (point-max))) + (helm-swoop--delete-overlay 'target-buffer) + (deactivate-mark t)) + +;;;###autoload +(cl-defun helm-swoop (&key $query $source ($multiline current-prefix-arg)) + "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." + (interactive) + (setq helm-swoop-synchronizing-window (selected-window)) + (setq helm-swoop-last-point (cons (point) (buffer-name (current-buffer)))) + (setq helm-swoop-last-line-info + (cons (current-buffer) (line-number-at-pos))) + (unless (boundp 'helm-swoop-last-query) + (set (make-local-variable 'helm-swoop-last-query) "")) + (setq helm-swoop-target-buffer (current-buffer)) + (helm-swoop--set-prefix (prefix-numeric-value $multiline)) + ;; Overlay + (setq helm-swoop-line-overlay (make-overlay (point) (point))) + (overlay-put helm-swoop-line-overlay + 'face (if (< 1 helm-swoop-last-prefix-number) + 'helm-swoop-target-line-block-face + 'helm-swoop-target-line-face)) + ;; Cache + (cond ((not (boundp 'helm-swoop-list-cache)) + (set (make-local-variable 'helm-swoop-list-cache) nil)) + ((buffer-modified-p) + (setq helm-swoop-list-cache nil))) + (unwind-protect + (progn + ;; For synchronizing line position + (ad-enable-advice 'helm-next-line 'around 'helm-swoop-next-line) + (ad-activate 'helm-next-line) + (ad-enable-advice 'helm-previous-line 'around 'helm-swoop-previous-line) + (ad-activate 'helm-previous-line) + (ad-enable-advice 'helm-toggle-visible-mark 'around 'helm-swoop-toggle-visible-mark) + (ad-activate 'helm-toggle-visible-mark) + (ad-enable-advice 'helm-move--next-line-fn 'around + 'helm-multi-swoop-next-line-cycle) + (ad-activate 'helm-move--next-line-fn) + (ad-enable-advice 'helm-move--previous-line-fn 'around + 'helm-multi-swoop-previous-line-cycle) + (ad-activate 'helm-move--previous-line-fn) + (add-hook 'helm-update-hook 'helm-swoop--pattern-match) + (add-hook 'helm-after-update-hook 'helm-swoop--keep-nearest-position t) + (cond ($query + (if (string-match + "\\(\\^\\[0\\-9\\]\\+\\.\\)\\(.*\\)" $query) + $query ;; NEED FIX #1 to appear as a "^" + $query)) + (mark-active + (let (($st (buffer-substring-no-properties + (region-beginning) (region-end)))) + (if (string-match "\n" $st) + (message "Multi line region is not allowed") + (setq $query (helm-swoop-pre-input-optimize $st))))) + ((setq $query (helm-swoop-pre-input-optimize + (funcall helm-swoop-pre-input-function)))) + (t (setq $query ""))) + ;; First behavior + (helm-swoop--recenter) + (move-beginning-of-line 1) + (helm-swoop--target-line-overlay-move) + ;; Execute helm + (let ((helm-display-function helm-swoop-split-window-function) + (helm-display-source-at-screen-top nil) + (helm-completion-window-scroll-margin 5)) + (helm :sources + (or $source + (helm-c-source-swoop)) + :buffer helm-swoop-buffer + :input $query + :prompt helm-swoop-prompt + :preselect + ;; Get current line has content or else near one + (if (string-match "^[\t\n\s]*$" (helm-swoop--get-string-at-line)) + (save-excursion + (if (re-search-forward "[^\t\n\s]" nil t) + (format "^%s\s" (line-number-at-pos)) + (re-search-backward "[^\t\n\s]" nil t) + (format "^%s\s" (line-number-at-pos)))) + (format "^%s\s" (line-number-at-pos))) + :candidate-number-limit helm-swoop-candidate-number-limit))) + ;; Restore helm's hook and window function etc + (helm-swoop--restore))) + +;; Receive word from isearch --------------- +;;;###autoload +(defun helm-swoop-from-isearch () + "Invoke `helm-swoop' from isearch." + (interactive) + (let (($query (if isearch-regexp + isearch-string + (regexp-quote isearch-string)))) + (let (search-nonincremental-instead) + (isearch-exit)) + (helm-swoop :$query $query))) +;; When doing isearch, hand the word over to helm-swoop +(define-key isearch-mode-map (kbd "M-i") 'helm-swoop-from-isearch) + +;; Receive word from evil search --------------- +(defun helm-swoop-from-evil-search () + "Invoke `helm-swoop' from evil isearch" + (interactive) + (if (string-match "\\(isearch-\\|evil.*search\\)" (symbol-name real-last-command)) + (helm-swoop :$query (if isearch-regexp + isearch-string + (regexp-quote isearch-string))) + (helm-swoop))) +;; When doing evil-search, hand the word over to helm-swoop +;; (define-key evil-motion-state-map (kbd "M-i") 'helm-swoop-from-evil-search) + +;; Receive word from evil search --------------- +(defun helm-swoop-yank-thing-at-point () + "Insert string at which the point helm-swoop started." + (interactive) + (let ($amend $buf) + (with-selected-window helm-swoop-synchronizing-window + (setq $buf (get-buffer (cdr helm-swoop-last-point))) + (when $buf + (with-current-buffer $buf + (save-excursion + (goto-char (car helm-swoop-last-point)) + (setq $amend (thing-at-point 'symbol)))))) + (when $amend + (with-selected-window (minibuffer-window) + (insert $amend))))) + +;; For helm-resume ------------------------ +(defadvice helm-resume-select-buffer + (around helm-swoop-if-selected-as-resume activate) + "Resume if *Helm Swoop* buffer selected as a resume + when helm-resume with prefix" + (if (boundp 'helm-swoop-last-query) + ad-do-it + ;; If the buffer hasn't called helm-swoop, just hide from options + (let ((helm-buffers (delete helm-swoop-buffer helm-buffers))) + ad-do-it)) + (when (and (equal ad-return-value helm-swoop-buffer) + (boundp 'helm-swoop-last-query)) + (helm-swoop :$query helm-swoop-last-query + :$multiline helm-swoop-last-prefix-number) + (setq ad-return-value nil))) + +(defadvice helm-resume (around helm-swoop-resume activate) + "Resume if the last used helm buffer is helm-swoop-buffer" + (if (equal helm-last-buffer helm-swoop-buffer) + (if (boundp 'helm-swoop-last-query) + (if (not (ad-get-arg 0)) + (helm-swoop :$query helm-swoop-last-query + :$multiline helm-swoop-last-prefix-number)) + ;; Temporary apply second last buffer + (let ((helm-last-buffer (cadr helm-buffers))) ad-do-it)) + ad-do-it)) + +;; For caret beginning-match ----------------------------- +(defun helm-swoop--caret-match-delete ($o $aft $beg $end &optional $len) + (if $aft + (- $end $beg $len) ;; Unused argument? To avoid byte compile error + (delete-region (overlay-start $o) (1- (overlay-end $o))))) + +(defun helm-swoop-caret-match (&optional _$resume) + (interactive) + (let* (($prompt helm-swoop-prompt) ;; Accept change of the variable + ($line-number-regexp "^[0-9]+.") + ($prompt-regexp + (funcall `(lambda () + (rx bol ,$prompt)))) + ($prompt-regexp-with-line-number + (funcall `(lambda () + (rx bol ,$prompt (group ,$line-number-regexp))))) + ($disguise-caret + (lambda () + (save-excursion + (re-search-backward $prompt-regexp-with-line-number nil t) + (let (($o (make-overlay (match-beginning 1) (match-end 1)))) + (overlay-put $o 'face 'helm-swoop-target-word-face) + (overlay-put $o 'modification-hooks '(helm-swoop--caret-match-delete)) + (overlay-put $o 'display "^") + (overlay-put $o 'evaporate t)))))) + (if (and (minibufferp) + (string-match $prompt-regexp + (buffer-substring-no-properties + (point-min) (point-max))) + (eq (point) (+ 1 (length helm-swoop-prompt)))) + (progn + (insert $line-number-regexp) + (funcall $disguise-caret)) + (insert "^")))) + +;;; @ helm-swoop-edit ----------------------------------------- + +(defvar helm-swoop-edit-target-buffer) +(defvar helm-swoop-edit-buffer "*Helm Swoop Edit*") +(defvar helm-swoop-edit-map + (let (($map (make-sparse-keymap))) + (define-key $map (kbd "C-x C-s") 'helm-swoop--edit-complete) + (define-key $map (kbd "C-c C-g") 'helm-swoop--edit-cancel) + (define-key $map (kbd "C-c C-q C-k") 'helm-swoop--edit-delete-all-lines) + $map)) + +(defun helm-swoop--clear-edit-buffer ($prop) + (let ((inhibit-read-only t)) + (mapc (lambda ($ov) + (when (overlay-get $ov $prop) + (delete-overlay $ov))) + (overlays-in (point-min) (point-max))) + (set-text-properties (point-min) (point-max) nil) + (goto-char (point-min)) + (erase-buffer))) + +(defun helm-swoop--collect-edited-lines () + "Create a list of edited lines with each its own line number" + (interactive) + (let ($list) + (goto-char (point-min)) + (while (re-search-forward "^\\([0-9]+\\)\s" nil t) + (setq $list + (cons (cons (string-to-number (match-string 1)) + (buffer-substring-no-properties + (point) + (save-excursion + (if (re-search-forward + "^\\([0-9]+\\)\s\\|^\\(\\-+\\)" nil t) + (1- (match-beginning 0)) + (goto-char (point-max)) + (re-search-backward "\n" nil t))))) + $list))) + $list)) + +(defun helm-swoop--edit ($candidate) + "This function will only be called from `helm-swoop-edit'" + (interactive) + (setq helm-swoop-edit-target-buffer helm-swoop-target-buffer) + (delete-overlay helm-swoop-line-overlay) + (helm-swoop--delete-overlay 'target-buffer) + (with-current-buffer (get-buffer-create helm-swoop-edit-buffer) + + (helm-swoop--clear-edit-buffer 'helm-swoop-edit) + (let (($bufstr "")) + ;; Get target line number to edit + (with-current-buffer helm-swoop-buffer + ;; Use selected line by [C-SPC] or [M-SPC] + (mapc (lambda ($ov) + (when (eq 'helm-visible-mark (overlay-get $ov 'face)) + (setq $bufstr (concat (buffer-substring-no-properties + (overlay-start $ov) (overlay-end $ov)) + $bufstr)))) + (overlays-in (point-min) (point-max))) + (if (equal "" $bufstr) + ;; Not found selected line + (setq $bufstr (buffer-substring-no-properties + (point-min) (point-max))) + ;; Attach title + (setq $bufstr (concat "Helm Swoop\n" $bufstr)))) + + ;; Set for edit buffer + (insert $bufstr) + (add-text-properties (point-min) (point-max) + '(read-only t rear-nonsticky t front-sticky t)) + + ;; Set for editable context + (let ((inhibit-read-only t)) + ;; Title and explanation + (goto-char (point-min)) + (let (($o (make-overlay (point) (point-at-eol)))) + (overlay-put $o 'helm-swoop-edit t) + (overlay-put $o 'face 'font-lock-function-name-face) + (overlay-put $o 'after-string + (propertize + (format " [%s] Complete, [%s] Cancel, [%s] Delete All" + (helm-swoop--key-of-function 'helm-swoop--edit-complete helm-swoop-edit-map) + (helm-swoop--key-of-function 'helm-swoop--edit-cancel helm-swoop-edit-map) + (helm-swoop--key-of-function 'helm-swoop--edit-delete-all-lines helm-swoop-edit-map)) + 'face 'helm-bookmark-addressbook))) + ;; Line number and editable area + (while (re-search-forward "^\\([0-9]+\s\\)\\(.*\\)$" nil t) + (let* (($bol1 (match-beginning 1)) + ($eol1 (match-end 1)) + ($bol2 (match-beginning 2)) + ($eol2 (match-end 2))) + ;; Line number + (add-text-properties $bol1 $eol1 + '(face font-lock-function-name-face + intangible t)) + ;; Editable area + (remove-text-properties $bol2 $eol2 '(read-only t)) + ;; For line tail + (set-text-properties $eol2 (or (1+ $eol2) (point-max)) + '(read-only t rear-nonsticky t)))) + (helm-swoop--target-word-overlay 'edit-buffer 0)))) + + (other-window 1) + (switch-to-buffer helm-swoop-edit-buffer) + (goto-char (point-min)) + (if (string-match "^[0-9]+" $candidate) + (re-search-forward + (concat "^" (match-string 0 $candidate)) nil t)) + (use-local-map helm-swoop-edit-map)) + +(defun helm-swoop--edit-complete () + "Apply changes and kill temporary edit buffer" + (interactive) + (let (($list (helm-swoop--collect-edited-lines))) + (with-current-buffer helm-swoop-edit-target-buffer + ;; Replace from the end of buffer + (save-excursion + (mapc (lambda ($cell) + (let (($k (car $cell)) + ($v (cdr $cell))) + (goto-char (point-min)) + (delete-region (point-at-bol $k) (point-at-eol $k)) + (goto-char (point-at-bol $k)) + (insert $v))) + $list))) + (select-window helm-swoop-synchronizing-window) + (kill-buffer (get-buffer helm-swoop-edit-buffer))) + (message "Successfully helm-swoop-edit applied to original buffer")) + +(defun helm-swoop--edit-delete-all-lines () + "Apply changes and kill temporary edit buffer" + (interactive) + (let (($list (helm-swoop--collect-edited-lines))) + (with-current-buffer helm-swoop-edit-target-buffer + ;; Replace from the end of buffer + (save-excursion + (mapc (lambda ($cell) + (let (($k (car $cell))) + (goto-char (point-min)) + (delete-region (point-at-bol $k) + (if (eq (point-at-eol $k) (point-max)) + (point-at-eol $k) + (1+ (point-at-eol $k)))))) + $list))) + (select-window helm-swoop-synchronizing-window) + (kill-buffer (get-buffer helm-swoop-edit-buffer))) + (message "Successfully helm-swoop-edit applied to original buffer")) + +(defun helm-swoop--edit-cancel () + "Cancel edit and kill temporary buffer" + (interactive) + (select-window helm-swoop-synchronizing-window) + (kill-buffer (get-buffer helm-swoop-edit-buffer)) + (message "helm-swoop-edit canceled")) + +(defun helm-swoop-edit () + (interactive) + (helm-exit-and-execute-action 'helm-swoop--edit)) + +;;; @ helm-multi-swoop ---------------------------------------- +(defvar helm-multi-swoop-buffer-list "*helm-multi-swoop buffers list*" + "Buffer name") +(defvar helm-multi-swoop-ignore-buffers-match "^\\*" + "Regexp to eliminate buffers you don't want to see") +(defvar helm-multi-swoop-candidate-number-limit 250) +(defvar helm-multi-swoop-last-selected-buffers nil) +(defvar helm-multi-swoop-last-query nil) +(defvar helm-multi-swoop-query nil) +(defvar helm-multi-swoop-buffer "*Helm Multi Swoop*") +(defvar helm-multi-swoop-all-from-helm-swoop-last-point nil + "For the last position, when helm-multi-swoop-all-from-helm-swoop canceled") +(defvar helm-multi-swoop-move-line-action-last-buffer nil) + +(defvar helm-multi-swoop-buffers-map + (let (($map (make-sparse-keymap))) + (set-keymap-parent $map helm-map) + (define-key $map (kbd "RET") + (lambda () (interactive) + (helm-exit-and-execute-action 'helm-multi-swoop--exec))) + (delq nil $map))) + +(defvar helm-multi-swoop-projectile-buffers-filter + #'projectile-buffers-with-file-or-process) +;; action ----------------------------------------------------- + +(defadvice helm-next-line (around helm-multi-swoop-next-line disable) + (let ((helm-move-to-line-cycle-in-source nil)) + ad-do-it + (when (called-interactively-p 'any) + (helm-multi-swoop--move-line-action)))) + +(defadvice helm-previous-line (around helm-multi-swoop-previous-line disable) + (let ((helm-move-to-line-cycle-in-source nil)) + ad-do-it + (when (called-interactively-p 'any) + (helm-multi-swoop--move-line-action)))) + +(defadvice helm-toggle-visible-mark (around helm-multi-swoop-toggle-visible-mark disable) + (let ((helm-move-to-line-cycle-in-source nil)) + ad-do-it + (when (called-interactively-p 'any) + (helm-multi-swoop--move-line-action)))) + +(defadvice helm-move--next-line-fn (around helm-multi-swoop-next-line-cycle disable) + (if (not (helm-pos-multiline-p)) + (if (eq (point-max) (save-excursion (forward-line 1) (point))) + (when helm-swoop-move-to-line-cycle + (helm-beginning-of-buffer) + (helm-swoop--recenter)) + (forward-line 1)) + (let ((line-num (line-number-at-pos))) + (helm-move--next-multi-line-fn) + (when (and helm-swoop-move-to-line-cycle + (eq line-num (line-number-at-pos))) + (helm-beginning-of-buffer))))) + +(defadvice helm-move--previous-line-fn (around helm-multi-swoop-previous-line-cycle disable) + (if (not (helm-pos-multiline-p)) + (forward-line -1) + (helm-move--previous-multi-line-fn)) + (when (and (helm-pos-header-line-p) + (eq (point) (save-excursion (forward-line -1) (point)))) + (when helm-swoop-move-to-line-cycle + (helm-end-of-buffer)) + (when (helm-pos-multiline-p) + (helm-move--previous-multi-line-fn)))) + +(defun helm-multi-swoop--move-line-action () + (with-helm-window + (let* (($key (buffer-substring (point-at-bol) (point-at-eol))) + ($num (when (string-match "^[0-9]+" $key) + (string-to-number (match-string 0 $key)))) + ($source (helm-get-current-source)) + ($buf (let (($name (assoc-default 'name $source))) + (when $name (get-buffer $name))))) + (when $buf + ;; Synchronizing line position + (with-selected-window helm-swoop-synchronizing-window + (with-current-buffer $buf + (when (not (eq $buf helm-multi-swoop-move-line-action-last-buffer)) + (set-window-buffer nil $buf) + (helm-swoop--pattern-match)) + (helm-swoop--goto-line $num) + (helm-swoop--target-line-overlay-move $buf) + (helm-swoop--recenter)) + (setq helm-multi-swoop-move-line-action-last-buffer $buf)) + (setq helm-swoop-last-line-info (cons $buf $num)))))) + +(defun helm-multi-swoop--get-marked-buffers () + (let ($list + ($buf (get-buffer helm-multi-swoop-buffer-list))) + (when $buf + (with-current-buffer (get-buffer helm-multi-swoop-buffer-list) + (mapc (lambda ($ov) + (when (eq 'helm-visible-mark (overlay-get $ov 'face)) + (setq $list (cons + (let (($word (buffer-substring-no-properties + (overlay-start $ov) (overlay-end $ov)))) + (mapc (lambda ($r) + (setq $word (replace-regexp-in-string + (car $r) (cdr $r) $word))) + (list '("\\`[ \t\n\r]+" . "") + '("[ \t\n\r]+\\'" . ""))) + $word) + $list)))) + (overlays-in (point-min) (point-max)))) + (delete "" $list)))) + +;; core -------------------------------------------------------- + +(cl-defun helm-multi-swoop--exec (ignored &key $query $buflist $func $action) + (interactive) + (setq helm-swoop-synchronizing-window (selected-window)) + (setq helm-swoop-last-point + (or helm-multi-swoop-all-from-helm-swoop-last-point + (cons (point) (buffer-name (current-buffer))))) + (setq helm-swoop-last-line-info + (cons (current-buffer) (line-number-at-pos))) + (unless (get-buffer helm-multi-swoop-buffer-list) + (get-buffer-create helm-multi-swoop-buffer-list)) + (helm-swoop--set-prefix (prefix-numeric-value current-prefix-arg)) + (let (($buffs (or $buflist + (helm-multi-swoop--get-marked-buffers) + `(,(buffer-name helm-swoop-target-buffer)) + (error "No buffer selected"))) + $contents + $preserve-position + ($prefix-arg (prefix-numeric-value + (or current-prefix-arg helm-swoop-last-prefix-number 1)))) + (helm-swoop--set-prefix $prefix-arg) + (setq helm-multi-swoop-last-selected-buffers $buffs) + ;; Create buffer sources + (mapc (lambda ($buf) + (when (get-buffer $buf) + (with-current-buffer (get-buffer $buf) + (let* (($func + (or $func + (lambda () + (helm-swoop--split-lines-by + (helm-swoop--get-content $buf t) + "\n" $prefix-arg)))) + ($action + (or $action + `(("Go to Line" + . (lambda ($line) + (switch-to-buffer ,$buf) + (helm-swoop--goto-line + (when (string-match "^[0-9]+" $line) + (string-to-number + (match-string 0 $line)))) + (when (re-search-forward + (mapconcat 'identity + (split-string + helm-pattern " ") "\\|") + nil t) + (helm-swoop-flash-word (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) + (helm-swoop--recenter))))))) + (setq $preserve-position + (cons (cons $buf (point)) $preserve-position)) + (setq + $contents + (cons + (helm-c-source-multi-swoop $buf $func $action $prefix-arg) + $contents)))))) + $buffs) + (unwind-protect + (progn + (ad-enable-advice 'helm-next-line 'around + 'helm-multi-swoop-next-line) + (ad-activate 'helm-next-line) + (ad-enable-advice 'helm-previous-line 'around + 'helm-multi-swoop-previous-line) + (ad-activate 'helm-previous-line) + (ad-enable-advice 'helm-toggle-visible-mark 'around + 'helm-multi-swoop-toggle-visible-mark) + (ad-activate 'helm-toggle-visible-mark) + (ad-enable-advice 'helm-move--next-line-fn 'around + 'helm-multi-swoop-next-line-cycle) + (ad-activate 'helm-move--next-line-fn) + (ad-enable-advice 'helm-move--previous-line-fn 'around + 'helm-multi-swoop-previous-line-cycle) + (ad-activate 'helm-move--previous-line-fn) + (add-hook 'helm-update-hook 'helm-swoop--pattern-match) + (add-hook 'helm-after-update-hook 'helm-swoop--keep-nearest-position t) + (setq helm-swoop-line-overlay + (make-overlay (point) (point))) + (overlay-put helm-swoop-line-overlay + 'face 'helm-swoop-target-line-face) + (helm-swoop--target-line-overlay-move) + ;; Execute helm + (let ((helm-display-function helm-swoop-split-window-function) + (helm-display-source-at-screen-top nil) + (helm-completion-window-scroll-margin 5)) + (helm :sources $contents + :buffer helm-multi-swoop-buffer + :input (or $query helm-multi-swoop-query "") + :prompt helm-swoop-prompt + :candidate-number-limit + helm-multi-swoop-candidate-number-limit + :preselect + (format "%s %s" (line-number-at-pos) + (helm-swoop--get-string-at-line))))) + ;; Restore + (progn + (when (= 1 helm-exit-status) + (helm-swoop-back-to-last-point t) + (helm-swoop--restore-unveiled-overlay)) + (setq helm-swoop-invisible-targets nil) + (ad-disable-advice 'helm-next-line 'around + 'helm-multi-swoop-next-line) + (ad-activate 'helm-next-line) + (ad-disable-advice 'helm-previous-line 'around + 'helm-multi-swoop-previous-line) + (ad-activate 'helm-previous-line) + (ad-disable-advice 'helm-toggle-visible-mark 'around + 'helm-multi-swoop-toggle-visible-mark) + (ad-activate 'helm-toggle-visible-mark) + (ad-disable-advice 'helm-move--next-line-fn 'around + 'helm-multi-swoop-next-line-cycle) + (ad-activate 'helm-move--next-line-fn) + (ad-disable-advice 'helm-move--previous-line-fn 'around + 'helm-multi-swoop-previous-line-cycle) + (ad-activate 'helm-move--previous-line-fn) + (remove-hook 'helm-update-hook 'helm-swoop--pattern-match) + (remove-hook 'helm-after-update-hook 'helm-swoop--keep-nearest-position) + (setq helm-multi-swoop-last-query helm-swoop-pattern) + (helm-swoop--restore-unveiled-overlay) + (setq helm-multi-swoop-query nil) + (setq helm-multi-swoop-all-from-helm-swoop-last-point nil) + (mapc (lambda ($buf) + (let (($current-buffer (buffer-name (current-buffer)))) + (with-current-buffer (car $buf) + ;; Delete overlay + (delete-overlay helm-swoop-line-overlay) + (helm-swoop--delete-overlay 'target-buffer) + ;; Restore each buffer's position + (unless (equal (car $buf) $current-buffer) + (goto-char (cdr $buf)))))) + $preserve-position))))) + +(defun helm-multi-swoop--get-buffer-list () + (let ($buflist1 $buflist2) + ;; eliminate buffers start with whitespace and dired buffers + (mapc (lambda ($buf) + (setq $buf (buffer-name $buf)) + (unless (string-match "^\\s-" $buf) + (unless (eq 'dired-mode (with-current-buffer $buf major-mode)) + (setq $buflist1 (cons $buf $buflist1))))) + (buffer-list)) + ;; eliminate buffers match pattern + (mapc (lambda ($buf) + (unless (string-match + helm-multi-swoop-ignore-buffers-match + $buf) + (setq $buflist2 (cons $buf $buflist2)))) + $buflist1) + $buflist2)) + +(defun helm-c-source-helm-multi-swoop-buffers () + "Show buffer list to select" + `((name . "helm-multi-swoop select buffers") + (candidates . helm-multi-swoop--get-buffer-list) + (header-line . "[C-SPC]/[M-SPC] select, [RET] next step") + (keymap . ,helm-multi-swoop-buffers-map) + (match . ,(helm-swoop-match-functions)) + (search . ,(helm-swoop-search-functions)))) + +(defun helm-multi-swoop--get-query ($query) + (cond ($query + (setq helm-multi-swoop-query $query)) + (mark-active + (let (($st (buffer-substring-no-properties + (region-beginning) (region-end)))) + (if (string-match "\n" $st) + (message "Multi line region is not allowed") + (setq helm-multi-swoop-query + (helm-swoop-pre-input-optimize $st))))) + ((setq helm-multi-swoop-query + (helm-swoop-pre-input-optimize + (funcall helm-swoop-pre-input-function)))) + (t (setq helm-multi-swoop-query "")))) + +;;;###autoload +(defun helm-multi-swoop (&optional $query $buflist) + "\ +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. +" + (interactive) + (setq helm-multi-swoop-query (helm-multi-swoop--get-query $query)) + (if (equal current-prefix-arg '(4)) + (helm-multi-swoop--exec nil + :$query helm-multi-swoop-query + :$buflist $buflist) + (if $buflist + (helm-multi-swoop--exec nil + :$query $query + :$buflist $buflist) + (helm :sources (helm-c-source-helm-multi-swoop-buffers) + :buffer helm-multi-swoop-buffer-list + :prompt "Mark any buffers by [C-SPC] or [M-SPC]: ")))) + +;;;###autoload +(defun helm-multi-swoop-all (&optional $query) + "Apply all buffers to helm-multi-swoop" + (interactive) + (setq helm-multi-swoop-query (helm-multi-swoop--get-query $query)) + (helm-multi-swoop--exec nil + :$query helm-multi-swoop-query + :$buflist (helm-multi-swoop--get-buffer-list))) + +(defun get-buffers-matching-mode ($mode) + "Returns a list of buffers where their major-mode is equal to MODE" + (let ($buffer-mode-matches) + (mapc (lambda ($buf) + (when (get-buffer $buf) + (with-current-buffer (get-buffer $buf) + (if (eq $mode major-mode) + (add-to-list '$buffer-mode-matches (buffer-name $buf)))))) + (buffer-list)) + $buffer-mode-matches)) + +(defun helm-multi-swoop-by-mode ($mode &optional $query) + "Apply all buffers whose mode is MODE to helm-multi-swoop" + (setq helm-multi-swoop-query (helm-multi-swoop--get-query $query)) + (if (get-buffers-matching-mode $mode) + (helm-multi-swoop--exec nil + :$query helm-multi-swoop-query + :$buflist (get-buffers-matching-mode $mode)) + (message "there are no buffers in that mode right now"))) + +;;;###autoload +(defun helm-multi-swoop-org (&optional $query) + "Applies all org-mode buffers to helm-multi-swoop" + (interactive) + (helm-multi-swoop-by-mode 'org-mode $query)) + +;;;###autoload +(defun helm-multi-swoop-current-mode (&optional $query) + "Applies all buffers of the same mode as the current buffer to helm-multi-swoop" + (interactive) + (helm-multi-swoop-by-mode major-mode $query)) + +;;;###autoload +(defun helm-multi-swoop-projectile (&optional $query) + "Apply all opened buffers of the current project to helm-multi-swoop" + (interactive) + (setq helm-multi-swoop-query (helm-multi-swoop--get-query $query)) + (if (require 'projectile nil 'noerror) + ;; set filter function that is used in projectile-project-buffers + (let ((projectile-buffers-filter-function + helm-multi-swoop-projectile-buffers-filter)) + (helm-multi-swoop--exec nil + :$query helm-multi-swoop-query + :$buflist (mapcar #'buffer-name + (projectile-project-buffers)))) + (error "Package 'projectile' is not available"))) + + +(defun helm-swoop--wrap-function-with-pre-input-function ($target-func $pre-input-func) + (let (($restore helm-swoop-pre-input-function)) + (unwind-protect + (progn + (setq helm-swoop-pre-input-function $pre-input-func) + (funcall $target-func)) + (setq helm-swoop-pre-input-function $restore)))) + +;;;###autoload +(defun helm-swoop-without-pre-input () + "Start helm-swoop without pre input query." + (interactive) + (helm-swoop--wrap-function-with-pre-input-function + 'helm-swoop (lambda () nil))) + +;;;###autoload +(defun helm-swoop-symble-pre-input () + "Start helm-swoop without pre input query." + (interactive) + (helm-swoop--wrap-function-with-pre-input-function + 'helm-swoop (lambda () (format "\\_<%s\\_> " (thing-at-point 'symbol))))) + +;; option ------------------------------------------------------- + +(defun helm-multi-swoop-all-from-isearch () + "Invoke `helm-multi-swoop-all' from isearch." + (interactive) + (let (($query (if isearch-regexp + isearch-string + (regexp-quote isearch-string)))) + (let (search-nonincremental-instead) + (isearch-exit)) + (helm-multi-swoop-all $query))) +;; When doing isearch, hand the word over to helm-swoop +;; (define-key isearch-mode-map (kbd "C-x M-i") 'helm-multi-swoop-all-from-isearch) + +(defun helm-multi-swoop-all-from-helm-swoop () + "Invoke `helm-multi-swoop-all' from helm-swoop." + (interactive) + (helm-swoop--restore) + (delete-overlay helm-swoop-line-overlay) + (setq helm-multi-swoop-all-from-helm-swoop-last-point helm-swoop-last-point) + (let (($query helm-pattern)) + (run-with-timer 0 nil (lambda () (helm-multi-swoop-all $query)))) + (helm-exit-minibuffer)) + +(defun helm-multi-swoop-current-mode-from-helm-swoop () + "Invoke `helm-multi-swoop-all' from helm-swoop." + (interactive) + (helm-swoop--restore) + (delete-overlay helm-swoop-line-overlay) + (setq helm-multi-swoop-all-from-helm-swoop-last-point helm-swoop-last-point) + (let (($query helm-pattern)) + (run-with-timer 0 nil (lambda () (helm-multi-swoop-current-mode $query)))) + (helm-exit-minibuffer)) +;; (define-key helm-swoop-map (kbd "M-m") 'helm-multi-swoop-current-mode-from-helm-swoop) + +(defadvice helm-resume (around helm-multi-swoop-resume activate) + "Resume if the last used helm buffer is *Helm Swoop*" + (if (equal helm-last-buffer helm-multi-swoop-buffer) + + (if (boundp 'helm-multi-swoop-last-query) + (if (not (ad-get-arg 0)) + (helm-multi-swoop helm-multi-swoop-last-query + helm-multi-swoop-last-selected-buffers)) + ;; Temporary apply second last buffer + (let ((helm-last-buffer (cadr helm-buffers))) ad-do-it)) + ad-do-it)) + +;;; @ helm-multi-swoop-edit ----------------------------------- +(defvar helm-multi-swoop-edit-save t + "Save each buffer you edit when editing is complete") +(defvar helm-multi-swoop-edit-buffer "*Helm Multi Swoop Edit*") + +(defvar helm-multi-swoop-edit-map + (let (($map (make-sparse-keymap))) + (define-key $map (kbd "C-x C-s") 'helm-multi-swoop--edit-complete) + (define-key $map (kbd "C-c C-g") 'helm-multi-swoop--edit-cancel) + (define-key $map (kbd "C-c C-q C-k") 'helm-multi-swoop--edit-delete-all-lines) + $map)) + +(defun helm-multi-swoop--edit ($candidate) + "This function will only be called from `helm-swoop-edit'" + (interactive) + (delete-overlay helm-swoop-line-overlay) + (helm-swoop--delete-overlay 'target-buffer) + (with-current-buffer (get-buffer-create helm-multi-swoop-edit-buffer) + (helm-swoop--clear-edit-buffer 'helm-multi-swoop-edit) + (let (($bufstr "") + ($mark nil) + ($buf (get-buffer helm-multi-swoop-buffer))) + ;; Get target line number to edit + (when $buf + (with-current-buffer $buf + ;; Set overlay to helm-source-header for editing marked lines + (save-excursion + (goto-char (point-min)) + (let (($beg (point)) $end) + (overlay-recenter (point-max)) + (while (setq $beg (text-property-any $beg (point-max) + 'face 'helm-source-header)) + (setq $end (next-single-property-change $beg 'face)) + (overlay-put (make-overlay $beg $end) 'source-header t) + (setq $beg $end) + (goto-char $end)))) + ;; Use selected line by [C-SPC] or [M-SPC] + (mapc (lambda ($ov) + (when (overlay-get $ov 'source-header) + (setq $bufstr (concat (buffer-substring + (overlay-start $ov) (overlay-end $ov)) + $bufstr))) + (when (eq 'helm-visible-mark (overlay-get $ov 'face)) + (let (($str (buffer-substring (overlay-start $ov) (overlay-end $ov)))) + (unless (equal "" $str) (setq $mark t)) + (setq $bufstr (concat (buffer-substring + (overlay-start $ov) (overlay-end $ov)) + $bufstr))))) + (overlays-in (point-min) (point-max))) + (if $mark + (progn (setq $bufstr (concat "Helm Multi Swoop\n" $bufstr)) + (setq $mark nil)) + (setq $bufstr (concat "Helm Multi Swoop\n" + (buffer-substring + (point-min) (point-max))))))) + + ;; Set for edit buffer + (insert $bufstr) + (add-text-properties (point-min) (point-max) + '(read-only t rear-nonsticky t front-sticky t)) + + ;; Set for editable context + (let ((inhibit-read-only t)) + ;; Title and explanation + (goto-char (point-min)) + (let (($o (make-overlay (point) (point-at-eol)))) + (overlay-put $o 'helm-multi-swoop-edit t) + (overlay-put $o 'face 'font-lock-function-name-face) + (overlay-put $o 'after-string + (propertize + (format " [%s] Complete, [%s] Cancel, [%s] Delete All" + (helm-swoop--key-of-function 'helm-swoop--edit-complete helm-swoop-edit-map) + (helm-swoop--key-of-function 'helm-swoop--edit-cancel helm-swoop-edit-map) + (helm-swoop--key-of-function 'helm-swoop--edit-delete-all-lines helm-swoop-edit-map)) + 'face 'helm-bookmark-addressbook))) + ;; Line number and editable area + (while (re-search-forward "^\\([0-9]+\s\\)\\(.*\\)$" nil t) + (let* (($bol1 (match-beginning 1)) + ($eol1 (match-end 1)) + ($bol2 (match-beginning 2)) + ($eol2 (match-end 2))) + + ;; Line number + (add-text-properties $bol1 $eol1 + '(face font-lock-function-name-face + intangible t)) + ;; Editable area + (remove-text-properties $bol2 $eol2 '(read-only t)) + ;; (add-text-properties $bol2 $eol2 '(font-lock-face helm-match)) + + ;; For line tail + (set-text-properties $eol2 (or (1+ $eol2) (point-max)) + '(read-only t rear-nonsticky t)))) + (helm-swoop--target-word-overlay 'edit-buffer 0)))) + + (other-window 1) + (switch-to-buffer helm-multi-swoop-edit-buffer) + (goto-char (point-min)) + (if (string-match "^[0-9]+" $candidate) + (re-search-forward + (concat "^" (match-string 0 $candidate)) nil t)) + (use-local-map helm-multi-swoop-edit-map)) + +(defun helm-multi-swoop--separate-text-property-into-list ($property) + (interactive) + (let ($list $end) + (save-excursion + (goto-char (point-min)) + (while (setq $end (next-single-property-change (point) $property)) + ;; Must eliminate last return because of unexpected edit result + (setq $list (cons + (let (($str (buffer-substring-no-properties (point) $end))) + (if (string-match "\n\n\\'" $str) + (replace-regexp-in-string "\n\\'" "" $str) + $str)) + $list)) + (goto-char $end)) + (setq $list (cons (buffer-substring-no-properties (point) (point-max)) + $list))) + (nreverse $list))) + +(defun helm-multi-swoop--collect-edited-lines () + "Create a list of edited lines with each its own line number" + (interactive) + (let* (($list + (helm-multi-swoop--separate-text-property-into-list 'helm-header)) + ($length (length $list)) + ($i 1) ;; 0th $list is header + $pairs) + (while (<= $i $length) + (let ($contents) + ;; Make ((number . line) (number . line) (number . line) ...) + (with-temp-buffer + (insert (format "%s" (nth (1+ $i) $list))) + (goto-char (point-min)) + (while (re-search-forward "^\\([0-9]+\\)\s" nil t) + (setq $contents + (cons (cons (string-to-number (match-string 1)) + (buffer-substring-no-properties + (point) + (save-excursion + (if (re-search-forward + "^\\([0-9]+\\)\s\\|^\\(\\-+\\)" nil t) + (1- (match-beginning 0)) + (goto-char (point-max)) + (re-search-backward "\n" nil t))))) + $contents)))) + ;; Make ((buffer-name (number . line) (number . line) ...) + ;; (buffer-name (number . line) (number . line) ...) ...) + (setq $pairs (cons (cons (nth $i $list) $contents) $pairs))) + (setq $i (+ $i 2))) + (delete '(nil) $pairs))) + +(defun helm-multi-swoop--edit-complete () + "Delete all extracted lines, and apply changes to buffers and kill temporary edit buffer" + (interactive) + (let (($list (helm-multi-swoop--collect-edited-lines)) + $read-only) + (mapc (lambda ($x) + (with-current-buffer (car $x) + (unless buffer-read-only + (save-excursion + (mapc (lambda ($cell) + (let (($k (car $cell)) + ($v (cdr $cell))) + (goto-char (point-min)) + (delete-region (point-at-bol $k) (point-at-eol $k)) + (goto-char (point-at-bol $k)) + (insert $v))) + (cdr $x)))) + (if helm-multi-swoop-edit-save + (if buffer-read-only + (setq $read-only t) + (save-buffer))))) + $list) + (select-window helm-swoop-synchronizing-window) + (kill-buffer (get-buffer helm-multi-swoop-edit-buffer)) + (if $read-only + (message "Couldn't save some buffers because of read-only") + (message "Successfully helm-multi-swoop-edit applied to original buffer")))) + +(defun helm-multi-swoop--edit-delete-all-lines () + "Delete all extracted lines, and apply changes to buffers and kill temporary edit buffer" + (interactive) + (let (($list (helm-multi-swoop--collect-edited-lines)) + $read-only) + (mapc (lambda ($x) + (with-current-buffer (car $x) + (unless buffer-read-only + (save-excursion + (mapc (lambda ($cell) + (let (($k (car $cell))) + (goto-char (point-min)) + (delete-region (point-at-bol $k) + (if (eq (point-at-eol $k) (point-max)) + (point-at-eol $k) + (1+ (point-at-eol $k)))))) + (cdr $x)))) + (if helm-multi-swoop-edit-save + (if buffer-read-only + (setq $read-only t) + (save-buffer))))) + $list) + (select-window helm-swoop-synchronizing-window) + (kill-buffer (get-buffer helm-multi-swoop-edit-buffer)) + (if $read-only + (message "Couldn't save some buffers because of read-only") + (message "Successfully helm-multi-swoop-edit applied to original buffer")))) + +(defun helm-multi-swoop--edit-cancel () + "Cancel edit and kill temporary buffer" + (interactive) + (select-window helm-swoop-synchronizing-window) + (kill-buffer (get-buffer helm-multi-swoop-edit-buffer)) + (message "helm-multi-swoop-edit canceled")) + +;;;###autoload +(defun helm-multi-swoop-edit () + (interactive) + (helm-exit-and-execute-action 'helm-multi-swoop--edit)) + +;;; @ helm-swoop-same-face-at-point ----------------------------------- + +(defsubst helm-swoop--get-at-face (&optional $point) + (or $point (setq $point (point))) + (let (($face (or (get-char-property $point 'read-face-name) + (get-char-property $point 'face)))) + $face)) + +(defun helm-swoop--cull-face-include-line ($face) + (let (($list) ($po (point-min))) + (save-excursion + (while (setq $po (next-single-property-change $po 'face)) + (when (equal $face (helm-swoop--get-at-face $po)) + (goto-char $po) + (setq $list (cons (format "%s %s" + (line-number-at-pos $po) + (buffer-substring (point-at-bol) (point-at-eol))) + $list)) + (let (($ov (make-overlay $po (or (next-single-property-change $po 'face) + (point-max))))) + (overlay-put $ov 'face 'helm-swoop-target-word-face) + (overlay-put $ov 'target-buffer 'helm-swoop-target-word-face))))) + (nreverse (delete-dups $list)))) + +(defun helm-swoop-same-face-at-point (&optional $face) + (interactive) + (or $face (setq $face (helm-swoop--get-at-face))) + (helm-swoop :$query "" + :$source + `((name . "helm-swoop-same-face-at-point") + (candidates . ,(helm-swoop--cull-face-include-line $face)) + (header-line . ,(format "%s" $face)) + (action + . (("Go to Line" + . (lambda ($line) + (helm-swoop--goto-line + (when (string-match "^[0-9]+" $line) + (string-to-number (match-string 0 $line)))) + (let (($po (point)) + ($poe (point-at-eol))) + (while (<= (setq $po (next-single-property-change $po 'face)) $poe) + (when (eq 'helm-swoop-target-word-face (helm-swoop--get-at-face $po)) + (goto-char $po)))) + (helm-swoop--recenter)))))))) + +(defun helm-multi-swoop-same-face-at-point (&optional $face) + (interactive) + (or $face (setq $face (helm-swoop--get-at-face))) + (helm-multi-swoop--exec + nil + :$query "" + :$func (lambda () (helm-swoop--cull-face-include-line $face)) + :$action (lambda ($line) + (switch-to-buffer (assoc-default 'name (helm-get-current-source))) + (helm-swoop--goto-line + (when (string-match "^[0-9]+" $line) + (string-to-number (match-string 0 $line)))) + (let (($po (point)) + ($poe (point-at-eol))) + (while (<= (setq $po (next-single-property-change $po 'face)) $poe) + (when (eq 'helm-swoop-target-word-face (helm-swoop--get-at-face $po)) + (goto-char $po)))) + (helm-swoop--recenter)) + :$buflist (helm-multi-swoop--get-buffer-list))) + +(provide 'helm-swoop) +;;; helm-swoop.el ends here diff --git a/elpa/helm-systemd-20160517.2333/helm-systemd-autoloads.el b/elpa/helm-systemd-20160517.2333/helm-systemd-autoloads.el new file mode 100644 index 0000000..2418857 --- /dev/null +++ b/elpa/helm-systemd-20160517.2333/helm-systemd-autoloads.el @@ -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 diff --git a/elpa/helm-systemd-20160517.2333/helm-systemd-pkg.el b/elpa/helm-systemd-20160517.2333/helm-systemd-pkg.el new file mode 100644 index 0000000..dcabf2b --- /dev/null +++ b/elpa/helm-systemd-20160517.2333/helm-systemd-pkg.el @@ -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")) diff --git a/elpa/helm-systemd-20160517.2333/helm-systemd.el b/elpa/helm-systemd-20160517.2333/helm-systemd.el new file mode 100644 index 0000000..c68600c --- /dev/null +++ b/elpa/helm-systemd-20160517.2333/helm-systemd.el @@ -0,0 +1,298 @@ +;;; helm-systemd.el --- helm's systemd interface -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 + +;; Author: +;; 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 . + +;;; 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 "") 'helm-cr-empty-string) + (define-key map (kbd "") '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 diff --git a/elpa/helm-themes-20151008.2321/helm-themes-autoloads.el b/elpa/helm-themes-20151008.2321/helm-themes-autoloads.el new file mode 100644 index 0000000..8db1057 --- /dev/null +++ b/elpa/helm-themes-20151008.2321/helm-themes-autoloads.el @@ -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 diff --git a/elpa/helm-themes-20151008.2321/helm-themes-pkg.el b/elpa/helm-themes-20151008.2321/helm-themes-pkg.el new file mode 100644 index 0000000..b3a3edb --- /dev/null +++ b/elpa/helm-themes-20151008.2321/helm-themes-pkg.el @@ -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") diff --git a/elpa/helm-themes-20151008.2321/helm-themes.el b/elpa/helm-themes-20151008.2321/helm-themes.el new file mode 100644 index 0000000..c3ba54e --- /dev/null +++ b/elpa/helm-themes-20151008.2321/helm-themes.el @@ -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 +;; 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 . + +;;; 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 diff --git a/elpa/helm-unicode-20160715.533/helm-unicode-autoloads.el b/elpa/helm-unicode-20160715.533/helm-unicode-autoloads.el new file mode 100644 index 0000000..62fdc53 --- /dev/null +++ b/elpa/helm-unicode-20160715.533/helm-unicode-autoloads.el @@ -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 diff --git a/elpa/helm-unicode-20160715.533/helm-unicode-pkg.el b/elpa/helm-unicode-20160715.533/helm-unicode-pkg.el new file mode 100644 index 0000000..fcd5695 --- /dev/null +++ b/elpa/helm-unicode-20160715.533/helm-unicode-pkg.el @@ -0,0 +1 @@ +(define-package "helm-unicode" "20160715.533" "Helm command for unicode characters." '((helm "1.9.8") (emacs "24.4"))) diff --git a/elpa/helm-unicode-20160715.533/helm-unicode.el b/elpa/helm-unicode-20160715.533/helm-unicode.el new file mode 100644 index 0000000..7238d80 --- /dev/null +++ b/elpa/helm-unicode-20160715.533/helm-unicode.el @@ -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 . + +;;; 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 diff --git a/elpa/let-alist-1.0.4.signed b/elpa/let-alist-1.0.4.signed new file mode 100644 index 0000000..281ce60 --- /dev/null +++ b/elpa/let-alist-1.0.4.signed @@ -0,0 +1 @@ +Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent (trust undefined) created at 2015-06-12T11:05:02+0200 using DSA \ No newline at end of file diff --git a/elpa/let-alist-1.0.4/let-alist-autoloads.el b/elpa/let-alist-1.0.4/let-alist-autoloads.el new file mode 100644 index 0000000..f375800 --- /dev/null +++ b/elpa/let-alist-1.0.4/let-alist-autoloads.el @@ -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 diff --git a/elpa/let-alist-1.0.4/let-alist-pkg.el b/elpa/let-alist-1.0.4/let-alist-pkg.el new file mode 100644 index 0000000..8bb379d --- /dev/null +++ b/elpa/let-alist-1.0.4/let-alist-pkg.el @@ -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")) diff --git a/elpa/let-alist-1.0.4/let-alist.el b/elpa/let-alist-1.0.4/let-alist.el new file mode 100644 index 0000000..dbf31e0 --- /dev/null +++ b/elpa/let-alist-1.0.4/let-alist.el @@ -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 +;; Maintainer: Artur Malabarba +;; 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 . + +;;; 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 +;; +;; * let-alist (let-alist--deep-dot-search): Fix cons +;; +;; 2015-03-07 Artur Malabarba +;; +;; let-alist: Update copyright +;; +;; 2014-12-22 Artur Malabarba +;; +;; packages/let-alist: Use `make-symbol' instead of `gensym'. +;; +;; 2014-12-20 Artur Malabarba +;; +;; packages/let-alist: Enable access to deeper alists +;; +;; 2014-12-14 Artur Malabarba +;; +;; let-alist.el: Add lexical binding. Version bump. +;; +;; 2014-12-11 Artur Malabarba +;; +;; let-alist: New package +;; + + +(provide 'let-alist) + +;;; let-alist.el ends here diff --git a/elpa/multi-20131013.844/multi-autoloads.el b/elpa/multi-20131013.844/multi-autoloads.el new file mode 100644 index 0000000..2ef3101 --- /dev/null +++ b/elpa/multi-20131013.844/multi-autoloads.el @@ -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 diff --git a/elpa/multi-20131013.844/multi-pkg.el b/elpa/multi-20131013.844/multi-pkg.el new file mode 100644 index 0000000..4a063cf --- /dev/null +++ b/elpa/multi-20131013.844/multi-pkg.el @@ -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")) diff --git a/elpa/multi-20131013.844/multi.el b/elpa/multi-20131013.844/multi.el new file mode 100644 index 0000000..9c8877e --- /dev/null +++ b/elpa/multi-20131013.844/multi.el @@ -0,0 +1,134 @@ +;;; multi.el --- Clojure-style multi-methods for emacs lisp -*- lexical-binding: t -*- + +;; Copyright (c) 2013 Christina Whyte + +;; Version: 2.0.1 +;; Package-Version: 20131013.844 +;; Package-Requires: ((emacs "24")) +;; Keywords: multimethod generic predicate dispatch +;; Author: Christina Whyte +;; 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 diff --git a/elpa/multiple-cursors-20160719.216/mc-cycle-cursors.el b/elpa/multiple-cursors-20160719.216/mc-cycle-cursors.el new file mode 100644 index 0000000..85af352 --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/mc-cycle-cursors.el @@ -0,0 +1,119 @@ +;;; mc-cycle-cursors.el + +;; Copyright (C) 2012-2016 Magnar Sveen + +;; Author: Magnar Sveen +;; 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 . + +;;; 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 diff --git a/elpa/multiple-cursors-20160719.216/mc-edit-lines.el b/elpa/multiple-cursors-20160719.216/mc-edit-lines.el new file mode 100644 index 0000000..e38d1c1 --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/mc-edit-lines.el @@ -0,0 +1,110 @@ +;;; mc-edit-lines.el + +;; Copyright (C) 2012-2016 Magnar Sveen + +;; Author: Magnar Sveen +;; 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 . + +;;; 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 diff --git a/elpa/multiple-cursors-20160719.216/mc-hide-unmatched-lines-mode.el b/elpa/multiple-cursors-20160719.216/mc-hide-unmatched-lines-mode.el new file mode 100644 index 0000000..18e1688 --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/mc-hide-unmatched-lines-mode.el @@ -0,0 +1,107 @@ +;;; mc-hide-unmatched-lines.el + +;; Copyright (C) 2014 Aleksey Fedotov + +;; Author: Aleksey Fedotov +;; 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 . + +;;; 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 "" 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 "") '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 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) diff --git a/elpa/multiple-cursors-20160719.216/mc-mark-more.el b/elpa/multiple-cursors-20160719.216/mc-mark-more.el new file mode 100644 index 0000000..27a84b7 --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/mc-mark-more.el @@ -0,0 +1,712 @@ +;;; mc-mark-more.el + +;; Copyright (C) 2012-2016 Magnar Sveen + +;; Author: Magnar Sveen +;; 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 . + +;;; 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: + + Mark previous like this and set direction to 'up + Mark next like this and set direction to 'down + +If direction is 'up: + + Skip past the cursor furthest up + Remove the cursor furthest up + +If direction is 'down: + + Remove the cursor furthest down + 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 " to mark previous, to skip, to remove, to mark next") + (message " to mark next, to skip, to remove, 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 "") 'mc/mmlte--up) +(define-key mc/mark-more-like-this-extended-keymap (kbd "") 'mc/mmlte--down) +(define-key mc/mark-more-like-this-extended-keymap (kbd "") 'mc/mmlte--left) +(define-key mc/mark-more-like-this-extended-keymap (kbd "") '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 " +;; 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 . + +;;; 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 diff --git a/elpa/multiple-cursors-20160719.216/multiple-cursors-autoloads.el b/elpa/multiple-cursors-20160719.216/multiple-cursors-autoloads.el new file mode 100644 index 0000000..4c645a0 --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/multiple-cursors-autoloads.el @@ -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 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: + + Mark previous like this and set direction to 'up + Mark next like this and set direction to 'down + +If direction is 'up: + + Skip past the cursor furthest up + Remove the cursor furthest up + +If direction is 'down: + + Remove the cursor furthest down + 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 diff --git a/elpa/multiple-cursors-20160719.216/multiple-cursors-core.el b/elpa/multiple-cursors-20160719.216/multiple-cursors-core.el new file mode 100644 index 0000000..5e9ed76 --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/multiple-cursors-core.el @@ -0,0 +1,790 @@ +;;; multiple-cursors-core.el --- An experiment in multiple cursors for emacs. + +;; Copyright (C) 2012-2016 Magnar Sveen + +;; Author: Magnar Sveen +;; 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 . + +;;; 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 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 "") '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 diff --git a/elpa/multiple-cursors-20160719.216/multiple-cursors-pkg.el b/elpa/multiple-cursors-20160719.216/multiple-cursors-pkg.el new file mode 100644 index 0000000..9e3a77d --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/multiple-cursors-pkg.el @@ -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: diff --git a/elpa/multiple-cursors-20160719.216/multiple-cursors.el b/elpa/multiple-cursors-20160719.216/multiple-cursors.el new file mode 100644 index 0000000..4a05dcc --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/multiple-cursors.el @@ -0,0 +1,199 @@ +;;; multiple-cursors.el --- Multiple cursors for emacs. + +;; Copyright (C) 2012-2016 Magnar Sveen + +;; Author: Magnar Sveen +;; 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 . + +;;; 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 `` 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 `` 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-")) +;; (global-set-key (kbd "M-") '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-") '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 diff --git a/elpa/multiple-cursors-20160719.216/rectangular-region-mode.el b/elpa/multiple-cursors-20160719.216/rectangular-region-mode.el new file mode 100644 index 0000000..01a078d --- /dev/null +++ b/elpa/multiple-cursors-20160719.216/rectangular-region-mode.el @@ -0,0 +1,125 @@ +;;; rectangular-region-mode.el + +;; Copyright (C) 2012-2016 Magnar Sveen + +;; Author: Magnar Sveen +;; 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 . + +;;; 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 "") '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 diff --git a/elpa/org-bullets-20140918.1137/org-bullets-autoloads.el b/elpa/org-bullets-20140918.1137/org-bullets-autoloads.el new file mode 100644 index 0000000..a68c0e5 --- /dev/null +++ b/elpa/org-bullets-20140918.1137/org-bullets-autoloads.el @@ -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 diff --git a/elpa/org-bullets-20140918.1137/org-bullets-pkg.el b/elpa/org-bullets-20140918.1137/org-bullets-pkg.el new file mode 100644 index 0000000..40b72c2 --- /dev/null +++ b/elpa/org-bullets-20140918.1137/org-bullets-pkg.el @@ -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") diff --git a/elpa/org-bullets-20140918.1137/org-bullets.el b/elpa/org-bullets-20140918.1137/org-bullets.el new file mode 100644 index 0000000..5b8ec02 --- /dev/null +++ b/elpa/org-bullets-20140918.1137/org-bullets.el @@ -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 diff --git a/elpa/origami-20160710.958/origami-autoloads.el b/elpa/origami-20160710.958/origami-autoloads.el new file mode 100644 index 0000000..e42d69c --- /dev/null +++ b/elpa/origami-20160710.958/origami-autoloads.el @@ -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 diff --git a/elpa/origami-20160710.958/origami-parsers.el b/elpa/origami-20160710.958/origami-parsers.el new file mode 100644 index 0000000..072769a --- /dev/null +++ b/elpa/origami-20160710.958/origami-parsers.el @@ -0,0 +1,245 @@ +;;; origami-parsers.el --- Collection of parsers -*- lexical-binding: t -*- + +;; Author: Greg Sexton +;; 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 diff --git a/elpa/origami-20160710.958/origami-pkg.el b/elpa/origami-20160710.958/origami-pkg.el new file mode 100644 index 0000000..015626c --- /dev/null +++ b/elpa/origami-20160710.958/origami-pkg.el @@ -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: diff --git a/elpa/origami-20160710.958/origami.el b/elpa/origami-20160710.958/origami.el new file mode 100644 index 0000000..53eddfe --- /dev/null +++ b/elpa/origami-20160710.958/origami.el @@ -0,0 +1,821 @@ +;;; origami.el --- Flexible text folding -*- lexical-binding: t -*- + +;; Author: Greg Sexton +;; 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 diff --git a/elpa/seq-2.16.signed b/elpa/seq-2.16.signed new file mode 100644 index 0000000..3bb9687 --- /dev/null +++ b/elpa/seq-2.16.signed @@ -0,0 +1 @@ +Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent (trust undefined) created at 2016-06-12T23:05:02+0200 using DSA \ No newline at end of file diff --git a/elpa/seq-2.16/ChangeLog b/elpa/seq-2.16/ChangeLog new file mode 100644 index 0000000..88f8e8c --- /dev/null +++ b/elpa/seq-2.16/ChangeLog @@ -0,0 +1,142 @@ +2016-06-12 Nicolas Petton + + 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 + + * seq-24.el (seq-concatenate,seq-into,seq--make-bindings): Use _ + + rather than t as catch-all for pcase. + +2016-03-31 Nicolas Petton + + 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 + + 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 + + * packages/seq/seq-25.el: Better declarations for seq--when-emacs-25-p + +2016-03-25 Nicolas Petton + + 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 + + * 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 + + * externals-list: Add seq and python as :core packages + + * .gitignore: Add packages/{seq,python}. + * packages/seq: Remove. + +2015-10-20 Nicolas Petton + + Update seq.el to version 1.11 + + * packages/seq/seq.el: + * packages/seq/tests/seq-tests.el: Update. + +2015-09-18 Nicolas Petton + + 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 + + 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 + + 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 + + * packages/seq/seq.el: Update seq.el to version 1.5. + +2015-04-15 Nicolas Petton + + 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 + + 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 + + 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 + + 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 + + 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 + + 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 + + packages/seq: New package + diff --git a/elpa/seq-2.16/seq-24.el b/elpa/seq-2.16/seq-24.el new file mode 100644 index 0000000..d0aa618 --- /dev/null +++ b/elpa/seq-2.16/seq-24.el @@ -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 +;; 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 . + +;;; 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 + '("\\" "\\"))) + +(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 diff --git a/elpa/seq-2.16/seq-25.el b/elpa/seq-2.16/seq-25.el new file mode 100644 index 0000000..b2f5c98 --- /dev/null +++ b/elpa/seq-2.16/seq-25.el @@ -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 +;; 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 . + +;;; 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 diff --git a/elpa/seq-2.16/seq-autoloads.el b/elpa/seq-2.16/seq-autoloads.el new file mode 100644 index 0000000..9c2c6ad --- /dev/null +++ b/elpa/seq-2.16/seq-autoloads.el @@ -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 diff --git a/elpa/seq-2.16/seq-pkg.el b/elpa/seq-2.16/seq-pkg.el new file mode 100644 index 0000000..0a19486 --- /dev/null +++ b/elpa/seq-2.16/seq-pkg.el @@ -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")) diff --git a/elpa/seq-2.16/seq.el b/elpa/seq-2.16/seq.el new file mode 100644 index 0000000..9f96ec8 --- /dev/null +++ b/elpa/seq-2.16/seq.el @@ -0,0 +1,48 @@ +;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2016 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; 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 . + +;;; 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 diff --git a/elpa/seq-2.16/tests/seq-tests.el b/elpa/seq-2.16/tests/seq-tests.el new file mode 100644 index 0000000..cf3da78 --- /dev/null +++ b/elpa/seq-2.16/tests/seq-tests.el @@ -0,0 +1,354 @@ +;;; seq-tests.el --- Tests for sequences.el + +;; Copyright (C) 2014-2015 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; 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 . + +;;; 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 diff --git a/init.el b/init.el index cbc2ce6..d487e49 100644 --- a/init.el +++ b/init.el @@ -59,6 +59,7 @@ (setq-default magit-gerrit-remote "gerrit") (set-face-attribute 'default t :font "Hack-10") (set-frame-font "Hack-10" nil t) +(setq user-mail-address "gergely@polonkai.eu") (custom-set-faces ;; custom-set-faces was added by Custom. @@ -300,3 +301,9 @@ Version 2016-02-16" (cond (arg-move-point (right-char))))) (put 'downcase-region 'disabled nil) + +(eval-after-load 'company + '(progn + (define-key company-mode-map (kbd "C-:") 'helm-company) + (define-key company-active-map (kbd "C-:") 'helm-company))) +(require 'xlicense)