diff options
Diffstat (limited to 'elpa/evil-20220510.2302/evil-ex.el')
| -rw-r--r-- | elpa/evil-20220510.2302/evil-ex.el | 1195 |
1 files changed, 0 insertions, 1195 deletions
diff --git a/elpa/evil-20220510.2302/evil-ex.el b/elpa/evil-20220510.2302/evil-ex.el deleted file mode 100644 index 3120e79..0000000 --- a/elpa/evil-20220510.2302/evil-ex.el +++ /dev/null @@ -1,1195 +0,0 @@ -;;; evil-ex.el --- Ex-mode -*- lexical-binding: nil -*- - -;; Author: Frank Fischer <frank fischer at mathematik.tu-chemnitz.de> -;; Maintainer: Vegard Øye <vegard_oye at hotmail.com> - -;; Version: 1.15.0 - -;; -;; 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 'evil-types) -(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)) - ("*" #'(evil-ex-last-visual-range)) - ((alt "," ";") line #'(evil-ex-range (evil-ex-current-line) $2)) - (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)) - ("`" marker-name ",`" marker-name - #'(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 - ("'" marker-name #'(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))) - (marker-name - "[]\\[-a-zA-Z_<>'}{)(]") - (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 - evil-want-empty-ex-last-command - (propertize evil-ex-previous-command 'face 'shadow))) - evil-ex-completion-map - nil - 'evil-ex-history - (when evil-want-empty-ex-last-command - 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 (and (zerop (length result)) - evil-want-empty-ex-last-command) - (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 (or (minibufferp) - (memq this-command '(mouse-drag-region choose-completion))) - (abort-recursive-edit))) - -(defun evil-ex-command-window-execute (config result) - (select-window (active-minibuffer-window) t) - (set-window-configuration config) - (delete-minibuffer-contents) - (insert result) - (exit-minibuffer)) - -(defun evil-ex-elisp-completion-at-point () - "Complete an `evil-ex' Elisp expression." - (when (and (fboundp 'elisp-completion-at-point) - (string-prefix-p "(" (minibuffer-contents-no-properties))) - (elisp-completion-at-point))) - -(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) - (add-hook 'minibuffer-exit-hook #'evil-ex-teardown nil t) - (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-elisp-completion-at-point - 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) - (remove-hook 'minibuffer-exit-hook #'evil-ex-teardown t) - (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-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 ((beg (or (get-text-property 0 'ex-index evil-ex-cmd) - (point))) - (end (point))) - (list beg end (evil-ex-completion-table) :exclusive 'no))) - -(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) - (doc-string 2) - (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 "1.2.13") - -(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." - (let ((remote (file-remote-p file-name)) - (current-fname (buffer-file-name)) - (alternate-fname (and (other-buffer) - (buffer-file-name (other-buffer))))) - (setq file-name (or (file-remote-p file-name 'localname) file-name)) - (when current-fname - (setq current-fname (or (file-remote-p current-fname 'localname) - current-fname)) - (setq file-name - (replace-regexp-in-string "\\(^\\|[^\\\\]\\)\\(%\\)" - current-fname file-name - t t 2))) - (when alternate-fname - (setq alternate-fname (or (file-remote-p alternate-fname 'localname) - alternate-fname)) - (setq file-name - (replace-regexp-in-string "\\(^\\|[^\\\\]\\)\\(#\\)" - alternate-fname file-name - t t 2))) - (setq file-name - (replace-regexp-in-string "\\\\\\([#%]\\)" - "\\1" file-name t)) - (setq file-name (concat remote file-name))) - file-name) - -(defun evil-ex-file-arg () - "Returns the current Ex argument as a file name. -This function interprets special file names like # and %." - (unless (zerop (length evil-ex-argument)) - (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)) - (restore-point (when (evil-get-command-property evil-ex-command :restore-point) - (min (point) (or (mark) most-positive-fixnum)))) - (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) - (evil-exit-visual-state) - (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 restore-point (goto-char restore-point))))) - (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-last-visual-range () - "Return a linewise range of the last visual selection." - (evil-line-expand evil-visual-mark evil-visual-point)) - -(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) - (if (re-search-forward pattern nil t) - (line-number-at-pos (1- (match-end 0))) - (goto-char (point-min)) - (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) - (if (re-search-backward pattern nil t) - (line-number-at-pos (match-beginning 0)) - (goto-char (point-max)) - (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, dash - ;; or number and either the part before is NOT known to be a binding, - ;; or the complete string IS known to be a binding - (when (and (> (length string) 0) - (string-match-p "^[-/[:digit:]]" string) - (or (evil-ex-binding (concat command string) t) - (not (evil-ex-binding command t)))) - (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--dexp (obj) - "Parse a numerical dollar-sign symbol. -Given e.g. $4, return 4." - (when (symbolp obj) - (let ((str (symbol-name obj))) - (save-match-data - (when (string-match "\\$\\([0-9]+\\)" str) - (string-to-number (match-string 1 str))))))) - -(defun evil-parser--dval (obj result) - "Substitute all dollar-sign symbols in OBJ. -Each dollar-sign symbol is replaced with the corresponding -element in RESULT, so that $1 becomes the first element, etc. -The special value $0 is substituted with the whole list RESULT. -If RESULT is not a list, all dollar-sign symbols are substituted with -RESULT." - (if (listp obj) - (mapcar (lambda (obj) (evil-parser--dval obj result)) obj) - (let ((num (evil-parser--dexp obj))) - (if num - (if (not (listp result)) - result - (if (eq num 0) - `(list ,@result) - (nth (1- num) result))) - obj)))) - -(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)) - (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 - ((evil-parser--dexp func) - (setq result (evil-parser--dval func result))) - ;; function call - ((listp func) - (setq result (evil-parser--dval func result))) - ;; 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 |