(pages-copy-header-and-position): Call end-of-line, not forward-line.

[bpt/emacs.git] / lisp / simple.el

diff --git a/lisp/simple.el b/lisp/simple.el
index 0416ba9..8555773 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -332,7 +332,11 @@ and the greater of them is not at the start of a line."
                (setq done (+ 40 done)))
              (while (re-search-forward "[\n\C-m]" nil t 1)
                (setq done (+ 1 done)))
                (setq done (+ 40 done)))
              (while (re-search-forward "[\n\C-m]" nil t 1)
                (setq done (+ 1 done)))

-             done)
+             (goto-char (point-max))
+             (if (and (/= start end)
+                      (not (bolp)))
+                 (1+ done)
+               done))

          (- (buffer-size) (forward-line (buffer-size))))))))
 
 (defun what-cursor-position ()
          (- (buffer-size) (forward-line (buffer-size))))))))
 
 (defun what-cursor-position ()


@@ -369,19 +373,23 @@ Other major modes are defined by comparison with this one."
   (interactive)
   (kill-all-local-variables))
 
   (interactive)
   (kill-all-local-variables))
 

-(defvar read-expression-map (copy-keymap minibuffer-local-map)
+(defvar read-expression-map (cons 'keymap minibuffer-local-map)

   "Minibuffer keymap used for reading Lisp expressions.")
 (define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
 
 (put 'eval-expression 'disabled t)
 
   "Minibuffer keymap used for reading Lisp expressions.")
 (define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
 
 (put 'eval-expression 'disabled t)
 

-;; We define this, rather than making  eval  interactive,
+(defvar read-expression-history nil)
+
+;; We define this, rather than making `eval' interactive,

 ;; for the sake of completion of names like eval-region, eval-current-buffer.
 (defun eval-expression (expression)
   "Evaluate EXPRESSION and print value in minibuffer.
 Value is also consed on to front of the variable `values'."
 ;; for the sake of completion of names like eval-region, eval-current-buffer.
 (defun eval-expression (expression)
   "Evaluate EXPRESSION and print value in minibuffer.
 Value is also consed on to front of the variable `values'."

-  (interactive (list (read-from-minibuffer "Eval: "
-                                          nil read-expression-map t)))
+  (interactive
+   (list (read-from-minibuffer "Eval: "
+                              nil read-expression-map t
+                              'read-expression-history)))

   (setq values (cons (eval expression) values))
   (prin1 (car values) t))
 
   (setq values (cons (eval expression) values))
   (prin1 (car values) t))
 


@@ -391,10 +399,8 @@ COMMAND is a Lisp expression.  Let user edit that expression in
 the minibuffer, then read and evaluate the result."
   (let ((command (read-from-minibuffer prompt
                                       (prin1-to-string command)
 the minibuffer, then read and evaluate the result."
   (let ((command (read-from-minibuffer prompt
                                       (prin1-to-string command)

-                                      read-expression-map t)))
-    ;; Add edited command to command history, unless redundant.
-    (or (equal command (car command-history))
-       (setq command-history (cons command command-history)))
+                                      read-expression-map t
+                                      '(command-history . 1))))

     (eval command)))
 
 (defun repeat-complex-command (arg)
     (eval command)))
 
 (defun repeat-complex-command (arg)


@@ -413,16 +419,16 @@ to get different commands to edit and resubmit."
        newcmd)
     (if elt
        (progn
        newcmd)
     (if elt
        (progn

-         (setq newcmd (read-from-minibuffer "Redo: "
-                                            (prin1-to-string elt)
-                                            read-expression-map
-                                            t
-                                            (cons 'command-history
-                                                  arg)))
+         (setq newcmd
+               (read-from-minibuffer
+                "Redo: " (prin1-to-string elt) read-expression-map t
+                (cons 'command-history arg)))
+

          ;; If command was added to command-history as a string,
          ;; get rid of that.  We want only evallable expressions there.
          (if (stringp (car command-history))
              (setq command-history (cdr command-history)))
          ;; If command was added to command-history as a string,
          ;; get rid of that.  We want only evallable expressions there.
          (if (stringp (car command-history))
              (setq command-history (cdr command-history)))

+

          ;; If command to be redone does not match front of history,
          ;; add it to the history.
          (or (equal newcmd (car command-history))
          ;; If command to be redone does not match front of history,
          ;; add it to the history.
          (or (equal newcmd (car command-history))


@@ -627,8 +633,8 @@ then call `undo-more' one or more times to undo them."
       (error "No further undo information"))
   (setq pending-undo-list (primitive-undo count pending-undo-list)))
 
       (error "No further undo information"))
   (setq pending-undo-list (primitive-undo count pending-undo-list)))
 

-(defvar last-shell-command "")
-(defvar last-shell-command-on-region "")
+(defvar shell-command-history nil
+  "History list for some commands that read shell commands.")

 
 (defun shell-command (command &optional flag)
   "Execute string COMMAND in inferior shell; display output, if any.
 
 (defun shell-command (command &optional flag)
   "Execute string COMMAND in inferior shell; display output, if any.


@@ -637,7 +643,8 @@ If COMMAND ends in ampersand, execute it asynchronously.
 Optional second arg non-nil (prefix arg, if interactive)
 means insert output in current buffer after point (leave mark after it).
 This cannot be done asynchronously."
 Optional second arg non-nil (prefix arg, if interactive)
 means insert output in current buffer after point (leave mark after it).
 This cannot be done asynchronously."

-  (interactive (list (read-string "Shell command: " last-shell-command)
+  (interactive (list (read-from-minibuffer "Shell command: "
+                                          nil nil nil 'shell-command-history)

                     current-prefix-arg))
   (if flag
       (progn (barf-if-buffer-read-only)
                     current-prefix-arg))
   (if flag
       (progn (barf-if-buffer-read-only)


@@ -732,8 +739,8 @@ even though that buffer is not automatically displayed.  If there is no output
 or output is inserted in the current buffer then `*Shell Command Output*' is
 deleted." 
   (interactive (list (region-beginning) (region-end)
 or output is inserted in the current buffer then `*Shell Command Output*' is
 deleted." 
   (interactive (list (region-beginning) (region-end)

-                    (read-string "Shell command on region: "
-                                 last-shell-command-on-region)
+                    (read-from-minibuffer "Shell command on region: "
+                                          nil nil nil 'shell-command-history)

                     current-prefix-arg
                     (prefix-numeric-value current-prefix-arg)))
   (if flag
                     current-prefix-arg
                     (prefix-numeric-value current-prefix-arg)))
   (if flag


@@ -994,11 +1001,10 @@ yanking point; just return the Nth kill forward."
            (kill-new interprogram-paste))
          interprogram-paste)
       (or kill-ring (error "Kill ring is empty"))
            (kill-new interprogram-paste))
          interprogram-paste)
       (or kill-ring (error "Kill ring is empty"))

-      (let* ((length (length kill-ring))
-            (ARGth-kill-element
-             (nthcdr (% (+ n (- length (length kill-ring-yank-pointer)))
-                        length)
-                     kill-ring)))
+      (let ((ARGth-kill-element
+            (nthcdr (mod (- n (length kill-ring-yank-pointer))
+                         (length kill-ring))
+                    kill-ring)))

        (or do-not-move
            (setq kill-ring-yank-pointer ARGth-kill-element))
        (car ARGth-kill-element)))))
        (or do-not-move
            (setq kill-ring-yank-pointer ARGth-kill-element))
        (car ARGth-kill-element)))))


@@ -1038,7 +1044,7 @@ to make one entry in the kill ring."
    ;; ring to share the same string object.  This code does that.
    ((not (or (eq buffer-undo-list t)
             (eq last-command 'kill-region)
    ;; ring to share the same string object.  This code does that.
    ((not (or (eq buffer-undo-list t)
             (eq last-command 'kill-region)

-            (eq beg end)))
+            (equal beg end)))

     ;; Don't let the undo list be truncated before we can even access it.
     (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
          (old-list buffer-undo-list)
     ;; Don't let the undo list be truncated before we can even access it.
     (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
          (old-list buffer-undo-list)


@@ -1094,11 +1100,8 @@ system cut and paste."
              (goto-char opoint)
              ;; If user quit, deactivate the mark
              ;; as C-g would as a command.
              (goto-char opoint)
              ;; If user quit, deactivate the mark
              ;; as C-g would as a command.

-             (and quit-flag transient-mark-mode mark-active
-                  (progn
-                    (message "foo")
-                    (setq mark-active nil)
-                    (run-hooks 'deactivate-mark-hook))))
+             (and quit-flag mark-active
+                  (deactivate-mark)))

          (let* ((killed-text (current-kill 0))
                 (message-len (min (length killed-text) 40)))
            (if (= (point) beg)
          (let* ((killed-text (current-kill 0))
                 (message-len (min (length killed-text) 40)))
            (if (= (point) beg)


@@ -1244,6 +1247,9 @@ When the option is non-nil, deactivation of the mark
 turns off region highlighting, but commands that use the mark
 behave as if the mark were still active.")
 
 turns off region highlighting, but commands that use the mark
 behave as if the mark were still active.")
 

+(put 'mark-inactive 'error-conditions '(mark-inactive error))
+(put 'mark-inactive 'error-message "The mark is not active now")
+

 (defun mark (&optional force)
   "Return this buffer's mark value as integer; error if mark inactive.
 If optional argument FORCE is non-nil, access the mark value
 (defun mark (&optional force)
   "Return this buffer's mark value as integer; error if mark inactive.
 If optional argument FORCE is non-nil, access the mark value


@@ -1254,7 +1260,16 @@ If you are using this in an editing command, you are most likely making
 a mistake; see the documentation of `set-mark'."
   (if (or force mark-active mark-even-if-inactive)
       (marker-position (mark-marker))
 a mistake; see the documentation of `set-mark'."
   (if (or force mark-active mark-even-if-inactive)
       (marker-position (mark-marker))

-    (error "The mark is not currently active")))
+    (signal 'mark-inactive nil)))
+
+;; Many places set mark-active directly, and several of them failed to also
+;; run deactivate-mark-hook.  This shorthand should simplify.
+(defsubst deactivate-mark ()
+  "Deactivate the mark by setting `mark-active' to nil.
+\(That makes a difference only in Transient Mark mode.)
+Also runs the hook `deactivate-mark-hook'."
+  (setq mark-active nil)
+  (run-hooks 'deactivate-mark-hook))

 
 (defun set-mark (pos)
   "Set this buffer's mark to POS.  Don't use this function!
 
 (defun set-mark (pos)
   "Set this buffer's mark to POS.  Don't use this function!


@@ -1273,9 +1288,13 @@ store it in a Lisp variable.  Example:
 
    (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
 
 
    (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
 

-  (setq mark-active t)
-  (run-hooks 'activate-mark-hook)
-  (set-marker (mark-marker) pos (current-buffer)))
+  (if pos
+      (progn
+       (setq mark-active t)
+       (run-hooks 'activate-mark-hook)
+       (set-marker (mark-marker) pos (current-buffer)))
+    (deactivate-mark)
+    (set-marker (mark-marker) pos (current-buffer))))

 
 (defvar mark-ring nil
   "The list of saved former marks of the current buffer,
 
 (defvar mark-ring nil
   "The list of saved former marks of the current buffer,


@@ -1331,8 +1350,7 @@ Does not set point.  Does nothing if mark ring is empty."
       (progn
        (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
        (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
       (progn
        (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
        (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))

-       (if transient-mark-mode
-           (setq mark-active nil))
+       (deactivate-mark)

        (move-marker (car mark-ring) nil)
        (if (null (mark t)) (ding))
        (setq mark-ring (cdr mark-ring)))))
        (move-marker (car mark-ring) nil)
        (if (null (mark t)) (ding))
        (setq mark-ring (cdr mark-ring)))))


@@ -1893,16 +1911,22 @@ Setting this variable automatically makes it local to the current buffer.")
            (if (save-excursion
                  (goto-char fill-point)
                  (not (bolp)))
            (if (save-excursion
                  (goto-char fill-point)
                  (not (bolp)))

-               ;; If point is at the fill-point, do not `save-excursion'.
-               ;; Otherwise, if a comment prefix or fill-prefix is inserted,
-               ;; point will end up before it rather than after it.
-               (if (save-excursion
-                     (skip-chars-backward " \t")
-                     (= (point) fill-point))
-                   (indent-new-comment-line)
-                 (save-excursion
-                   (goto-char fill-point)
-                   (indent-new-comment-line)))
+               (let ((prev-column (current-column)))
+                 ;; If point is at the fill-point, do not `save-excursion'.
+                 ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+                 ;; point will end up before it rather than after it.
+                 (if (save-excursion
+                       (skip-chars-backward " \t")
+                       (= (point) fill-point))
+                     (indent-new-comment-line)
+                   (save-excursion
+                     (goto-char fill-point)
+                     (indent-new-comment-line)))
+                 ;; If making the new line didn't reduce the hpos of
+                 ;; the end of the line, then give up now;
+                 ;; trying again will not help.
+                 (if (>= (current-column) prev-column)
+                     (setq give-up t)))

              ;; No place to break => stop trying.
              (setq give-up t)))))))
 
              ;; No place to break => stop trying.
              (setq give-up t)))))))
 


@@ -2088,7 +2112,7 @@ in the mode line."
   "Move cursor momentarily to the beginning of the sexp before point."
   (interactive)
   (and (> (point) (1+ (point-min)))
   "Move cursor momentarily to the beginning of the sexp before point."
   (interactive)
   (and (> (point) (1+ (point-min)))

-       (/= (char-syntax (char-after (- (point) 2))) ?\\ )
+       (not (memq (char-syntax (char-after (- (point) 2))) '(?/ ?\\ )))

        blink-matching-paren
        (let* ((oldpos (point))
              (blinkpos)
        blink-matching-paren
        (let* ((oldpos (point))
              (blinkpos)


@@ -2146,10 +2170,7 @@ in the mode line."
 During execution of Lisp code, this character causes a quit directly.
 At top-level, as an editor command, this simply beeps."
   (interactive)
 During execution of Lisp code, this character causes a quit directly.
 At top-level, as an editor command, this simply beeps."
   (interactive)

-  (and transient-mark-mode mark-active
-       (progn
-        (setq mark-active nil)
-        (run-hooks 'deactivate-mark-hook)))
+  (deactivate-mark)

   (signal 'quit nil))
 
 (define-key global-map "\C-g" 'keyboard-quit)
   (signal 'quit nil))
 
 (define-key global-map "\C-g" 'keyboard-quit)


@@ -2188,7 +2209,38 @@ it were the arg to `interactive' (which see) to interactively read the value."
                                           'arg))
               (eval-minibuffer (format "Set %s to value: " var)))))))
   (set var val))
                                           'arg))
               (eval-minibuffer (format "Set %s to value: " var)))))))
   (set var val))

+\f
+;; Define the major mode for lists of completions.
+
+(defvar completion-list-mode-map nil)
+(or completion-list-mode-map
+    (let ((map (make-sparse-keymap)))
+      (define-key map [mouse-2] 'mouse-choose-completion)
+      (setq completion-list-mode-map map)))
+
+;; Completion mode is suitable only for specially formatted data.
+(put 'completion-list-mode 'mode-class 'special)
+
+(defun completion-list-mode ()
+  "Major mode for buffers showing lists of possible completions.
+Type \\<completion-list-mode-map>\\[mouse-choose-completion] to select
+a completion with the mouse."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map completion-list-mode-map)
+  (setq mode-name "Completion List")
+  (setq major-mode 'completion-list-mode)
+  (run-hooks 'completion-list-mode-hook))
+
+(defun completion-setup-function ()
+  (save-excursion
+    (completion-list-mode)
+    (goto-char (point-min))
+    (if window-system
+       (insert (substitute-command-keys
+                "Click \\[mouse-choose-completion] on a completion to select it.\n\n")))))

 
 

+(add-hook 'completion-setup-hook 'completion-setup-function)

 \f
 ;;;; Keypad support.
 
 \f
 ;;;; Keypad support.