[Emacs-diffs] Changes to emacs/lisp/simple.el [lexbind]

[Miles Bader]

Index: emacs/lisp/simple.el
diff -c emacs/lisp/simple.el:1.551.2.31 emacs/lisp/simple.el:1.551.2.32
*** emacs/lisp/simple.el:1.551.2.31     Thu Nov  4 13:12:41 2004
--- emacs/lisp/simple.el        Fri Nov 12 04:21:13 2004
***************
*** 67,72 ****
--- 67,110 ----
      (switch-to-buffer found)))
  
  ;;; next-error support framework
+ 
+ (defgroup next-error nil
+   "next-error support framework."
+   :group 'compilation
+   :version "21.4")
+ 
+ (defface next-error
+   '((t (:inherit region)))
+   "Face used to highlight next error locus."
+   :group 'next-error
+   :version "21.4")
+ 
+ (defcustom next-error-highlight 0.1
+   "*Highlighting of locations in selected source buffers.
+ If number, highlight the locus in next-error face for given time in seconds.
+ If t, use persistent overlays fontified in next-error face.
+ If nil, don't highlight the locus in the source buffer.
+ If `fringe-arrow', indicate the locus by the fringe arrow."
+   :type '(choice (number :tag "Delay")
+                  (const :tag "Persistent overlay" t)
+                  (const :tag "No highlighting" nil)
+                  (const :tag "Fringe arrow" 'fringe-arrow))
+   :group 'next-error
+   :version "21.4")
+ 
+ (defcustom next-error-highlight-no-select 0.1
+   "*Highlighting of locations in non-selected source buffers.
+ If number, highlight the locus in next-error face for given time in seconds.
+ If t, use persistent overlays fontified in next-error face.
+ If nil, don't highlight the locus in the source buffer.
+ If `fringe-arrow', indicate the locus by the fringe arrow."
+   :type '(choice (number :tag "Delay")
+                  (const :tag "Persistent overlay" t)
+                  (const :tag "No highlighting" nil)
+                  (const :tag "Fringe arrow" 'fringe-arrow))
+   :group 'next-error
+   :version "21.4")
+ 
  (defvar next-error-last-buffer nil
    "The most recent next-error buffer.
  A buffer becomes most recent when its compilation, grep, or
***************
*** 213,255 ****
    (interactive "p")
    (next-error-no-select (- (or n 1))))
  
- (defgroup next-error nil
-   "next-error support framework."
-   :group 'compilation
-   :version "21.4")
- 
- (defface next-error
-   '((t (:inherit region)))
-   "Face used to highlight next error locus."
-   :group 'next-error
-   :version "21.4")
- 
- (defcustom next-error-highlight 0.1
-   "*Highlighting of locations in selected source buffers.
- If number, highlight the locus in next-error face for given time in seconds.
- If t, use persistent overlays fontified in next-error face.
- If nil, don't highlight the locus in the source buffer.
- If `fringe-arrow', indicate the locus by the fringe arrow."
-   :type '(choice (number :tag "Delay")
-                  (const :tag "Persistent overlay" t)
-                  (const :tag "No highlighting" nil)
-                  (const :tag "Fringe arrow" 'fringe-arrow))
-   :group 'next-error
-   :version "21.4")
- 
- (defcustom next-error-highlight-no-select 0.1
-   "*Highlighting of locations in non-selected source buffers.
- If number, highlight the locus in next-error face for given time in seconds.
- If t, use persistent overlays fontified in next-error face.
- If nil, don't highlight the locus in the source buffer.
- If `fringe-arrow', indicate the locus by the fringe arrow."
-   :type '(choice (number :tag "Delay")
-                  (const :tag "Persistent overlay" t)
-                  (const :tag "No highlighting" nil)
-                  (const :tag "Fringe arrow" 'fringe-arrow))
-   :group 'next-error
-   :version "21.4")
- 
  ;;; Internal variable for `next-error-follow-mode-post-command-hook'.
  (defvar next-error-follow-last-line nil)
  
--- 251,256 ----
***************
*** 2280,2285 ****
--- 2281,2288 ----
  visual feedback indicating the extent of the region being copied."
    (interactive "r")
    (copy-region-as-kill beg end)
+   ;; This use of interactive-p is correct
+   ;; because the code it controls just gives the user visual feedback.
    (if (interactive-p)
        (let ((other-end (if (= (point) beg) end beg))
            (opoint (point))
***************
*** 3081,3093 ****
  at the start of current run of vertical motion commands.
  When the `track-eol' feature is doing its job, the value is 9999.")
  
! (defcustom line-move-ignore-invisible nil
    "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
  Outline mode sets this."
    :type 'boolean
    :group 'editing-basics)
  
! (defun line-move-invisible (pos)
    "Return non-nil if the character after POS is currently invisible."
    (let ((prop
         (get-char-property pos 'invisible)))
--- 3084,3096 ----
  at the start of current run of vertical motion commands.
  When the `track-eol' feature is doing its job, the value is 9999.")
  
! (defcustom line-move-ignore-invisible t
    "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
  Outline mode sets this."
    :type 'boolean
    :group 'editing-basics)
  
! (defun line-move-invisible-p (pos)
    "Return non-nil if the character after POS is currently invisible."
    (let ((prop
         (get-char-property pos 'invisible)))
***************
*** 3098,3104 ****
  
  ;; This is the guts of next-line and previous-line.
  ;; Arg says how many lines to move.
! (defun line-move (arg)
    ;; Don't run any point-motion hooks, and disregard intangibility,
    ;; for intermediate positions.
    (let ((inhibit-point-motion-hooks t)
--- 3101,3108 ----
  
  ;; This is the guts of next-line and previous-line.
  ;; Arg says how many lines to move.
! ;; The value is t if we can move the specified number of lines.
! (defun line-move (arg &optional noerror to-end)
    ;; Don't run any point-motion hooks, and disregard intangibility,
    ;; for intermediate positions.
    (let ((inhibit-point-motion-hooks t)
***************
*** 3114,3119 ****
--- 3118,3124 ----
                             (or (not (bolp)) (eq last-command 'end-of-line)))
                        9999
                      (current-column))))
+ 
          (if (and (not (integerp selective-display))
                   (not line-move-ignore-invisible))
              ;; Use just newline characters.
***************
*** 3129,3156 ****
                    (and (zerop (forward-line arg))
                         (bolp)
                         (setq arg 0)))
!                 (signal (if (< arg 0)
!                             'beginning-of-buffer
!                           'end-of-buffer)
!                         nil))
            ;; Move by arg lines, but ignore invisible ones.
!           (while (> arg 0)
!             ;; If the following character is currently invisible,
!             ;; skip all characters with that same `invisible' property value.
!             (while (and (not (eobp)) (line-move-invisible (point)))
!               (goto-char (next-char-property-change (point))))
!             ;; Now move a line.
!             (end-of-line)
!             (and (zerop (vertical-motion 1))
!                  (signal 'end-of-buffer nil))
!             (setq arg (1- arg)))
!           (while (< arg 0)
!             (beginning-of-line)
!             (and (zerop (vertical-motion -1))
!                  (signal 'beginning-of-buffer nil))
!             (setq arg (1+ arg))
!             (while (and (not (bobp)) (line-move-invisible (1- (point))))
!               (goto-char (previous-char-property-change (point)))))))
  
        (cond ((> arg 0)
             ;; If we did not move down as far as desired,
--- 3134,3176 ----
                    (and (zerop (forward-line arg))
                         (bolp)
                         (setq arg 0)))
!                 (unless noerror
!                   (signal (if (< arg 0)
!                               'beginning-of-buffer
!                             'end-of-buffer)
!                           nil)))
            ;; Move by arg lines, but ignore invisible ones.
!           (let (done)
!             (while (and (> arg 0) (not done))
!               ;; If the following character is currently invisible,
!               ;; skip all characters with that same `invisible' property 
value.
!               (while (and (not (eobp)) (line-move-invisible-p (point)))
!                 (goto-char (next-char-property-change (point))))
!               ;; Now move a line.
!               (end-of-line)
!               (and (zerop (vertical-motion 1))
!                    (if (not noerror)
!                        (signal 'end-of-buffer nil)
!                      (setq done t)))
!               (unless done
!                 (setq arg (1- arg))))
!             (while (and (< arg 0) (not done))
!               (beginning-of-line)
! 
!               (if (zerop (vertical-motion -1))
!                   (if (not noerror)
!                       (signal 'beginning-of-buffer nil)
!                     (setq done t)))
!               (unless done
!                 (setq arg (1+ arg))
!                 (while (and ;; Don't move over previous invis lines
!                         ;; if our target is the middle of this line.
!                         (or (zerop (or goal-column temporary-goal-column))
!                             (< arg 0))
!                         (not (bobp)) (line-move-invisible-p (1- (point))))
!                   (goto-char (previous-char-property-change (point))))))))
!         ;; This is the value the function returns.
!         (= arg 0))
  
        (cond ((> arg 0)
             ;; If we did not move down as far as desired,
***************
*** 3161,3168 ****
             ;; at least go to end of line.
             (beginning-of-line))
            (t
!            (line-move-finish (or goal-column temporary-goal-column) 
opoint)))))
!   nil)
  
  (defun line-move-finish (column opoint)
    (let ((repeat t))
--- 3181,3187 ----
             ;; at least go to end of line.
             (beginning-of-line))
            (t
!            (line-move-finish (or goal-column temporary-goal-column) 
opoint))))))
  
  (defun line-move-finish (column opoint)
    (let ((repeat t))
***************
*** 3175,3183 ****
            (line-end
             ;; Compute the end of the line
             ;; ignoring effectively intangible newlines.
!            (let ((inhibit-point-motion-hooks nil)
!                  (inhibit-field-text-motion t))
!              (save-excursion (end-of-line) (point)))))
  
        ;; Move to the desired column.
        (line-move-to-column column)
--- 3194,3204 ----
            (line-end
             ;; Compute the end of the line
             ;; ignoring effectively intangible newlines.
!            (save-excursion
!              (let ((inhibit-point-motion-hooks nil)
!                    (inhibit-field-text-motion t))
!                (end-of-line))
!              (point))))
  
        ;; Move to the desired column.
        (line-move-to-column column)
***************
*** 3228,3240 ****
      (move-to-column col))
  
    (when (and line-move-ignore-invisible
!            (not (bolp)) (line-move-invisible (1- (point))))
      (let ((normal-location (point))
          (normal-column (current-column)))
        ;; If the following character is currently invisible,
        ;; skip all characters with that same `invisible' property value.
        (while (and (not (eobp))
!                 (line-move-invisible (point)))
        (goto-char (next-char-property-change (point))))
        ;; Have we advanced to a larger column position?
        (if (> (current-column) normal-column)
--- 3249,3261 ----
      (move-to-column col))
  
    (when (and line-move-ignore-invisible
!            (not (bolp)) (line-move-invisible-p (1- (point))))
      (let ((normal-location (point))
          (normal-column (current-column)))
        ;; If the following character is currently invisible,
        ;; skip all characters with that same `invisible' property value.
        (while (and (not (eobp))
!                 (line-move-invisible-p (point)))
        (goto-char (next-char-property-change (point))))
        ;; Have we advanced to a larger column position?
        (if (> (current-column) normal-column)
***************
*** 3247,3255 ****
        ;; but with a more reasonable buffer position.
        (goto-char normal-location)
        (let ((line-beg (save-excursion (beginning-of-line) (point))))
!         (while (and (not (bolp)) (line-move-invisible (1- (point))))
            (goto-char (previous-char-property-change (point) line-beg))))))))
  
  ;;; Many people have said they rarely use this feature, and often type
  ;;; it by accident.  Maybe it shouldn't even be on a key.
  (put 'set-goal-column 'disabled t)
--- 3268,3312 ----
        ;; but with a more reasonable buffer position.
        (goto-char normal-location)
        (let ((line-beg (save-excursion (beginning-of-line) (point))))
!         (while (and (not (bolp)) (line-move-invisible-p (1- (point))))
            (goto-char (previous-char-property-change (point) line-beg))))))))
  
+ (defun move-end-of-line (arg)
+   "Move point to end of current line.
+ With argument ARG not nil or 1, move forward ARG - 1 lines first.
+ If point reaches the beginning or end of buffer, it stops there.
+ To ignore intangibility, bind `inhibit-point-motion-hooks' to t.
+ 
+ This command does not move point across a field boundary unless doing so
+ would move beyond there to a different line; if ARG is nil or 1, and
+ point starts at a field boundary, point does not move.  To ignore field
+ boundaries bind `inhibit-field-text-motion' to t."
+   (interactive "p")
+   (or arg (setq arg 1))
+   (let (done)
+     (while (not done)
+       (let ((newpos
+            (save-excursion
+              (let ((goal-column 0))
+                (and (line-move arg t)
+                     (not (bobp))
+                     (progn
+                       (while (and (not (bobp)) (line-move-invisible-p (1- 
(point))))
+                         (goto-char (previous-char-property-change (point))))
+                       (backward-char 1)))
+                (point)))))
+       (goto-char newpos)
+       (if (and (> (point) newpos)
+                (eq (preceding-char) ?\n))
+           (backward-char 1)
+         (if (and (> (point) newpos) (not (eobp))
+                  (not (eq (following-char) ?\n)))
+             ;; If we skipped something intangible
+             ;; and now we're not really at eol,
+             ;; keep going.
+             (setq arg 1)
+           (setq done t)))))))
+ 
  ;;; Many people have said they rarely use this feature, and often type
  ;;; it by accident.  Maybe it shouldn't even be on a key.
  (put 'set-goal-column 'disabled t)
***************
*** 3298,3304 ****
        (progn
          (select-window window)
          ;; Set point and mark in that window's buffer.
!         (beginning-of-buffer arg)
          ;; Set point accordingly.
          (recenter '(t)))
        (select-window orig-window))))
--- 3355,3362 ----
        (progn
          (select-window window)
          ;; Set point and mark in that window's buffer.
!         (with-no-warnings
!          (beginning-of-buffer arg))
          ;; Set point accordingly.
          (recenter '(t)))
        (select-window orig-window))))
***************
*** 3314,3320 ****
      (unwind-protect
        (progn
          (select-window window)
!         (end-of-buffer arg)
          (recenter '(t)))
        (select-window orig-window))))
  
--- 3372,3379 ----
      (unwind-protect
        (progn
          (select-window window)
!         (with-no-warnings
!          (end-of-buffer arg))
          (recenter '(t)))
        (select-window orig-window))))