;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
;; Do the rest in post-self-insert-hook, because we want to do it
;; *before* other functions on that hook.
(lambda ()
+ (cl-assert (eq ?\n (char-before)))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
- (if (not interactive)
+ (unwind-protect
+ (if (not interactive)
;; FIXME: For non-interactive uses, many calls actually just want
;; (insert "\n"), so maybe we should do just that, so as to avoid
;; the risk of filling or running abbrevs unexpectedly.
;; We first used let-binding to protect the hook, but that was naive
;; since add-hook affects the symbol-default value of the variable,
;; whereas the let-binding might only protect the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc))))
+ (remove-hook 'post-self-insert-hook postproc)))
+ (cl-assert (not (member postproc post-self-insert-hook)))
+ (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
nil)
(defun set-hard-newline-properties (from to)
(defvar extended-command-history nil)
+(defvar execute-extended-command--last-typed nil)
(defun read-extended-command ()
"Read command name to invoke in `execute-extended-command'."
(minibuffer-with-setup-hook
(lambda ()
+ (add-hook 'post-self-insert-hook
+ (lambda ()
+ (setq execute-extended-command--last-typed
+ (minibuffer-contents)))
+ nil 'local)
(set (make-local-variable 'minibuffer-default-add-function)
(lambda ()
;; Get a command name at point in the original buffer
;; because "M-x" is a well-known prompt to read a command
;; and it serves as a shorthand for "Extended command: ".
"M-x ")
- obarray 'commandp t nil 'extended-command-history)))
+ (lambda (string pred action)
+ (let ((pred
+ (if (memq action '(nil t))
+ ;; Exclude obsolete commands from completions.
+ (lambda (sym)
+ (and (funcall pred sym)
+ (or (equal string (symbol-name sym))
+ (not (get sym 'byte-obsolete-info)))))
+ pred)))
+ (complete-with-action action obarray string pred)))
+ #'commandp t nil 'extended-command-history)))
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
(integer :tag "time" 2)
(other :tag "on")))
-(defun execute-extended-command (prefixarg &optional command-name)
+(defun execute-extended-command--shorter-1 (name length)
+ (cond
+ ((zerop length) (list ""))
+ ((equal name "") nil)
+ (t
+ (nconc (mapcar (lambda (s) (concat (substring name 0 1) s))
+ (execute-extended-command--shorter-1
+ (substring name 1) (1- length)))
+ (when (string-match "\\`\\(-\\)?[^-]*" name)
+ (execute-extended-command--shorter-1
+ (substring name (match-end 0)) length))))))
+
+(defun execute-extended-command--shorter (name typed)
+ (let ((candidates '())
+ (max (length typed))
+ (len 1)
+ binding)
+ (while (and (not binding)
+ (progn
+ (unless candidates
+ (setq len (1+ len))
+ (setq candidates (execute-extended-command--shorter-1
+ name len)))
+ ;; Don't show the help message if the binding isn't
+ ;; significantly shorter than the M-x command the user typed.
+ (< len (- max 5))))
+ (let ((candidate (pop candidates)))
+ (when (equal name
+ (car-safe (completion-try-completion
+ candidate obarray 'commandp len)))
+ (setq binding candidate))))
+ binding))
+
+(defun execute-extended-command (prefixarg &optional command-name typed)
;; Based on Fexecute_extended_command in keyboard.c of Emacs.
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
"Read a command name, then read the arguments and call the command.
-Interactively, to pass a prefix argument to the command you are
-invoking, give a prefix argument to `execute-extended-command'.
-Noninteractively, the argument PREFIXARG is the prefix argument to
-give to the command you invoke."
- (interactive (list current-prefix-arg (read-extended-command)))
+To pass a prefix argument to the command you are
+invoking, give a prefix argument to `execute-extended-command'."
+ (declare (interactive-only command-execute))
+ ;; FIXME: Remember the actual text typed by the user before completion,
+ ;; so that we don't later on suggest the same shortening.
+ (interactive
+ (let ((execute-extended-command--last-typed nil))
+ (list current-prefix-arg
+ (read-extended-command)
+ execute-extended-command--last-typed)))
;; Emacs<24 calling-convention was with a single `prefixarg' argument.
- (if (null command-name)
- (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt
- (read-extended-command))))
+ (unless command-name
+ (let ((current-prefix-arg prefixarg) ; for prompt
+ (execute-extended-command--last-typed nil))
+ (setq command-name (read-extended-command))
+ (setq typed execute-extended-command--last-typed)))
(let* ((function (and (stringp command-name) (intern-soft command-name)))
(binding (and suggest-key-bindings
(not executing-kbd-macro)
(let ((prefix-arg prefixarg))
(command-execute function 'record))
;; If enabled, show which key runs this command.
- (when binding
- ;; But first wait, and skip the message if there is input.
- (let* ((waited
- ;; If this command displayed something in the echo area;
- ;; wait a few seconds, then display our suggestion message.
- (sit-for (cond
- ((zerop (length (current-message))) 0)
- ((numberp suggest-key-bindings) suggest-key-bindings)
- (t 2)))))
- (when (and waited (not (consp unread-command-events)))
+ ;; (when binding
+ ;; But first wait, and skip the message if there is input.
+ (let* ((waited
+ ;; If this command displayed something in the echo area;
+ ;; wait a few seconds, then display our suggestion message.
+ ;; FIXME: Wait *after* running post-command-hook!
+ ;; FIXME: Don't wait if execute-extended-command--shorter won't
+ ;; find a better answer anyway!
+ (sit-for (cond
+ ((zerop (length (current-message))) 0)
+ ((numberp suggest-key-bindings) suggest-key-bindings)
+ (t 2)))))
+ (when (and waited (not (consp unread-command-events)))
+ (unless (or binding executing-kbd-macro (not (symbolp function))
+ (<= (length (symbol-name function)) 2))
+ ;; There's no binding for CMD. Let's try and find the shortest
+ ;; string to use in M-x.
+ ;; FIXME: Can be slow. Cache it maybe?
+ (while-no-input
+ (setq binding (execute-extended-command--shorter
+ (symbol-name function) typed))))
+ (when binding
(with-temp-message
(format "You can run the command `%s' with %s"
- function (key-description binding))
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))
(or (zerop n)
(goto-history-element (+ minibuffer-history-position n))))
+(defun next-line-or-history-element (&optional arg)
+ "Move cursor vertically down ARG lines, or to the next history element.
+When point moves over the bottom line of multi-line minibuffer, puts ARGth
+next element of the minibuffer history in the minibuffer."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let ((old-point (point)))
+ (condition-case nil
+ (with-no-warnings
+ (next-line arg))
+ (end-of-buffer
+ ;; Restore old position since `line-move-visual' moves point to
+ ;; the end of the line when it fails to go to the next line.
+ (goto-char old-point)
+ (next-history-element arg)))))
+
+(defun previous-line-or-history-element (&optional arg)
+ "Move cursor vertically up ARG lines, or to the previous history element.
+When point moves over the top line of multi-line minibuffer, puts ARGth
+previous element of the minibuffer history in the minibuffer."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let ((old-point (point)))
+ (condition-case nil
+ (with-no-warnings
+ (previous-line arg))
+ (beginning-of-buffer
+ ;; Restore old position since `line-move-visual' moves point to
+ ;; the beginning of the line when it fails to go to the previous line.
+ (goto-char old-point)
+ (previous-history-element arg)))))
+
(defun next-complete-history-element (n)
"Get next history element which completes the minibuffer before the point.
The contents of the minibuffer after the point are deleted, and replaced
;; If will create a new buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
(setq buffer (generate-new-buffer
- (or output-buffer "*Async Shell Command*")))
+ (or (and (bufferp output-buffer) (buffer-name output-buffer))
+ output-buffer "*Async Shell Command*")))
(error "Shell command in progress")))
((eq async-shell-command-buffer 'new-buffer)
;; It will create a new buffer.
(setq buffer (generate-new-buffer
- (or output-buffer "*Async Shell Command*"))))
+ (or (and (bufferp output-buffer) (buffer-name output-buffer))
+ output-buffer "*Async Shell Command*"))))
((eq async-shell-command-buffer 'confirm-rename-buffer)
;; If will rename the buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
(goto-char point)
;; If user quit, deactivate the mark
;; as C-g would as a command.
- (and quit-flag mark-active
+ (and quit-flag (region-active-p)
(deactivate-mark)))
(let ((len (min (abs (- mark point))
(or message-len 40))))
of the variable `transient-mark-mode'; if this causes Transient
Mark mode to be disabled, don't change `mark-active' to nil or
run `deactivate-mark-hook'."
- (when (or transient-mark-mode force)
+ (when (or (region-active-p) force)
(when (and (if (eq select-active-regions 'only)
(eq (car-safe transient-mark-mode) 'only)
select-active-regions)