;; 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:
(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.
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)))
- (list (point) (mark)
+ ;; 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 (< start end))))
;; Don't muck with mark unless REPLACE says we should.
;; then replace that region with the output.
(progn (setq buffer-read-only nil)
(delete-region (max start end) (point-max))
- (delete-region (point-min) (max start end))
+ (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
(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)))
(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
(fill-prefix fill-prefix))
;; Choose a fill-prefix automatically.
(if (and adaptive-fill-mode
(or (null fill-prefix) (string= fill-prefix "")))
- (let (start end temp)
- (save-excursion
- (end-of-line)
- (setq end (point))
- (beginning-of-line)
- (setq start (point))
- (move-to-left-margin)
- ;; Don't do it if this line is a paragraph-starter line
- ;; because then the next line will probably also become one.
- ;; In text mode, when the user indents the first line of a
- ;; paragraph, we don't want all the lines to be indented.
- (if (not (looking-at paragraph-start))
- (cond ((re-search-forward adaptive-fill-regexp end t)
- (setq fill-prefix
- (buffer-substring-no-properties start (point))))
- ((setq temp (funcall adaptive-fill-function))
- (setq fill-prefix temp)))))))
+ (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.
;; 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.
(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."
+ "Set `fill-column' to specified argument.
+Just \\[universal-argument] as argument means to use the current column."
(interactive "P")
- (setq fill-column (if (integerp arg) arg (current-column)))
+ (cond ((integerp arg)
+ (setq fill-column arg))
+ ((consp arg)
+ (setq fill-column (current-column)))
+ ;; Disallow missing argument; it's probably a typo for C-x C-f.
+ (t
+ (error "set-fill-column requires an explicit argument")))
(message "fill-column set to %d" fill-column))
\f
(defconst comment-multi-line nil
(> (prefix-numeric-value arg) 0)))
(force-mode-line-update))
-(defvar column-number-mode t
+(defvar column-number-mode nil
"*Non-nil means display column number in mode line.")
(defun column-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.")
(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 ()
;; Switch to BUFFER and insert the completion choice CHOICE.
;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
;; to keep. If it is nil, use choose-completion-delete-max-match instead.
+
+;; If BUFFER is the minibuffer, exit the minibuffer
+;; unless it is reading a file name and CHOICE is a directory.
(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
;; If completing for the minibuffer, exit it with this choice.
(and (equal buffer (window-buffer (minibuffer-window)))
minibuffer-completion-table
- (exit-minibuffer)))))
+ ;; If this is reading a file name, and the file name chosen
+ ;; is a directory, don't exit the minibuffer.
+ (if (and (eq minibuffer-completion-table 'read-file-name-internal)
+ (file-directory-p (buffer-string)))
+ (select-window (active-minibuffer-window))
+ (exit-minibuffer))))))
(defun completion-list-mode ()
"Major mode for buffers showing lists of possible completions.
HCoop / bpt / emacs.git / blobdiff