;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
With arg, insert that many newlines.
In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
(interactive "*P")
+ (barf-if-buffer-read-only)
;; Inserting a newline at the end of a line produces better redisplay in
;; try_window_id than inserting at the beginning of a line, and the textual
;; result is the same. So, if we're at beginning of line, pretend to be at
(delete-char 1)))
(forward-char -1)
(setq count (1- count)))))
- (delete-backward-char arg killp)
- ;; In overwrite mode, back over columns while clearing them out,
- ;; unless at end of line.
- (and overwrite-mode (not (eolp))
- (save-excursion (insert-char ?\ arg))))
+ (delete-backward-char arg killp))
(defun zap-to-char (arg char)
"Kill up to and including ARG'th occurrence of CHAR.
(count-lines start end) (- end start)))
(defun what-line ()
- "Print the current line number (in the buffer) of point."
+ "Print the current buffer line number and narrowed line number of point."
(interactive)
- (save-restriction
- (widen)
+ (let ((opoint (point)) start)
(save-excursion
- (beginning-of-line)
- (message "Line %d"
- (1+ (count-lines 1 (point)))))))
+ (save-restriction
+ (goto-char (point-min))
+ (widen)
+ (beginning-of-line)
+ (setq start (point))
+ (goto-char opoint)
+ (beginning-of-line)
+ (if (/= start 1)
+ (message "line %d (narrowed line %d)"
+ (1+ (count-lines 1 (point)))
+ (1+ (count-lines start (point))))
+ (message "Line %d" (1+ (count-lines 1 (point)))))))))
+
(defun count-lines (start end)
"Return number of lines between START and END.
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.
+ ;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
(cons 'command-history arg))))
;; If command was added to command-history as a string,
- ;; get rid of that. We want only evallable expressions there.
+ ;; get rid of that. We want only evaluable expressions there.
(if (stringp (car command-history))
(setq command-history (cdr command-history)))
(interactive (list (read-from-minibuffer "Shell command: "
nil nil nil 'shell-command-history)
current-prefix-arg))
- (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
- ;; .cshrcs. Even the BSD csh manual says to use
- ;; "if ($?prompt) exit" before things which are not useful
- ;; non-interactively. Besides, if someone wants their other
- ;; aliases for shell commands then they can still have them.
- (call-process shell-file-name nil t nil
- shell-command-switch command)
- ;; This is like exchange-point-and-mark, but doesn't
- ;; activate the mark. It is cleaner to avoid activation,
- ;; even though the command loop would deactivate the mark
- ;; because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker) (point)
- (current-buffer)))))
- ;; Preserve the match data in case called from a program.
- (save-match-data
- (if (string-match "[ \t]*&[ \t]*$" command)
- ;; Command ending with ampersand means asynchronous.
- (let ((buffer (get-buffer-create
- (or output-buffer "*Asynch Shell Command*")))
- (directory default-directory)
- proc)
- ;; Remove the ampersand.
- (setq command (substring command 0 (match-beginning 0)))
- ;; If will kill a process, query first.
- (setq proc (get-buffer-process buffer))
- (if proc
- (if (yes-or-no-p "A command is running. Kill it? ")
- (kill-process proc)
- (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
- shell-command-switch command))
- (setq mode-line-process '(":%s"))
- (require 'shell) (shell-mode)
- (set-process-sentinel proc 'shell-command-sentinel)
- ))
- (shell-command-on-region (point) (point) command nil)
- ))))
+ ;; Look for a handler in case default-directory is a remote file name.
+ (let ((handler
+ (find-file-name-handler (directory-file-name default-directory)
+ 'shell-command)))
+ (if handler
+ (funcall handler 'shell-command command output-buffer)
+ (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
+ ;; .cshrcs. Even the BSD csh manual says to use
+ ;; "if ($?prompt) exit" before things which are not useful
+ ;; non-interactively. Besides, if someone wants their other
+ ;; aliases for shell commands then they can still have them.
+ (call-process shell-file-name nil t nil
+ shell-command-switch command)
+ ;; This is like exchange-point-and-mark, but doesn't
+ ;; activate the mark. It is cleaner to avoid activation,
+ ;; even though the command loop would deactivate the mark
+ ;; because we inserted text.
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)
+ (current-buffer)))))
+ ;; Preserve the match data in case called from a program.
+ (save-match-data
+ (if (string-match "[ \t]*&[ \t]*$" command)
+ ;; Command ending with ampersand means asynchronous.
+ (let ((buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*")))
+ (directory default-directory)
+ proc)
+ ;; Remove the ampersand.
+ (setq command (substring command 0 (match-beginning 0)))
+ ;; If will kill a process, query first.
+ (setq proc (get-buffer-process buffer))
+ (if proc
+ (if (yes-or-no-p "A command is running. Kill it? ")
+ (kill-process proc)
+ (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
+ shell-command-switch command))
+ (setq mode-line-process '(":%s"))
+ (require 'shell) (shell-mode)
+ (set-process-sentinel proc 'shell-command-sentinel)
+ ))
+ (shell-command-on-region (point) (point) command nil)
+ ))))))
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(read-from-minibuffer "Shell command on region: "
nil nil nil
'shell-command-history)))
+ ;; call-interactively recognizes region-beginning and
+ ;; region-end specially, leaving them in the history.
(list (region-beginning) (region-end)
string
current-prefix-arg
current-prefix-arg)))
(if (or replace
(and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer)))))
+ (not (or (bufferp output-buffer) (stringp output-buffer))))
+ (equal (buffer-name (current-buffer)) "*Shell Command Output*"))
;; Replace specified region with output from command.
- (let ((swap (and replace (< (point) (mark)))))
+ (let ((swap (and replace (< start end))))
;; Don't muck with mark unless REPLACE says we should.
(goto-char start)
(and replace (push-mark))
;; delete everything but the specified region,
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
- (delete-region end (point-max))
- (delete-region (point-min) start)
+ (delete-region (max start end) (point-max))
+ (delete-region (point-min) (min start end))
(call-process-region (point-min) (point-max)
shell-file-name t t nil
shell-command-switch command)
(buffer-substring (point)
(progn (end-of-line) (point))))))
(t
- (set-window-start (display-buffer buffer) 1))))))))
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min)))
+ (display-buffer buffer))))))))
\f
(defconst universal-argument-map
(let ((map (make-sparse-keymap)))
(let* ((key (this-command-keys))
(keylist (listify-key-sequence key)))
(setq unread-command-events
- (nthcdr universal-argument-num-events keylist)))
+ (append (nthcdr universal-argument-num-events keylist)
+ unread-command-events)))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
\f
(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)))
+ (funcall interprogram-cut-function string (not replace))))
(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
(defvar kill-read-only-ok nil
"*Non-nil means don't signal an error for killing read-only text.")
+(put 'text-read-only 'error-conditions
+ '(text-read-only buffer-read-only error))
+(put 'text-read-only 'error-message "Text is read-only")
+
(defun kill-region (beg end)
"Kill between point and mark.
The text is deleted but saved in the kill ring.
(if kill-read-only-ok
(message "Read only text copied to kill ring")
(setq this-command 'kill-region)
- (barf-if-buffer-read-only)))
+ ;; Signal an error if the buffer is read-only.
+ (barf-if-buffer-read-only)
+ ;; If the buffer isn't read-only, the text is.
+ (signal 'text-read-only (list (current-buffer)))))
;; In certain cases, we can arrange for the undo list and the kill
;; ring to share the same string object. This code does that.
(if (not (eq last-command 'yank))
(error "Previous command was not a yank"))
(setq this-command 'yank)
- (let ((before (< (point) (mark t))))
+ (let ((inhibit-read-only t)
+ (before (< (point) (mark t))))
(delete-region (point) (mark t))
(set-marker (mark-marker) (point) (current-buffer))
(insert (current-kill arg))
"Insert after point the contents of BUFFER.
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 (current-buffer) t)
- t))))
+ (interactive
+ (list
+ (progn
+ (barf-if-buffer-read-only)
+ (read-buffer "Insert buffer: "
+ (if (eq (selected-window) (next-window (selected-window)))
+ (other-buffer (current-buffer))
+ (window-buffer (next-window (selected-window))))
+ t))))
(or (bufferp buffer)
(setq buffer (get-buffer buffer)))
(let (start end newmark)
(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)
+ (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark set"))
(if (or activate (not transient-mark-mode))
(set-mark (mark t)))
If there is no line in the buffer after this one, behavior depends on the
value of `next-line-add-newlines'. If non-nil, it inserts a newline character
to create a line, and moves the cursor to that line. Otherwise it moves the
-cursor to the end of the buffer (if already at the end of the buffer, an error
-is signaled).
+cursor to the end of the buffer.
The command \\[set-goal-column] can be used to create
a semipermanent goal column to which this command always moves.
;; (hscroll-point-visible))
(defun scroll-other-window-down (lines)
- "Scroll the \"other window\" down."
+ "Scroll the \"other window\" down.
+For more details, see the documentation for `scroll-other-window'."
(interactive "P")
(scroll-other-window
;; Just invert the argument's meaning.
(if (eq lines '-) nil
(if (null lines) '-
(- (prefix-numeric-value lines))))))
+(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
(defun beginning-of-buffer-other-window (arg)
"Move point to the beginning of the buffer in the other window.
(defconst auto-fill-inhibit-regexp nil
"*Regexp to match lines which should not be auto-filled.")
+;; This function is the auto-fill-function of a buffer
+;; when Auto-Fill mode is enabled.
+;; It returns t if it really did any work.
(defun do-auto-fill ()
- (let (fc justify bol give-up)
+ (let (fc justify bol give-up
+ (fill-prefix fill-prefix))
(if (or (not (setq justify (current-justification)))
(null (setq fc (current-fill-column)))
(and (eq justify 'left)
nil ;; Auto-filling not required
(if (memq justify '(full center right))
(save-excursion (unjustify-current-line)))
+
+ ;; Choose a fill-prefix automatically.
+ (if (and adaptive-fill-mode
+ (or (null fill-prefix) (string= fill-prefix "")))
+ (let ((prefix
+ (fill-context-prefix
+ (save-excursion (backward-paragraph 1) (point))
+ (save-excursion (forward-paragraph 1) (point))
+ ;; Don't accept a non-whitespace fill prefix
+ ;; from the first line of a paragraph.
+ "^[ \t]*$")))
+ (and prefix (not (equal prefix ""))
+ (setq fill-prefix prefix))))
+
(while (and (not give-up) (> (current-column) fc))
- ;; Determine where to split the line.
- (let ((fill-point
- (let ((opoint (point))
- bounce
- (first t))
- (save-excursion
- (move-to-column (1+ fc))
- ;; 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 that place is not the beginning of the line,
- ;; break the line there.
- (if (save-excursion
- (goto-char fill-point)
- (not (bolp)))
- (let ((prev-column (current-column)))
- ;; If point is at the fill-point, do not `save-excursion'.
- ;; Otherwise, if a comment prefix or fill-prefix is inserted,
- ;; point will end up before it rather than after it.
- (if (save-excursion
- (skip-chars-backward " \t")
- (= (point) fill-point))
- (indent-new-comment-line t)
- (save-excursion
- (goto-char fill-point)
- (indent-new-comment-line t)))
- ;; Now do justification, if required
- (if (not (eq justify 'left))
- (save-excursion
- (end-of-line 0)
- (justify-current-line justify nil t)))
- ;; If making the new line didn't reduce the hpos of
- ;; the end of the line, then give up now;
- ;; trying again will not help.
- (if (>= (current-column) prev-column)
- (setq give-up t)))
- ;; No place to break => stop trying.
- (setq give-up t))))
+ ;; Determine where to split the line.
+ (let ((fill-point
+ (let ((opoint (point))
+ bounce
+ (first t))
+ (save-excursion
+ (move-to-column (1+ fc))
+ ;; 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 that place is not the beginning of the line,
+ ;; break the line there.
+ (if (save-excursion
+ (goto-char fill-point)
+ (not (bolp)))
+ (let ((prev-column (current-column)))
+ ;; If point is at the fill-point, do not `save-excursion'.
+ ;; Otherwise, if a comment prefix or fill-prefix is inserted,
+ ;; point will end up before it rather than after it.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (= (point) fill-point))
+ (indent-new-comment-line t)
+ (save-excursion
+ (goto-char fill-point)
+ (indent-new-comment-line t)))
+ ;; Now do justification, if required
+ (if (not (eq justify 'left))
+ (save-excursion
+ (end-of-line 0)
+ (justify-current-line justify nil t)))
+ ;; If making the new line didn't reduce the hpos of
+ ;; the end of the line, then give up now;
+ ;; trying again will not help.
+ (if (>= (current-column) prev-column)
+ (setq give-up t)))
+ ;; No place to break => stop trying.
+ (setq give-up t))))
;; justify last line
- (justify-current-line justify t t))))
+ (justify-current-line justify t t)
+ t)))
(defun auto-fill-mode (&optional arg)
"Toggle auto-fill mode.
'overwrite-mode-binary))
(force-mode-line-update))
\f
-(defvar line-number-mode nil
+(defvar line-number-mode t
"*Non-nil means display line number in mode line.")
(defun line-number-mode (arg)
(defvar blink-matching-paren t
"*Non-nil means show matching open-paren when close-paren is inserted.")
+(defvar blink-matching-paren-on-screen t
+ "*Non-nil means show matching open-paren when it is on screen.
+nil means don't show it (but the open-paren can still be shown
+when it is off screen.")
+
(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.")
+(defconst blink-matching-paren-dont-ignore-comments nil
+ "*Non-nil means `blink-matching-paren' should not ignore comments.")
+
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
(- (point) blink-matching-paren-distance))
oldpos))
(condition-case ()
- (setq blinkpos (scan-sexps oldpos -1))
+ (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 (/= (char-syntax (char-after blinkpos))
- ?\$)
+ (and blinkpos
+ (/= (char-syntax (char-after blinkpos))
+ ?\$)
(setq mismatch
- (/= (char-after (1- oldpos))
- (matching-paren (char-after blinkpos)))))
+ (or (null (matching-paren (char-after blinkpos)))
+ (/= (char-after (1- oldpos))
+ (matching-paren (char-after blinkpos))))))
(if mismatch (setq blinkpos nil))
(if blinkpos
(progn
(goto-char blinkpos)
(if (pos-visible-in-window-p)
- (sit-for blink-matching-delay)
+ (and blink-matching-paren-on-screen
+ (sit-for blink-matching-delay))
(goto-char blinkpos)
(message
"Matches %s"
(defun next-completion (n)
"Move to the next item in the completion list.
-WIth prefix argument N, move N items (negative N means move backward)."
+With prefix argument N, move N items (negative N means move backward)."
(interactive "p")
(while (and (> n 0) (not (eobp)))
- (let ((prop (get-text-property (point) 'mouse-face)))
+ (let ((prop (get-text-property (point) 'mouse-face))
+ (end (point-max)))
;; If in a completion, move to the end of it.
(if prop
- (goto-char (next-single-property-change (point) 'mouse-face)))
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
;; Move to start of next one.
- (goto-char (next-single-property-change (point) 'mouse-face)))
+ (goto-char (next-single-property-change (point) 'mouse-face nil end)))
(setq n (1- n)))
(while (and (< n 0) (not (bobp)))
- (let ((prop (get-text-property (1- (point)) 'mouse-face)))
+ (let ((prop (get-text-property (1- (point)) 'mouse-face))
+ (end (point-min)))
;; If in a completion, move to the start of it.
(if prop
- (goto-char (previous-single-property-change (point) 'mouse-face)))
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil end)))
;; Move to end of the previous completion.
- (goto-char (previous-single-property-change (point) 'mouse-face))
+ (goto-char (previous-single-property-change (point) 'mouse-face nil end))
;; Move to the start of that one.
- (goto-char (previous-single-property-change (point) 'mouse-face)))
+ (goto-char (previous-single-property-change (point) 'mouse-face nil end)))
(setq n (1+ n))))
(defun choose-completion ()
HCoop / bpt / emacs.git / blobdiff