(defun delete-blank-lines ()
"On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
-On nonblank line, delete all blank lines that follow it."
+On nonblank line, delete any immediately following blank lines."
(interactive "*")
(let (thisblank singleblank)
(save-excursion
"Delete characters backward, changing tabs into spaces.
Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
Interactively, ARG is the prefix arg (default 1)
-and KILLP is t if prefix arg is was specified."
+and KILLP is t if a prefix arg was specified."
(interactive "*p\nP")
(let ((count arg))
(save-excursion
(goto-char (window-start))
(vertical-motion (window-height))
(< (point) old-point)))
- (recenter -3))))
+ (progn
+ (overlay-recenter (point))
+ (recenter -3)))))
(defun mark-whole-buffer ()
"Put point at beginning and mark at end of buffer.
This is usually the number of newlines between them,
but can be one more if START is not equal to END
and the greater of them is not at the start of a line."
- (save-match-data
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (if (eq selective-display t)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (save-match-data
(let ((done 0))
(while (re-search-forward "[\n\C-m]" nil t 40)
(setq done (+ 40 done)))
(if (and (/= start end)
(not (bolp)))
(1+ done)
- done))
- (- (buffer-size) (forward-line (buffer-size))))))))
+ done)))
+ (- (buffer-size) (forward-line (buffer-size)))))))
(defun what-cursor-position ()
"Print info on cursor position (on screen and within buffer)."
(prin1-to-string command)
read-expression-map t
'(command-history . 1))))
+ ;; 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 command (car command-history))
+ (setq command-history (cons command command-history)))
(eval command)))
(defun repeat-complex-command (arg)
(if elt
(progn
(setq newcmd
- (read-from-minibuffer
- "Redo: " (prin1-to-string elt) read-expression-map t
- (cons 'command-history arg)))
+ (let ((print-level nil))
+ (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.
This is used for all minibuffer input
except when an alternate history list is specified.")
(defvar minibuffer-history-sexp-flag nil
- "Nonzero when doing history operations on `command-history'.
+ "Non-nil when doing history operations on `command-history'.
More generally, indicates that the history list being acted on
contains expressions rather than strings.")
(setq minibuffer-history-variable 'minibuffer-history)
"No earlier matching history item")))
(if (string-match regexp
(if minibuffer-history-sexp-flag
- (prin1-to-string (nth (1- pos) history))
+ (let ((print-level nil))
+ (prin1-to-string (nth (1- pos) history)))
(nth (1- pos) history)))
(setq n (+ n (if (< n 0) 1 -1)))))
(setq minibuffer-history-position pos)
(erase-buffer)
(let ((elt (nth (1- pos) history)))
(insert (if minibuffer-history-sexp-flag
- (prin1-to-string elt)
+ (let ((print-level nil))
+ (prin1-to-string elt))
elt)))
(goto-char (point-min)))
(if (or (eq (car (car command-history)) 'previous-matching-history-element)
(symbol-value minibuffer-history-variable))))
(insert
(if minibuffer-history-sexp-flag
- (prin1-to-string elt)
+ (let ((print-level nil))
+ (prin1-to-string elt))
elt)))
(goto-char (point-min)))))
(defun goto-line (arg)
"Goto line ARG, counting from line 1 at beginning of buffer."
(interactive "NGoto line: ")
+ (setq arg (prefix-numeric-value arg))
(save-restriction
(widen)
(goto-char 1)
Repeat this command to undo more changes.
A numeric argument serves as a repeat count."
(interactive "*p")
+ ;; If we don't get all the way thru, make last-command indicate that
+ ;; for the following command.
+ (setq this-command t)
(let ((modified (buffer-modified-p))
(recent-save (recent-auto-save-p)))
(or (eq (selected-window) (minibuffer-window))
(or (eq last-command 'undo)
(progn (undo-start)
(undo-more 1)))
- (setq this-command 'undo)
(undo-more (or arg 1))
+ ;; Don't specify a position in the undo record for the undo command.
+ ;; Instead, undoing this should move point to where the change is.
+ (let ((tail buffer-undo-list)
+ done)
+ (while (and tail (not done) (not (null (car tail))))
+ (if (integerp (car tail))
+ (progn
+ (setq done t)
+ (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
+ (setq tail (cdr tail))))
(and modified (not (buffer-modified-p))
- (delete-auto-save-file-if-necessary recent-save))))
+ (delete-auto-save-file-if-necessary recent-save)))
+ ;; If we do get all the way thru, make this-command indicate that.
+ (setq this-command 'undo))
(defvar pending-undo-list nil
"Within a run of consecutive undo commands, list remaining to be undone.")
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
-(defun shell-command (command &optional flag)
+(defun shell-command (command &optional output-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
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."
+The output appears in the buffer `*Shell Command*'.
+
+The optional second argument OUTPUT-BUFFER, if non-nil,
+says to put the output in some other buffer.
+If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
+If OUTPUT-BUFFER is not a buffer and not nil,
+insert output in current buffer. (This cannot be done asynchronously.)
+In either case, the output is inserted after point (leaving mark after it)."
(interactive (list (read-from-minibuffer "Shell command: "
nil nil nil 'shell-command-history)
current-prefix-arg))
- (if flag
+ (if (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer))))
(progn (barf-if-buffer-read-only)
(push-mark)
;; We do not use -f for csh; we will not support broken use of
(unwind-protect
(if (string-match "[ \t]*&[ \t]*$" command)
;; Command ending with ampersand means asynchronous.
- (let ((buffer (get-buffer-create "*shell-command*"))
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Shell-Command*")))
(directory default-directory)
proc)
;; Remove the ampersand.
(error "Shell command in progress")))
(save-excursion
(set-buffer buffer)
+ (setq buffer-read-only nil)
(erase-buffer)
(display-buffer buffer)
(setq default-directory directory)
(setq proc (start-process "Shell" buffer
shell-file-name "-c" command))
- (setq mode-line-process '(": %s"))
+ (setq mode-line-process '(":%s"))
(set-process-sentinel proc 'shell-command-sentinel)
(set-process-filter proc 'shell-command-filter)
))
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
- (if (memq (process-status process) '(exit signal))
+ (if (and (memq (process-status process) '(exit signal))
+ (buffer-name (process-buffer process)))
(progn
(message "%s: %s."
(car (cdr (cdr (process-command process))))
(unwind-protect
(progn
(set-buffer buffer)
- (setq opoint (point))
+ (or (= (point) (point-max))
+ (setq opoint (point)))
(goto-char (point-max))
(insert-before-markers string))
;; insert-before-markers moved this marker: set it back.
(set-window-start window pos)
;; Finish our save-excursion.
- (goto-char opoint)
+ (if opoint
+ (goto-char opoint))
(set-buffer obuf))))
-(defun shell-command-on-region (start end command &optional flag interactive)
+(defun shell-command-on-region (start end command
+ &optional output-buffer interactive)
"Execute string COMMAND in inferior shell with region as input.
Normally display output (if any) in temp buffer `*Shell Command Output*';
Prefix arg means replace the region with it.
but it is nonetheless available in buffer `*Shell Command Output*'
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."
+deleted.
+
+The optional second argument OUTPUT-BUFFER, if non-nil,
+says to put the output in some other buffer.
+If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
+If OUTPUT-BUFFER is not a buffer and not nil,
+insert output in the current buffer.
+In either case, the output is inserted after point (leaving mark after it)."
(interactive (list (region-beginning) (region-end)
(read-from-minibuffer "Shell command on region: "
nil nil nil 'shell-command-history)
current-prefix-arg
(prefix-numeric-value current-prefix-arg)))
- (if flag
+ (if (and output-buffer
+ (not (or (bufferp output-buffer) (stringp output-buffer))))
;; Replace specified region with output from command.
(let ((swap (and interactive (< (point) (mark)))))
;; Don't muck with mark
(and interactive (push-mark))
(call-process-region start end shell-file-name t t nil
"-c" command)
- (if (get-buffer "*Shell Command Output*")
- (kill-buffer "*Shell Command Output*"))
+ (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ (and shell-buffer (not (eq shell-buffer (current-buffer)))
+ (kill-buffer shell-buffer)))
(and interactive swap (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
;; replacing its entire contents.
- (let ((buffer (get-buffer-create "*Shell Command Output*"))
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Shell Command Output*")))
(success nil))
(unwind-protect
(if (eq buffer (current-buffer))
;; If the input is the same buffer as the output,
;; delete everything but the specified region,
;; then replace that region with the output.
- (progn (delete-region end (point-max))
+ (progn (setq buffer-read-only nil)
+ (delete-region end (point-max))
(delete-region (point-min) start)
(call-process-region (point-min) (point-max)
shell-file-name t t nil
;; Clear the output buffer, then run the command with output there.
(save-excursion
(set-buffer buffer)
+ (setq buffer-read-only nil)
(erase-buffer))
(call-process-region start end shell-file-name
nil buffer nil
(set-buffer buffer)
(goto-char (point-min))
(buffer-substring (point)
- (progn (end-of-line) (point)))))
- (kill-buffer buffer))
+ (progn (end-of-line) (point))))))
(t
(set-window-start (display-buffer buffer) 1))))))))
\f
when given no argument at the beginning of a line."
(interactive "P")
(kill-region (point)
- ;; Don't shift point before doing the delete; that way,
- ;; undo will record the right position of point.
- (save-excursion
+ ;; It is better to move point to the other end of the kill
+ ;; before killing. That way, in a read-only buffer, point
+ ;; moves across the text that is copied to the kill ring.
+ ;; The choice has no effect on undo now that undo records
+ ;; the value of point from before the command was run.
+ (progn
(if arg
(forward-line (prefix-numeric-value arg))
(if (eobp)
(defvar kill-ring-yank-pointer nil
"The tail of the kill ring whose car is the last thing yanked.")
-(defun kill-new (string)
+(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set the kill-ring-yank pointer to point to it.
-If `interprogram-cut-function' is non-nil, apply it to STRING."
- (setq kill-ring (cons string kill-ring))
- (if (> (length kill-ring) kill-ring-max)
- (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
+If `interprogram-cut-function' is non-nil, apply it to STRING.
+Optional second argument REPLACE non-nil means that STRING will replace
+the front of the kill ring, rather than being added to the list."
+ (and (fboundp 'menu-bar-update-yank-menu)
+ (menu-bar-update-yank-menu string (and replace (car kill-ring))))
+ (if replace
+ (setcar kill-ring string)
+ (setq kill-ring (cons string kill-ring))
+ (if (> (length kill-ring) kill-ring-max)
+ (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string t)))
If BEFORE-P is non-nil, prepend STRING to the kill.
If `interprogram-cut-function' is set, pass the resulting kill to
it."
- (setcar kill-ring
- (if before-p
- (concat string (car kill-ring))
- (concat (car kill-ring) string)))
- (if interprogram-cut-function
- (funcall interprogram-cut-function (car kill-ring))))
+ (kill-new (if before-p
+ (concat string (car kill-ring))
+ (concat (car kill-ring) string)) t))
(defun current-kill (n &optional do-not-move)
"Rotate the yanking point by N places, and then return that kill.
\f
;;;; Commands for manipulating the kill ring.
+(defvar kill-read-only-ok nil
+ "*Non-nil means don't signal an error for killing read-only text.")
+
(defun kill-region (beg end)
"Kill between point and mark.
The text is deleted but saved in the kill ring.
;; If the buffer is read-only, we should beep, in case the person
;; just isn't aware of this. However, there's no harm in putting
;; the region's text in the kill ring, anyway.
- (buffer-read-only
+ ((or (and buffer-read-only (not inhibit-read-only))
+ (text-property-not-all beg end 'read-only nil))
(copy-region-as-kill beg end)
;; This should always barf, and give us the correct error.
- (barf-if-buffer-read-only))
+ (if kill-read-only-ok
+ (message "Read only text copied to kill ring")
+ (barf-if-buffer-read-only)))
;; In certain cases, we can arrange for the undo list and the kill
;; ring to share the same string object. This code does that.
text.
See also the command \\[yank-pop]."
(interactive "*P")
+ ;; If we don't get all the way thru, make last-command indicate that
+ ;; for the following command.
+ (setq this-command t)
(push-mark (point))
(insert (current-kill (cond
((listp arg) 0)
;; loop would deactivate the mark because we inserted text.
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point) (current-buffer)))))
+ ;; If we do get all the way thru, make this-command indicate that.
+ (setq this-command 'yank)
nil)
(defun rotate-yank-pointer (arg)
Puts mark after the inserted text.
BUFFER may be a buffer or a buffer name."
(interactive (list (progn (barf-if-buffer-read-only)
- (read-buffer "Insert buffer: " (other-buffer) t))))
+ (read-buffer "Insert buffer: "
+ (other-buffer (current-buffer) t)
+ t))))
(or (bufferp buffer)
(setq buffer (get-buffer buffer)))
(let (start end newmark)
"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))
+ (if transient-mark-mode
+ (progn
+ (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!
(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))))
+ ;; Normally we never clear mark-active except in Transient Mark mode.
+ ;; But when we actually clear out the mark value too,
+ ;; we must clear mark-active in any mode.
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook)
+ (set-marker (mark-marker) nil)))
(defvar mark-ring nil
- "The list of saved former marks of the current buffer,
-most recent first.")
+ "The list of former marks of the current buffer, most recent first.")
(make-variable-buffer-local 'mark-ring)
+(put 'mark-ring 'permanent-local t)
(defconst mark-ring-max 16
"*Maximum size of mark ring. Start discarding off end if gets this big.")
+(defvar global-mark-ring nil
+ "The list of saved global marks, most recent first.")
+
+(defconst global-mark-ring-max 16
+ "*Maximum size of global mark ring. \
+Start discarding off end if gets this big.")
+
(defun set-mark-command (arg)
"Set mark at where point is, or jump to mark.
-With no prefix argument, set mark, and push old mark position on mark ring.
-With argument, jump to mark, and pop a new position for mark off the ring.
+With no prefix argument, set mark, push old mark position on local mark
+ring, and push mark on global mark ring.
+With argument, jump to mark, and pop a new position for mark off the ring
+\(does not affect global mark ring\).
Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(defun push-mark (&optional location nomsg activate)
"Set mark at LOCATION (point, by default) and push old mark on mark ring.
+If the last global mark pushed was not in the current buffer,
+also push LOCATION on the global mark ring.
Display `Mark set' unless the optional second arg NOMSG is non-nil.
In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
(move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
(setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
(set-marker (mark-marker) (or location (point)) (current-buffer))
+ ;; Now push the mark on the global mark ring.
+ (if (and global-mark-ring
+ (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
+ ;; The last global mark pushed was in this same buffer.
+ ;; Don't push another one.
+ nil
+ (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
+ (if (> (length global-mark-ring) global-mark-ring-max)
+ (progn
+ (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
+ nil)
+ (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
(or nomsg executing-macro (> (minibuffer-depth) 0)
(message "Mark set"))
(if (or activate (not transient-mark-mode))
(if (null arg)
(not transient-mark-mode)
(> (prefix-numeric-value arg) 0))))
+
+(defun pop-global-mark ()
+ "Pop off global mark ring and jump to the top location."
+ (interactive)
+ ;; Pop entries which refer to non-existent buffers.
+ (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
+ (setq global-mark-ring (cdr global-mark-ring)))
+ (or global-mark-ring
+ (error "No global mark set"))
+ (let* ((marker (car global-mark-ring))
+ (buffer (marker-buffer marker))
+ (position (marker-position marker)))
+ (setq global-mark-ring (cdr global-mark-ring))
+ (set-buffer buffer)
+ (or (and (>= position (point-min))
+ (<= position (point-max)))
+ (widen))
+ (goto-char position)
+ (switch-to-buffer buffer)))
\f
(defvar next-line-add-newlines t
"*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
(interactive "p")
(if (and next-line-add-newlines (= arg 1))
(let ((opoint (point)))
- (forward-line 1)
- (if (or (= opoint (point)) (not (eq (preceding-char) ?\n)))
+ (end-of-line)
+ (if (eobp)
(insert ?\n)
(goto-char opoint)
(line-move arg)))
When the `track-eol' feature is doing its job, the value is 9999.")
(defun line-move (arg)
- (let ((signal
- (catch 'exit
- (if (not (or (eq last-command 'next-line)
- (eq last-command 'previous-line)))
- (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 'end-of-line)))
- 9999
- (current-column))))
- (if (not (integerp selective-display))
- (or (and (zerop (forward-line arg))
- (bolp))
- (throw 'exit (if (bobp)
- 'beginning-of-buffer
- 'end-of-buffer)))
- ;; Move by arg lines, but ignore invisible ones.
- (while (> arg 0)
- (end-of-line)
- (and (zerop (vertical-motion 1))
- (throw 'exit 'end-of-buffer))
- (setq arg (1- arg)))
- (while (< arg 0)
- (beginning-of-line)
- (and (zerop (vertical-motion -1))
- (throw 'exit 'beginning-of-buffer))
- (setq arg (1+ arg))))
- (move-to-column (or goal-column temporary-goal-column))
- nil)))
- (cond
- ((eq signal 'beginning-of-buffer)
- (message "Beginning of buffer")
- (ding))
- ((eq signal 'end-of-buffer)
- (message "End of buffer")
- (ding)))))
+ (if (not (or (eq last-command 'next-line)
+ (eq last-command 'previous-line)))
+ (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 'end-of-line)))
+ 9999
+ (current-column))))
+ (if (not (integerp selective-display))
+ (or (if (> arg 0)
+ (progn (if (> arg 1) (forward-line (1- arg)))
+ ;; This way of moving forward ARG lines
+ ;; verifies that we have a newline after the last one.
+ ;; It doesn't get confused by intangible text.
+ (end-of-line)
+ (zerop (forward-line 1)))
+ (and (zerop (forward-line arg))
+ (bolp)))
+ (signal (if (< arg 0)
+ 'beginning-of-buffer
+ 'end-of-buffer)
+ nil))
+ ;; Move by arg lines, but ignore invisible ones.
+ (while (> arg 0)
+ (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))))
+ (move-to-column (or goal-column temporary-goal-column))
+ nil)
;;; Many people have said they rarely use this feature, and often type
;;; it by accident. Maybe it shouldn't even be on a key.
If this is zero, point is always centered after it moves off frame.")
(defun hscroll-point-visible ()
- "Scrolls the window horizontally to make point visible."
- (let* ((here (current-column))
- (left (window-hscroll))
- (right (- (+ left (window-width)) 3)))
- (cond
- ;; Should we recenter?
- ((or (< here (- left hscroll-step))
- (> here (+ right hscroll-step)))
- (set-window-hscroll
- (selected-window)
- ;; Recenter, but don't show too much white space off the end of
- ;; the line.
- (max 0
- (min (- (save-excursion (end-of-line) (current-column))
- (window-width)
- -5)
- (- here (/ (window-width) 2))))))
- ;; Should we scroll left?
- ((> here right)
- (scroll-left hscroll-step))
- ;; Or right?
- ((< here left)
- (scroll-right hscroll-step)))))
+ "Scrolls the selected window horizontally to make point visible."
+ (save-excursion
+ (set-buffer (window-buffer))
+ (if (not (or truncate-lines
+ (> (window-hscroll) 0)
+ (and truncate-partial-width-windows
+ (< (window-width) (frame-width)))))
+ ;; Point is always visible when lines are wrapped.
+ ()
+ ;; If point is on the invisible part of the line before window-start,
+ ;; then hscrolling can't bring it back, so reset window-start first.
+ (and (< (point) (window-start))
+ (let ((ws-bol (save-excursion
+ (goto-char (window-start))
+ (beginning-of-line)
+ (point))))
+ (and (>= (point) ws-bol)
+ (set-window-start nil ws-bol))))
+ (let* ((here (hscroll-window-column))
+ (left (min (window-hscroll) 1))
+ (right (1- (window-width))))
+ ;; Allow for the truncation glyph, if we're not exactly at eol.
+ (if (not (and (= here right)
+ (= (following-char) ?\n)))
+ (setq right (1- right)))
+ (cond
+ ;; If too far away, just recenter. But don't show too much
+ ;; white space off the end of the line.
+ ((or (< here (- left hscroll-step))
+ (> here (+ right hscroll-step)))
+ (let ((eol (save-excursion (end-of-line) (hscroll-window-column))))
+ (scroll-left (min (- here (/ (window-width) 2))
+ (- eol (window-width) -5)))))
+ ;; Within range. Scroll by one step (or maybe not at all).
+ ((< here left)
+ (scroll-right hscroll-step))
+ ((> here right)
+ (scroll-left hscroll-step)))))))
+
+;; This function returns the window's idea of the display column of point,
+;; assuming that the window is already known to be truncated rather than
+;; wrapped, and that we've already handled the case where point is on the
+;; part of the line before window-start. We ignore window-width; if point
+;; is beyond the right margin, we want to know how far. The return value
+;; includes the effects of window-hscroll, window-start, and the prompt
+;; string in the minibuffer. It may be negative due to hscroll.
+(defun hscroll-window-column ()
+ (let* ((hscroll (window-hscroll))
+ (startpos (save-excursion
+ (beginning-of-line)
+ (if (= (point) (save-excursion
+ (goto-char (window-start))
+ (beginning-of-line)
+ (point)))
+ (goto-char (window-start)))
+ (point)))
+ (hpos (+ (if (and (eq (selected-window) (minibuffer-window))
+ (= 1 (window-start))
+ (= startpos (point-min)))
+ (minibuffer-prompt-width)
+ 0)
+ (min 0 (- 1 hscroll))))
+ val)
+ (car (cdr (compute-motion startpos (cons hpos 0)
+ (point) (cons 0 1)
+ 1000000 (cons hscroll 0) nil)))))
+
;; rms: (1) The definitions of arrow keys should not simply restate
;; what keys they are. The arrow keys should run the ordinary commands.
;; (interactive "P")
;; (backward-char arg)
;; (hscroll-point-visible))
+
+(defun scroll-other-window-down (lines)
+ "Scroll the \"other window\" down."
+ (interactive "P")
+ (scroll-other-window
+ ;; Just invert the argument's meaning.
+ ;; We can do that without knowing which window it will be.
+ (if (eq lines '-) nil
+ (if (null lines) '-
+ (- (prefix-numeric-value lines))))))
+
+(defun beginning-of-buffer-other-window (arg)
+ "Move point to the beginning of the buffer in the other window.
+Leave mark at previous position.
+With arg N, put point N/10 of the way from the true beginning."
+ (interactive "P")
+ (let ((orig-window (selected-window))
+ (window (other-window-for-scrolling)))
+ ;; We use unwind-protect rather than save-window-excursion
+ ;; 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)
+ "Move point to the end of the buffer in the other window.
+Leave mark at previous position.
+With arg N, put point N/10 of the way from the true end."
+ (interactive "P")
+ ;; See beginning-of-buffer-other-window for comments.
+ (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))))
\f
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
"*Column to indent right-margin comments to.
Setting this variable automatically makes it local to the current buffer.
Each mode establishes a different default value for this variable; you
-can the value for a particular mode using that mode's hook.")
+can set the value for a particular mode using that mode's hook.")
(make-variable-buffer-local 'comment-column)
(defconst comment-start nil
(backward-char (length ce))
(looking-at (regexp-quote ce))))
(delete-char (- (length ce)))))
- (setq count numarg)
- (while (> 1 (setq count (1+ count)))
- (end-of-line)
- ;; this is questionable if comment-end ends in whitespace
- ;; that is pretty brain-damaged though
- (skip-chars-backward " \t")
- (save-excursion
- (backward-char (length ce))
- (if (looking-at (regexp-quote ce))
- (delete-char (length ce)))))))
+ (let ((count numarg))
+ (while (> 1 (setq count (1+ count)))
+ (end-of-line)
+ ;; this is questionable if comment-end ends in whitespace
+ ;; that is pretty brain-damaged though
+ (skip-chars-backward " \t")
+ (save-excursion
+ (backward-char (length ce))
+ (if (looking-at (regexp-quote ce))
+ (delete-char (length ce))))))))
(forward-line 1))
;; Insert at beginning and at end.
(if (looking-at "[ \t]*$") ()
"Kill characters forward until encountering the end of a word.
With argument, do this that many times."
(interactive "p")
- (kill-region (point) (save-excursion (forward-word arg) (point))))
+ (kill-region (point) (progn (forward-word arg) (point))))
(defun backward-kill-word (arg)
"Kill characters backward until encountering the end of a word.
(interactive "p")
(kill-word (- arg)))
-(defun current-word ()
- "Return the word point is on as a string, if it's between two
-word-constituent characters. If not, but it immediately follows one,
-move back first. Otherwise, if point precedes a word constituent,
-move forward first. Otherwise, move backwards until a word constituent
-is found and get that word; if you reach a newline first, move forward
-instead."
- (interactive)
+(defun current-word (&optional strict)
+ "Return the word point is on (or a nearby word) as a string.
+If optional arg STRICT is non-nil, return nil unless point is within
+or adjacent to a word."
(save-excursion
(let ((oldpoint (point)) (start (point)) (end (point)))
(skip-syntax-backward "w_") (setq start (point))
(goto-char oldpoint)
(skip-syntax-forward "w_") (setq end (point))
(if (and (eq start oldpoint) (eq end oldpoint))
- (progn
- (skip-syntax-backward "^w_"
- (save-excursion (beginning-of-line) (point)))
- (if (eq (preceding-char) ?\n)
- (progn
- (skip-syntax-forward "^w_")
- (setq start (point))
- (skip-syntax-forward "w_")
- (setq end (point)))
- (setq end (point))
- (skip-syntax-backward "w_")
- (setq start (point)))))
- (buffer-substring start end))))
+ ;; Point is neither within nor adjacent to a word.
+ (and (not strict)
+ (progn
+ ;; Look for preceding word in same line.
+ (skip-syntax-backward "^w_"
+ (save-excursion (beginning-of-line)
+ (point)))
+ (if (bolp)
+ ;; No preceding word in same line.
+ ;; Look for following word in same line.
+ (progn
+ (skip-syntax-forward "^w_"
+ (save-excursion (end-of-line)
+ (point)))
+ (setq start (point))
+ (skip-syntax-forward "w_")
+ (setq end (point)))
+ (setq end (point))
+ (skip-syntax-backward "w_")
+ (setq start (point)))
+ (buffer-substring start end)))
+ (buffer-substring start end)))))
\f
(defconst fill-prefix nil
"*String for filling to insert at front of new line, or nil for none.
(save-excursion (beginning-of-line)
(looking-at auto-fill-inhibit-regexp)))
(while (and (not give-up) (> (current-column) fill-column))
+ ;; Determine where to split the line.
(let ((fill-point
- (let ((opoint (point)))
+ (let ((opoint (point))
+ bounce
+ (first t))
(save-excursion
(move-to-column (1+ fill-column))
- (skip-chars-backward "^ \t\n")
- (if (bolp)
- (re-search-forward "[ \t]" opoint t))
- (skip-chars-backward " \t")
+ ;; Move back to a word boundary.
+ (while (or first
+ ;; If this is after period and a single space,
+ ;; move back once more--we don't want to break
+ ;; the line there and make it look like a
+ ;; sentence end.
+ (and (not (bobp))
+ (not bounce)
+ sentence-end-double-space
+ (save-excursion (forward-char -1)
+ (and (looking-at "\\. ")
+ (not (looking-at "\\. "))))))
+ (setq first nil)
+ (skip-chars-backward "^ \t\n")
+ ;; If we find nowhere on the line to break it,
+ ;; break after one word. Set bounce to t
+ ;; so we will not keep going in this while loop.
+ (if (bolp)
+ (progn
+ (re-search-forward "[ \t]" opoint t)
+ (setq bounce t)))
+ (skip-chars-backward " \t"))
+ ;; Let fill-point be set to the place where we end up.
(point)))))
- ;; If there is a space on the line before fill-point,
- ;; and nonspaces precede it, break the line there.
+ ;; If that place is not the beginning of the line,
+ ;; break the line there.
(if (save-excursion
(goto-char fill-point)
(not (bolp)))
;; No place to break => stop trying.
(setq give-up t)))))))
+(defun auto-fill-mode (&optional arg)
+ "Toggle auto-fill mode.
+With arg, turn Auto-Fill mode on if and only if arg is positive.
+In Auto-Fill mode, inserting a space at a column beyond `fill-column'
+automatically breaks the line at a previous space."
+ (interactive "P")
+ (prog1 (setq auto-fill-function
+ (if (if (null arg)
+ (not auto-fill-function)
+ (> (prefix-numeric-value arg) 0))
+ 'do-auto-fill
+ nil))
+ ;; update mode-line
+ (set-buffer-modified-p (buffer-modified-p))))
+
+;; This holds a document string used to document auto-fill-mode.
+(defun auto-fill-function ()
+ "Automatically break line at a previous space, in insertion of text."
+ nil)
+
+(defun turn-on-auto-fill ()
+ "Unconditionally turn on Auto Fill mode."
+ (auto-fill-mode 1))
+
+(defun set-fill-column (arg)
+ "Set `fill-column' to current column, or to argument if given.
+The variable `fill-column' has a separate value for each buffer."
+ (interactive "P")
+ (setq fill-column (if (integerp arg) arg (current-column)))
+ (message "fill-column set to %d" fill-column))
+\f
(defconst comment-multi-line nil
"*Non-nil means \\[indent-new-comment-line] should continue same comment
on new line, with no new terminator or starter.
This is obsolete because you might as well use \\[newline-and-indent].")
(defun indent-new-comment-line ()
- "Break line at point and indent, continuing comment if presently within one.
-The body of the continued comment is indented under the previous comment line.
+ "Break line at point and indent, continuing comment if within one.
+This indents the body of the continued comment
+under the previous comment line.
This command is intended for styles where you write a comment per line,
starting a new comment (and terminating it if necessary) on each line.
(if fill-prefix
(insert fill-prefix)
(indent-according-to-mode)))))
-
-(defun auto-fill-mode (&optional arg)
- "Toggle auto-fill mode.
-With arg, turn auto-fill mode on if and only if arg is positive.
-In auto-fill mode, inserting a space at a column beyond fill-column
-automatically breaks the line at a previous space."
- (interactive "P")
- (prog1 (setq auto-fill-function
- (if (if (null arg)
- (not auto-fill-function)
- (> (prefix-numeric-value arg) 0))
- 'do-auto-fill
- nil))
- ;; update mode-line
- (set-buffer-modified-p (buffer-modified-p))))
-
-(defun turn-on-auto-fill ()
- "Unconditionally turn on Auto Fill mode."
- (auto-fill-mode 1))
-
-(defun set-fill-column (arg)
- "Set `fill-column' to current column, or to argument if given.
-The variable `fill-column' has a separate value for each buffer."
- (interactive "P")
- (setq fill-column (if (integerp arg) arg (current-column)))
- (message "fill-column set to %d" fill-column))
\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
(defconst blink-matching-paren-distance 12000
"*If non-nil, is maximum distance to search for matching open-paren.")
+(defconst blink-matching-delay 1
+ "*The number of seconds that `blink-matching-open' will delay at a match.")
+
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
(and (> (point) (1+ (point-min)))
- (not (memq (char-syntax (char-after (- (point) 2))) '(?/ ?\\ )))
blink-matching-paren
+ ;; Verify an even number of quoting characters precede the close.
+ (= 1 (logand 1 (- (point)
+ (save-excursion
+ (forward-char -1)
+ (skip-syntax-backward "/\\")
+ (point)))))
(let* ((oldpos (point))
(blinkpos)
(mismatch))
?\$)
(setq mismatch
(/= (char-after (1- oldpos))
- (logand (lsh (aref (syntax-table)
- (char-after blinkpos))
- -8)
- 255))))
+ (matching-paren (char-after blinkpos)))))
(if mismatch (setq blinkpos nil))
(if blinkpos
(progn
(goto-char blinkpos)
(if (pos-visible-in-window-p)
- (sit-for 1)
+ (sit-for blink-matching-delay)
(goto-char blinkpos)
(message
"Matches %s"
+ ;; Show what precedes the open in its line, if anything.
(if (save-excursion
(skip-chars-backward " \t")
(not (bolp)))
(buffer-substring (progn (beginning-of-line) (point))
(1+ blinkpos))
- (buffer-substring blinkpos
- (progn
- (forward-char 1)
- (skip-chars-forward "\n \t")
- (end-of-line)
- (point)))))))
+ ;; 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
+ (progn (end-of-line) (point)))
+ ;; 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")
+ (beginning-of-line)
+ (point))
+ (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))))))))
(cond (mismatch
(message "Mismatched parentheses"))
((not blink-matching-paren-distance)
(or completion-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'mouse-choose-completion)
+ (define-key map [down-mouse-2] nil)
+ (define-key map "\C-m" 'choose-completion)
+ (define-key map [return] 'choose-completion)
(setq completion-list-mode-map map)))
;; Completion mode is suitable only for specially formatted data.
(put 'completion-list-mode 'mode-class 'special)
+;; Record the buffer that was current when the completion list was requested.
+(defvar completion-reference-buffer)
+
+;; This records the length of the text at the beginning of the buffer
+;; which was not included in the completion.
+(defvar completion-base-size nil)
+
+(defun choose-completion ()
+ "Choose the completion that point is in or next to."
+ (interactive)
+ (let (beg end completion (buffer completion-reference-buffer)
+ (base-size completion-base-size))
+ (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg(point)))
+ (if (null beg)
+ (error "No completion here"))
+ (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
+ (setq completion (buffer-substring beg end))
+ (let ((owindow (selected-window)))
+ (if (and (one-window-p t 'selected-frame)
+ (window-dedicated-p (selected-window)))
+ ;; This is a special buffer's frame
+ (iconify-frame (selected-frame))
+ (or (window-dedicated-p (selected-window))
+ (bury-buffer)))
+ (select-window owindow))
+ (choose-completion-string completion buffer base-size)))
+
+;; Delete the longest partial match for STRING
+;; that can be found before POINT.
+(defun choose-completion-delete-max-match (string)
+ (let ((opoint (point))
+ (len (min (length string)
+ (- (point) (point-min)))))
+ (goto-char (- (point) (length string)))
+ (if completion-ignore-case
+ (setq string (downcase string)))
+ (while (and (> len 0)
+ (let ((tail (buffer-substring (point)
+ (+ (point) len))))
+ (if completion-ignore-case
+ (setq tail (downcase tail)))
+ (not (string= tail (substring string 0 len)))))
+ (setq len (1- len))
+ (forward-char 1))
+ (delete-char len)))
+
+(defun choose-completion-string (choice &optional buffer base-size)
+ (let ((buffer (or buffer completion-reference-buffer)))
+ ;; If BUFFER is a minibuffer, barf unless it's the currently
+ ;; active minibuffer.
+ (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
+ (or (not (minibuffer-window-active-p (minibuffer-window)))
+ (not (equal buffer (window-buffer (minibuffer-window))))))
+ (error "Minibuffer is not active for completion")
+ ;; Insert the completion into the buffer where completion was requested.
+ (set-buffer buffer)
+ (if base-size
+ (delete-region (+ base-size (point-min)) (point))
+ (choose-completion-delete-max-match choice))
+ (insert choice)
+ (remove-text-properties (- (point) (length choice)) (point)
+ '(mouse-face nil))
+ ;; Update point in the window that BUFFER is showing in.
+ (let ((window (get-buffer-window buffer t)))
+ (set-window-point window (point)))
+ ;; If completing for the minibuffer, exit it with this choice.
+ (and (equal buffer (window-buffer (minibuffer-window)))
+ minibuffer-completion-table
+ (exit-minibuffer)))))
+
(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."
+Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
+ to select the completion near point.
+Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
+ 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)
+ (make-local-variable 'completion-base-size)
+ (setq completion-base-size nil)
(run-hooks 'completion-list-mode-hook))
+(defvar completion-fixup-function nil)
+
(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")))))
+ (let ((mainbuf (current-buffer)))
+ (set-buffer standard-output)
+ (completion-list-mode)
+ (make-local-variable 'completion-reference-buffer)
+ (setq completion-reference-buffer mainbuf)
+ (goto-char (point-min))
+ (if window-system
+ (insert (substitute-command-keys
+ "Click \\[mouse-choose-completion] on a completion to select it.\n")))
+ (insert (substitute-command-keys
+ "In this buffer, type \\[choose-completion] to \
+select the completion near point.\n\n"))
+ (forward-line 1)
+ (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
+ (let ((beg (match-beginning 0))
+ (end (point)))
+ (if completion-fixup-function
+ (funcall completion-fixup-function))
+ (put-text-property beg (point) 'mouse-face 'highlight)
+ (goto-char end))))))
(add-hook 'completion-setup-hook 'completion-setup-function)
\f
HCoop / bpt / emacs.git / blobdiff