aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-11-03 17:27:26 -0500
committerStefan Monnier2014-11-03 17:27:26 -0500
commitd94bc77ec77dea298063f182cc8a6548b6ccce81 (patch)
treead87b9959c2c3e2f81477b7f6ad4b02444c66e99
parent033b622b42b1c82242de5f071f01c424fe1cd2c7 (diff)
downloademacs-d94bc77ec77dea298063f182cc8a6548b6ccce81.tar.gz
emacs-d94bc77ec77dea298063f182cc8a6548b6ccce81.zip
* lisp/simple.el (execute-extended-command--last-typed): New var.
(read-extended-command): Set it. Don't complete obsolete commands. (execute-extended-command--shorter-1) (execute-extended-command--shorter): New functions. (execute-extended-command): Use them to suggest shorter names. (indicate-copied-region, deactivate-mark): Use region-active-p.
-rw-r--r--etc/NEWS1
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/simple.el115
3 files changed, 103 insertions, 23 deletions
diff --git a/etc/NEWS b/etc/NEWS
index d88e8b3f335..681efbd6d82 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -49,6 +49,7 @@ Use './configure PKG_CONFIG=/full/name/of/pkg-config' if you need to.
49 49
50* Changes in Emacs 25.1 50* Changes in Emacs 25.1
51 51
52** M-x suggests shorthands and ignores obsolete commands for completion.
52** x-select-enable-clipboard is renamed select-enable-clipboard. 53** x-select-enable-clipboard is renamed select-enable-clipboard.
53x-select-enable-primary and renamed select-enable-primary. 54x-select-enable-primary and renamed select-enable-primary.
54Additionally they both now apply to all systems (OSX, GNUstep, Windows, you 55Additionally they both now apply to all systems (OSX, GNUstep, Windows, you
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 05c8ce4d83a..52538031a23 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
12014-11-03 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * simple.el (execute-extended-command--last-typed): New var.
4 (read-extended-command): Set it.
5 Don't complete obsolete commands.
6 (execute-extended-command--shorter-1)
7 (execute-extended-command--shorter): New functions.
8 (execute-extended-command): Use them to suggest shorter names.
9 (indicate-copied-region, deactivate-mark): Use region-active-p.
10
12014-11-03 Michael Albinus <michael.albinus@gmx.de> 112014-11-03 Michael Albinus <michael.albinus@gmx.de>
2 12
3 * net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer): Use a 13 * net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer): Use a
diff --git a/lisp/simple.el b/lisp/simple.el
index 1a596cf11db..08374c4ed65 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1539,11 +1539,17 @@ to get different commands to edit and resubmit."
1539 1539
1540 1540
1541(defvar extended-command-history nil) 1541(defvar extended-command-history nil)
1542(defvar execute-extended-command--last-typed nil)
1542 1543
1543(defun read-extended-command () 1544(defun read-extended-command ()
1544 "Read command name to invoke in `execute-extended-command'." 1545 "Read command name to invoke in `execute-extended-command'."
1545 (minibuffer-with-setup-hook 1546 (minibuffer-with-setup-hook
1546 (lambda () 1547 (lambda ()
1548 (add-hook 'post-self-insert-hook
1549 (lambda ()
1550 (setq execute-extended-command--last-typed
1551 (minibuffer-contents)))
1552 nil 'local)
1547 (set (make-local-variable 'minibuffer-default-add-function) 1553 (set (make-local-variable 'minibuffer-default-add-function)
1548 (lambda () 1554 (lambda ()
1549 ;; Get a command name at point in the original buffer 1555 ;; Get a command name at point in the original buffer
@@ -1571,7 +1577,17 @@ to get different commands to edit and resubmit."
1571 ;; because "M-x" is a well-known prompt to read a command 1577 ;; because "M-x" is a well-known prompt to read a command
1572 ;; and it serves as a shorthand for "Extended command: ". 1578 ;; and it serves as a shorthand for "Extended command: ".
1573 "M-x ") 1579 "M-x ")
1574 obarray 'commandp t nil 'extended-command-history))) 1580 (lambda (string pred action)
1581 (let ((pred
1582 (if (memq action '(nil t))
1583 ;; Exclude obsolete commands from completions.
1584 (lambda (sym)
1585 (and (funcall pred sym)
1586 (or (equal string (symbol-name sym))
1587 (not (get sym 'byte-obsolete-info)))))
1588 pred)))
1589 (complete-with-action action obarray string pred)))
1590 #'commandp t nil 'extended-command-history)))
1575 1591
1576(defcustom suggest-key-bindings t 1592(defcustom suggest-key-bindings t
1577 "Non-nil means show the equivalent key-binding when M-x command has one. 1593 "Non-nil means show the equivalent key-binding when M-x command has one.
@@ -1582,19 +1598,57 @@ If the value is non-nil and not a number, we wait 2 seconds."
1582 (integer :tag "time" 2) 1598 (integer :tag "time" 2)
1583 (other :tag "on"))) 1599 (other :tag "on")))
1584 1600
1585(defun execute-extended-command (prefixarg &optional command-name) 1601(defun execute-extended-command--shorter-1 (name length)
1602 (cond
1603 ((zerop length) (list ""))
1604 ((equal name "") nil)
1605 (t
1606 (nconc (mapcar (lambda (s) (concat (substring name 0 1) s))
1607 (execute-extended-command--shorter-1
1608 (substring name 1) (1- length)))
1609 (when (string-match "\\`\\(-\\)?[^-]*" name)
1610 (execute-extended-command--shorter-1
1611 (substring name (match-end 0)) length))))))
1612
1613(defun execute-extended-command--shorter (name typed)
1614 (let ((candidates '())
1615 (max (length (or typed name)))
1616 (len 1)
1617 binding)
1618 (while (and (not binding)
1619 (progn
1620 (unless candidates
1621 (setq len (1+ len))
1622 (setq candidates (execute-extended-command--shorter-1
1623 name len)))
1624 (< len max)))
1625 (let ((candidate (pop candidates)))
1626 (when (equal name
1627 (car-safe (completion-try-completion
1628 candidate obarray 'commandp len)))
1629 (setq binding candidate))))
1630 binding))
1631
1632(defun execute-extended-command (prefixarg &optional command-name typed)
1586 ;; Based on Fexecute_extended_command in keyboard.c of Emacs. 1633 ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
1587 ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24 1634 ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
1588 "Read a command name, then read the arguments and call the command. 1635 "Read a command name, then read the arguments and call the command.
1589Interactively, to pass a prefix argument to the command you are 1636To pass a prefix argument to the command you are
1590invoking, give a prefix argument to `execute-extended-command'. 1637invoking, give a prefix argument to `execute-extended-command'."
1591Noninteractively, the argument PREFIXARG is the prefix argument to 1638 (declare (interactive-only command-execute))
1592give to the command you invoke." 1639 ;; FIXME: Remember the actual text typed by the user before completion,
1593 (interactive (list current-prefix-arg (read-extended-command))) 1640 ;; so that we don't later on suggest the same shortening.
1641 (interactive
1642 (let ((execute-extended-command--last-typed nil))
1643 (list current-prefix-arg
1644 (read-extended-command)
1645 execute-extended-command--last-typed)))
1594 ;; Emacs<24 calling-convention was with a single `prefixarg' argument. 1646 ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
1595 (if (null command-name) 1647 (unless command-name
1596 (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt 1648 (let ((current-prefix-arg prefixarg) ; for prompt
1597 (read-extended-command)))) 1649 (execute-extended-command--last-typed nil))
1650 (setq command-name (read-extended-command))
1651 (setq typed execute-extended-command--last-typed)))
1598 (let* ((function (and (stringp command-name) (intern-soft command-name))) 1652 (let* ((function (and (stringp command-name) (intern-soft command-name)))
1599 (binding (and suggest-key-bindings 1653 (binding (and suggest-key-bindings
1600 (not executing-kbd-macro) 1654 (not executing-kbd-macro)
@@ -1611,19 +1665,34 @@ give to the command you invoke."
1611 (let ((prefix-arg prefixarg)) 1665 (let ((prefix-arg prefixarg))
1612 (command-execute function 'record)) 1666 (command-execute function 'record))
1613 ;; If enabled, show which key runs this command. 1667 ;; If enabled, show which key runs this command.
1614 (when binding 1668 ;; (when binding
1615 ;; But first wait, and skip the message if there is input. 1669 ;; But first wait, and skip the message if there is input.
1616 (let* ((waited 1670 (let* ((waited
1617 ;; If this command displayed something in the echo area; 1671 ;; If this command displayed something in the echo area;
1618 ;; wait a few seconds, then display our suggestion message. 1672 ;; wait a few seconds, then display our suggestion message.
1619 (sit-for (cond 1673 ;; FIXME: Wait *after* running post-command-hook!
1620 ((zerop (length (current-message))) 0) 1674 ;; FIXME: Don't wait if execute-extended-command--shorter won't
1621 ((numberp suggest-key-bindings) suggest-key-bindings) 1675 ;; find a better answer anyway!
1622 (t 2))))) 1676 (sit-for (cond
1623 (when (and waited (not (consp unread-command-events))) 1677 ((zerop (length (current-message))) 0)
1678 ((numberp suggest-key-bindings) suggest-key-bindings)
1679 (t 2)))))
1680 (when (and waited (not (consp unread-command-events)))
1681 (unless (or binding executing-kbd-macro (not (symbolp function))
1682 (<= (length (symbol-name function)) 2))
1683 ;; There's no binding for CMD. Let's try and find the shortest
1684 ;; string to use in M-x.
1685 ;; FIXME: Can be slow. Cache it maybe?
1686 (while-no-input
1687 (setq binding (execute-extended-command--shorter
1688 (symbol-name function) typed))))
1689 (when binding
1624 (with-temp-message 1690 (with-temp-message
1625 (format "You can run the command `%s' with %s" 1691 (format "You can run the command `%s' with %s"
1626 function (key-description binding)) 1692 function
1693 (if (stringp binding)
1694 (concat "M-x " binding " RET")
1695 (key-description binding)))
1627 (sit-for (if (numberp suggest-key-bindings) 1696 (sit-for (if (numberp suggest-key-bindings)
1628 suggest-key-bindings 1697 suggest-key-bindings
1629 2)))))))) 1698 2))))))))
@@ -3990,7 +4059,7 @@ of this sample text; it defaults to 40."
3990 (goto-char point) 4059 (goto-char point)
3991 ;; If user quit, deactivate the mark 4060 ;; If user quit, deactivate the mark
3992 ;; as C-g would as a command. 4061 ;; as C-g would as a command.
3993 (and quit-flag mark-active 4062 (and quit-flag (region-active-p)
3994 (deactivate-mark))) 4063 (deactivate-mark)))
3995 (let ((len (min (abs (- mark point)) 4064 (let ((len (min (abs (- mark point))
3996 (or message-len 40)))) 4065 (or message-len 40))))
@@ -4523,7 +4592,7 @@ If Transient Mark mode was temporarily enabled, reset the value
4523of the variable `transient-mark-mode'; if this causes Transient 4592of the variable `transient-mark-mode'; if this causes Transient
4524Mark mode to be disabled, don't change `mark-active' to nil or 4593Mark mode to be disabled, don't change `mark-active' to nil or
4525run `deactivate-mark-hook'." 4594run `deactivate-mark-hook'."
4526 (when (or transient-mark-mode force) 4595 (when (or (region-active-p) force)
4527 (when (and (if (eq select-active-regions 'only) 4596 (when (and (if (eq select-active-regions 'only)
4528 (eq (car-safe transient-mark-mode) 'only) 4597 (eq (car-safe transient-mark-mode) 'only)
4529 select-active-regions) 4598 select-active-regions)