comparison lisp/simple.el @ 58046:e24a83048e7b

(next-error group, face): Move before first use. (next-error-highlight, next-error-highlight-no-select): Likewise. (line-move-invisible-p): Renamed from line-move-invisible. (line-move): New args NOERROR and TO-END. Return t if if succeed in moving specified number of lines. (move-end-of-line): New function. (beginning-of-buffer-other-window, end-of-buffer-other-window): Use with-no-warnings.

58045:a683f1bc6fbe

	    (setq found buffer)))
      (setq list (cdr list)))
    (switch-to-buffer found)))

;;; next-error support framework
(defvar next-error-last-buffer nil
  "The most recent next-error buffer.
A buffer becomes most recent when its compilation, grep, or
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")

forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
select the source buffer."
  (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)

(define-minor-mode next-error-follow-minor-mode

This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
  (interactive "r")
  (copy-region-as-kill beg end)
  (if (interactive-p)
      (let ((other-end (if (= (point) beg) end beg))
	    (opoint (point))
	    ;; Inhibit quitting so we can make a quit here
	    ;; look like a C-g typed as a command.

  "Current goal column for vertical motion.
It is the column where point was
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)))
    (if (eq buffer-invisibility-spec t)
	prop
      (or (memq prop buffer-invisibility-spec)
	  (assq prop buffer-invisibility-spec)))))

;; 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)
	(opoint (point))
	new line-end line-beg)

			     ;; Don't count beg of empty line as end of line
			     ;; unless we just did explicit end-of-line.
			     (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.
	      ;; Set ARG to 0 if we move as many lines as requested.
	      (or (if (> arg 0)

			     (if (zerop (forward-line 1))
				 (setq arg 0)))
		    (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,
	     ;; at least go to end of line.
	     (end-of-line))
	    ((< arg 0)
	     ;; If we did not move down as far as desired,
	     ;; 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))
    (while repeat
      ;; Set REPEAT to t to repeat the whole thing.

      (let (new
	    (line-beg (save-excursion (beginning-of-line) (point)))
	    (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)
	(setq new (point))

  (if (zerop col)
      (beginning-of-line)
    (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)
	  ;; We have made some progress towards the desired column.
	  ;; See if we can make any further progress.

	;; and move back over invisible text.
	;; that will get us to the same place on the screen
	;; 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)

    ;; because the latter would preserve the things we want to change.
    (unwind-protect
	(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))))

(defun end-of-buffer-other-window (arg)

  (let ((orig-window (selected-window))
	(window (other-window-for-scrolling)))
    (unwind-protect
	(progn
	  (select-window window)
	  (end-of-buffer arg)
	  (recenter '(t)))
      (select-window orig-window))))

(defun transpose-chars (arg)
  "Interchange characters around point, moving forward one character.

58046:e24a83048e7b

	    (setq found buffer)))
      (setq list (cdr list)))
    (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
similar mode is started, or when it is used with \\[next-error]
or \\[compile-goto-error].")

forwards, if negative).
Finds and highlights the source line like \\[previous-error], but does not
select the source buffer."
  (interactive "p")
  (next-error-no-select (- (or n 1))))

;;; Internal variable for `next-error-follow-mode-post-command-hook'.
(defvar next-error-follow-last-line nil)

(define-minor-mode next-error-follow-minor-mode

This command is similar to `copy-region-as-kill', except that it gives
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))
	    ;; Inhibit quitting so we can make a quit here
	    ;; look like a C-g typed as a command.

  "Current goal column for vertical motion.
It is the column where point was
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)))
    (if (eq buffer-invisibility-spec t)
	prop
      (or (memq prop buffer-invisibility-spec)
	  (assq prop buffer-invisibility-spec)))))

;; 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)
	(opoint (point))
	new line-end line-beg)

			     ;; Don't count beg of empty line as end of line
			     ;; unless we just did explicit end-of-line.
			     (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.
	      ;; Set ARG to 0 if we move as many lines as requested.
	      (or (if (> arg 0)

			     (if (zerop (forward-line 1))
				 (setq arg 0)))
		    (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,
	     ;; at least go to end of line.
	     (end-of-line))
	    ((< arg 0)
	     ;; If we did not move down as far as desired,
	     ;; 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))
    (while repeat
      ;; Set REPEAT to t to repeat the whole thing.

      (let (new
	    (line-beg (save-excursion (beginning-of-line) (point)))
	    (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)
	(setq new (point))

  (if (zerop col)
      (beginning-of-line)
    (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)
	  ;; We have made some progress towards the desired column.
	  ;; See if we can make any further progress.

	;; and move back over invisible text.
	;; that will get us to the same place on the screen
	;; 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)

    ;; because the latter would preserve the things we want to change.
    (unwind-protect
	(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))))

(defun end-of-buffer-other-window (arg)

  (let ((orig-window (selected-window))
	(window (other-window-for-scrolling)))
    (unwind-protect
	(progn
	  (select-window window)
	  (with-no-warnings
	   (end-of-buffer arg))
	  (recenter '(t)))
      (select-window orig-window))))

(defun transpose-chars (arg)
  "Interchange characters around point, moving forward one character.