]> code.delx.au - gnu-emacs/blobdiff - lisp/simple.el
There's no reason not to compile version.el
[gnu-emacs] / lisp / simple.el
index c968ac01b0d38453f1387be08b1ed663657b3733..2b7d5580ba2890523867c85bdfc91169c213237d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; simple.el --- basic editing commands for Emacs
 
-;; Copyright (C) 1985-1987, 1993-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -817,7 +817,7 @@ instead of deleted."
   :type '(choice (const :tag "Delete active region" t)
                  (const :tag "Kill active region" kill)
                  (const :tag "Do ordinary deletion" nil))
-  :group 'editing
+  :group 'killing
   :version "24.1")
 
 (defun delete-backward-char (n &optional killflag)
@@ -893,16 +893,23 @@ that uses or sets the mark."
 ;; Counting lines, one way or another.
 
 (defun goto-line (line &optional buffer)
-  "Goto LINE, counting from line 1 at beginning of buffer.
-Normally, move point in the current buffer, and leave mark at the
-previous position.  With just \\[universal-argument] as argument,
-move point in the most recently selected other buffer, and switch to it.
+  "Go to LINE, counting from line 1 at beginning of buffer.
+If called interactively, a numeric prefix argument specifies
+LINE; without a numeric prefix argument, read LINE from the
+minibuffer.
+
+If optional argument BUFFER is non-nil, switch to that buffer and
+move to line LINE there.  If called interactively with \\[universal-argument]
+as argument, BUFFER is the most recently selected other buffer.
 
-If there's a number in the buffer at point, it is the default for LINE.
+Prior to moving point, this function sets the mark (without
+activating it), unless Transient Mark mode is enabled and the
+mark is already active.
 
 This function is usually the wrong thing to use in a Lisp program.
 What you probably want instead is something like:
-  (goto-char (point-min)) (forward-line (1- N))
+  (goto-char (point-min))
+  (forward-line (1- N))
 If at all possible, an even better solution is to use char counts
 rather than line counts."
   (interactive
@@ -949,46 +956,51 @@ rather than line counts."
       (forward-line (1- line)))))
 
 (defun count-words-region (start end)
-  "Return the number of words between START and END.
+  "Count the number of words in the region.
 If called interactively, print a message reporting the number of
-lines, words, and characters in the region."
+lines, words, and chars in the region.
+If called from Lisp, return the number of words between positions
+START and END."
   (interactive "r")
-  (let ((words 0))
-    (save-excursion
-      (save-restriction
-        (narrow-to-region start end)
-        (goto-char (point-min))
-        (while (forward-word 1)
-          (setq words (1+ words)))))
-    (when (called-interactively-p 'interactive)
-      (count-words--message "Region"
-                           (count-lines start end)
-                           words
-                           (- end start)))
-    words))
-
-(defun count-words ()
-  "Display the number of lines, words, and characters in the buffer.
-In Transient Mark mode when the mark is active, display the
-number of lines, words, and characters in the region."
-  (interactive)
-  (if (use-region-p)
-      (call-interactively 'count-words-region)
-    (let* ((beg (point-min))
-          (end (point-max))
-          (lines (count-lines beg end))
-          (words (count-words-region beg end))
-          (chars (- end beg)))
-      (count-words--message "Buffer" lines words chars))))
-
-(defun count-words--message (str lines words chars)
-  (message "%s has %d line%s, %d word%s, and %d character%s."
-          str
-          lines (if (= lines 1) "" "s")
-          words (if (= words 1) "" "s")
-          chars (if (= chars 1) "" "s")))
-
-(defalias 'count-lines-region 'count-words-region)
+  (if (called-interactively-p 'any)
+      (count-words--message "Region" start end)
+    (count-words start end)))
+
+(defun count-words (start end)
+  "Count words between START and END.
+If called interactively, START and END are normally the start and
+end of the buffer; but if the region is active, START and END are
+the start and end of the region.  Print a message reporting the
+number of lines, words, and chars.
+
+If called from Lisp, return the number of words between START and
+END, without printing any message."
+  (interactive (list nil nil))
+  (cond ((not (called-interactively-p 'any))
+        (let ((words 0))
+          (save-excursion
+            (save-restriction
+              (narrow-to-region start end)
+              (goto-char (point-min))
+              (while (forward-word 1)
+                (setq words (1+ words)))))
+          words))
+       ((use-region-p)
+        (call-interactively 'count-words-region))
+       (t
+        (count-words--message "Buffer" (point-min) (point-max)))))
+
+(defun count-words--message (str start end)
+  (let ((lines (count-lines start end))
+       (words (count-words start end))
+       (chars (- end start)))
+    (message "%s has %d line%s, %d word%s, and %d character%s."
+            str
+            lines (if (= lines 1) "" "s")
+            words (if (= words 1) "" "s")
+            chars (if (= chars 1) "" "s"))))
+
+(define-obsolete-function-alias 'count-lines-region 'count-words-region "24.1")
 
 (defun what-line ()
   "Print the current buffer line number and narrowed line number of point."
@@ -1342,6 +1354,56 @@ to get different commands to edit and resubmit."
             "M-x ")
      obarray '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.
+The value can be a length of time to show the message for.
+If the value is non-nil and not a number, we wait 2 seconds."
+  :group 'keyboard
+  :type '(choice (const :tag "off" nil)
+                 (integer :tag "time" 2)
+                 (other :tag "on")))
+
+(defun execute-extended-command (prefixarg &optional command-name)
+  ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
+  ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
+  "Read function name, then read its arguments and call it.
+
+To pass a numeric argument to the command you are invoking with, specify
+the numeric argument to this command.
+
+Noninteractively, the argument PREFIXARG is the prefix argument to
+give to the command you invoke, if it asks for an argument."
+  (interactive (list current-prefix-arg (read-extended-command)))
+  ;; Emacs<24 calling-convention was with a single `prefixarg' argument.
+  (if (null command-name) (setq command-name (read-extended-command)))
+  (let* ((function (and (stringp command-name) (intern-soft command-name)))
+         (binding (and suggest-key-bindings
+                        (not executing-kbd-macro)
+                        (where-is-internal function overriding-local-map t))))
+    (unless (commandp function)
+      (error "`%s' is not a valid command name" command-name))
+    ;; Set this_command_keys to the concatenation of saved-keys and
+    ;; function, followed by a RET.
+    (setq this-command function)
+    (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)))
+          (with-temp-message
+              (format "You can run the command `%s' with %s"
+                      function (key-description binding))
+            (sit-for (if (numberp suggest-key-bindings)
+                         suggest-key-bindings
+                       2))))))))
 \f
 (defvar minibuffer-history nil
   "Default minibuffer history list.
@@ -1403,7 +1465,7 @@ See also `minibuffer-history-case-insensitive-variables'."
      (list (if (string= regexp "")
               (if minibuffer-history-search-history
                   (car minibuffer-history-search-history)
-                (error "No previous history search regexp"))
+                (user-error "No previous history search regexp"))
             regexp)
           (prefix-numeric-value current-prefix-arg))))
   (unless (zerop n)
@@ -1429,9 +1491,9 @@ See also `minibuffer-history-case-insensitive-variables'."
        (setq prevpos pos)
        (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
        (when (= pos prevpos)
-         (error (if (= pos 1)
-                    "No later matching history item"
-                  "No earlier matching history item")))
+         (user-error (if (= pos 1)
+                          "No later matching history item"
+                        "No earlier matching history item")))
        (setq match-string
              (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
                  (let ((print-level nil))
@@ -1474,7 +1536,7 @@ makes the search case-sensitive."
      (list (if (string= regexp "")
               (if minibuffer-history-search-history
                   (car minibuffer-history-search-history)
-                (error "No previous history search regexp"))
+                (user-error "No previous history search regexp"))
             regexp)
           (prefix-numeric-value current-prefix-arg))))
   (previous-matching-history-element regexp (- n)))
@@ -1533,11 +1595,11 @@ The argument NABS specifies the absolute history position."
        (setq minibuffer-text-before-history
              (minibuffer-contents-no-properties)))
     (if (< nabs minimum)
-       (if minibuffer-default
-           (error "End of defaults; no next item")
-         (error "End of history; no default available")))
+       (user-error (if minibuffer-default
+                        "End of defaults; no next item"
+                      "End of history; no default available")))
     (if (> nabs (length (symbol-value minibuffer-history-variable)))
-       (error "Beginning of history; no preceding item"))
+       (user-error "Beginning of history; no preceding item"))
     (unless (memq last-command '(next-history-element
                                 previous-history-element))
       (let ((prompt-end (minibuffer-prompt-end)))
@@ -1883,8 +1945,8 @@ Some change-hooks test this variable to do something different.")
 Call `undo-start' to get ready to undo recent changes,
 then call `undo-more' one or more times to undo them."
   (or (listp pending-undo-list)
-      (error (concat "No further undo information"
-                    (and undo-in-region " for region"))))
+      (user-error (concat "No further undo information"
+                          (and undo-in-region " for region"))))
   (let ((undo-in-progress t))
     ;; Note: The following, while pulling elements off
     ;; `pending-undo-list' will call primitive change functions which
@@ -1910,7 +1972,7 @@ If BEG and END are specified, then only undo elements
 that apply to text between BEG and END are used; other undo elements
 are ignored.  If BEG and END are nil, all undo elements are used."
   (if (eq buffer-undo-list t)
-      (error "No undo information in this buffer"))
+      (user-error "No undo information in this buffer"))
   (setq pending-undo-list
        (if (and beg end (not (= beg end)))
            (undo-make-selective-list (min beg end) (max beg end))
@@ -2138,7 +2200,7 @@ of `history-length', which see.")
   "Switch used to have the shell execute its command line argument.")
 
 (defvar shell-command-default-error-buffer nil
-  "*Buffer name for `shell-command' and `shell-command-on-region' error output.
+  "Buffer name for `shell-command' and `shell-command-on-region' error output.
 This buffer is used when `shell-command' or `shell-command-on-region'
 is run interactively.  A value of nil means that output to stderr and
 stdout will be intermixed in the output stream.")
@@ -2452,9 +2514,9 @@ COMMAND.
 To specify a coding system for converting non-ASCII characters
 in the input and output to the shell command, use \\[universal-coding-system-argument]
 before this command.  By default, the input (from the current buffer)
-is encoded in the same coding system that will be used to save the file,
-`buffer-file-coding-system'.  If the output is going to replace the region,
-then it is decoded from that same coding system.
+is encoded using coding-system specified by `process-coding-system-alist',
+falling back to `default-process-coding-system' if no match for COMMAND
+is found in `process-coding-system-alist'.
 
 The noninteractive arguments are START, END, COMMAND,
 OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
@@ -2665,13 +2727,13 @@ value passed."
 (defvar process-file-side-effects t
   "Whether a call of `process-file' changes remote files.
 
-Per default, this variable is always set to `t', meaning that a
+By default, this variable is always set to `t', meaning that a
 call of `process-file' could potentially change any file on a
 remote host.  When set to `nil', a file handler could optimize
-its behavior with respect to remote file attributes caching.
+its behavior with respect to remote file attribute caching.
 
-This variable should never be changed by `setq'.  Instead of, it
-shall be set only by let-binding.")
+You should only ever change this variable with a let-binding;
+never with `setq'.")
 
 (defun start-file-process (name buffer program &rest program-args)
   "Start a program in a subprocess.  Return the process object for it.
@@ -3057,7 +3119,8 @@ before the Emacs kill and one can still paste it using \\[yank] \\[yank-pop]."
   :version "23.2")
 
 (defcustom kill-do-not-save-duplicates nil
-  "Do not add a new string to `kill-ring' when it is the same as the last one."
+  "Do not add a new string to `kill-ring' if it duplicates the last one.
+The comparison is done using `equal-including-properties'."
   :type 'boolean
   :group 'killing
   :version "23.2")
@@ -3085,7 +3148,10 @@ argument should still be a \"useful\" string for such uses."
        (signal 'args-out-of-range
                (list string "yank-handler specified for empty string"))))
   (unless (and kill-do-not-save-duplicates
-              (equal string (car kill-ring)))
+              ;; Due to text properties such as 'yank-handler that
+              ;; can alter the contents to yank, comparison using
+              ;; `equal' is unsafe.
+              (equal-including-properties string (car kill-ring)))
     (if (fboundp 'menu-bar-update-yank-menu)
        (menu-bar-update-yank-menu string (and replace (car kill-ring)))))
   (when save-interprogram-paste-before-kill
@@ -3096,10 +3162,10 @@ argument should still be a \"useful\" string for such uses."
                       (nreverse interprogram-paste)
                     (list interprogram-paste)))
          (unless (and kill-do-not-save-duplicates
-                      (equal s (car kill-ring)))
+                      (equal-including-properties s (car kill-ring)))
            (push s kill-ring))))))
   (unless (and kill-do-not-save-duplicates
-              (equal string (car kill-ring)))
+              (equal-including-properties string (car kill-ring)))
     (if (and replace kill-ring)
        (setcar kill-ring string)
       (push string kill-ring)
@@ -3178,10 +3244,6 @@ move the yanking point; just return the Nth kill forward."
   :type 'boolean
   :group 'killing)
 
-(put 'text-read-only 'error-conditions
-     '(text-read-only buffer-read-only error))
-(put 'text-read-only 'error-message (purecopy "Text is read-only"))
-
 (defun kill-region (beg end &optional yank-handler)
   "Kill (\"cut\") text between point and mark.
 This deletes the text from the buffer and saves it in the kill ring.
@@ -3458,8 +3520,10 @@ and KILLP is t if a prefix arg was specified."
                      ((eq backward-delete-char-untabify-method 'all)
                       " \t\n\r")))
          (n (if skip
-                (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
-                                                     (point)))))
+                (let* ((oldpt (point))
+                       (wh (- oldpt (save-excursion
+                                      (skip-chars-backward skip)
+                                      (constrain-to-field nil oldpt)))))
                   (+ arg (if (zerop wh) 0 (1- wh))))
               arg)))
     ;; Avoid warning about delete-backward-char
@@ -3469,14 +3533,14 @@ and KILLP is t if a prefix arg was specified."
   "Kill up to and including ARGth occurrence of CHAR.
 Case is ignored if `case-fold-search' is non-nil in the current buffer.
 Goes backward if ARG is negative; error if CHAR not found."
-  (interactive "p\ncZap to char: ")
+  (interactive (list (prefix-numeric-value current-prefix-arg)
+                    (read-char "Zap to char: " t)))
   ;; Avoid "obsolete" warnings for translation-table-for-input.
   (with-no-warnings
     (if (char-table-p translation-table-for-input)
        (setq char (or (aref translation-table-for-input char) char))))
   (kill-region (point) (progn
                         (search-forward (char-to-string char) nil nil arg)
-;                       (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
                         (point))))
 
 ;; kill-line and its subroutines.
@@ -3670,7 +3734,8 @@ If ARG is zero, move to the beginning of the current line."
                        (assq prop buffer-invisibility-spec))))))
     (skip-chars-forward "^\n")
     (if (get-text-property (point) 'invisible)
-       (goto-char (next-single-property-change (point) 'invisible))
+       (goto-char (or (next-single-property-change (point) 'invisible)
+                      (point-max)))
       (goto-char (next-overlay-change (point))))
     (end-of-line)))
 \f
@@ -4386,23 +4451,25 @@ lines."
 ;; a cleaner solution to the problem of making C-n do something
 ;; useful given a tall image.
 (defun line-move (arg &optional noerror to-end try-vscroll)
-  (unless (and auto-window-vscroll try-vscroll
-              ;; Only vscroll for single line moves
-              (= (abs arg) 1)
-              ;; But don't vscroll in a keyboard macro.
-              (not defining-kbd-macro)
-              (not executing-kbd-macro)
-              (line-move-partial arg noerror to-end))
-    (set-window-vscroll nil 0 t)
-    (if (and line-move-visual
-            ;; Display-based column are incompatible with goal-column.
-            (not goal-column)
-            ;; When the text in the window is scrolled to the left,
-            ;; display-based motion doesn't make sense (because each
-            ;; logical line occupies exactly one screen line).
-            (not (> (window-hscroll) 0)))
-       (line-move-visual arg noerror)
-      (line-move-1 arg noerror to-end))))
+  (if noninteractive
+      (forward-line arg)
+    (unless (and auto-window-vscroll try-vscroll
+                ;; Only vscroll for single line moves
+                (= (abs arg) 1)
+                ;; But don't vscroll in a keyboard macro.
+                (not defining-kbd-macro)
+                (not executing-kbd-macro)
+                (line-move-partial arg noerror to-end))
+      (set-window-vscroll nil 0 t)
+      (if (and line-move-visual
+              ;; Display-based column are incompatible with goal-column.
+              (not goal-column)
+              ;; When the text in the window is scrolled to the left,
+              ;; display-based motion doesn't make sense (because each
+              ;; logical line occupies exactly one screen line).
+              (not (> (window-hscroll) 0)))
+         (line-move-visual arg noerror)
+       (line-move-1 arg noerror to-end)))))
 
 ;; Display-based alternative to line-move-1.
 ;; Arg says how many lines to move.  The value is t if we can move the
@@ -5302,7 +5369,7 @@ Returns t if it really did any work."
       t)))
 
 (defvar comment-line-break-function 'comment-indent-new-line
-  "*Mode-specific function which line breaks and continues a comment.
+  "Mode-specific function which line breaks and continues a comment.
 This function is called during auto-filling when a comment syntax
 is defined.
 The function should take a single optional argument, which is a flag
@@ -5964,7 +6031,7 @@ in the definition is used to check that VALUE is valid.
 With a prefix argument, set VARIABLE to VALUE buffer-locally."
   (interactive
    (let* ((default-var (variable-at-point))
-          (var (if (user-variable-p default-var)
+          (var (if (custom-variable-p default-var)
                   (read-variable (format "Set variable (default %s): " default-var)
                                  default-var)
                 (read-variable "Set variable: ")))