;;; simple.el --- basic editing commands for Emacs
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 1999
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 96, 97, 98, 99, 2000
;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;;; Code:
+(eval-when-compile
+ (autoload 'widget-convert "wid-edit")
+ (autoload 'shell-mode "shell")
+ (require 'cl))
+
+
(defgroup killing nil
"Killing and yanking commands"
:group 'editing)
-(defgroup fill-comments nil
- "Indenting and filling of comments."
- :prefix "comment-"
- :group 'fill)
-
(defgroup paren-matching nil
"Highlight (un)matching of parens and expressions."
:group 'matching)
;; 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 after-change-function)
- (not before-change-function)
(not after-change-functions)
(not before-change-functions)
;; Make sure there are no markers here.
(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.
(push-mark (point))
(push-mark (point-max) nil t)
(goto-char (point-min)))
+
\f
;; Counting lines, one way or another.
code is shown in hex. If the character is encoded into more than one
byte, just \"...\" is shown.
-With prefix argument, print additional details about that character,
-instead of the cursor position. This includes the character set name,
-the codes that identify the character within that character set. In
-addition, the encoding is fully shown."
+In addition, with prefix argument, show details about that character
+in *Help* buffer. See also the command `describe-char-after'."
(interactive "P")
(let* ((char (following-char))
(beg (point-min))
(col (current-column)))
(if (= pos end)
(if (or (/= beg 1) (/= end (1+ total)))
- (message "point=%d of %d(%d%%) <%d - %d> column %d %s"
+ (message "point=%d of %d (%d%%) <%d - %d> column %d %s"
pos total percent beg end col hscroll)
- (message "point=%d of %d(%d%%) column %d %s"
+ (message "point=%d of %d (%d%%) column %d %s"
pos total percent col hscroll))
(let ((coding buffer-file-coding-system)
encoded encoding-msg)
(setq encoded (and (>= char 128) (encode-coding-char char coding)))
(setq encoding-msg
(if encoded
- (format "(0%o, %d, 0x%x, ext %s)"
+ (format "(0%o, %d, 0x%x, file %s)"
char char char
- (if (and (not detail)
- (> (length encoded) 1))
+ (if (> (length encoded) 1)
"..."
- (concat
- (encoded-string-description encoded coding)
- (if (cmpcharp char) "..." ""))))
+ (encoded-string-description encoded coding)))
(format "(0%o, %d, 0x%x)" char char char))))
(if detail
- ;; We show the detailed information of CHAR.
- (let ((internal
- (if (cmpcharp char)
- ;; For a composite character, we show the
- ;; components only.
- (concat "(composed \""
- (decompose-composite-char char)
- "\")")
- (split-char char))))
- (message "Char: %s %s %s"
- (if (< char 256)
- (single-key-description char)
- (buffer-substring (point) (1+ (point))))
- encoding-msg internal))
- (if (or (/= beg 1) (/= end (1+ total)))
- (message "Char: %s %s point=%d of %d(%d%%) <%d - %d> column %d %s"
- (if (< char 256)
- (single-key-description char)
- (buffer-substring (point) (1+ (point))))
- encoding-msg pos total percent beg end col hscroll)
- (message "Char: %s %s point=%d of %d(%d%%) column %d %s"
+ ;; We show the detailed information about CHAR.
+ (describe-char-after (point)))
+ (if (or (/= beg 1) (/= end (1+ total)))
+ (message "Char: %s %s point=%d of %d (%d%%) <%d - %d> column %d %s"
(if (< char 256)
(single-key-description char)
- (buffer-substring (point) (1+ (point))))
- encoding-msg pos total percent col hscroll)))))))
+ (buffer-substring-no-properties (point) (1+ (point))))
+ encoding-msg pos total percent beg end col hscroll)
+ (message "Char: %s %s point=%d of %d (%d%%) column %d %s"
+ (if (< char 256)
+ (single-key-description char)
+ (buffer-substring-no-properties (point) (1+ (point))))
+ encoding-msg pos total percent col hscroll))))))
\f
(defvar read-expression-map (cons 'keymap minibuffer-local-map)
"Minibuffer keymap used for reading Lisp expressions.")
(defcustom eval-expression-print-length 12
"*Value to use for `print-length' when printing value in `eval-expression'."
:group 'lisp
- :type 'integer
+ :type '(choice (const nil) integer)
:version "21.1")
(defcustom eval-expression-debug-on-error t
- "*Value to use for `debug-on-error' when evaluating in `eval-expression'."
+ "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'.
+If nil, don't change the value of `debug-on-error'."
:group 'lisp
:type 'boolean
:version "21.1")
nil read-expression-map t
'read-expression-history)
current-prefix-arg))
- (let ((debug-on-error eval-expression-debug-on-error))
- (setq values (cons (eval eval-expression-arg) values)))
+
+ (if (null eval-expression-debug-on-error)
+ (setq values (cons (eval eval-expression-arg) values))
+ (let ((old-value (make-symbol "t")) new-value)
+ ;; Bind debug-on-error to something unique so that we can
+ ;; detect when evaled code changes it.
+ (let ((debug-on-error old-value))
+ (setq values (cons (eval eval-expression-arg) values))
+ (setq new-value debug-on-error))
+ ;; If evaled code has changed the value of debug-on-error,
+ ;; propagate that change to the global binding.
+ (unless (eq old-value new-value)
+ (setq debug-on-error new-value))))
+
(let ((print-length eval-expression-print-length)
(print-level eval-expression-print-level))
(prin1 (car values)
(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)
command)))
;; Clear the output buffer, then run the command with
;; output there.
- (save-excursion
- (set-buffer buffer)
- (setq buffer-read-only nil)
- (erase-buffer))
+ (let ((directory default-directory))
+ (save-excursion
+ (set-buffer buffer)
+ (setq buffer-read-only nil)
+ (if (not output-buffer)
+ (setq default-directory directory))
+ (erase-buffer)))
(setq exit-status
(call-process-region start end shell-file-name nil
(if error-file
(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
(define-key map [?7] 'digit-argument)
(define-key map [?8] 'digit-argument)
(define-key map [?9] 'digit-argument)
+ (define-key map [kp-0] 'digit-argument)
+ (define-key map [kp-1] 'digit-argument)
+ (define-key map [kp-2] 'digit-argument)
+ (define-key map [kp-3] 'digit-argument)
+ (define-key map [kp-4] 'digit-argument)
+ (define-key map [kp-5] 'digit-argument)
+ (define-key map [kp-6] 'digit-argument)
+ (define-key map [kp-7] 'digit-argument)
+ (define-key map [kp-8] 'digit-argument)
+ (define-key map [kp-9] 'digit-argument)
+ (define-key map [kp-subtract] 'universal-argument-minus)
map)
"Keymap used while processing \\[universal-argument].")
"Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (let ((digit (- (logand last-command-char ?\177) ?0)))
+ (let* ((char (if (integerp last-command-char)
+ last-command-char
+ (get last-command-char 'ascii-character)))
+ (digit (- (logand char ?\177) ?0)))
(cond ((integerp arg)
(setq prefix-arg (+ (* arg 10)
(if (< arg 0) (- digit) digit))))
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 the previous command was also a kill command,
the text killed this time appends to the text killed last time
to make one entry in the kill ring."
- (interactive "*r")
+ (interactive "r")
(condition-case nil
- ;; Don't let the undo list be truncated before we can even access it.
- (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
- (old-list buffer-undo-list)
- tail
- ;; If we can't rely on finding the killed text
- ;; in the undo list, save it now as a string.
- (string (if (or (eq buffer-undo-list t)
- (= beg end))
- (buffer-substring beg end))))
- (delete-region beg end)
- ;; Search back in buffer-undo-list for this string,
- ;; in case a change hook made property changes.
- (setq tail buffer-undo-list)
- (unless string
- (while (not (stringp (car (car tail))))
- (setq tail (cdr tail)))
- ;; If we did not already make the string to use,
- ;; use the same one that undo made for us.
- (setq string (car (car tail))))
- ;; Add that string to the kill ring, one way or another.
- (if (eq last-command 'kill-region)
- (kill-append string (< end beg))
- (kill-new string))
+ (let ((string (delete-and-extract-region beg end)))
+ (when string ;STRING is nil if BEG = END
+ ;; Add that string to the kill ring, one way or another.
+ (if (eq last-command 'kill-region)
+ (kill-append string (< end beg))
+ (kill-new string)))
(setq this-command 'kill-region))
((buffer-read-only text-read-only)
;; The code above failed because the buffer, or some of the characters
(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)
"Kill up to and including ARG'th occurrence of CHAR.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
Goes backward if ARG is negative; error if CHAR not found."
- (interactive "*p\ncZap to char: ")
+ (interactive "p\ncZap to char: ")
(kill-region (point) (progn
(search-forward (char-to-string char) nil nil arg)
; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
including its terminating newline, when used at the beginning of a line
with no argument. As a consequence, you can always kill a whole line
by typing \\[beginning-of-line] \\[kill-line]."
- (interactive "*P")
+ (interactive "P")
(kill-region (point)
;; It is better to move point to the other end of the kill
;; before killing. That way, in a read-only buffer, point
(defun insert-buffer (buffer)
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
-BUFFER may be a buffer or a buffer name."
+BUFFER may be a buffer or a buffer name.
+
+This function is meant for the user to run interactively.
+Don't call it from programs!"
(interactive
(list
(progn
(region-beginning) (region-end)))
(let ((oldbuf (current-buffer)))
(save-excursion
- (set-buffer (get-buffer-create buffer))
- (barf-if-buffer-read-only)
- (insert-buffer-substring oldbuf start end))))
+ (let* ((append-to (get-buffer-create buffer))
+ (windows (get-buffer-window-list append-to t t))
+ point)
+ (set-buffer append-to)
+ (setq point (point))
+ (barf-if-buffer-read-only)
+ (insert-buffer-substring oldbuf start end)
+ (dolist (window windows)
+ (when (= (window-point window) point)
+ (set-window-point window (point))))))))
(defun prepend-to-buffer (buffer start end)
"Prepend to specified buffer the text of the region.
;; 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 nil t
+ 'inhibit-line-move-field-capture))
;; 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 nil t
+ 'inhibit-line-move-field-capture))
)))
nil)
(delete-region (point) (+ (point) len1))
(insert word2)))
\f
-(defcustom comment-column 32
- "*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 set the value for a particular mode using that mode's hook."
- :type 'integer
- :group 'fill-comments)
-(make-variable-buffer-local 'comment-column)
-
-(defcustom comment-start nil
- "*String to insert to start a new comment, or nil if no comment syntax."
- :type '(choice (const :tag "None" nil)
- string)
- :group 'fill-comments)
-
-(defcustom comment-start-skip nil
- "*Regexp to match the start of a comment plus everything up to its body.
-If there are any \\(...\\) pairs, the comment delimiter text is held to begin
-at the place matched by the close of the first pair."
- :type '(choice (const :tag "None" nil)
- regexp)
- :group 'fill-comments)
-
-(defcustom comment-end ""
- "*String to insert to end a new comment.
-Should be an empty string if comments are terminated by end-of-line."
- :type 'string
- :group 'fill-comments)
-
(defvar comment-indent-hook nil
"Obsolete variable for function to compute desired indentation for a comment.
This function is called with no args with point at the beginning of
the comment's starting delimiter.")
-
-(defvar comment-indent-function
- '(lambda () comment-column)
- "Function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter.")
-
-(defcustom block-comment-start nil
- "*String to insert to start a new comment on a line by itself.
-If nil, use `comment-start' instead.
-Note that the regular expression `comment-start-skip' should skip this string
-as well as the `comment-start' string."
- :type '(choice (const :tag "Use comment-start" nil)
- string)
- :group 'fill-comments)
-
-(defcustom block-comment-end nil
- "*String to insert to end a new comment on a line by itself.
-Should be an empty string if comments are terminated by end-of-line.
-If nil, use `comment-end' instead."
- :type '(choice (const :tag "Use comment-end" nil)
- string)
- :group 'fill-comments)
-
-(defun indent-for-comment ()
- "Indent this line's comment to comment column, or insert an empty comment."
- (interactive "*")
- (let* ((empty (save-excursion (beginning-of-line)
- (looking-at "[ \t]*$")))
- (starter (or (and empty block-comment-start) comment-start))
- (ender (or (and empty block-comment-end) comment-end)))
- (cond
- ((null starter)
- (error "No comment syntax defined"))
- ((null comment-start-skip)
- (error "This mode doesn't define `comment-start-skip'"))
- (t (let* ((eolpos (save-excursion (end-of-line) (point)))
- cpos indent begpos)
- (beginning-of-line)
- (if (re-search-forward comment-start-skip eolpos 'move)
- (progn (setq cpos (point-marker))
- ;; Find the start of the comment delimiter.
- ;; If there were paren-pairs in comment-start-skip,
- ;; position at the end of the first pair.
- (if (match-end 1)
- (goto-char (match-end 1))
- ;; If comment-start-skip matched a string with
- ;; internal whitespace (not final whitespace) then
- ;; the delimiter start at the end of that
- ;; whitespace. Otherwise, it starts at the
- ;; beginning of what was matched.
- (skip-syntax-backward " " (match-beginning 0))
- (skip-syntax-backward "^ " (match-beginning 0)))))
- (setq begpos (point))
- ;; Compute desired indent.
- (if (= (current-column)
- (setq indent (if comment-indent-hook
- (funcall comment-indent-hook)
- (funcall comment-indent-function))))
- (goto-char begpos)
- ;; If that's different from current, change it.
- (skip-chars-backward " \t")
- (delete-region (point) begpos)
- (indent-to indent))
- ;; An existing comment?
- (if cpos
- (progn (goto-char cpos)
- (set-marker cpos nil))
- ;; No, insert one.
- (insert starter)
- (save-excursion
- (insert ender))))))))
-
-(defun set-comment-column (arg)
- "Set the comment column based on point.
-With no arg, set the comment column to the current column.
-With just minus as arg, kill any comment on this line.
-With any other arg, set comment column to indentation of the previous comment
- and then align or create a comment on this line at that column."
- (interactive "P")
- (if (eq arg '-)
- (kill-comment nil)
- (if arg
- (progn
- (save-excursion
- (beginning-of-line)
- (re-search-backward comment-start-skip)
- (beginning-of-line)
- (re-search-forward comment-start-skip)
- (goto-char (match-beginning 0))
- (setq comment-column (current-column))
- (message "Comment column set to %d" comment-column))
- (indent-for-comment))
- (setq comment-column (current-column))
- (message "Comment column set to %d" comment-column))))
-
-(defun kill-comment (arg)
- "Kill the comment on this line, if any.
-With argument, kill comments on that many lines starting with this one."
- ;; this function loses in a lot of situations. it incorrectly recognises
- ;; comment delimiters sometimes (ergo, inside a string), doesn't work
- ;; with multi-line comments, can kill extra whitespace if comment wasn't
- ;; through end-of-line, et cetera.
- (interactive "P")
- (or comment-start-skip (error "No comment syntax defined"))
- (let ((count (prefix-numeric-value arg)) endc)
- (while (> count 0)
- (save-excursion
- (end-of-line)
- (setq endc (point))
- (beginning-of-line)
- (and (string< "" comment-end)
- (setq endc
- (progn
- (re-search-forward (regexp-quote comment-end) endc 'move)
- (skip-chars-forward " \t")
- (point))))
- (beginning-of-line)
- (if (re-search-forward comment-start-skip endc t)
- (progn
- (goto-char (match-beginning 0))
- (skip-chars-backward " \t")
- (kill-region (point) endc)
- ;; to catch comments a line beginnings
- (indent-according-to-mode))))
- (if arg (forward-line 1))
- (setq count (1- count)))))
-
-(defvar comment-padding 1
- "Number of spaces `comment-region' puts between comment chars and text.
-
-Extra spacing between the comment characters and the comment text
-makes the comment easier to read. Default is 1. Nil means 0 and is
-more efficient.")
-
-(defun comment-region (beg end &optional arg)
- "Comment or uncomment each line in the region.
-With just C-u prefix arg, uncomment each line in region.
-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."
- ;; 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
- ;; every line.
- (interactive "*r\nP")
- (or comment-start (error "No comment syntax is defined"))
- (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)
- (if (consp arg) (setq numarg t)
- (setq numarg (prefix-numeric-value arg))
- ;; For positive arg > 1, replicate the comment delims now,
- ;; then insert the replicated strings just once.
- (while (> numarg 1)
- (setq cs (concat cs comment-start)
- ce (concat ce comment-end))
- (setq numarg (1- numarg))))
- ;; Loop over all lines from BEG to END.
- (narrow-to-region beg end)
- (goto-char beg)
- (if (or (eq numarg t) (< numarg 0))
- (while (not (eobp))
- (let (found-comment)
- ;; Delete comment start from beginning of line.
- (if (eq numarg t)
- (while (looking-at (regexp-quote cs))
- (setq found-comment t)
- (delete-char (length cs)))
- (let ((count numarg))
- (while (and (> 1 (setq count (1+ count)))
- (looking-at (regexp-quote cs)))
- (setq found-comment t)
- (delete-char (length cs)))))
- ;; Delete comment padding from beginning of line
- (when (and found-comment comment-padding
- (looking-at (regexp-quote cp)))
- (delete-char comment-padding))
- ;; Delete comment end from end of line.
- (if (string= "" ce)
- nil
- (if (eq numarg t)
- (progn
- (end-of-line)
- ;; This is questionable if comment-end ends in
- ;; whitespace. That is pretty brain-damaged,
- ;; though.
- (while (progn (skip-chars-backward " \t")
- (and (>= (- (point) (point-min)) (length ce))
- (save-excursion
- (backward-char (length ce))
- (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")
- (if (>= (- (point) (point-min)) (length ce))
- (save-excursion
- (backward-char (length ce))
- (if (looking-at (regexp-quote ce))
- (delete-char (length ce)))))))))
- (forward-line 1)))
-
- (when comment-padding
- (setq cs (concat cs cp)))
- (while (not (eobp))
- ;; Insert at beginning and at end.
- (if (looking-at "[ \t]*$") ()
- (insert cs)
- (if (string= "" ce) ()
- (end-of-line)
- (insert ce)))
- (search-forward "\n" nil 'move)))))))
\f
(defun backward-word (arg)
"Move backward until encountering the end of a word.
(defun kill-word (arg)
"Kill characters forward until encountering the end of a word.
With argument, do this that many times."
- (interactive "*p")
+ (interactive "p")
(kill-region (point) (progn (forward-word arg) (point))))
(defun backward-kill-word (arg)
"Kill characters backward until encountering the end of a word.
With argument, do this that many times."
- (interactive "*p")
+ (interactive "p")
(kill-word (- arg)))
(defun current-word (&optional strict)
(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.
(defun turn-on-auto-fill ()
"Unconditionally turn on Auto Fill mode."
(auto-fill-mode 1))
+
+(defun turn-off-auto-fill ()
+ "Unconditionally turn off Auto Fill mode."
+ (auto-fill-mode -1))
+
(custom-add-option 'text-mode-hook 'turn-on-auto-fill)
(defun set-fill-column (arg)
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
\f
-(defcustom 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]."
- :type 'boolean
- :group 'fill-comments)
-
-(defun indent-new-comment-line (&optional soft)
- "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 you want to continue one comment across several lines, use \\[newline-and-indent].
-
-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,
-unless optional argument SOFT is non-nil."
- (interactive)
- (let (comcol comstart)
- (skip-chars-backward " \t")
- (delete-region (point)
- (progn (skip-chars-forward " \t")
- (point)))
- (if soft (insert-and-inherit ?\n) (newline 1))
- (if fill-prefix
- (progn
- (indent-to-left-margin)
- (insert-and-inherit fill-prefix))
- (if (not comment-multi-line)
- (save-excursion
- (if (and comment-start-skip
- (let ((opoint (1- (point)))
- inside)
- (forward-line -1)
- ;; Determine (more or less) whether
- ;; target position is inside a comment.
- (while (and (re-search-forward comment-start-skip opoint t)
- (not (setq inside (or (equal comment-end "")
- (not (search-forward comment-end opoint t)))))))
- inside))
- ;; The old line has a comment and point was inside the comment.
- ;; Set WIN to the pos of the comment-start.
- ;; But if the comment is empty, look at preceding lines
- ;; to find one that has a nonempty comment.
-
- ;; If comment-start-skip contains a \(...\) pair,
- ;; the real comment delimiter starts at the end of that pair.
- (let ((win (or (match-end 1) (match-beginning 0))))
- (while (and (eolp) (not (bobp))
- (let (opoint)
- (beginning-of-line)
- (setq opoint (point))
- (forward-line -1)
- (re-search-forward comment-start-skip opoint t)))
- (setq win (or (match-end 1) (match-beginning 0))))
- ;; Indent this line like what we found.
- (goto-char win)
- (setq comcol (current-column))
- (setq comstart
- (buffer-substring (point) (match-end 0)))))))
- (if comcol
- (let ((comment-column comcol)
- (comment-start comstart)
- (comment-end comment-end))
- (and comment-end (not (equal comment-end ""))
- ; (if (not comment-multi-line)
- (progn
- (forward-char -1)
- (insert comment-end)
- (forward-char 1))
- ; (setq comment-column (+ comment-column (length comment-start))
- ; comment-start "")
- ; )
- )
- (if (not (eolp))
- (setq comment-end ""))
- (insert-and-inherit ?\n)
- (forward-char -1)
- (indent-for-comment)
- (save-excursion
- ;; Make sure we delete the newline inserted above.
- (end-of-line)
- (delete-char 1)))
- (indent-according-to-mode)))))
-\f
(defun set-selective-display (arg)
"Set `selective-display' to ARG; clear it if no arg.
When the value of `selective-display' is a number > 0,
(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 read-mail-command 'rmail
+ "*Your preference for a mail reading package.
+This is used by some keybindings which support reading mail.
+See also `mail-user-agent' concerning sending mail."
+ :type '(choice (function-item rmail)
+ (function-item gnus)
+ (function-item mh-rmail)
+ (function :tag "Other"))
+ :version "21.1"
+ :group 'mail)
+
(defcustom mail-user-agent 'sendmail-user-agent
"*Your preference for a mail composition package.
-Various Emacs Lisp packages (e.g. reporter) require you to compose an
+Various Emacs Lisp packages (e.g. Reporter) require you to compose an
outgoing email message. This variable lets you specify which
mail-sending package you prefer.
Valid values include:
- sendmail-user-agent -- use the default Emacs Mail package
- mh-e-user-agent -- use the Emacs interface to the MH mail system
- message-user-agent -- use the GNUS mail sending package
+ `sendmail-user-agent' -- use the default Emacs Mail package.
+ See Info node `(emacs)Sending Mail'.
+ `mh-e-user-agent' -- use the Emacs interface to the MH mail system.
+ See Info node `(mh-e)'.
+ `message-user-agent' -- use the Gnus Message package.
+ See Info node `(message)'.
+ `gnus-user-agent' -- like `message-user-agent', but with Gnus
+ paraphernalia, particularly the Gcc: header for
+ archiving.
Additional valid symbols may be available; check with the author of
-your package for details."
+your package for details.
+
+See also `read-mail-command' concerning reading mail."
:type '(radio (function-item :tag "Default Emacs mail"
:format "%t\n"
sendmail-user-agent)
(function-item :tag "Emacs interface to MH"
:format "%t\n"
mh-e-user-agent)
- (function-item :tag "Gnus mail sending package"
+ (function-item :tag "Gnus Message package"
:format "%t\n"
message-user-agent)
+ (function-item :tag "Gnus Message with full Gnus features"
+ :format "%t\n"
+ gnus-user-agent)
(function :tag "Other"))
:group 'mail)
(same-window-regexps nil))
(funcall switch-function "*mail*")))
(let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
- (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers))))
+ (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))
+ (body (cdr (assoc-ignore-case "body" other-headers))))
(or (mail continue to subject in-reply-to cc yank-action send-actions)
continue
(error "Message aborted"))
(save-excursion
(rfc822-goto-eoh)
(while other-headers
- (if (not (assoc-ignore-case (car (car other-headers))
- '(("in-reply-to") ("cc"))))
+ (unless (member-ignore-case (car (car other-headers))
+ '("in-reply-to" "cc" "body"))
(insert (car (car other-headers)) ": "
(cdr (car other-headers)) "\n"))
(setq other-headers (cdr other-headers)))
+ (when body
+ (forward-line 1)
+ (insert body))
t)))
(define-mail-user-agent 'mh-e-user-agent
(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
;; unless it is reading a file name and CHOICE is a directory,
;; or completion-no-auto-exit is non-nil.
(defun choose-completion-string (choice &optional buffer base-size)
- (let ((buffer (or buffer completion-reference-buffer)))
+ (let ((buffer (or buffer completion-reference-buffer))
+ (mini-p (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))))
;; If BUFFER is a minibuffer, barf unless it's the currently
;; active minibuffer.
- (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
+ (if (and mini-p
(or (not (active-minibuffer-window))
(not (equal buffer
(window-buffer (active-minibuffer-window))))))
;; Insert the completion into the buffer where completion was requested.
(set-buffer buffer)
(if base-size
- (delete-region (+ base-size (point-min)) (point))
+ (delete-region (+ base-size (if mini-p
+ (minibuffer-prompt-end)
+ (point-min)))
+ (point))
(choose-completion-delete-max-match choice))
(insert choice)
(remove-text-properties (- (point) (length choice)) (point)
;; 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))))))
(set-buffer mainbuf)
(goto-char (point-max))
(skip-chars-backward (format "^%c" directory-sep-char))
- (- (point) (point-min))))
+ (- (point) (minibuffer-prompt-end))))
;; Otherwise, in minibuffer, the whole input is being completed.
(save-match-data
(if (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
(buffer-name mainbuf))
(setq completion-base-size 0))))
(goto-char (point-min))
- (if window-system
+ (if (display-mouse-p)
(insert (substitute-command-keys
"Click \\[mouse-choose-completion] on a completion to select it.\n")))
(insert (substitute-command-keys
(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))
+
+(defun clone-indirect-buffer (newname display-flag &optional norecord)
+ "Create an indirect buffer that is a twin copy of the current buffer.
+
+Give the indirect buffer name NEWNAME. Interactively, read NEW-NAME
+from the minibuffer when invoked with a prefix arg. If NEWNAME is nil
+or if not called with a prefix arg, NEWNAME defaults to the current
+buffer's name. The name is modified by adding a `<N>' suffix to it
+or by incrementing the N in an existing suffix.
+
+DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
+This is always done when called interactively.
+
+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))
+ (setq newname (or newname (buffer-name)))
+ (if (string-match "<[0-9]+>\\'" newname)
+ (setq newname (substring newname 0 (match-beginning 0))))
+ (let* ((name (generate-new-buffer-name newname))
+ (buffer (make-indirect-buffer (current-buffer) name t)))
+ (when display-flag
+ (pop-to-buffer buffer))
+ buffer))
+
+
+(defun clone-indirect-buffer-other-window (buffer &optional norecord)
+ "Create an indirect buffer that is a twin copy of BUFFER.
+Select the new buffer in another window.
+Optional second arg NORECORD non-nil means do not put this buffer at
+the front of the list of recently selected ones."
+ (interactive "bClone buffer in other window: ")
+ (let ((popup-windows t))
+ (set-buffer buffer)
+ (clone-indirect-buffer nil t norecord)))
+
+(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
+
+\f
+;;; Syntax stuff.
+
+(defconst syntax-code-table
+ '((?\ 0 "whitespace")
+ (?- 0 "whitespace")
+ (?. 1 "punctuation")
+ (?w 2 "word")
+ (?_ 3 "symbol")
+ (?\( 4 "open parenthesis")
+ (?\) 5 "close parenthesis")
+ (?\' 6 "expression prefix")
+ (?\" 7 "string quote")
+ (?$ 8 "paired delimiter")
+ (?\\ 9 "escape")
+ (?/ 10 "character quote")
+ (?< 11 "comment start")
+ (?> 12 "comment end")
+ (?@ 13 "inherit")
+ (nil 14 "comment fence")
+ (nil 15 "string fence"))
+ "Alist of forms (CHAR CODE DESCRIPTION) mapping characters to syntax info.
+CHAR is a character that is allowed as first char in the string
+specifying the syntax when calling `modify-syntax-entry'. CODE is the
+corresponing syntax code as it is stored in a syntax cell, and
+can be used as value of a `syntax-table' property.
+DESCRIPTION is the descriptive string for the syntax.")
+
+(defconst syntax-flag-table
+ '((?1 . #b10000000000000000)
+ (?2 . #b100000000000000000)
+ (?3 . #b1000000000000000000)
+ (?4 . #b10000000000000000000)
+ (?p . #b100000000000000000000)
+ (?b . #b1000000000000000000000)
+ (?n . #b10000000000000000000000))
+ "Alist of pairs (CHAR . FLAG) mapping characters to syntax flags.
+CHAR is a character that is allowed as second or following character
+in the string argument to `modify-syntax-entry' specifying the syntax.
+FLAG is the corresponding syntax flag value that is stored in a
+syntax table.")
+
+(defun string-to-syntax (string)
+ "Convert a syntax specification STRING into syntax cell form.
+STRING should be a string as it is allowed as argument of
+`modify-syntax-entry'. Value is the equivalent cons cell
+\(CODE . MATCHING-CHAR) that can be used as value of a `syntax-table'
+text property."
+ (let* ((first-char (aref string 0))
+ (code (or (nth 1 (assq first-char syntax-code-table))
+ (error "Invalid syntax specification `%s'" string)))
+ (length (length string))
+ (i 1)
+ matching-char)
+ ;; Determine the matching character, if any.
+ (when (and (> length 1)
+ (memq first-char '(?\( ?\))))
+ (setq matching-char (aref string i)
+ i (1+ i)))
+ ;; Add any flags to the syntax code.
+ (while (< i length)
+ (let ((flag (or (assq (aref string i) syntax-flag-table)
+ (error "Invalid syntax flag in `%s'" string))))
+ (setq code (logior flag code))
+ (setq i (1+ i))))
+
+ (cons code matching-char)))
+
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff