comparison lisp/simple.el @ 84609:653c328271e7

(newline): Simplify use of prefix-numeric-value. (line-move-partial): Remove unused var `ppos'. (line-move-1): Replace 9999 with most-positive-fixnum. (move-end-of-line): Use more efficient single-property search. (move-beginning-of-line): Remove unused var `start'. (blink-matching-open): Restructure in a more functional style.

84608:2768a568e11e

    ;; thinks he inserted.

    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
	(set-hard-newline-properties
	 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
    ;; If the newline leaves the previous line blank,
    ;; and we have a left margin, delete that from the blank line.
    (or flag
	(save-excursion
	  (goto-char beforepos)

           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
               (eq this-command last-command)
               (if (boundp 'edebug-active) edebug-active)))
      (let ((char-string
             (if (or (if (boundp 'edebug-active) edebug-active)
                     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
                 (prin1-char value))))
        (if char-string
            (format " (#o%o, #x%x, %s)" value value char-string)
          (format " (#o%o, #x%x)" value value)))))

;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
  '(read-only invisible intangible field mouse-face help-echo local-map keymap
    yank-handler follow-link fontified)
  "*Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
which means to discard all text properties."
  :type '(choice (const :tag "All" t) (repeat symbol))
  :group 'killing
  :version "22.1")

(defvar temporary-goal-column 0
  "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

    ;; Move forward (down).
    (let* ((lh (window-line-height -1))
	   (vpos (nth 1 lh))
	   (ypos (nth 2 lh))
	   (rbot (nth 3 lh))
	   ppos py vs)
      (when (or (null lh)
		(>= rbot (frame-char-height))
		(<= ypos (- (frame-char-height))))
	(unless lh
	  (let ((wend (pos-visible-in-window-p t nil t)))

	      (setq temporary-goal-column
		    (if (and track-eol (eolp)
			     ;; 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 'move-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)
		      (progn (if (> arg 1) (forward-line (1- arg)))
			     ;; This way of moving forward ARG lines

	       (let ((goal-column 0))
		 (and (line-move arg t)
		      (not (bobp))
		      (progn
			(while (and (not (bobp)) (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))

To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
  (interactive "p")
  (or arg (setq arg 1))

  (let ((orig (point))
	start first-vis first-vis-field-value)

    ;; Move by lines, if ARG is not 1 (the default).
    (if (/= arg 1)
	(line-move (1- arg) t))

    ;; Move to beginning-of-line, ignoring fields and invisibles.
    (skip-chars-backward "^\n")
    (while (and (not (bobp)) (invisible-p (1- (point))))
      (goto-char (previous-char-property-change (point)))
      (skip-chars-backward "^\n"))
    (setq start (point))

    ;; Now find first visible char in the line
    (while (and (not (eobp)) (invisible-p (point)))
      (goto-char (next-char-property-change (point))))
    (setq first-vis (point))

			       (save-excursion
				 (forward-char -1)
				 (skip-syntax-backward "/\\")
				 (point))))))
    (let* ((oldpos (point))
	   blinkpos
	   message-log-max  ; Don't log messages about paren matching.
	   matching-paren
	   open-paren-line-string)
      (save-excursion
	(save-restriction
	  (if blink-matching-paren-distance
	      (narrow-to-region (max (minibuffer-prompt-end)
				     (- (point) blink-matching-paren-distance))
				oldpos))
	  (condition-case ()
	      (let ((parse-sexp-ignore-comments
		     (and parse-sexp-ignore-comments
			  (not blink-matching-paren-dont-ignore-comments))))
		(setq blinkpos (scan-sexps oldpos -1)))
	    (error nil)))
	(and blinkpos
	     ;; Not syntax '$'.
	     (not (eq (syntax-class (syntax-after blinkpos)) 8))
	     (setq matching-paren
		   (let ((syntax (syntax-after blinkpos)))
		     (and (consp syntax)
			  (eq (syntax-class syntax) 4)
			  (cdr syntax)))))
	(cond
	 ((not (or (eq matching-paren (char-before oldpos))
                   ;; The cdr might hold a new paren-class info rather than
                   ;; a matching-char info, in which case the two CDRs
                   ;; should match.
                   (eq matching-paren (cdr (syntax-after (1- oldpos))))))
	  (message "Mismatched parentheses"))
	 ((not blinkpos)
	  (if (not blink-matching-paren-distance)
	      (message "Unmatched parenthesis")))
	 ((pos-visible-in-window-p blinkpos)
	  ;; Matching open within window, temporarily move to blinkpos but only
	  ;; if `blink-matching-paren-on-screen' is non-nil.
	  (and blink-matching-paren-on-screen
	       (not show-paren-mode)
	       (save-excursion
		 (goto-char blinkpos)
		 (sit-for blink-matching-delay))))
	 (t
	  (save-excursion
	    (goto-char blinkpos)
	    (setq open-paren-line-string
		  ;; Show what precedes the open in its line, if anything.
		  (if (save-excursion
			(skip-chars-backward " \t")
			(not (bolp)))
		      (buffer-substring (line-beginning-position)
					(1+ blinkpos))
		    ;; Show what follows the open in its line, if anything.
		    (if (save-excursion
			  (forward-char 1)
			  (skip-chars-forward " \t")
			  (not (eolp)))
			(buffer-substring blinkpos
					  (line-end-position))
		      ;; Otherwise show the previous nonblank line,
		      ;; if there is one.
		      (if (save-excursion
			    (skip-chars-backward "\n \t")
			    (not (bobp)))
			  (concat
			   (buffer-substring (progn
					       (skip-chars-backward "\n \t")
					       (line-beginning-position))
					     (progn (end-of-line)
						    (skip-chars-backward " \t")
						    (point)))
			   ;; Replace the newline and other whitespace with `...'.
			   "..."
			   (buffer-substring blinkpos (1+ blinkpos)))
			;; There is nothing to show except the char itself.
			(buffer-substring blinkpos (1+ blinkpos)))))))
	  (message "Matches %s"
		   (substring-no-properties open-paren-line-string))))))))

;Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)

;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
;; that happens in the QUIT macro at the C code level.

84609:653c328271e7

    ;; thinks he inserted.

    ;; Mark the newline(s) `hard'.
    (if use-hard-newlines
	(set-hard-newline-properties
	 (- (point) (prefix-numeric-value arg)) (point)))
    ;; If the newline leaves the previous line blank,
    ;; and we have a left margin, delete that from the blank line.
    (or flag
	(save-excursion
	  (goto-char beforepos)

           (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
               (eq this-command last-command)
               (if (boundp 'edebug-active) edebug-active)))
      (let ((char-string
             (if (or (if (boundp 'edebug-active) edebug-active)
		     (memq this-command '(eval-last-sexp eval-print-last-sexp)))
                 (prin1-char value))))
        (if char-string
            (format " (#o%o, #x%x, %s)" value value char-string)
          (format " (#o%o, #x%x)" value value)))))

;; This is actually used in subr.el but defcustom does not work there.
(defcustom yank-excluded-properties
  '(read-only invisible intangible field mouse-face help-echo local-map keymap
    yank-handler follow-link fontified)
  "Text properties to discard when yanking.
The value should be a list of text properties to discard or t,
which means to discard all text properties."
  :type '(choice (const :tag "All" t) (repeat symbol))
  :group 'killing
  :version "22.1")

(defvar temporary-goal-column 0
  "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 `most-positive-fixnum'.")

(defcustom line-move-ignore-invisible t
  "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
Outline mode sets this."
  :type 'boolean

    ;; Move forward (down).
    (let* ((lh (window-line-height -1))
	   (vpos (nth 1 lh))
	   (ypos (nth 2 lh))
	   (rbot (nth 3 lh))
	   py vs)
      (when (or (null lh)
		(>= rbot (frame-char-height))
		(<= ypos (- (frame-char-height))))
	(unless lh
	  (let ((wend (pos-visible-in-window-p t nil t)))

	      (setq temporary-goal-column
		    (if (and track-eol (eolp)
			     ;; 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 'move-end-of-line)))
			most-positive-fixnum
		      (current-column))))

	  (if (not (or (integerp selective-display)
                       line-move-ignore-invisible))
	      ;; Use just newline characters.
	      ;; Set ARG to 0 if we move as many lines as requested.
	      (or (if (> arg 0)
		      (progn (if (> arg 1) (forward-line (1- arg)))
			     ;; This way of moving forward ARG lines

	       (let ((goal-column 0))
		 (and (line-move arg t)
		      (not (bobp))
		      (progn
			(while (and (not (bobp)) (invisible-p (1- (point))))
			  (goto-char (previous-single-char-property-change
                                      (point) 'invisible)))
			(backward-char 1)))
		 (point)))))
	(goto-char newpos)
	(if (and (> (point) newpos)
		 (eq (preceding-char) ?\n))

To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
  (interactive "p")
  (or arg (setq arg 1))

  (let ((orig (point))
	first-vis first-vis-field-value)

    ;; Move by lines, if ARG is not 1 (the default).
    (if (/= arg 1)
	(line-move (1- arg) t))

    ;; Move to beginning-of-line, ignoring fields and invisibles.
    (skip-chars-backward "^\n")
    (while (and (not (bobp)) (invisible-p (1- (point))))
      (goto-char (previous-char-property-change (point)))
      (skip-chars-backward "^\n"))

    ;; Now find first visible char in the line
    (while (and (not (eobp)) (invisible-p (point)))
      (goto-char (next-char-property-change (point))))
    (setq first-vis (point))

			       (save-excursion
				 (forward-char -1)
				 (skip-syntax-backward "/\\")
				 (point))))))
    (let* ((oldpos (point))
	   (message-log-max nil)  ; Don't log messages about paren matching.
	   (blinkpos
            (save-excursion
              (save-restriction
                (if blink-matching-paren-distance
                    (narrow-to-region
                     (max (minibuffer-prompt-end) ;(point-min) unless minibuf.
                          (- (point) blink-matching-paren-distance))
                     oldpos))
                (let ((parse-sexp-ignore-comments
                       (and parse-sexp-ignore-comments
                            (not blink-matching-paren-dont-ignore-comments))))
                  (condition-case ()
                      (scan-sexps oldpos -1)
                    (error nil))))))
	   (matching-paren
            (and blinkpos
                 ;; Not syntax '$'.
                 (not (eq (syntax-class (syntax-after blinkpos)) 8))
                 (let ((syntax (syntax-after blinkpos)))
                   (and (consp syntax)
                        (eq (syntax-class syntax) 4)
                        (cdr syntax))))))
      (cond
       ((not (or (eq matching-paren (char-before oldpos))
                 ;; The cdr might hold a new paren-class info rather than
                 ;; a matching-char info, in which case the two CDRs
                 ;; should match.
                 (eq matching-paren (cdr (syntax-after (1- oldpos))))))
        (message "Mismatched parentheses"))
       ((not blinkpos)
        (if (not blink-matching-paren-distance)
            (message "Unmatched parenthesis")))
       ((pos-visible-in-window-p blinkpos)
        ;; Matching open within window, temporarily move to blinkpos but only
        ;; if `blink-matching-paren-on-screen' is non-nil.
        (and blink-matching-paren-on-screen
             (not show-paren-mode)
             (save-excursion
               (goto-char blinkpos)
               (sit-for blink-matching-delay))))
       (t
        (save-excursion
          (goto-char blinkpos)
          (let ((open-paren-line-string
                 ;; Show what precedes the open in its line, if anything.
                 (cond
                  ((save-excursion (skip-chars-backward " \t") (not (bolp)))
                   (buffer-substring (line-beginning-position)
                                     (1+ blinkpos)))
                  ;; Show what follows the open in its line, if anything.
                  ((save-excursion
                     (forward-char 1)
                     (skip-chars-forward " \t")
                     (not (eolp)))
                   (buffer-substring blinkpos
                                     (line-end-position)))
                  ;; Otherwise show the previous nonblank line,
                  ;; if there is one.
                  ((save-excursion (skip-chars-backward "\n \t") (not (bobp)))
                   (concat
                    (buffer-substring (progn
                                        (skip-chars-backward "\n \t")
                                        (line-beginning-position))
                                      (progn (end-of-line)
                                             (skip-chars-backward " \t")
                                             (point)))
                    ;; Replace the newline and other whitespace with `...'.
                    "..."
                    (buffer-substring blinkpos (1+ blinkpos))))
                  ;; There is nothing to show except the char itself.
                  (t (buffer-substring blinkpos (1+ blinkpos))))))
            (message "Matches %s"
                     (substring-no-properties open-paren-line-string)))))))))

;; Turned off because it makes dbx bomb out.
(setq blink-paren-function 'blink-matching-open)

;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
;; that happens in the QUIT macro at the C code level.