;;; Code:
+(eval-when-compile
+ (require 'cl))
+
+
(defgroup killing nil
"Killing and yanking commands"
:group 'editing)
;; 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
;; the end of the previous line.
- (let ((flag (and (not (bobp))
+ (let ((flag (and (not (bobp))
(bolp)
;; Make sure no functions want to be told about
;; the range of the changes.
(not (get-char-property (1- (point)) 'invisible))
;; Make sure the newline before point has the same
;; properties as the char before it (if any).
- (< (or (previous-property-change (point)) -2)
+ (< (or (previous-property-change (point)) -2)
(- (point) 2))))
(was-page-start (and (bolp)
(looking-at page-delimiter)))
(point-max))))
;; If we went to a place in the middle of the buffer,
;; adjust it to the beginning of a line.
- (if arg (forward-line 1)
- ;; If the end of the buffer is not already on the screen,
- ;; then scroll specially to put it near, but not at, the bottom.
- (if (let ((old-point (point)))
- (save-excursion
- (goto-char (window-start))
- (vertical-motion (window-height))
- (< (point) old-point)))
- (progn
- (overlay-recenter (point))
- (recenter -3)))))
+ (cond (arg (forward-line 1))
+ ((< (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))
+ (recenter -3))))
(defun mark-whole-buffer ()
"Put point at beginning and mark at end of buffer.
(prefix-numeric-value current-prefix-arg))))
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (buffer-string)))
+ (setq minibuffer-text-before-history (field-string (point-max))))
(let ((history (symbol-value minibuffer-history-variable))
(case-fold-search
(if (isearch-no-upper-case-p regexp t) ; assume isearch.el is dumped
(nth (1- pos) history)))
(setq n (+ n (if (< n 0) 1 -1)))))
(setq minibuffer-history-position pos)
- (erase-buffer)
+ (goto-char (point-max))
+ (delete-field)
(let ((elt (nth (1- pos) history)))
(insert (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
(prin1-to-string elt))
elt)))
- (goto-char (point-min)))
+ (goto-char (field-beginning)))
(if (or (eq (car (car command-history)) 'previous-matching-history-element)
(eq (car (car command-history)) 'next-matching-history-element))
(setq command-history (cdr command-history))))
elt minibuffer-returned-to-present)
(if (and (zerop minibuffer-history-position)
(null minibuffer-text-before-history))
- (setq minibuffer-text-before-history (buffer-string)))
+ (setq minibuffer-text-before-history (field-string (point-max))))
(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"))
- (erase-buffer)
+ (goto-char (point-max))
+ (delete-field)
(setq minibuffer-history-position narg)
(cond ((= narg -1)
(setq elt minibuffer-default))
(let ((print-level nil))
(prin1-to-string elt))
elt))
- (goto-char (minibuffer-prompt-end)))))
+ (goto-char (field-beginning)))))
(defun previous-history-element (n)
"Inserts the previous element of the minibuffer history into the minibuffer."
(next-history-element (- n)))
(defun next-complete-history-element (n)
- "Get next element of history which is a completion of minibuffer contents."
+ "Get next history element which completes the minibuffer before the point.
+The contents of the minibuffer after the point are deleted, and replaced
+by the new completion."
(interactive "p")
(let ((point-at-start (point)))
(next-matching-history-element
- (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
+ (concat
+ "^" (regexp-quote (buffer-substring (field-beginning) (point))))
+ n)
;; next-matching-history-element always puts us at (point-min).
;; Move to the position we were at before changing the buffer contents.
;; This is still sensical, because the text before point has not changed.
(defun previous-complete-history-element (n)
"\
-Get previous element of history which is a completion of minibuffer contents."
+Get previous history element which completes the minibuffer before the point.
+The contents of the minibuffer after the point are deleted, and replaced
+by the new completion."
(interactive "p")
(next-complete-history-element (- n)))
+
+;; These two functions are for compatibility with the old subrs 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 0 if current buffer is not a mini-buffer."
+ (field-beginning (point-max)))
+
\f
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
are ignored. If BEG and END are nil, all undo elements are used."
(if (eq buffer-undo-list t)
(error "No undo information in this buffer"))
- (setq pending-undo-list
+ (setq pending-undo-list
(if (and beg end (not (= beg end)))
(undo-make-selective-list (min beg end) (max beg end))
buffer-undo-list)))
(let ((text-pos (abs (cdr undo-elt)))
(point-at-end (< (cdr undo-elt) 0 )))
(if (>= text-pos position)
- (setcdr undo-elt (* (if point-at-end -1 1)
+ (setcdr undo-elt (* (if point-at-end -1 1)
(- text-pos offset))))))
((integerp (car undo-elt))
;; (BEGIN . END)
(if (and output-buffer
(not (or (bufferp output-buffer) (stringp output-buffer))))
(let ((error-file
- (if error-buffer
+ (if error-buffer
(make-temp-file
(expand-file-name "scor"
(or small-temporary-file-directory
;; "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
+ (call-process shell-file-name nil
(if error-file
(list t error-file)
t)
(erase-buffer)
(display-buffer buffer)
(setq default-directory directory)
- (setq proc (start-process "Shell" buffer shell-file-name
+ (setq proc (start-process "Shell" buffer shell-file-name
shell-command-switch command))
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
(if (memq (process-status process) '(exit signal))
- (message "%s: %s."
+ (message "%s: %s."
(car (cdr (cdr (process-command process))))
(substring signal 0 -1))))
(delete-region (point-min) (min start end))
(setq exit-status
(call-process-region (point-min) (point-max)
- shell-file-name t
+ shell-file-name t
(if error-file
(list t error-file)
t)
(goto-char (point-min))
(buffer-substring (point)
(progn (end-of-line) (point))))))
- (t
+ (t
(save-excursion
(set-buffer buffer)
(goto-char (point-min)))
(display-buffer (current-buffer))))
(delete-file error-file))
exit-status))
-
+
(defun shell-command-to-string (command)
"Execute shell command COMMAND and return its output as a string."
(with-output-to-string
If N is zero, `interprogram-paste-function' is set, and calling it
returns a string, then that string is added to the front of the
kill ring and returned as the latest kill.
-If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
+If optional arg DO-NOT-MOVE is non-nil, then don't actually move the
yanking point; just return the Nth kill forward."
(let ((interprogram-paste (and (= n 0)
interprogram-paste-function
(if (eq last-command 'kill-region)
(kill-append (buffer-substring beg end) (< end beg))
(kill-new (buffer-substring beg end)))
- (if transient-mark-mode
+ (if transient-mark-mode
(setq deactivate-mark t))
nil)
(defcustom backward-delete-char-untabify-method 'untabify
"*The method for untabifying when deleting backward.
-Can be `untabify' -- turn a tab to many spaces, then delete one space.
- `hungry' -- delete all whitespace, both tabs and spaces.
+Can be `untabify' -- turn a tab to many spaces, then delete one space;
+ `hungry' -- delete all whitespace, both tabs and spaces;
+ `all' -- delete all whitespace, including tabs, spaces and newlines;
nil -- just delete one character."
- :type '(choice (const untabify) (const hungry) (const nil))
+ :type '(choice (const untabify) (const hungry) (const all) (const nil))
:group 'killing)
(defun backward-delete-char-untabify (arg &optional killp)
(forward-char -1)
(setq count (1- count))))))
(delete-backward-char
- (if (eq backward-delete-char-untabify-method 'hungry)
- (let ((wh (- (point) (save-excursion (skip-chars-backward " \t")
+ (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
+ ((eq backward-delete-char-untabify-method 'all)
+ " \t\n\r"))))
+ (if skip
+ (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
(point)))))
(+ arg (if (zerop wh) 0 (1- wh))))
- arg)
+ arg))
killp))
(defun zap-to-char (arg char)
;; with intangibility and point-motion hooks enabled this time.
(goto-char opoint)
(setq inhibit-point-motion-hooks nil)
- (goto-char new)
+ (goto-char (constrain-to-field new opoint t t))
;; If intangibility processing moved us to a different line,
;; readjust the horizontal position within the line we ended up at.
(when (or (< (point) line-beg) (> (point) line-end))
(setq new (point)))
(goto-char (point-min))
(setq inhibit-point-motion-hooks nil)
- (goto-char new)
+ (goto-char (constrain-to-field new opoint t t))
)))
nil)
(delete-region (point) begpos)
(indent-to indent))
;; An existing comment?
- (if cpos
+ (if cpos
(progn (goto-char cpos)
(set-marker cpos nil))
;; No, insert one.
Numeric prefix arg ARG means use ARG comment characters.
If ARG is negative, delete that many comment characters instead.
Comments are terminated on each line, even for syntax in which newline does
-not end the comment. Blank lines do not get comments."
+not end the comment. Blank lines do not get comments.
+
+The strings used as comment starts are build from
+`comment-start' without trailing spaces and `comment-padding'."
;; if someone wants it to only put a comment-start at the beginning and
;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
;; is easy enough. No option is made here for other than commenting
(if (> beg end) (let (mid) (setq mid beg beg end end mid)))
(save-excursion
(save-restriction
- (let ((cs comment-start) (ce comment-end)
- (cp (when comment-padding
- (make-string comment-padding ? )))
- numarg)
+ (let* ((comment-start
+ (substring comment-start 0
+ (string-match "[ \t]*$" comment-start)))
+ (cs comment-start) (ce comment-end)
+ (cp (when comment-padding
+ (make-string comment-padding ? )))
+ numarg)
(if (consp arg) (setq numarg t)
(setq numarg (prefix-numeric-value arg))
;; For positive arg > 1, replicate the comment delims now,
(null (setq fc (current-fill-column)))
(and (eq justify 'left)
(<= (current-column) fc))
- (save-excursion (beginning-of-line)
+ (save-excursion (beginning-of-line)
(setq bol (point))
(and auto-fill-inhibit-regexp
(looking-at auto-fill-inhibit-regexp))))
(funcall comment-line-break-function t)))
;; Now do justification, if required
(if (not (eq justify 'left))
- (save-excursion
+ (save-excursion
(end-of-line 0)
(justify-current-line justify nil t)))
;; If making the new line didn't reduce the hpos of
(setq give-up t))))
;; Justify last line.
(justify-current-line justify t t)
- t)))
+ t)))
(defvar normal-auto-fill-function 'do-auto-fill
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
If a fill column is specified, it overrides the use of the comment column
or comment indentation.
-The inserted newline is marked hard if `use-hard-newlines' is true,
+The inserted newline is marked hard if `use-hard-newlines' is true,
unless optional argument SOFT is non-nil."
(interactive)
(let (comcol comstart)
(bury-buffer))))
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
+
+(defcustom input-mode-8-bit t
+ "Control acceptance of 8-bit keyboard input.
+This may be useful for inputting non-ASCII characters if your keyboard
+can generate them. It is not necessary to change this under a window
+system which can distinguish 8-bit characters and Meta keys.
+Setting this variable directly does not take effect;
+use either M-x customize or the function `set-input-mode'."
+ :set (lambda (symbol value)
+ (let ((mode (current-input-mode)))
+ (set-input-mode (nth 0 mode) (nth 1 mode) value)))
+ :initialize 'custom-initialize-default
+ :type '(choice (const :tag "8-bit input for a Meta key" t)
+ (const :tag "Direct 8-bit character input" 0)
+ (const :tag "Assume top bit is parity and ignore" nil))
+ :version "21.1"
+ :link '(custom-manual "Single-Byte European Support")
+ :group 'keyboard)
\f
(defcustom mail-user-agent 'sendmail-user-agent
"*Your preference for a mail composition package.
(require 'wid-edit)
(setq type (widget-convert type))
(unless (widget-apply type :match val)
- (error "Value `%S' does not match type %S of %S"
+ (error "Value `%S' does not match type %S of %S"
val (car type) var))))
(set var val))
\f
;; 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)))
+ (file-directory-p (field-string (point-max))))
(select-window (active-minibuffer-window))
(exit-minibuffer))))))
(kp-divide ?/)
(kp-equal ?=)))
-;;;;
+;;;;
;;;; forking a twin copy of a buffer.
-;;;;
+;;;;
(defvar clone-buffer-hook nil
"Normal hook to run in the new buffer at the end of `clone-buffer'.")
(if display-flag (pop-to-buffer new))
new))
+
+(defmacro with-syntax-table (table &rest body)
+ "Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
+Current buffer and syntax table are saved, BODY is evaluated, and the
+saved values are restored, even in case of an abnormal exit.
+Value is what BODY returns."
+ (let ((old-table (gensym))
+ (old-buffer (gensym)))
+ '(let ((,old-table (syntax-table))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (set-syntax-table (copy-syntax-table ,table))
+ ,@body)
+ (set-buffer ,old-buffer)
+ (set-syntax-table ,old-table)))))
+
+(put 'with-syntax-table 'lisp-indent-function 1)
+(put 'with-syntax-table 'edebug-form-spec '(form body))
+
;;; simple.el ends here