2018-09-10 20:51:14 +02:00
|
|
|
;;; evil-ex.el --- Ex-mode
|
|
|
|
|
|
|
|
|
|
;; Author: Frank Fischer <frank fischer at mathematik.tu-chemnitz.de>
|
|
|
|
|
;; Maintainer: Vegard Øye <vegard_oye at hotmail.com>
|
|
|
|
|
|
|
|
|
|
;; Version: 1.2.13
|
|
|
|
|
|
|
|
|
|
;;
|
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
;;; License:
|
|
|
|
|
|
|
|
|
|
;; This file is part of Evil.
|
|
|
|
|
;;
|
|
|
|
|
;; Evil 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.
|
|
|
|
|
;;
|
|
|
|
|
;; Evil 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 Evil. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; Ex is implemented as an extensible minilanguage, whose grammar
|
|
|
|
|
;; is stored in `evil-ex-grammar'. Ex commands are defined with
|
|
|
|
|
;; `evil-ex-define-cmd', which creates a binding from a string
|
|
|
|
|
;; to an interactive function. It is also possible to define key
|
|
|
|
|
;; sequences which execute a command immediately when entered:
|
|
|
|
|
;; such shortcuts go in `evil-ex-map'.
|
|
|
|
|
;;
|
|
|
|
|
;; To provide buffer and filename completion, as well as interactive
|
|
|
|
|
;; feedback, Ex defines the concept of an argument handler, specified
|
|
|
|
|
;; with `evil-ex-define-argument-type'. In the case of the
|
|
|
|
|
;; substitution command (":s/foo/bar"), the handler incrementally
|
|
|
|
|
;; highlights matches in the buffer as the substitution is typed.
|
|
|
|
|
|
|
|
|
|
(require 'evil-common)
|
|
|
|
|
(require 'evil-states)
|
|
|
|
|
(require 'shell)
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(defconst evil-ex-grammar
|
|
|
|
|
'((expression
|
|
|
|
|
(count command argument #'evil-ex-call-command)
|
|
|
|
|
((\? range) command argument #'evil-ex-call-command)
|
|
|
|
|
(line #'evil-goto-line)
|
|
|
|
|
(sexp #'eval-expression))
|
|
|
|
|
(count
|
|
|
|
|
number)
|
|
|
|
|
(command #'evil-ex-parse-command)
|
|
|
|
|
(binding
|
|
|
|
|
"[~&*@<>=:]+\\|[[:alpha:]-]+\\|!")
|
|
|
|
|
(emacs-binding
|
|
|
|
|
"[[:alpha:]-][[:alnum:][:punct:]-]+")
|
|
|
|
|
(bang
|
|
|
|
|
(\? (! space) "!" #'$1))
|
|
|
|
|
(argument
|
|
|
|
|
((\? space) (\? "\\(?:.\\|\n\\)+") #'$2))
|
|
|
|
|
(range
|
|
|
|
|
("%" #'(evil-ex-full-range))
|
|
|
|
|
(line ";" line #'(let ((tmp1 $1))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-line tmp1)
|
|
|
|
|
(evil-ex-range tmp1 $3))))
|
|
|
|
|
(line "," line #'(evil-ex-range $1 $3))
|
|
|
|
|
(line #'(evil-ex-range $1 nil))
|
|
|
|
|
("`" "[-a-zA-Z_<>']" ",`" "[-a-zA-Z_<>']"
|
|
|
|
|
#'(evil-ex-char-marker-range $2 $4)))
|
|
|
|
|
(line
|
|
|
|
|
(base (\? offset) search (\? offset)
|
|
|
|
|
#'(let ((tmp (evil-ex-line $1 $2)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-line tmp)
|
|
|
|
|
(evil-ex-line $3 $4))))
|
|
|
|
|
((\? base) offset search (\? offset)
|
|
|
|
|
#'(let ((tmp (evil-ex-line $1 $2)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-line tmp)
|
|
|
|
|
(evil-ex-line $3 $4))))
|
|
|
|
|
(base (\? offset) #'evil-ex-line)
|
|
|
|
|
((\? base) offset #'evil-ex-line))
|
|
|
|
|
(base
|
|
|
|
|
number
|
|
|
|
|
marker
|
|
|
|
|
search
|
|
|
|
|
("\\^" #'(evil-ex-first-line))
|
|
|
|
|
("\\$" #'(evil-ex-last-line))
|
|
|
|
|
("\\." #'(evil-ex-current-line)))
|
|
|
|
|
(offset
|
|
|
|
|
(+ signed-number #'+))
|
|
|
|
|
(marker
|
|
|
|
|
("'" "[-a-zA-Z_<>']" #'(evil-ex-marker $2)))
|
|
|
|
|
(search
|
|
|
|
|
forward
|
|
|
|
|
backward
|
|
|
|
|
next
|
|
|
|
|
prev
|
|
|
|
|
subst)
|
|
|
|
|
(forward
|
|
|
|
|
("/" "\\(?:[\\].\\|[^/,; ]\\)+" (! "/")
|
|
|
|
|
#'(evil-ex-re-fwd $2))
|
|
|
|
|
("/" "\\(?:[\\].\\|[^/]\\)+" "/"
|
|
|
|
|
#'(evil-ex-re-fwd $2)))
|
|
|
|
|
(backward
|
|
|
|
|
("\\?" "\\(?:[\\].\\|[^?,; ]\\)+" (! "\\?")
|
|
|
|
|
#'(evil-ex-re-bwd $2))
|
|
|
|
|
("\\?" "\\(?:[\\].\\|[^?]\\)+" "\\?"
|
|
|
|
|
#'(evil-ex-re-bwd $2)))
|
|
|
|
|
(next
|
|
|
|
|
"\\\\/" #'(evil-ex-prev-search))
|
|
|
|
|
(prev
|
|
|
|
|
"\\\\\\?" #'(evil-ex-prev-search))
|
|
|
|
|
(subst
|
|
|
|
|
"\\\\&" #'(evil-ex-prev-search))
|
|
|
|
|
(signed-number
|
|
|
|
|
(sign (\? number) #'evil-ex-signed-number))
|
|
|
|
|
(sign
|
|
|
|
|
"\\+\\|-" #'intern)
|
|
|
|
|
(number
|
|
|
|
|
"[0-9]+" #'string-to-number)
|
|
|
|
|
(space
|
|
|
|
|
"[ ]+")
|
|
|
|
|
(sexp
|
|
|
|
|
"(.*)" #'(car-safe (read-from-string $1))))
|
|
|
|
|
"Grammar for Ex.
|
|
|
|
|
An association list of syntactic symbols and their definitions.
|
|
|
|
|
The first entry is the start symbol. A symbol's definition may
|
|
|
|
|
reference other symbols, but the grammar cannot contain
|
|
|
|
|
left recursion. See `evil-parser' for a detailed explanation
|
|
|
|
|
of the syntax.")
|
|
|
|
|
|
|
|
|
|
(defvar evil-ex-echo-overlay nil
|
|
|
|
|
"Overlay used for displaying info messages during ex.")
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-p ()
|
|
|
|
|
"Whether Ex is currently active."
|
|
|
|
|
(and evil-ex-current-buffer t))
|
|
|
|
|
|
|
|
|
|
(evil-define-command evil-ex (&optional initial-input)
|
|
|
|
|
"Enter an Ex command.
|
|
|
|
|
The ex command line is initialized with the value of
|
|
|
|
|
INITIAL-INPUT. If the command is called interactively the initial
|
|
|
|
|
input depends on the current state. If the current state is
|
|
|
|
|
normal state and no count argument is given then the initial
|
|
|
|
|
input is empty. If a prefix count is given the initial input is
|
|
|
|
|
.,.+count. If the current state is visual state then the initial
|
|
|
|
|
input is the visual region '<,'> or `<,`>. If the value of the
|
|
|
|
|
global variable `evil-ex-initial-input' is non-nil, its content
|
|
|
|
|
is appended to the line."
|
|
|
|
|
:keep-visual t
|
|
|
|
|
:repeat abort
|
|
|
|
|
(interactive
|
|
|
|
|
(list
|
|
|
|
|
(let ((s (concat
|
|
|
|
|
(cond
|
|
|
|
|
((and (evil-visual-state-p)
|
|
|
|
|
evil-ex-visual-char-range
|
|
|
|
|
(memq (evil-visual-type) '(inclusive exclusive)))
|
|
|
|
|
"`<,`>")
|
|
|
|
|
((evil-visual-state-p)
|
|
|
|
|
"'<,'>")
|
|
|
|
|
(current-prefix-arg
|
|
|
|
|
(let ((arg (prefix-numeric-value current-prefix-arg)))
|
|
|
|
|
(cond ((< arg 0) (setq arg (1+ arg)))
|
|
|
|
|
((> arg 0) (setq arg (1- arg))))
|
|
|
|
|
(if (= arg 0) '(".")
|
|
|
|
|
(format ".,.%+d" arg)))))
|
|
|
|
|
evil-ex-initial-input)))
|
|
|
|
|
(and (> (length s) 0) s))))
|
|
|
|
|
(let ((evil-ex-current-buffer (current-buffer))
|
|
|
|
|
(evil-ex-previous-command (unless initial-input
|
|
|
|
|
(car-safe evil-ex-history)))
|
|
|
|
|
evil-ex-argument-handler
|
|
|
|
|
evil-ex-info-string
|
|
|
|
|
result)
|
|
|
|
|
(minibuffer-with-setup-hook
|
|
|
|
|
(if initial-input #'evil-ex-setup-and-update #'evil-ex-setup)
|
|
|
|
|
(setq result
|
|
|
|
|
(read-from-minibuffer
|
|
|
|
|
":"
|
|
|
|
|
(or initial-input
|
|
|
|
|
(and evil-ex-previous-command
|
|
|
|
|
(propertize evil-ex-previous-command 'face 'shadow)))
|
|
|
|
|
evil-ex-completion-map
|
|
|
|
|
nil
|
|
|
|
|
'evil-ex-history
|
|
|
|
|
evil-ex-previous-command
|
|
|
|
|
t)))
|
|
|
|
|
(evil-ex-execute result)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-execute (result)
|
|
|
|
|
"Execute RESULT as an ex command on `evil-ex-current-buffer'."
|
|
|
|
|
;; empty input means repeating the previous command
|
|
|
|
|
(when (zerop (length result))
|
|
|
|
|
(setq result evil-ex-previous-command))
|
|
|
|
|
;; parse data
|
|
|
|
|
(evil-ex-update nil nil nil result)
|
|
|
|
|
;; execute command
|
|
|
|
|
(unless (zerop (length result))
|
|
|
|
|
(if evil-ex-expression
|
|
|
|
|
(eval evil-ex-expression)
|
|
|
|
|
(user-error "Ex: syntax error"))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-delete-backward-char ()
|
|
|
|
|
"Close the minibuffer if it is empty.
|
|
|
|
|
Otherwise behaves like `delete-backward-char'."
|
|
|
|
|
(interactive)
|
|
|
|
|
(call-interactively
|
|
|
|
|
(if (zerop (length (minibuffer-contents)))
|
|
|
|
|
#'abort-recursive-edit
|
|
|
|
|
#'delete-backward-char)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-abort ()
|
|
|
|
|
"Cancel ex state when another buffer is selected."
|
|
|
|
|
(unless (minibufferp)
|
|
|
|
|
(abort-recursive-edit)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-setup ()
|
|
|
|
|
"Initialize Ex minibuffer.
|
|
|
|
|
This function registers several hooks that are used for the
|
|
|
|
|
interactive actions during ex state."
|
|
|
|
|
(add-hook 'post-command-hook #'evil-ex-abort)
|
|
|
|
|
(add-hook 'after-change-functions #'evil-ex-update nil t)
|
2018-10-02 15:54:39 +02:00
|
|
|
(add-hook 'minibuffer-exit-hook #'evil-ex-teardown nil t)
|
2018-09-10 20:51:14 +02:00
|
|
|
(when evil-ex-previous-command
|
|
|
|
|
(add-hook 'pre-command-hook #'evil-ex-remove-default))
|
|
|
|
|
(remove-hook 'minibuffer-setup-hook #'evil-ex-setup)
|
|
|
|
|
(with-no-warnings
|
|
|
|
|
(make-variable-buffer-local 'completion-at-point-functions))
|
|
|
|
|
(setq completion-at-point-functions
|
|
|
|
|
'(evil-ex-command-completion-at-point
|
|
|
|
|
evil-ex-argument-completion-at-point)))
|
|
|
|
|
(put 'evil-ex-setup 'permanent-local-hook t)
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-setup-and-update ()
|
|
|
|
|
"Initialize Ex minibuffer with `evil-ex-setup', then call `evil-ex-update'."
|
|
|
|
|
(evil-ex-setup)
|
|
|
|
|
(evil-ex-update))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-teardown ()
|
|
|
|
|
"Deinitialize Ex minibuffer.
|
|
|
|
|
Clean up everything set up by `evil-ex-setup'."
|
|
|
|
|
(remove-hook 'post-command-hook #'evil-ex-abort)
|
2018-10-02 15:54:39 +02:00
|
|
|
(remove-hook 'minibuffer-exit-hook #'evil-ex-teardown t)
|
2018-09-10 20:51:14 +02:00
|
|
|
(remove-hook 'after-change-functions #'evil-ex-update t)
|
|
|
|
|
(when evil-ex-argument-handler
|
|
|
|
|
(let ((runner (evil-ex-argument-handler-runner
|
|
|
|
|
evil-ex-argument-handler)))
|
|
|
|
|
(when runner
|
|
|
|
|
(funcall runner 'stop)))))
|
|
|
|
|
(put 'evil-ex-teardown 'permanent-local-hook t)
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-remove-default ()
|
|
|
|
|
"Remove the default text shown in the ex minibuffer.
|
|
|
|
|
When ex starts, the previous command is shown enclosed in
|
|
|
|
|
parenthesis. This function removes this text when the first key
|
|
|
|
|
is pressed."
|
|
|
|
|
(when (and (not (eq this-command 'exit-minibuffer))
|
|
|
|
|
(/= (minibuffer-prompt-end) (point-max)))
|
|
|
|
|
(if (eq this-command 'evil-ex-delete-backward-char)
|
|
|
|
|
(setq this-command 'ignore))
|
|
|
|
|
(delete-minibuffer-contents))
|
|
|
|
|
(remove-hook 'pre-command-hook #'evil-ex-remove-default))
|
|
|
|
|
(put 'evil-ex-remove-default 'permanent-local-hook t)
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-update (&optional beg end len string)
|
|
|
|
|
"Update Ex variables when the minibuffer changes.
|
|
|
|
|
This function is usually called from `after-change-functions'
|
|
|
|
|
hook. If BEG is non-nil (which is the case when called from
|
|
|
|
|
`after-change-functions'), then an error description is shown
|
|
|
|
|
in case of incomplete or unknown commands."
|
|
|
|
|
(let* ((prompt (minibuffer-prompt-end))
|
|
|
|
|
(string (or string (buffer-substring prompt (point-max))))
|
|
|
|
|
arg bang cmd count expr func handler range tree type)
|
|
|
|
|
(cond
|
|
|
|
|
((and (eq this-command #'self-insert-command)
|
|
|
|
|
(commandp (setq cmd (lookup-key evil-ex-map string))))
|
|
|
|
|
(setq evil-ex-expression `(call-interactively #',cmd))
|
|
|
|
|
(when (minibufferp)
|
|
|
|
|
(exit-minibuffer)))
|
|
|
|
|
(t
|
|
|
|
|
(setq cmd nil)
|
|
|
|
|
;; store the buffer position of each character
|
|
|
|
|
;; as the `ex-index' text property
|
|
|
|
|
(dotimes (i (length string))
|
|
|
|
|
(add-text-properties
|
|
|
|
|
i (1+ i) (list 'ex-index (+ i prompt)) string))
|
|
|
|
|
(with-current-buffer evil-ex-current-buffer
|
|
|
|
|
(setq tree (evil-ex-parse string t)
|
|
|
|
|
expr (evil-ex-parse string))
|
|
|
|
|
(when (eq (car-safe expr) 'evil-ex-call-command)
|
|
|
|
|
(setq count (eval (nth 1 expr))
|
|
|
|
|
cmd (eval (nth 2 expr))
|
|
|
|
|
arg (eval (nth 3 expr))
|
|
|
|
|
range (cond
|
|
|
|
|
((evil-range-p count)
|
|
|
|
|
count)
|
|
|
|
|
((numberp count)
|
|
|
|
|
(evil-ex-range count count)))
|
|
|
|
|
bang (and (save-match-data (string-match ".!$" cmd)) t))))
|
|
|
|
|
(setq evil-ex-tree tree
|
|
|
|
|
evil-ex-expression expr
|
|
|
|
|
evil-ex-range range
|
|
|
|
|
evil-ex-cmd cmd
|
|
|
|
|
evil-ex-bang bang
|
|
|
|
|
evil-ex-argument arg)
|
|
|
|
|
;; test the current command
|
|
|
|
|
(when (and cmd (minibufferp))
|
|
|
|
|
(setq func (evil-ex-completed-binding cmd t))
|
|
|
|
|
(cond
|
|
|
|
|
;; update argument-handler
|
|
|
|
|
(func
|
|
|
|
|
(when (setq type (evil-get-command-property
|
|
|
|
|
func :ex-arg))
|
|
|
|
|
(setq handler (cdr-safe
|
|
|
|
|
(assoc type
|
|
|
|
|
evil-ex-argument-types))))
|
|
|
|
|
(unless (eq handler evil-ex-argument-handler)
|
|
|
|
|
(let ((runner (and evil-ex-argument-handler
|
|
|
|
|
(evil-ex-argument-handler-runner
|
|
|
|
|
evil-ex-argument-handler))))
|
|
|
|
|
(when runner (funcall runner 'stop)))
|
|
|
|
|
(setq evil-ex-argument-handler handler)
|
|
|
|
|
(let ((runner (and evil-ex-argument-handler
|
|
|
|
|
(evil-ex-argument-handler-runner
|
|
|
|
|
evil-ex-argument-handler))))
|
|
|
|
|
(when runner (funcall runner 'start evil-ex-argument))))
|
|
|
|
|
(let ((runner (and evil-ex-argument-handler
|
|
|
|
|
(evil-ex-argument-handler-runner
|
|
|
|
|
evil-ex-argument-handler))))
|
|
|
|
|
(when runner (funcall runner 'update evil-ex-argument))))
|
|
|
|
|
(beg
|
|
|
|
|
;; show error message only when called from `after-change-functions'
|
|
|
|
|
(let ((n (length (all-completions cmd (evil-ex-completion-table)))))
|
|
|
|
|
(cond
|
|
|
|
|
((> n 1) (evil-ex-echo "Incomplete command"))
|
|
|
|
|
((= n 0) (evil-ex-echo "Unknown command")))))))))))
|
|
|
|
|
(put 'evil-ex-update 'permanent-local-hook t)
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-echo (string &rest args)
|
|
|
|
|
"Display a message after the current Ex command."
|
|
|
|
|
(with-selected-window (minibuffer-window)
|
|
|
|
|
(with-current-buffer (window-buffer (minibuffer-window))
|
|
|
|
|
(unless (or evil-no-display
|
|
|
|
|
(zerop (length string)))
|
|
|
|
|
(let ((string (format " [%s]" (apply #'format string args)))
|
|
|
|
|
(ov (or evil-ex-echo-overlay
|
|
|
|
|
(setq evil-ex-echo-overlay (make-overlay (point-min) (point-max) nil t t))))
|
|
|
|
|
after-change-functions before-change-functions)
|
|
|
|
|
(put-text-property 0 (length string) 'face 'evil-ex-info string)
|
|
|
|
|
;; The following 'trick' causes point to be shown before the
|
|
|
|
|
;; message instead behind. It is shamelessly stolen from the
|
|
|
|
|
;; implementation of `minibuffer-message`.
|
|
|
|
|
(put-text-property 0 1 'cursor t string)
|
|
|
|
|
(move-overlay ov (point-max) (point-max))
|
|
|
|
|
(overlay-put ov 'after-string string)
|
|
|
|
|
(add-hook 'pre-command-hook #'evil--ex-remove-echo-overlay nil t))))))
|
|
|
|
|
|
|
|
|
|
(defun evil--ex-remove-echo-overlay ()
|
|
|
|
|
"Remove echo overlay from ex minibuffer."
|
|
|
|
|
(when evil-ex-echo-overlay
|
|
|
|
|
(delete-overlay evil-ex-echo-overlay)
|
|
|
|
|
(setq evil-ex-echo-overlay nil))
|
|
|
|
|
(remove-hook 'pre-command-hook 'evil--ex-remove-echo-overlay t))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-completion ()
|
|
|
|
|
"Completes the current ex command or argument."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let (after-change-functions)
|
|
|
|
|
(evil-ex-update)
|
|
|
|
|
(completion-at-point)
|
|
|
|
|
(remove-text-properties (minibuffer-prompt-end) (point-max) '(face nil evil))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-command-completion-at-point ()
|
|
|
|
|
(let ((context (evil-ex-syntactic-context (1- (point)))))
|
|
|
|
|
(when (memq 'command context)
|
|
|
|
|
(let ((beg (or (get-text-property 0 'ex-index evil-ex-cmd)
|
|
|
|
|
(point)))
|
|
|
|
|
(end (1+ (or (get-text-property (1- (length evil-ex-cmd))
|
|
|
|
|
'ex-index
|
|
|
|
|
evil-ex-cmd)
|
|
|
|
|
(1- (point))))))
|
|
|
|
|
(list beg end (evil-ex-completion-table))))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-completion-table ()
|
|
|
|
|
(cond
|
|
|
|
|
((eq evil-ex-complete-emacs-commands nil)
|
|
|
|
|
#'evil-ex-command-collection)
|
|
|
|
|
((eq evil-ex-complete-emacs-commands 'in-turn)
|
|
|
|
|
(completion-table-in-turn
|
|
|
|
|
#'evil-ex-command-collection
|
|
|
|
|
#'(lambda (str pred flag)
|
|
|
|
|
(completion-table-with-predicate
|
|
|
|
|
obarray #'commandp t str pred flag))))
|
|
|
|
|
(t
|
|
|
|
|
#'(lambda (str pred flag)
|
|
|
|
|
(evil-completion-table-concat
|
|
|
|
|
#'evil-ex-command-collection
|
|
|
|
|
#'(lambda (str pred flag)
|
|
|
|
|
(completion-table-with-predicate
|
|
|
|
|
obarray #'commandp t str pred flag))
|
|
|
|
|
str pred flag)))))
|
|
|
|
|
|
|
|
|
|
(defun evil-completion-table-concat (table1 table2 string pred flag)
|
|
|
|
|
(cond
|
|
|
|
|
((eq flag nil)
|
|
|
|
|
(let ((result1 (try-completion string table1 pred))
|
|
|
|
|
(result2 (try-completion string table2 pred)))
|
|
|
|
|
(cond
|
|
|
|
|
((null result1) result2)
|
|
|
|
|
((null result2) result1)
|
|
|
|
|
((and (eq result1 t) (eq result2 t)) t)
|
|
|
|
|
(t result1))))
|
|
|
|
|
((eq flag t)
|
|
|
|
|
(delete-dups
|
|
|
|
|
(append (all-completions string table1 pred)
|
|
|
|
|
(all-completions string table2 pred))))
|
|
|
|
|
((eq flag 'lambda)
|
|
|
|
|
(and (or (eq t (test-completion string table1 pred))
|
|
|
|
|
(eq t (test-completion string table2 pred)))
|
|
|
|
|
t))
|
|
|
|
|
((eq (car-safe flag) 'boundaries)
|
|
|
|
|
(or (completion-boundaries string table1 pred (cdr flag))
|
|
|
|
|
(completion-boundaries string table2 pred (cdr flag))))
|
|
|
|
|
((eq flag 'metadata)
|
|
|
|
|
'(metadata (display-sort-function . evil-ex-sort-completions)))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-sort-completions (completions)
|
|
|
|
|
(sort completions
|
|
|
|
|
#'(lambda (str1 str2)
|
|
|
|
|
(let ((p1 (eq 'evil-ex-commands (get-text-property 0 'face str1)))
|
|
|
|
|
(p2 (eq 'evil-ex-commands (get-text-property 0 'face str2))))
|
|
|
|
|
(if (equal p1 p2)
|
|
|
|
|
(string< str1 str2)
|
|
|
|
|
p1)))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-command-collection (cmd predicate flag)
|
|
|
|
|
"Called to complete a command."
|
|
|
|
|
(let (commands)
|
|
|
|
|
;; append ! to all commands that may take a bang argument
|
|
|
|
|
(dolist (cmd (mapcar #'car evil-ex-commands))
|
|
|
|
|
(push cmd commands)
|
|
|
|
|
(if (evil-ex-command-force-p cmd)
|
|
|
|
|
(push (concat cmd "!") commands)))
|
|
|
|
|
(when (eq evil-ex-complete-emacs-commands t)
|
|
|
|
|
(setq commands
|
|
|
|
|
(mapcar #'(lambda (str) (propertize str 'face 'evil-ex-commands))
|
|
|
|
|
commands)))
|
|
|
|
|
(cond
|
|
|
|
|
((eq flag nil) (try-completion cmd commands predicate))
|
|
|
|
|
((eq flag t) (all-completions cmd commands predicate))
|
|
|
|
|
((eq flag 'lambda) (test-completion cmd commands))
|
|
|
|
|
((eq (car-safe flag) 'boundaries)
|
|
|
|
|
`(boundaries 0 . ,(length (cdr flag)))))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-argument-completion-at-point ()
|
|
|
|
|
(let ((context (evil-ex-syntactic-context (1- (point)))))
|
|
|
|
|
(when (memq 'argument context)
|
|
|
|
|
;; if it's an autoload, load the function; this allows external
|
|
|
|
|
;; packages to register autoloaded ex commands which will be
|
|
|
|
|
;; loaded when ex argument completion is triggered
|
|
|
|
|
(let ((binding-definition (symbol-function (evil-ex-binding evil-ex-cmd))))
|
|
|
|
|
(when (autoloadp binding-definition)
|
|
|
|
|
(autoload-do-load binding-definition)))
|
|
|
|
|
|
|
|
|
|
(let* ((beg (or (and evil-ex-argument
|
|
|
|
|
(get-text-property 0 'ex-index evil-ex-argument))
|
|
|
|
|
(point)))
|
|
|
|
|
(end (1+ (or (and evil-ex-argument
|
|
|
|
|
(get-text-property (1- (length evil-ex-argument))
|
|
|
|
|
'ex-index
|
|
|
|
|
evil-ex-argument))
|
|
|
|
|
(1- (point)))))
|
|
|
|
|
(binding (evil-ex-completed-binding evil-ex-cmd))
|
|
|
|
|
(arg-type (evil-get-command-property binding :ex-arg))
|
|
|
|
|
(arg-handler (assoc arg-type evil-ex-argument-types))
|
|
|
|
|
(completer (and arg-handler
|
|
|
|
|
(evil-ex-argument-handler-completer
|
|
|
|
|
(cdr arg-handler)))))
|
|
|
|
|
(when completer
|
|
|
|
|
(if (eq (car completer) 'collection)
|
|
|
|
|
(list beg end (cdr completer))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region beg (point-max))
|
|
|
|
|
(funcall (cdr completer)))))))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-define-cmd (cmd function)
|
|
|
|
|
"Binds the function FUNCTION to the command CMD."
|
|
|
|
|
(save-match-data
|
|
|
|
|
(if (string-match "^[^][]*\\(\\[\\(.*\\)\\]\\)[^][]*$" cmd)
|
|
|
|
|
(let ((abbrev (replace-match "" nil t cmd 1))
|
|
|
|
|
(full (replace-match "\\2" nil nil cmd 1)))
|
|
|
|
|
(evil-add-to-alist 'evil-ex-commands full function)
|
|
|
|
|
(evil-add-to-alist 'evil-ex-commands abbrev full))
|
|
|
|
|
(evil-add-to-alist 'evil-ex-commands cmd function))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-make-argument-handler (runner completer)
|
|
|
|
|
(list runner completer))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-argument-handler-runner (arg-handler)
|
|
|
|
|
(car arg-handler))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-argument-handler-completer (arg-handler)
|
|
|
|
|
(cadr arg-handler))
|
|
|
|
|
|
|
|
|
|
(defmacro evil-ex-define-argument-type (arg-type doc &rest body)
|
|
|
|
|
"Defines a new handler for argument-type ARG-TYPE.
|
|
|
|
|
DOC is the documentation string. It is followed by a list of
|
|
|
|
|
keywords and function:
|
|
|
|
|
|
|
|
|
|
:collection COLLECTION
|
|
|
|
|
|
|
|
|
|
A collection for completion as required by `all-completions'.
|
|
|
|
|
|
|
|
|
|
:completion-at-point FUNC
|
|
|
|
|
|
|
|
|
|
Function to be called to initialize a potential
|
|
|
|
|
completion. FUNC must match the requirements as described for
|
|
|
|
|
the variable `completion-at-point-functions'. When FUNC is
|
|
|
|
|
called the minibuffer content is narrowed to exactly match the
|
|
|
|
|
argument.
|
|
|
|
|
|
|
|
|
|
:runner FUNC
|
|
|
|
|
|
|
|
|
|
Function to be called when the type of the current argument
|
|
|
|
|
changes or when the content of this argument changes. This
|
|
|
|
|
function should take one obligatory argument FLAG followed by
|
|
|
|
|
an optional argument ARG. FLAG is one of three symbol 'start,
|
|
|
|
|
'stop or 'update. When the argument type is recognized for the
|
|
|
|
|
first time and this handler is started the FLAG is 'start. If
|
|
|
|
|
the argument type changes to something else or ex state
|
|
|
|
|
finished the handler FLAG is 'stop. If the content of the
|
|
|
|
|
argument has changed FLAG is 'update. If FLAG is either 'start
|
|
|
|
|
or 'update then ARG is the current value of this argument. If
|
|
|
|
|
FLAG is 'stop then arg is nil."
|
|
|
|
|
(declare (indent defun)
|
|
|
|
|
(debug (&define name
|
|
|
|
|
[&optional stringp]
|
|
|
|
|
[&rest [keywordp function-form]])))
|
|
|
|
|
(unless (stringp doc) (push doc body))
|
|
|
|
|
(let (runner completer)
|
|
|
|
|
(while (keywordp (car-safe body))
|
|
|
|
|
(let ((key (pop body))
|
|
|
|
|
(func (pop body)))
|
|
|
|
|
(cond
|
|
|
|
|
((eq key :runner)
|
|
|
|
|
(setq runner func))
|
|
|
|
|
((eq key :collection)
|
|
|
|
|
(setq completer (cons 'collection func)))
|
|
|
|
|
((eq key :completion-at-point)
|
|
|
|
|
(setq completer (cons 'completion-at-point func))))))
|
|
|
|
|
`(eval-and-compile
|
|
|
|
|
(evil-add-to-alist
|
|
|
|
|
'evil-ex-argument-types
|
|
|
|
|
',arg-type
|
|
|
|
|
'(,runner ,completer)))))
|
|
|
|
|
|
|
|
|
|
(evil-ex-define-argument-type file
|
|
|
|
|
"Handles a file argument."
|
|
|
|
|
:collection read-file-name-internal)
|
|
|
|
|
|
|
|
|
|
(evil-ex-define-argument-type buffer
|
|
|
|
|
"Called to complete a buffer name argument."
|
|
|
|
|
:collection internal-complete-buffer)
|
|
|
|
|
|
|
|
|
|
(declare-function shell-completion-vars "shell" ())
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-init-shell-argument-completion (flag &optional arg)
|
|
|
|
|
"Prepares the current minibuffer for completion of shell commands.
|
|
|
|
|
This function must be called from the :runner function of some
|
|
|
|
|
argument handler that requires shell completion."
|
|
|
|
|
(when (and (eq flag 'start)
|
|
|
|
|
(not evil-ex-shell-argument-initialized))
|
|
|
|
|
(set (make-local-variable 'evil-ex-shell-argument-initialized) t)
|
|
|
|
|
(cond
|
|
|
|
|
;; Emacs 24
|
|
|
|
|
((fboundp 'comint-completion-at-point)
|
|
|
|
|
(shell-completion-vars))
|
|
|
|
|
(t
|
|
|
|
|
(set (make-local-variable 'minibuffer-default-add-function)
|
|
|
|
|
'minibuffer-default-add-shell-commands)))
|
|
|
|
|
(setq completion-at-point-functions
|
|
|
|
|
'(evil-ex-command-completion-at-point
|
|
|
|
|
evil-ex-argument-completion-at-point))))
|
|
|
|
|
|
|
|
|
|
(define-obsolete-function-alias
|
|
|
|
|
'evil-ex-shell-command-completion-at-point
|
|
|
|
|
'comint-completion-at-point)
|
|
|
|
|
|
|
|
|
|
(evil-ex-define-argument-type shell
|
|
|
|
|
"Shell argument type, supports completion."
|
|
|
|
|
:completion-at-point comint-completion-at-point
|
|
|
|
|
:runner evil-ex-init-shell-argument-completion)
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-file-or-shell-command-completion-at-point ()
|
|
|
|
|
(if (and (< (point-min) (point-max))
|
|
|
|
|
(= (char-after (point-min)) ?!))
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region (1+ (point-min)) (point-max))
|
|
|
|
|
(comint-completion-at-point))
|
|
|
|
|
(list (point-min) (point-max) #'read-file-name-internal)))
|
|
|
|
|
|
|
|
|
|
(evil-ex-define-argument-type file-or-shell
|
|
|
|
|
"File or shell argument type.
|
|
|
|
|
If the current argument starts with a ! the rest of the argument
|
|
|
|
|
is considered a shell command, otherwise a file-name. Completion
|
|
|
|
|
works accordingly."
|
|
|
|
|
:completion-at-point evil-ex-file-or-shell-command-completion-at-point
|
|
|
|
|
:runner evil-ex-init-shell-argument-completion)
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-binding (command &optional noerror)
|
|
|
|
|
"Returns the final binding of COMMAND."
|
|
|
|
|
(save-match-data
|
|
|
|
|
(let ((binding command))
|
|
|
|
|
(when binding
|
|
|
|
|
(string-match "^\\(.+?\\)\\!?$" binding)
|
|
|
|
|
(setq binding (match-string 1 binding))
|
|
|
|
|
(while (progn
|
|
|
|
|
(setq binding (cdr (assoc binding evil-ex-commands)))
|
|
|
|
|
(stringp binding)))
|
|
|
|
|
(unless binding
|
|
|
|
|
(setq binding (intern command)))
|
|
|
|
|
(if (commandp binding)
|
|
|
|
|
;; check for remaps
|
|
|
|
|
(or (command-remapping binding) binding)
|
|
|
|
|
(unless noerror
|
|
|
|
|
(user-error "Unknown command: `%s'" command)))))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-completed-binding (command &optional noerror)
|
|
|
|
|
"Returns the final binding of the completion of COMMAND."
|
|
|
|
|
(let ((completion (try-completion command evil-ex-commands)))
|
|
|
|
|
(evil-ex-binding (if (eq completion t) command
|
|
|
|
|
(or completion command))
|
|
|
|
|
noerror)))
|
|
|
|
|
|
|
|
|
|
;;; TODO: extensions likes :p :~ <cfile> ...
|
|
|
|
|
(defun evil-ex-replace-special-filenames (file-name)
|
|
|
|
|
"Replace special symbols in FILE-NAME.
|
|
|
|
|
Replaces % by the current file-name,
|
|
|
|
|
Replaces # by the alternate file-name in FILE-NAME."
|
2018-10-02 15:54:39 +02:00
|
|
|
(let ((remote (file-remote-p file-name))
|
|
|
|
|
(current-fname (buffer-file-name))
|
2018-09-10 20:51:14 +02:00
|
|
|
(alternate-fname (and (other-buffer)
|
|
|
|
|
(buffer-file-name (other-buffer)))))
|
2018-10-02 15:54:39 +02:00
|
|
|
(setq file-name (or (file-remote-p file-name 'localname) file-name))
|
2018-09-10 20:51:14 +02:00
|
|
|
(when current-fname
|
2018-10-02 15:54:39 +02:00
|
|
|
(setq current-fname (or (file-remote-p current-fname 'localname)
|
|
|
|
|
current-fname))
|
2018-09-10 20:51:14 +02:00
|
|
|
(setq file-name
|
|
|
|
|
(replace-regexp-in-string "\\(^\\|[^\\\\]\\)\\(%\\)"
|
|
|
|
|
current-fname file-name
|
|
|
|
|
t t 2)))
|
|
|
|
|
(when alternate-fname
|
2018-10-02 15:54:39 +02:00
|
|
|
(setq alternate-fname (or (file-remote-p alternate-fname 'localname)
|
|
|
|
|
alternate-fname))
|
2018-09-10 20:51:14 +02:00
|
|
|
(setq file-name
|
|
|
|
|
(replace-regexp-in-string "\\(^\\|[^\\\\]\\)\\(#\\)"
|
|
|
|
|
alternate-fname file-name
|
|
|
|
|
t t 2)))
|
|
|
|
|
(setq file-name
|
|
|
|
|
(replace-regexp-in-string "\\\\\\([#%]\\)"
|
2018-10-02 15:54:39 +02:00
|
|
|
"\\1" file-name t))
|
|
|
|
|
(setq file-name (concat remote file-name)))
|
2018-09-10 20:51:14 +02:00
|
|
|
file-name)
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-file-arg ()
|
|
|
|
|
"Returns the current Ex argument as a file name.
|
|
|
|
|
This function interprets special file names like # and %."
|
2018-10-02 15:54:39 +02:00
|
|
|
(unless (zerop (length evil-ex-argument))
|
2018-09-10 20:51:14 +02:00
|
|
|
(evil-ex-replace-special-filenames evil-ex-argument)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-repeat (count)
|
|
|
|
|
"Repeats the last ex command."
|
|
|
|
|
(interactive "P")
|
|
|
|
|
(when count
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(forward-line (1- count)))
|
|
|
|
|
(let ((evil-ex-current-buffer (current-buffer))
|
|
|
|
|
(hist evil-ex-history))
|
|
|
|
|
(while hist
|
|
|
|
|
(let ((evil-ex-last-cmd (pop hist)))
|
|
|
|
|
(when evil-ex-last-cmd
|
|
|
|
|
(evil-ex-update nil nil nil evil-ex-last-cmd)
|
|
|
|
|
(let ((binding (evil-ex-binding evil-ex-cmd)))
|
|
|
|
|
(unless (eq binding #'evil-ex-repeat)
|
|
|
|
|
(setq hist nil)
|
|
|
|
|
(if evil-ex-expression
|
|
|
|
|
(eval evil-ex-expression)
|
|
|
|
|
(user-error "Ex: syntax error")))))))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-call-command (range command argument)
|
|
|
|
|
"Execute the given command COMMAND."
|
|
|
|
|
(let* ((count (when (numberp range) range))
|
|
|
|
|
(range (when (evil-range-p range) range))
|
|
|
|
|
(bang (and (save-match-data (string-match ".!$" command)) t))
|
|
|
|
|
(evil-ex-point (point))
|
|
|
|
|
(evil-ex-range
|
|
|
|
|
(or range (and count (evil-ex-range count count))))
|
|
|
|
|
(evil-ex-command (evil-ex-completed-binding command))
|
|
|
|
|
(evil-ex-bang (and bang t))
|
|
|
|
|
(evil-ex-argument (copy-sequence argument))
|
|
|
|
|
(evil-this-type (evil-type evil-ex-range))
|
|
|
|
|
(current-prefix-arg count)
|
|
|
|
|
(prefix-arg current-prefix-arg))
|
|
|
|
|
(when (stringp evil-ex-argument)
|
|
|
|
|
(set-text-properties
|
|
|
|
|
0 (length evil-ex-argument) nil evil-ex-argument))
|
|
|
|
|
(let ((buf (current-buffer)))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(cond
|
|
|
|
|
((not evil-ex-range)
|
|
|
|
|
(setq this-command evil-ex-command)
|
|
|
|
|
(run-hooks 'pre-command-hook)
|
|
|
|
|
(call-interactively evil-ex-command)
|
|
|
|
|
(run-hooks 'post-command-hook))
|
|
|
|
|
(t
|
|
|
|
|
;; set visual selection to match the region if an explicit
|
|
|
|
|
;; range has been specified
|
|
|
|
|
(let ((ex-range (evil-copy-range evil-ex-range))
|
|
|
|
|
beg end)
|
|
|
|
|
(evil-expand-range ex-range)
|
|
|
|
|
(setq beg (evil-range-beginning ex-range)
|
|
|
|
|
end (evil-range-end ex-range))
|
|
|
|
|
(evil-sort beg end)
|
|
|
|
|
(setq this-command evil-ex-command)
|
|
|
|
|
(run-hooks 'pre-command-hook)
|
|
|
|
|
(set-mark end)
|
|
|
|
|
(goto-char beg)
|
|
|
|
|
(activate-mark)
|
|
|
|
|
(call-interactively evil-ex-command)
|
|
|
|
|
(run-hooks 'post-command-hook))))
|
|
|
|
|
(when (buffer-live-p buf)
|
|
|
|
|
(with-current-buffer buf
|
|
|
|
|
(deactivate-mark)))))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-line (base &optional offset)
|
|
|
|
|
"Return the line number of BASE plus OFFSET."
|
|
|
|
|
(+ (or base (line-number-at-pos))
|
|
|
|
|
(or offset 0)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-first-line ()
|
|
|
|
|
"Return the line number of the first line."
|
|
|
|
|
(line-number-at-pos (point-min)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-current-line ()
|
|
|
|
|
"Return the line number of the current line."
|
|
|
|
|
(line-number-at-pos (point)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-last-line ()
|
|
|
|
|
"Return the line number of the last line."
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(when (bolp)
|
|
|
|
|
(forward-line -1))
|
|
|
|
|
(line-number-at-pos)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-range (beg-line &optional end-line)
|
|
|
|
|
"Returns the first and last position of the current range."
|
|
|
|
|
(evil-range
|
|
|
|
|
(evil-line-position beg-line)
|
|
|
|
|
(evil-line-position (or end-line beg-line) -1)
|
|
|
|
|
'line
|
|
|
|
|
:expanded t))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-full-range ()
|
|
|
|
|
"Return a range encompassing the whole buffer."
|
|
|
|
|
(evil-range (point-min) (point-max) 'line))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-marker (marker)
|
|
|
|
|
"Return MARKER's line number in the current buffer.
|
|
|
|
|
Signal an error if MARKER is in a different buffer."
|
|
|
|
|
(when (stringp marker)
|
|
|
|
|
(setq marker (aref marker 0)))
|
|
|
|
|
(setq marker (evil-get-marker marker))
|
|
|
|
|
(if (numberp marker)
|
|
|
|
|
(line-number-at-pos marker)
|
|
|
|
|
(user-error "Ex does not support markers in other files")))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-char-marker-range (beg end)
|
|
|
|
|
(when (stringp beg) (setq beg (aref beg 0)))
|
|
|
|
|
(when (stringp end) (setq end (aref end 0)))
|
|
|
|
|
(setq beg (evil-get-marker beg)
|
|
|
|
|
end (evil-get-marker end))
|
|
|
|
|
(if (and (numberp beg) (numberp end))
|
|
|
|
|
(evil-expand-range
|
|
|
|
|
(evil-range beg end
|
|
|
|
|
(if (evil-visual-state-p)
|
|
|
|
|
(evil-visual-type)
|
|
|
|
|
'inclusive)))
|
|
|
|
|
(user-error "Ex does not support markers in other files")))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-re-fwd (pattern)
|
|
|
|
|
"Search forward for PATTERN.
|
|
|
|
|
Returns the line number of the match."
|
|
|
|
|
(condition-case err
|
|
|
|
|
(save-match-data
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-text-properties 0 (length pattern) nil pattern)
|
|
|
|
|
(evil-move-end-of-line)
|
|
|
|
|
(and (re-search-forward pattern nil t)
|
|
|
|
|
(line-number-at-pos (1- (match-end 0))))))
|
|
|
|
|
(invalid-regexp
|
|
|
|
|
(evil-ex-echo (cadr err))
|
|
|
|
|
nil)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-re-bwd (pattern)
|
|
|
|
|
"Search backward for PATTERN.
|
|
|
|
|
Returns the line number of the match."
|
|
|
|
|
(condition-case err
|
|
|
|
|
(save-match-data
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-text-properties 0 (length pattern) nil pattern)
|
|
|
|
|
(evil-move-beginning-of-line)
|
|
|
|
|
(and (re-search-backward pattern nil t)
|
|
|
|
|
(line-number-at-pos (match-beginning 0)))))
|
|
|
|
|
(invalid-regexp
|
|
|
|
|
(evil-ex-echo (cadr err))
|
|
|
|
|
nil)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-prev-search ()
|
|
|
|
|
(error "Previous search not yet implemented"))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-signed-number (sign &optional number)
|
|
|
|
|
"Return a signed number like -3 and +1.
|
|
|
|
|
NUMBER defaults to 1."
|
|
|
|
|
(funcall sign (or number 1)))
|
|
|
|
|
|
|
|
|
|
;; function `evil-ex-eval' has been superseded by `evil-ex-parse' plus `eval'
|
|
|
|
|
(make-obsolete 'evil-ex-eval 'evil-ex-parse "1.2.14")
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-parse (string &optional syntax start)
|
|
|
|
|
"Parse STRING as an Ex expression and return an evaluation tree.
|
|
|
|
|
If SYNTAX is non-nil, return a syntax tree instead.
|
|
|
|
|
START is the start symbol, which defaults to `expression'."
|
|
|
|
|
(let* ((start (or start (car-safe (car-safe evil-ex-grammar))))
|
|
|
|
|
(match (evil-parser
|
|
|
|
|
string start evil-ex-grammar t syntax)))
|
|
|
|
|
(car-safe match)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-parse-command (string)
|
|
|
|
|
"Parse STRING as an Ex binding."
|
|
|
|
|
(let ((result (evil-parser string 'binding evil-ex-grammar))
|
|
|
|
|
bang command)
|
|
|
|
|
(when result
|
|
|
|
|
(setq command (car-safe result)
|
|
|
|
|
string (cdr-safe result))
|
|
|
|
|
;; check whether the parsed command is followed by a slash or
|
|
|
|
|
;; number and the part before it is not a known ex binding
|
|
|
|
|
(when (and (> (length string) 0)
|
|
|
|
|
(string-match-p "^[/[:digit:]]" string)
|
|
|
|
|
(not (evil-ex-binding command t)))
|
|
|
|
|
;; if this is the case, assume the slash or number and all
|
|
|
|
|
;; following symbol characters form an (Emacs-)command
|
|
|
|
|
(setq result (evil-parser (concat command string)
|
|
|
|
|
'emacs-binding
|
|
|
|
|
evil-ex-grammar)
|
|
|
|
|
command (car-safe result)
|
|
|
|
|
string (cdr-safe result)))
|
|
|
|
|
;; parse a following "!" as bang only if
|
|
|
|
|
;; the command has the property :ex-bang t
|
|
|
|
|
(when (evil-ex-command-force-p command)
|
|
|
|
|
(setq result (evil-parser string 'bang evil-ex-grammar)
|
|
|
|
|
bang (or (car-safe result) "")
|
|
|
|
|
string (cdr-safe result)
|
|
|
|
|
command (concat command bang)))
|
|
|
|
|
(cons command string))))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-command-force-p (command)
|
|
|
|
|
"Whether COMMAND accepts the bang argument."
|
|
|
|
|
(let ((binding (evil-ex-completed-binding command t)))
|
|
|
|
|
(when binding
|
|
|
|
|
(evil-get-command-property binding :ex-bang))))
|
|
|
|
|
|
|
|
|
|
(defun evil-flatten-syntax-tree (tree)
|
|
|
|
|
"Find all paths from the root of TREE to its leaves.
|
|
|
|
|
TREE is a syntax tree, i.e., all its leave nodes are strings.
|
|
|
|
|
The `nth' element in the result is the syntactic context
|
|
|
|
|
for the corresponding string index (counted from zero)."
|
|
|
|
|
(let* ((result nil)
|
|
|
|
|
(traverse nil)
|
|
|
|
|
(traverse
|
|
|
|
|
#'(lambda (tree path)
|
|
|
|
|
(if (stringp tree)
|
|
|
|
|
(dotimes (char (length tree))
|
|
|
|
|
(push path result))
|
|
|
|
|
(let ((path (cons (car tree) path)))
|
|
|
|
|
(dolist (subtree (cdr tree))
|
|
|
|
|
(funcall traverse subtree path)))))))
|
|
|
|
|
(funcall traverse tree nil)
|
|
|
|
|
(nreverse result)))
|
|
|
|
|
|
|
|
|
|
(defun evil-ex-syntactic-context (&optional pos)
|
|
|
|
|
"Return the syntactical context of the character at POS.
|
|
|
|
|
POS defaults to the current position of point."
|
|
|
|
|
(let* ((contexts (evil-flatten-syntax-tree evil-ex-tree))
|
|
|
|
|
(length (length contexts))
|
|
|
|
|
(pos (- (or pos (point)) (minibuffer-prompt-end))))
|
|
|
|
|
(when (>= pos length)
|
|
|
|
|
(setq pos (1- length)))
|
|
|
|
|
(when (< pos 0)
|
|
|
|
|
(setq pos 0))
|
|
|
|
|
(when contexts
|
|
|
|
|
(nth pos contexts))))
|
|
|
|
|
|
|
|
|
|
(defun evil-parser (string symbol grammar &optional greedy syntax)
|
|
|
|
|
"Parse STRING as a SYMBOL in GRAMMAR.
|
|
|
|
|
If GREEDY is non-nil, the whole of STRING must match.
|
|
|
|
|
If the parse succeeds, the return value is a cons cell
|
|
|
|
|
\(RESULT . TAIL), where RESULT is a parse tree and TAIL is
|
|
|
|
|
the remainder of STRING. Otherwise, the return value is nil.
|
|
|
|
|
|
|
|
|
|
GRAMMAR is an association list of symbols and their definitions.
|
|
|
|
|
A definition is either a list of production rules, which are
|
|
|
|
|
tried in succession, or a #'-quoted function, which is called
|
|
|
|
|
to parse the input.
|
|
|
|
|
|
|
|
|
|
A production rule can be one of the following:
|
|
|
|
|
|
|
|
|
|
nil matches the empty string.
|
|
|
|
|
A regular expression matches a substring.
|
|
|
|
|
A symbol matches a production for that symbol.
|
|
|
|
|
(X Y) matches X followed by Y.
|
|
|
|
|
(\\? X) matches zero or one of X.
|
|
|
|
|
(* X) matches zero or more of X.
|
|
|
|
|
(+ X) matches one or more of X.
|
|
|
|
|
(& X) matches X, but does not consume.
|
|
|
|
|
(! X) matches anything but X, but does not consume.
|
|
|
|
|
|
|
|
|
|
Thus, a simple grammar may look like:
|
|
|
|
|
|
|
|
|
|
((plus \"\\\\+\") ; plus <- \"+\"
|
|
|
|
|
(minus \"-\") ; minus <- \"-\"
|
|
|
|
|
(operator plus minus)) ; operator <- plus / minus
|
|
|
|
|
|
|
|
|
|
All input-consuming rules have a value. A regular expression evaluates
|
|
|
|
|
to the text matched, while a list evaluates to a list of values.
|
|
|
|
|
The value of a list may be overridden with a semantic action, which is
|
|
|
|
|
specified with a #'-quoted expression at the end:
|
|
|
|
|
|
|
|
|
|
(X Y #'foo)
|
|
|
|
|
|
|
|
|
|
The value of this rule is the result of calling foo with the values
|
|
|
|
|
of X and Y as arguments. Alternatively, the function call may be
|
|
|
|
|
specified explicitly:
|
|
|
|
|
|
|
|
|
|
(X Y #'(foo $1 $2))
|
|
|
|
|
|
|
|
|
|
Here, $1 refers to X and $2 refers to Y. $0 refers to the whole list.
|
|
|
|
|
Dollar expressions can also be used directly:
|
|
|
|
|
|
|
|
|
|
(X Y #'$1)
|
|
|
|
|
|
|
|
|
|
This matches X followed by Y, but ignores the value of Y;
|
|
|
|
|
the value of the list is the same as the value of X.
|
|
|
|
|
|
|
|
|
|
If the SYNTAX argument is non-nil, then all semantic actions
|
|
|
|
|
are ignored, and a syntax tree is constructed instead. The
|
|
|
|
|
syntax tree obeys the property that all the leave nodes are
|
|
|
|
|
parts of the input string. Thus, by traversing the syntax tree,
|
|
|
|
|
one can determine how each character was parsed.
|
|
|
|
|
|
|
|
|
|
The following symbols have reserved meanings within a grammar:
|
|
|
|
|
`\\?', `*', `+', `&', `!', `function', `alt', `seq' and nil."
|
|
|
|
|
(let ((string (or string ""))
|
|
|
|
|
func pair result rules tail)
|
|
|
|
|
(cond
|
|
|
|
|
;; epsilon
|
|
|
|
|
((member symbol '("" nil))
|
|
|
|
|
(setq pair (cons (if syntax "" nil) string)))
|
|
|
|
|
;; token
|
|
|
|
|
((stringp symbol)
|
|
|
|
|
(save-match-data
|
|
|
|
|
(when (or (eq (string-match symbol string) 0)
|
|
|
|
|
;; ignore leading whitespace
|
|
|
|
|
(and (eq (string-match "^[ \f\t\n\r\v]+" string) 0)
|
|
|
|
|
(eq (match-end 0)
|
|
|
|
|
(string-match
|
|
|
|
|
symbol string (match-end 0)))))
|
|
|
|
|
(setq result (match-string 0 string)
|
|
|
|
|
tail (substring string (match-end 0))
|
|
|
|
|
pair (cons result tail))
|
|
|
|
|
(when (and syntax pair)
|
|
|
|
|
(setq result (substring string 0
|
|
|
|
|
(- (length string)
|
|
|
|
|
(length tail))))
|
|
|
|
|
(setcar pair result)))))
|
|
|
|
|
;; symbol
|
|
|
|
|
((symbolp symbol)
|
|
|
|
|
(let ((context symbol))
|
|
|
|
|
(setq rules (cdr-safe (assq symbol grammar)))
|
|
|
|
|
(setq pair (evil-parser string `(alt ,@rules)
|
|
|
|
|
grammar greedy syntax))
|
|
|
|
|
(when (and syntax pair)
|
|
|
|
|
(setq result (car pair))
|
|
|
|
|
(if (and (listp result) (sequencep (car result)))
|
|
|
|
|
(setq result `(,symbol ,@result))
|
|
|
|
|
(setq result `(,symbol ,result)))
|
|
|
|
|
(setcar pair result))))
|
|
|
|
|
;; function
|
|
|
|
|
((eq (car-safe symbol) 'function)
|
|
|
|
|
(setq symbol (cadr symbol)
|
|
|
|
|
pair (funcall symbol string))
|
|
|
|
|
(when (and syntax pair)
|
|
|
|
|
(setq tail (or (cdr pair) "")
|
|
|
|
|
result (substring string 0
|
|
|
|
|
(- (length string)
|
|
|
|
|
(length tail))))
|
|
|
|
|
(setcar pair result)))
|
|
|
|
|
;; list
|
|
|
|
|
((listp symbol)
|
|
|
|
|
(setq rules symbol
|
|
|
|
|
symbol (car-safe rules))
|
|
|
|
|
(if (memq symbol '(& ! \? * + alt seq))
|
|
|
|
|
(setq rules (cdr rules))
|
|
|
|
|
(setq symbol 'seq))
|
|
|
|
|
(when (and (memq symbol '(+ alt seq))
|
|
|
|
|
(> (length rules) 1))
|
|
|
|
|
(setq func (car (last rules)))
|
|
|
|
|
(if (eq (car-safe func) 'function)
|
|
|
|
|
(setq rules (delq func (copy-sequence rules))
|
|
|
|
|
func (cadr func))
|
|
|
|
|
(setq func nil)))
|
|
|
|
|
(cond
|
|
|
|
|
;; positive lookahead
|
|
|
|
|
((eq symbol '&)
|
|
|
|
|
(when (evil-parser string rules grammar greedy syntax)
|
|
|
|
|
(setq pair (evil-parser string nil grammar nil syntax))))
|
|
|
|
|
;; negative lookahead
|
|
|
|
|
((eq symbol '!)
|
|
|
|
|
(unless (evil-parser string rules grammar greedy syntax)
|
|
|
|
|
(setq pair (evil-parser string nil grammar nil syntax))))
|
|
|
|
|
;; zero or one
|
|
|
|
|
((eq symbol '\?)
|
|
|
|
|
(setq rules (if (> (length rules) 1)
|
|
|
|
|
`(alt ,rules nil)
|
|
|
|
|
`(alt ,@rules nil))
|
|
|
|
|
pair (evil-parser string rules grammar greedy syntax)))
|
|
|
|
|
;; zero or more
|
|
|
|
|
((eq symbol '*)
|
|
|
|
|
(setq rules `(alt (+ ,@rules) nil)
|
|
|
|
|
pair (evil-parser string rules grammar greedy syntax)))
|
|
|
|
|
;; one or more
|
|
|
|
|
((eq symbol '+)
|
|
|
|
|
(let (current results)
|
|
|
|
|
(catch 'done
|
|
|
|
|
(while (setq current (evil-parser
|
|
|
|
|
string rules grammar nil syntax))
|
|
|
|
|
(setq result (car-safe current)
|
|
|
|
|
tail (or (cdr-safe current) "")
|
|
|
|
|
results (append results (if syntax result
|
|
|
|
|
(cdr-safe result))))
|
|
|
|
|
;; stop if stuck
|
|
|
|
|
(if (equal string tail)
|
|
|
|
|
(throw 'done nil)
|
|
|
|
|
(setq string tail))))
|
|
|
|
|
(when results
|
|
|
|
|
(setq func (or func 'list)
|
|
|
|
|
pair (cons results tail)))))
|
|
|
|
|
;; alternatives
|
|
|
|
|
((eq symbol 'alt)
|
|
|
|
|
(catch 'done
|
|
|
|
|
(dolist (rule rules)
|
|
|
|
|
(when (setq pair (evil-parser
|
|
|
|
|
string rule grammar greedy syntax))
|
|
|
|
|
(throw 'done pair)))))
|
|
|
|
|
;; sequence
|
|
|
|
|
(t
|
|
|
|
|
(setq func (or func 'list))
|
|
|
|
|
(let ((last (car-safe (last rules)))
|
|
|
|
|
current results rule)
|
|
|
|
|
(catch 'done
|
|
|
|
|
(while rules
|
|
|
|
|
(setq rule (pop rules)
|
|
|
|
|
current (evil-parser string rule grammar
|
|
|
|
|
(when greedy
|
|
|
|
|
(null rules))
|
|
|
|
|
syntax))
|
|
|
|
|
(cond
|
|
|
|
|
((null current)
|
|
|
|
|
(setq results nil)
|
|
|
|
|
(throw 'done nil))
|
|
|
|
|
(t
|
|
|
|
|
(setq result (car-safe current)
|
|
|
|
|
tail (cdr-safe current))
|
|
|
|
|
(unless (memq (car-safe rule) '(& !))
|
|
|
|
|
(if (and syntax
|
|
|
|
|
(or (null result)
|
|
|
|
|
(and (listp result)
|
|
|
|
|
(listp rule)
|
|
|
|
|
;; splice in single-element
|
|
|
|
|
;; (\? ...) expressions
|
|
|
|
|
(not (and (eq (car-safe rule) '\?)
|
|
|
|
|
(eq (length rule) 2))))))
|
|
|
|
|
(setq results (append results result))
|
|
|
|
|
(setq results (append results (list result)))))
|
|
|
|
|
(setq string (or tail ""))))))
|
|
|
|
|
(when results
|
|
|
|
|
(setq pair (cons results tail))))))
|
|
|
|
|
;; semantic action
|
|
|
|
|
(when (and pair func (not syntax))
|
|
|
|
|
(setq result (car pair))
|
|
|
|
|
(let* ((dexp
|
|
|
|
|
#'(lambda (obj)
|
|
|
|
|
(when (symbolp obj)
|
|
|
|
|
(let ((str (symbol-name obj)))
|
|
|
|
|
(save-match-data
|
|
|
|
|
(when (string-match "\\$\\([0-9]+\\)" str)
|
|
|
|
|
(string-to-number (match-string 1 str))))))))
|
|
|
|
|
;; traverse a tree for dollar expressions
|
|
|
|
|
(dval nil)
|
|
|
|
|
(dval
|
|
|
|
|
#'(lambda (obj)
|
|
|
|
|
(if (listp obj)
|
|
|
|
|
(mapcar dval obj)
|
|
|
|
|
(let ((num (funcall dexp obj)))
|
|
|
|
|
(if num
|
|
|
|
|
(if (not (listp result))
|
|
|
|
|
result
|
|
|
|
|
(if (eq num 0)
|
|
|
|
|
`(list ,@result)
|
|
|
|
|
(nth (1- num) result)))
|
|
|
|
|
obj))))))
|
|
|
|
|
(cond
|
|
|
|
|
((null func)
|
|
|
|
|
(setq result nil))
|
|
|
|
|
;; lambda function
|
|
|
|
|
((eq (car-safe func) 'lambda)
|
|
|
|
|
(if (memq symbol '(+ seq))
|
|
|
|
|
(setq result `(funcall ,func ,@result))
|
|
|
|
|
(setq result `(funcall ,func ,result))))
|
|
|
|
|
;; string replacement
|
|
|
|
|
((or (stringp func) (stringp (car-safe func)))
|
|
|
|
|
(let* ((symbol (or (car-safe (cdr-safe func))
|
|
|
|
|
(and (boundp 'context) context)
|
|
|
|
|
(car-safe (car-safe grammar))))
|
|
|
|
|
(string (if (stringp func) func (car-safe func))))
|
|
|
|
|
(setq result (car-safe (evil-parser string symbol grammar
|
|
|
|
|
greedy syntax)))))
|
|
|
|
|
;; dollar expression
|
|
|
|
|
((funcall dexp func)
|
|
|
|
|
(setq result (funcall dval func)))
|
|
|
|
|
;; function call
|
|
|
|
|
((listp func)
|
|
|
|
|
(setq result (funcall dval func)))
|
|
|
|
|
;; symbol
|
|
|
|
|
(t
|
|
|
|
|
(if (memq symbol '(+ seq))
|
|
|
|
|
(setq result `(,func ,@result))
|
|
|
|
|
(setq result `(,func ,result))))))
|
|
|
|
|
(setcar pair result))))
|
|
|
|
|
;; weed out incomplete matches
|
|
|
|
|
(when pair
|
|
|
|
|
(if (not greedy) pair
|
|
|
|
|
(if (null (cdr pair)) pair
|
|
|
|
|
;; ignore trailing whitespace
|
|
|
|
|
(when (save-match-data (string-match "^[ \f\t\n\r\v]*$" (cdr pair)))
|
|
|
|
|
(unless syntax (setcdr pair nil))
|
|
|
|
|
pair))))))
|
|
|
|
|
|
|
|
|
|
(provide 'evil-ex)
|
|
|
|
|
|
|
|
|
|
;;; evil-ex.el ends here
|
