Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 5923:61d7d7bcbe76 cygwin

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merged heads after pull -u
author Henry Thompson <ht@markup.co.uk>
date Thu, 05 Feb 2015 17:19:05 +0000
parents 9e5f3a0d4e66
children ccb0cff115d2
comparison
equal deleted inserted replaced
5921:68639fb08af8 5923:61d7d7bcbe76
2439 :type 'boolean 2439 :type 'boolean
2440 :group 'editing-basics) 2440 :group 'editing-basics)
2441 2441
2442 ;; This is the guts of next-line and previous-line. 2442 ;; This is the guts of next-line and previous-line.
2443 ;; Count says how many lines to move. 2443 ;; Count says how many lines to move.
2444 (defun line-move (count) 2444 (defun line-move (count &optional noerror)
2445 ;; Don't run any point-motion hooks, and disregard intangibility, 2445 ;; Don't run any point-motion hooks, and disregard intangibility,
2446 ;; for intermediate positions. 2446 ;; for intermediate positions.
2447 (let ((inhibit-point-motion-hooks t) 2447 (let ((inhibit-point-motion-hooks t)
2448 (opoint (point)) 2448 (opoint (point))
2449 new) 2449 new)
2468 ;; It doesn't get confused by intangible text. 2468 ;; It doesn't get confused by intangible text.
2469 (end-of-line) 2469 (end-of-line)
2470 (zerop (forward-line 1))) 2470 (zerop (forward-line 1)))
2471 (and (zerop (forward-line count)) 2471 (and (zerop (forward-line count))
2472 (bolp))) 2472 (bolp)))
2473 (signal (if (< count 0) 2473 (if (not noerror)
2474 'beginning-of-buffer 2474 (signal (if (< count 0)
2475 'end-of-buffer) 2475 'beginning-of-buffer
2476 nil)) 2476 'end-of-buffer)
2477 nil)))
2477 ;; Move by count lines, but ignore invisible ones. 2478 ;; Move by count lines, but ignore invisible ones.
2478 (while (> count 0) 2479 (while (> count 0)
2479 (end-of-line) 2480 (end-of-line)
2480 (and (zerop (vertical-motion 1)) 2481 (and (zerop (vertical-motion 1))
2482 (not noerror)
2481 (signal 'end-of-buffer nil)) 2483 (signal 'end-of-buffer nil))
2482 ;; If the following character is currently invisible, 2484 ;; If the following character is currently invisible,
2483 ;; skip all characters with that same `invisible' property value. 2485 ;; skip all characters with that same `invisible' property value.
2484 (while (and (not (eobp)) 2486 (while (and (not (eobp))
2485 (let ((prop 2487 (let ((prop
2493 (goto-char (next-extent-change (point))))) ; XEmacs 2495 (goto-char (next-extent-change (point))))) ; XEmacs
2494 (setq count (1- count))) 2496 (setq count (1- count)))
2495 (while (< count 0) 2497 (while (< count 0)
2496 (beginning-of-line) 2498 (beginning-of-line)
2497 (and (zerop (vertical-motion -1)) 2499 (and (zerop (vertical-motion -1))
2500 (not noerror)
2498 (signal 'beginning-of-buffer nil)) 2501 (signal 'beginning-of-buffer nil))
2499 (while (and (not (bobp)) 2502 (while (and (not (bobp))
2500 (let ((prop 2503 (let ((prop
2501 (get-char-property (1- (point)) 'invisible))) 2504 (get-char-property (1- (point)) 'invisible)))
2502 (if (eq buffer-invisibility-spec t) 2505 (if (eq buffer-invisibility-spec t)
4410 :resignal t 4413 :resignal t
4411 (run-hook-with-args 'remove-message-hook 4414 (run-hook-with-args 'remove-message-hook
4412 (car (car log)) (cdr (car log)))) 4415 (car (car log)) (cdr (car log))))
4413 (setq log (cdr log))))) 4416 (setq log (cdr log)))))
4414 4417
4415 (defun append-message (label message &optional frame stdout-p) 4418 (defun* append-message (label message &optional frame stdout-p
4419 &key (start 0) end)
4416 "Add MESSAGE to the message-stack, or append it to the existing text. 4420 "Add MESSAGE to the message-stack, or append it to the existing text.
4421
4417 LABEL is the class of the message. If it is the same as that of the top of 4422 LABEL is the class of the message. If it is the same as that of the top of
4418 the message stack, MESSAGE is appended to the existing message, otherwise 4423 the message stack, MESSAGE is appended to the existing message, otherwise
4419 it is pushed on the stack. 4424 it is pushed on the stack.
4425
4420 FRAME determines the minibuffer window to send the message to. 4426 FRAME determines the minibuffer window to send the message to.
4427
4421 STDOUT-P is ignored, except for output to stream devices. For streams, 4428 STDOUT-P is ignored, except for output to stream devices. For streams,
4422 STDOUT-P non-nil directs output to stdout, otherwise to stderr." 4429 STDOUT-P non-nil directs output to stdout, otherwise to stderr.
4430
4431 START and END, if supplied, designate a substring of MESSAGE to add. See
4432 `write-sequence'."
4423 (or frame (setq frame (selected-frame))) 4433 (or frame (setq frame (selected-frame)))
4424 ;; If outputting to the terminal, make sure output from anyone else clears 4434 ;; If outputting to the terminal, make sure output from anyone else clears
4425 ;; the left side first, but don't do it ourselves, otherwise we won't be 4435 ;; the left side first, but don't do it ourselves, otherwise we won't be
4426 ;; able to append to an existing message. 4436 ;; able to append to an existing message.
4427 (if (eq 'stream (frame-type frame)) 4437 (if (eq 'stream (frame-type frame))
4428 (set-device-clear-left-side (frame-device frame) nil)) 4438 (set-device-clear-left-side (frame-device frame) nil))
4429 (let ((top (car message-stack))) 4439 (let ((top (car message-stack)))
4430 (if (eq label (car top)) 4440 (if (eq label (car top))
4431 (setcdr top (concat (cdr top) message)) 4441 (setcdr top (concat (cdr top) message))
4432 (push (cons label message) message-stack))) 4442 (push (cons label message) message-stack)))
4433 (raw-append-message message frame stdout-p) 4443 (raw-append-message message frame stdout-p :start start :end end)
4434 (if (eq 'stream (frame-type frame)) 4444 (if (eq 'stream (frame-type frame))
4435 (set-device-clear-left-side (frame-device frame) t))) 4445 (set-device-clear-left-side (frame-device frame) t)))
4436 4446
4437 ;; Really append the message to the echo area. No fiddling with 4447 ;; Really append the message to the echo area. No fiddling with
4438 ;; message-stack. 4448 ;; message-stack.
4439 (defun raw-append-message (message &optional frame stdout-p) 4449 (defun* raw-append-message (message &optional frame stdout-p
4450 &key (start 0) end)
4440 (unless (equal message "") 4451 (unless (equal message "")
4441 (let ((inhibit-read-only t)) 4452 (let ((inhibit-read-only t))
4442 (with-current-buffer " *Echo Area*" 4453 (with-current-buffer " *Echo Area*"
4443 (insert-string message) 4454 (write-sequence message (current-buffer) :start start :end end)
4444 ;; #### This needs to be conditional; cf discussion by Stefan Monnier 4455 ;; #### This needs to be conditional; cf discussion by Stefan Monnier
4445 ;; et al on emacs-devel in mid-to-late April 2007. One problem is 4456 ;; et al on emacs-devel in mid-to-late April 2007. One problem is
4446 ;; there is no known good way to guess whether the user wants to have 4457 ;; there is no known good way to guess whether the user wants to have
4447 ;; the echo area height changed on him asynchronously, especially 4458 ;; the echo area height changed on him asynchronously, especially
4448 ;; after message display. 4459 ;; after message display.
4487 ;; the cleanest way is to make the concept of a "redisplayable" 4498 ;; the cleanest way is to make the concept of a "redisplayable"
4488 ;; device, which stream devices are not. Look into this more if 4499 ;; device, which stream devices are not. Look into this more if
4489 ;; we ever create another non-redisplayable device type (e.g. 4500 ;; we ever create another non-redisplayable device type (e.g.
4490 ;; processes? printers?). 4501 ;; processes? printers?).
4491 (if (eq 'stream (frame-type frame)) 4502 (if (eq 'stream (frame-type frame))
4492 (send-string-to-terminal message stdout-p (frame-device frame)) 4503 (send-string-to-terminal (subseq message start end) stdout-p
4504 (frame-device frame))
4493 (funcall redisplay-echo-area-function)))))) 4505 (funcall redisplay-echo-area-function))))))
4494 4506
4495 (defun display-message (label message &optional frame stdout-p) 4507 (defun display-message (label message &optional frame stdout-p)
4496 "Print a one-line message at the bottom of the frame. First argument 4508 "Print a one-line message at the bottom of the frame. First argument
4497 LABEL is an identifier for this message. MESSAGE is the string to display. 4509 LABEL is an identifier for this message. MESSAGE is the string to display.