In some text modes, where TAB inserts a tab, this indents to the
column specified by the function `current-left-margin'."
(interactive "*")
- (save-excursion
- (delete-horizontal-space t)
- (indent-according-to-mode))
- (newline)
- (indent-according-to-mode))
+ (delete-horizontal-space t)
+ (let ((pos (point)))
+ ;; Be careful to insert the newline before indenting the line.
+ ;; Otherwise, the indentation might be wrong.
+ (newline)
+ (save-excursion
+ (goto-char pos)
+ (indent-according-to-mode))
+ (indent-according-to-mode)))
(defun quoted-insert (arg)
"Read next input character and insert it.
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
(cond (arg (forward-line 1))
- ((< (point) (window-end nil t))
+ ((> (point) (window-end nil t))
;; If the end of the buffer is not already on the screen,
;; then scroll specially to put it near, but not at, the bottom.
(overlay-recenter (point))
(save-restriction
(goto-char (point-min))
(widen)
- (beginning-of-line)
+ (forward-line 0)
(setq start (point))
(goto-char opoint)
- (beginning-of-line)
+ (forward-line 0)
(if (/= start 1)
(message "line %d (narrowed line %d)"
(1+ (count-lines 1 (point)))
This is used for all minibuffer input
except when an alternate history list is specified.")
(defvar minibuffer-history-sexp-flag nil
- "Non-nil when doing history operations on `command-history'.
+ "Non-nil when doing history operations on the variable `command-history'.
More generally, indicates that the history list being acted on
contains expressions rather than strings.
It is only valid if its value equals the current minibuffer depth,
(setq minibuffer-history-position nil)
(defvar minibuffer-history-search-history nil)
-(mapcar
- (lambda (key-and-command)
- (mapcar
- (lambda (keymap-and-completionp)
- ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
- ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
- ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
- (define-key (symbol-value (car keymap-and-completionp))
- (car key-and-command)
- (let ((command (cdr key-and-command)))
- (if (consp command)
- ;; (and ... nil) => ... turns back on the completion-oriented
- ;; history commands which rms turned off since they seem to
- ;; do things he doesn't like.
- (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
- (progn (error "EMACS BUG!") (cdr command))
- (car command))
- command))))
- '((minibuffer-local-map . nil)
- (minibuffer-local-ns-map . nil)
- (minibuffer-local-completion-map . t)
- (minibuffer-local-must-match-map . t)
- (read-expression-map . nil))))
- '(("\en" . (next-history-element . next-complete-history-element))
- ([next] . (next-history-element . next-complete-history-element))
- ("\ep" . (previous-history-element . previous-complete-history-element))
- ([prior] . (previous-history-element . previous-complete-history-element))
- ("\er" . previous-matching-history-element)
- ("\es" . next-matching-history-element)))
-
(defvar minibuffer-text-before-history nil
"Text that was in this minibuffer before any history commands.
This is nil if there have not yet been any history commands
(unless (zerop n)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (field-string (point-max))))
+ (setq minibuffer-text-before-history
+ (minibuffer-contents-no-properties)))
(let ((history (symbol-value minibuffer-history-variable))
(case-fold-search
(if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
(setq n (+ n (if (< n 0) 1 -1)))))
(setq minibuffer-history-position pos)
(goto-char (point-max))
- (delete-field)
+ (delete-minibuffer-contents)
(insert match-string)
- (goto-char (+ (field-beginning) match-offset))))
- (if (or (eq (car (car command-history)) 'previous-matching-history-element)
- (eq (car (car command-history)) 'next-matching-history-element))
+ (goto-char (+ (minibuffer-prompt-end) match-offset))))
+ (if (memq (car (car command-history)) '(previous-matching-history-element
+ next-matching-history-element))
(setq command-history (cdr command-history))))
(defun next-matching-history-element (regexp n)
elt minibuffer-returned-to-present)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (field-string (point-max))))
+ (setq minibuffer-text-before-history
+ (minibuffer-contents-no-properties)))
(if (< narg minimum)
(if minibuffer-default
(error "End of history; no next item")
(error "End of history; no default available")))
(if (> narg (length (symbol-value minibuffer-history-variable)))
(error "Beginning of history; no preceding item"))
- (unless (or (eq last-command 'next-history-element)
- (eq last-command 'previous-history-element))
- (let ((prompt-end (field-beginning (point-max))))
+ (unless (memq last-command '(next-history-element
+ previous-history-element))
+ (let ((prompt-end (minibuffer-prompt-end)))
(set (make-local-variable 'minibuffer-temporary-goal-position)
(cond ((<= (point) prompt-end) prompt-end)
((eobp) nil)
(t (point))))))
(goto-char (point-max))
- (delete-field)
+ (delete-minibuffer-contents)
(setq minibuffer-history-position narg)
(cond ((= narg -1)
(setq elt minibuffer-default))
(let ((point-at-start (point)))
(next-matching-history-element
(concat
- "^" (regexp-quote (buffer-substring (field-beginning) (point))))
+ "^" (regexp-quote (buffer-substring (minibuffer-prompt-end) (point))))
n)
;; next-matching-history-element always puts us at (point-min).
;; Move to the position we were at before changing the buffer contents.
(interactive "p")
(next-complete-history-element (- n)))
-;; These two functions are for compatibility with the old subrs of the
-;; same name.
-
+;; For compatibility with the old subr of the same name.
(defun minibuffer-prompt-width ()
"Return the display width of the minibuffer prompt.
Return 0 if current buffer is not a mini-buffer."
;; Return the width of everything before the field at the end of
;; the buffer; this should be 0 for normal buffers.
- (1- (field-beginning (point-max))))
-
-(defun minibuffer-prompt-end ()
- "Return the buffer position of the end of the minibuffer prompt.
-Return (point-min) if current buffer is not a mini-buffer."
- (field-beginning (point-max)))
-
-(defun minibuffer-contents ()
- "Return the user input in a minbuffer as a string.
-The current buffer must be a minibuffer."
- (field-string (point-max)))
-
-(defun minibuffer-contents-no-properties ()
- "Return the user input in a minbuffer as a string, without text-properties.
-The current buffer must be a minibuffer."
- (field-string-no-properties (point-max)))
-
-(defun delete-minibuffer-contents ()
- "Delete all user input in a minibuffer.
-The current buffer must be a minibuffer."
- (delete-field (point-max)))
+ (1- (minibuffer-prompt-end)))
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
;; 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))))
+ (prev nil))
+ (while (car tail)
+ (when (integerp (car tail))
+ (let ((pos (car tail)))
+ (if (null prev)
+ (setq buffer-undo-list (cdr tail))
+ (setcdr prev (cdr tail)))
+ (setq tail (cdr tail))
+ (while (car tail)
+ (if (eq pos (car tail))
+ (if prev
+ (setcdr prev (cdr tail))
+ (setq buffer-undo-list (cdr tail)))
+ (setq prev tail))
+ (setq tail (cdr tail)))
+ (setq tail nil)))
+ (setq prev tail tail (cdr tail))))
+
(and modified (not (buffer-modified-p))
(delete-auto-save-file-if-necessary recent-save)))
;; If we do get all the way thru, make this-command indicate that.
(let ((position (car delta))
(offset (cdr delta)))
- ;; Loop down the earlier events adjusting their buffer positions
- ;; to reflect the fact that a change to the buffer isn't being
- ;; undone. We only need to process those element types which
- ;; undo-elt-in-region will return as being in the region since
- ;; only those types can ever get into the output
+ ;; Loop down the earlier events adjusting their buffer
+ ;; positions to reflect the fact that a change to the buffer
+ ;; isn't being undone. We only need to process those element
+ ;; types which undo-elt-in-region will return as being in
+ ;; the region since only those types can ever get into the
+ ;; output
(while temp-undo-list
(setq undo-elt (car temp-undo-list))
'(0 . 0)))
'(0 . 0)))
+(defun undo-get-state ()
+ "Return a handler for the current state to which we might want to undo.
+The returned handler can then be passed to `undo-revert-to-handle'."
+ (unless (eq buffer-undo-list t)
+ buffer-undo-list))
+
+(defun undo-revert-to-state (handle)
+ "Revert to the state HANDLE earlier grabbed with `undo-get-handle'.
+This undoing is not itself undoable (aka redoable)."
+ (unless (eq buffer-undo-list t)
+ (let ((new-undo-list (cons (car handle) (cdr handle))))
+ ;; Truncate the undo log at `handle'.
+ (when handle
+ (setcar handle nil) (setcdr handle nil))
+ (unless (eq last-command 'undo) (undo-start))
+ ;; Make sure there's no confusion.
+ (when (and handle (not (eq handle (last pending-undo-list))))
+ (error "Undoing to some unrelated state"))
+ ;; Undo it all.
+ (while pending-undo-list (undo-more 1))
+ ;; Reset the modified cons cell to its original content.
+ (when handle
+ (setcar handle (car new-undo-list))
+ (setcdr handle (cdr new-undo-list)))
+ ;; Revert the undo info to what it was when we grabbed the state.
+ (setq buffer-undo-list handle))))
+
+\f
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
display in the echo area (which is determined by the variables
`resize-mini-windows' and `max-mini-window-height'), it is shown
there, but it is nonetheless available in buffer `*Shell Command
-Output*' even though that buffer is not automatically displayed. If
-there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
+Output*' even though that buffer is not automatically displayed.
To specify a coding system for converting non-ASCII characters
in the shell command output, use \\[universal-coding-system-argument]
(t
;; Buffer
(goto-char (point-min))
- (display-buffer message not-this-window frame))))))))
+ (display-buffer (current-buffer)
+ not-this-window frame))))))))
;; We have a sentinel to prevent insertion of a termination message
(list t error-file)
t)
nil shell-command-switch command))
-;;; It is rude to delete a buffer which the command is not using.
-;;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
-;;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
-;;; (kill-buffer shell-buffer)))
+ ;; It is rude to delete a buffer which the command is not using.
+ ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
+ ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
+ ;; (kill-buffer shell-buffer)))
;; Don't muck with mark unless REPLACE says we should.
(and replace swap (exchange-point-and-mark)))
;; No prefix argument: put the output in a temp buffer,
(< 0 (nth 7 (file-attributes error-file))))
"(Shell command %sed with some error output)"
"(Shell command %sed with no output)")
- (if (equal 0 exit-status) "succeed" "fail"))))))
+ (if (equal 0 exit-status) "succeed" "fail"))
+ ;; Don't kill: there might be useful info in the undo-log.
+ ;; (kill-buffer buffer)
+ ))))
(when (and error-file (file-exists-p error-file))
(if (< 0 (nth 7 (file-attributes error-file)))
;; look like a C-g typed as a command.
(inhibit-quit t))
(if (pos-visible-in-window-p other-end (selected-window))
- (progn
+ (unless transient-mark-mode
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char other-end)
(forward-line arg))))
arg))
-(defvar transpose-subr-start1)
-(defvar transpose-subr-start2)
-(defvar transpose-subr-end1)
-(defvar transpose-subr-end2)
-
-(defun transpose-subr (mover arg)
- (let (transpose-subr-start1
- transpose-subr-end1
- transpose-subr-start2
- transpose-subr-end2)
- (if (= arg 0)
- (progn
- (save-excursion
- (funcall mover 1)
- (setq transpose-subr-end2 (point))
- (funcall mover -1)
- (setq transpose-subr-start2 (point))
- (goto-char (mark))
- (funcall mover 1)
- (setq transpose-subr-end1 (point))
- (funcall mover -1)
- (setq transpose-subr-start1 (point))
- (transpose-subr-1))
- (exchange-point-and-mark))
- (if (> arg 0)
- (progn
- (funcall mover -1)
- (setq transpose-subr-start1 (point))
- (funcall mover 1)
- (setq transpose-subr-end1 (point))
- (funcall mover arg)
- (setq transpose-subr-end2 (point))
- (funcall mover (- arg))
- (setq transpose-subr-start2 (point))
- (transpose-subr-1)
- (goto-char transpose-subr-end2))
- (funcall mover -1)
- (setq transpose-subr-start2 (point))
- (funcall mover 1)
- (setq transpose-subr-end2 (point))
- (funcall mover (1- arg))
- (setq transpose-subr-start1 (point))
- (funcall mover (- arg))
- (setq transpose-subr-end1 (point))
- (transpose-subr-1)))))
-
-(defun transpose-subr-1 ()
- (if (> (min transpose-subr-end1 transpose-subr-end2)
- (max transpose-subr-start1 transpose-subr-start2))
- (error "Don't have two things to transpose"))
- (let* ((word1 (buffer-substring transpose-subr-start1 transpose-subr-end1))
- (len1 (length word1))
- (word2 (buffer-substring transpose-subr-start2 transpose-subr-end2))
- (len2 (length word2)))
- (delete-region transpose-subr-start2 transpose-subr-end2)
- (goto-char transpose-subr-start2)
- (insert word1)
- (goto-char (if (< transpose-subr-start1 transpose-subr-start2)
- transpose-subr-start1
- (+ transpose-subr-start1 (- len1 len2))))
- (delete-region (point) (+ (point) len1))
+(defun transpose-subr (mover arg &optional special)
+ (let ((aux (if special mover
+ (lambda (x)
+ (cons (progn (funcall mover x) (point))
+ (progn (funcall mover (- x)) (point))))))
+ pos1 pos2)
+ (cond
+ ((= arg 0)
+ (save-excursion
+ (setq pos1 (funcall aux 1))
+ (goto-char (mark))
+ (setq pos2 (funcall aux 1))
+ (transpose-subr-1 pos1 pos2))
+ (exchange-point-and-mark))
+ ((> arg 0)
+ (setq pos1 (funcall aux -1))
+ (setq pos2 (funcall aux arg))
+ (transpose-subr-1 pos1 pos2)
+ (goto-char (car pos2)))
+ (t
+ (setq pos1 (funcall aux -1))
+ (goto-char (car pos1))
+ (setq pos2 (funcall aux arg))
+ (transpose-subr-1 pos1 pos2)))))
+
+(defun transpose-subr-1 (pos1 pos2)
+ (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
+ (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
+ (when (> (car pos1) (car pos2))
+ (let ((swap pos1))
+ (setq pos1 pos2 pos2 swap)))
+ (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose"))
+ (let ((word2 (delete-and-extract-region (car pos2) (cdr pos2))))
+ (goto-char (car pos2))
+ (insert (delete-and-extract-region (car pos1) (cdr pos1)))
+ (goto-char (car pos1))
(insert word2)))
(defun backward-word (arg)
(buffer-substring-no-properties start end)))))
(defcustom fill-prefix nil
- "*String for filling to insert at front of new line, or nil for none.
-Setting this variable automatically makes it local to the current buffer."
+ "*String for filling to insert at front of new line, or nil for none."
:type '(choice (const :tag "None" nil)
string)
:group 'fill)
(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)))))
- (and prefix (not (equal prefix ""))
- (setq fill-prefix prefix))))
-
+ (when (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)))))
+ (and prefix (not (equal prefix ""))
+ ;; Use auto-indentation rather than a guessed empty prefix.
+ (not (and fill-indent-according-to-mode
+ (string-match "[ \t]*" prefix)))
+ (setq fill-prefix prefix))))
+
(while (and (not give-up) (> (current-column) fc))
;; Determine where to split the line.
(let* (after-prefix
;; a character, or \c| following a character. If
;; not found, place the point at beginning of line.
(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 "\\. ")))))
- (and (not (bobp))
- (not bounce)
- fill-nobreak-predicate
- (funcall fill-nobreak-predicate)))
+ (fill-nobreak-p)))
(setq first nil)
(re-search-backward "[ \t]\\|\\c|.\\|.\\c|\\|^")
;; If we find nowhere on the line to break it,
;; Now do justification, if required
(if (not (eq justify 'left))
(save-excursion
- (end-of-line 0)
- (justify-current-line justify nil t)))
+ (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.
(defun rfc822-goto-eoh ()
;; Go to header delimiter line in a mail message, following RFC822 rules
(goto-char (point-min))
- (while (looking-at "^[^: \n]+:\\|^[ \t]")
- (forward-line 1))
- (point))
+ (when (re-search-forward
+ "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
+ (goto-char (match-beginning 0))))
(defun sendmail-user-agent-compose (&optional to subject other-headers continue
switch-function yank-action
;;; bindings.
;; Also tell read-char how to handle these keys.
-(mapcar
+(mapc
(lambda (keypad-normal)
(let ((keypad (nth 0 keypad-normal))
(normal (nth 1 keypad-normal)))
If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
This runs the normal hook `clone-buffer-hook' in the new buffer
after it has been set up properly in other respects."
- (interactive (list (if current-prefix-arg (read-string "Name: "))
- t))
+ (interactive
+ (progn
+ (if buffer-file-name
+ (error "Cannot clone a file-visiting buffer"))
+ (if (get major-mode 'no-clone)
+ (error "Cannot clone a buffer in %s mode" mode-name))
+ (list (if current-prefix-arg (read-string "Name: "))
+ t)))
(if buffer-file-name
(error "Cannot clone a file-visiting buffer"))
(if (get major-mode 'no-clone)
Optional last arg NORECORD non-nil means do not put this buffer at the
front of the list of recently selected ones."
- (interactive (list (if current-prefix-arg
- (read-string "BName of indirect buffer: "))
- t))
+ (interactive
+ (progn
+ (if (get major-mode 'no-clone-indirect)
+ (error "Cannot indirectly clone a buffer in %s mode" mode-name))
+ (list (if current-prefix-arg
+ (read-string "BName of indirect buffer: "))
+ t)))
+ (if (get major-mode 'no-clone-indirect)
+ (error "Cannot indirectly clone a buffer in %s mode" mode-name))
(setq newname (or newname (buffer-name)))
(if (string-match "<[0-9]+>\\'" newname)
(setq newname (substring newname 0 (match-beginning 0))))
(and (boundp 'byte-compile-current-file)
(stringp byte-compile-current-file)))
+
+;; Minibuffer prompt stuff.
+
+;(defun minibuffer-prompt-modification (start end)
+; (error "You cannot modify the prompt"))
+;
+;
+;(defun minibuffer-prompt-insertion (start end)
+; (let ((inhibit-modification-hooks t))
+; (delete-region start end)
+; ;; Discard undo information for the text insertion itself
+; ;; and for the text deletion.above.
+; (when (consp buffer-undo-list)
+; (setq buffer-undo-list (cddr buffer-undo-list)))
+; (message "You cannot modify the prompt")))
+;
+;
+;(setq minibuffer-prompt-properties
+; (list 'modification-hooks '(minibuffer-prompt-modification)
+; 'insert-in-front-hooks '(minibuffer-prompt-insertion)))
+;
+
;;; simple.el ends here