;;; Code:
(eval-when-compile
+ (autoload 'widget-convert "wid-edit")
+ (autoload 'shell-mode "shell")
(require 'cl))
Other major modes are defined by comparison with this one."
(interactive)
(kill-all-local-variables))
-\f
+
;; Making and deleting lines.
(defun newline (&optional arg)
"Insert a newline, and move to left margin of the new line if it's blank.
The newline is marked with the text-property `hard'.
-With arg, insert that many newlines.
+With ARG, insert that many newlines.
In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
(interactive "*P")
(barf-if-buffer-read-only)
(if (and (listp sticky) (not (memq 'hard sticky)))
(put-text-property from (point) 'rear-nonsticky
(cons 'hard sticky)))))
-\f
+
(defun open-line (arg)
"Insert a newline and leave point before it.
If there is a fill prefix and/or a left-margin, insert them on the new line
(fixup-whitespace))))
(defalias 'join-line #'delete-indentation) ; easier to find
-\f
+
(defun delete-blank-lines ()
"On blank line, delete all surrounding blank lines, leaving just one.
On isolated blank line, delete that one.
(if (looking-at "^[ \t]*\n\\'")
(delete-region (point) (point-max)))))
+(defun delete-trailing-whitespace ()
+ "Delete all the trailing whitespace across the current buffer.
+All whitespace after the last non-whitespace character in a line is deleted.
+This respects narrowing, created by \\[narrow-to-region] and friends."
+ (interactive "*")
+ (save-match-data
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\\s-$" nil t)
+ (skip-syntax-backward "-" (save-excursion (forward-line 0) (point)))
+ (delete-region (point) (match-end 0))))))
+
(defun newline-and-indent ()
"Insert a newline, then indent according to major mode.
Indentation is done using the value of `indent-line-function'.
In some text modes, where TAB inserts a tab, this command indents to the
column specified by the function `current-left-margin'."
(interactive "*")
- (delete-region (point) (progn (skip-chars-backward " \t") (point)))
+ (delete-horizontal-space t)
(newline)
(indent-according-to-mode))
column specified by the function `current-left-margin'."
(interactive "*")
(save-excursion
- (delete-region (point) (progn (skip-chars-backward " \t") (point)))
+ (delete-horizontal-space t)
(indent-according-to-mode))
(newline)
(indent-according-to-mode))
-\f
+
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
(while (> arg 0)
(insert-and-inherit char)
(setq arg (1- arg)))))
-\f
+
(defun forward-to-indentation (arg)
"Move forward ARG lines and position at first nonblank character."
(interactive "p")
nil
(insert ?\ ))))
-(defun delete-horizontal-space ()
- "Delete all spaces and tabs around point."
+(defun delete-horizontal-space (&optional backward-only)
+ "Delete all spaces and tabs around point.
+If BACKWARD-ONLY is non-nil, only delete spaces before point."
(interactive "*")
- (skip-chars-backward " \t")
- (delete-region (point) (progn (skip-chars-forward " \t") (point))))
+ (delete-region
+ (if backward-only
+ (point)
+ (progn
+ (skip-chars-forward " \t" (field-end))
+ (point)))
+ (progn
+ (skip-chars-backward " \t" (field-beginning nil t))
+ (point))))
(defun just-one-space ()
"Delete all spaces and tabs around point, leaving one space."
(interactive "*")
- (skip-chars-backward " \t")
+ (skip-chars-backward " \t" (field-beginning))
(if (= (following-char) ? )
(forward-char 1)
(insert ? ))
- (delete-region (point) (progn (skip-chars-forward " \t") (point))))
+ (delete-region
+ (point)
+ (progn
+ (skip-chars-forward " \t" (field-end nil t))
+ (point))))
-\f
(defun beginning-of-buffer (&optional arg)
"Move point to the beginning of the buffer; leave mark at previous position.
With arg N, put point N/10 of the way from the beginning.
(push-mark (point-max) nil t)
(goto-char (point-min)))
-\f
+
;; Counting lines, one way or another.
(defun goto-line (arg)
(1+ done)
done)))
(- (buffer-size) (forward-line (buffer-size)))))))
-\f
+
(defun what-cursor-position (&optional detail)
"Print info on cursor position (on screen and within buffer).
Also describe the character after point, and give its character code
(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)
+
+(defvar read-expression-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\M-\t" 'lisp-complete-symbol)
+ (set-keymap-parent m minibuffer-local-map)
+ m)
"Minibuffer keymap used for reading Lisp expressions.")
-(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
(defvar read-expression-history nil)
nil read-expression-map t
'read-expression-history)
current-prefix-arg))
-
+
(if (null eval-expression-debug-on-error)
(setq values (cons (eval eval-expression-arg) values))
(let ((old-value (make-symbol "t")) new-value)
;; 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)
(setq command-history (cons newcmd command-history)))
(eval newcmd))
(ding))))
-\f
+
(defvar minibuffer-history nil
"Default minibuffer history list.
This is used for all minibuffer input
(defun minibuffer-history-initialize ()
(setq minibuffer-text-before-history nil))
+(defun minibuffer-avoid-prompt (new old)
+ "A point-motion hook for the minibuffer, that moves point out of the prompt."
+ (constrain-to-field nil (point-max)))
+
(defcustom minibuffer-history-case-insensitive-variables nil
"*Minibuffer history variables for which matching should ignore case.
If a history variable is a member of this list, then the
(error "No previous history search regexp"))
regexp)
(prefix-numeric-value current-prefix-arg))))
- (if (and (zerop minibuffer-history-position)
- (null minibuffer-text-before-history))
- (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
- ;; On some systems, ignore case for file names.
- (if (memq minibuffer-history-variable
- minibuffer-history-case-insensitive-variables)
- t
- ;; Respect the user's setting for case-fold-search:
- case-fold-search)
- nil))
- prevpos
- (pos minibuffer-history-position))
- (while (/= n 0)
- (setq prevpos pos)
- (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
- (if (= pos prevpos)
+ (unless (zerop n)
+ (if (and (zerop minibuffer-history-position)
+ (null minibuffer-text-before-history))
+ (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
+ ;; On some systems, ignore case for file names.
+ (if (memq minibuffer-history-variable
+ minibuffer-history-case-insensitive-variables)
+ t
+ ;; Respect the user's setting for case-fold-search:
+ case-fold-search)
+ nil))
+ prevpos
+ match-string
+ match-offset
+ (pos minibuffer-history-position))
+ (while (/= n 0)
+ (setq prevpos pos)
+ (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
+ (when (= pos prevpos)
(error (if (= pos 1)
"No later matching history item"
"No earlier matching history item")))
- (if (string-match regexp
- (if (eq minibuffer-history-sexp-flag
- (minibuffer-depth))
- (let ((print-level nil))
- (prin1-to-string (nth (1- pos) history)))
- (nth (1- pos) history)))
- (setq n (+ n (if (< n 0) 1 -1)))))
- (setq minibuffer-history-position pos)
- (goto-char (point-max))
- (delete-field)
- (let ((elt (nth (1- pos) history)))
- (insert (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
+ (setq match-string
+ (if (eq minibuffer-history-sexp-flag (minibuffer-depth))
(let ((print-level nil))
- (prin1-to-string elt))
- elt)))
- (goto-char (field-beginning)))
+ (prin1-to-string (nth (1- pos) history)))
+ (nth (1- pos) history)))
+ (setq match-offset
+ (if (< n 0)
+ (and (string-match regexp match-string)
+ (match-end 0))
+ (and (string-match (concat ".*\\(" regexp "\\)") match-string)
+ (match-beginning 1))))
+ (when match-offset
+ (setq n (+ n (if (< n 0) 1 -1)))))
+ (setq minibuffer-history-position pos)
+ (goto-char (point-max))
+ (delete-field)
+ (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))
(setq command-history (cdr command-history))))
(prefix-numeric-value current-prefix-arg))))
(previous-matching-history-element regexp (- n)))
+(defvar minibuffer-temporary-goal-position nil)
+
(defun next-history-element (n)
"Insert the next element of the minibuffer history into the minibuffer."
(interactive "p")
(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))))
+ (set (make-local-variable 'minibuffer-temporary-goal-position)
+ (cond ((<= (point) prompt-end) prompt-end)
+ ((eobp) nil)
+ (t (point))))))
(goto-char (point-max))
(delete-field)
(setq minibuffer-history-position narg)
(let ((print-level nil))
(prin1-to-string elt))
elt))
- (goto-char (field-beginning)))))
+ (goto-char (or minibuffer-temporary-goal-position (point-max))))))
(defun previous-history-element (n)
"Inserts the previous element of the minibuffer history into the minibuffer."
(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."
+Return (point-min) if current buffer is not a mini-buffer."
(field-beginning (point-max)))
-\f
+(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)))
+
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(defalias 'advertised-undo 'undo)
Repeat this command to undo more changes.
A numeric argument serves as a repeat count.
-Just C-u as argument requests selective undo,
-limited to changes within the current region.
-Likewise in Transient Mark mode when the mark is active."
+In Transient Mark mode when the mark is active, only undo changes within
+the current region. Similarly, when not in Transient Mark mode, just C-u
+as an argument limits undo to changes within the current region."
(interactive "*P")
;; If we don't get all the way thru, make last-command indicate that
;; for the following command.
(recent-save (recent-auto-save-p)))
(or (eq (selected-window) (minibuffer-window))
(message "Undo!"))
- (or (eq last-command 'undo)
- (progn (if (or arg (and transient-mark-mode mark-active))
- (undo-start (region-beginning) (region-end))
- (undo-start))
- (undo-more 1)))
- (undo-more (if arg (prefix-numeric-value arg) 1))
+ (unless (eq last-command 'undo)
+ (if (if transient-mark-mode mark-active (and arg (not (numberp arg))))
+ (undo-start (region-beginning) (region-end))
+ (undo-start))
+ ;; get rid of initial undo boundary
+ (undo-more 1))
+ (undo-more
+ (if (or transient-mark-mode (numberp arg))
+ (prefix-numeric-value arg)
+ 1))
;; 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)
(t
'(0 . 0)))
'(0 . 0)))
-\f
+
(defvar shell-command-history nil
"History list for some commands that read shell commands.")
(defun shell-command (command &optional output-buffer error-buffer)
"Execute string COMMAND in inferior shell; display output, if any.
+With prefix argument, insert the COMMAND's output at point.
If COMMAND ends in ampersand, execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode.
-Otherwise, COMMAND is executed synchronously. The output appears in the
-buffer `*Shell Command Output*'.
-If the output is one line, it is displayed in the echo area *as well*,
-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,
+Otherwise, COMMAND is executed synchronously. The output appears in
+the buffer `*Shell Command Output*'. If the output is short enough to
+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.
To specify a coding system for converting non-ASCII characters
))
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
-\f
+
+(defun display-message-or-buffer (message
+ &optional buffer-name not-this-window frame)
+ "Display MESSAGE in the echo area if possible, otherwise in a pop-up buffer.
+MESSAGE may be either a string or a buffer.
+
+A buffer is displayed using `display-buffer' if MESSAGE is too long for
+the maximum height of the echo area, as defined by `max-mini-window-height'
+if `resize-mini-windows' is non-nil.
+
+Returns either the string shown in the echo area, or when a pop-up
+buffer is used, the window used to display it.
+
+If MESSAGE is a string, then the optional argument BUFFER-NAME is the
+name of the buffer used to display it in the case where a pop-up buffer
+is used, defaulting to `*Message*'. In the case where MESSAGE is a
+string and it is displayed in the echo area, it is not specified whether
+the contents are inserted into the buffer anyway.
+
+Optional arguments NOT-THIS-WINDOW and FRAME are as for `display-buffer',
+and only used if a buffer is displayed."
+ (cond ((and (stringp message) (not (string-match "\n" message)))
+ ;; Trivial case where we can use the echo area
+ (message "%s" message))
+ ((and (stringp message)
+ (= (string-match "\n" message) (1- (length message))))
+ ;; Trivial case where we can just remove single trailing newline
+ (message "%s" (substring message 0 (1- (length message)))))
+ (t
+ ;; General case
+ (with-current-buffer
+ (if (bufferp message)
+ message
+ (get-buffer-create (or buffer-name "*Message*")))
+
+ (unless (bufferp message)
+ (erase-buffer)
+ (insert message))
+
+ (let ((lines
+ (if (= (buffer-size) 0)
+ 0
+ (count-lines (point-min) (point-max)))))
+ (cond ((or (<= lines 1)
+ (<= lines
+ (if resize-mini-windows
+ (cond ((floatp max-mini-window-height)
+ (* (frame-height)
+ max-mini-window-height))
+ ((integerp max-mini-window-height)
+ max-mini-window-height)
+ (t
+ 1))
+ 1)))
+ ;; Echo area
+ (goto-char (point-max))
+ (when (bolp)
+ (backward-char 1))
+ (message "%s" (buffer-substring (point-min) (point))))
+ (t
+ ;; Buffer
+ (goto-char (point-min))
+ (display-buffer message not-this-window frame))))))))
+
+
;; We have a sentinel to prevent insertion of a termination message
;; in the buffer itself.
(defun shell-command-sentinel (process signal)
systems by binding `coding-system-for-read' and
`coding-system-for-write'.
-If the output is one line, it is displayed in the echo area,
-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.
+If the output is short enough to display in the echo area (which is
+determined by the variable `max-mini-window-height' if
+`resize-mini-windows' is non-nil), 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.
If the optional fourth argument OUTPUT-BUFFER is non-nil,
that says to put the output in some other buffer.
nil shell-command-switch command)))
(setq success (and exit-status (equal 0 exit-status)))
;; Report the amount of output.
- (let ((lines (save-excursion
- (set-buffer buffer)
- (if (= (buffer-size) 0)
- 0
- (count-lines (point-min) (point-max))))))
- (cond ((= lines 0)
- (if (and error-file
- (< 0 (nth 7 (file-attributes error-file))))
- (message "(Shell command %sed with some error output)"
- (if (equal 0 exit-status)
- "succeed"
- "fail"))
- (message "(Shell command %sed with no output)"
- (if (equal 0 exit-status)
- "succeed"
- "fail")))
- (kill-buffer buffer))
- ((= lines 1)
- (message "%s"
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (buffer-substring (point)
- (progn (end-of-line) (point))))))
- (t
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min)))
- (display-buffer buffer)))))))
+ (if (with-current-buffer buffer (> (point-max) (point-min)))
+ ;; There's some output, display it
+ (display-message-or-buffer buffer)
+ ;; No output; error?
+ (message (if (and error-file
+ (< 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"))
+ (kill-buffer buffer)))))
+
(when (and error-file (file-exists-p error-file))
(if (< 0 (nth 7 (file-attributes error-file)))
(with-current-buffer (get-buffer-create error-buffer)
(with-current-buffer
standard-output
(call-process shell-file-name nil t nil shell-command-switch command))))
-\f
+
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
unread-command-events)))
(reset-this-command-lengths)
(setq overriding-terminal-local-map nil))
-\f
+
;;;; Window system cut and paste hooks.
(defvar interprogram-cut-function nil
is equal (according to `string=') to the last text Emacs provided.")
-\f
+
;;;; The kill ring data structure.
(defvar kill-ring nil
the front of the kill ring, rather than being added to the list."
(and (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring))))
- (if replace
+ (if (and replace kill-ring)
(setcar kill-ring string)
(setq kill-ring (cons string kill-ring))
(if (> (length kill-ring) kill-ring-max)
(car ARGth-kill-element)))))
-\f
+
;;;; Commands for manipulating the kill ring.
(defcustom kill-read-only-ok nil
(setq this-command 'kill-region)
(message "If the next command is a kill, it will append"))
(setq last-command 'kill-region)))
-\f
+
;; Yanking.
(defun yank-pop (arg)
With argument, rotate that many kills forward (or backward, if negative)."
(interactive "p")
(current-kill arg))
-\f
+
;; Some kill commands.
;; Internal subroutine of delete-char
(search-forward (char-to-string char) nil nil arg)
; (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
(point))))
-\f
+
;; kill-line and its subroutines.
(defcustom kill-whole-line nil
"Kill the rest of the current line; if no nonblanks there, kill thru newline.
With prefix argument, kill that many lines from point.
Negative arguments kill lines backward.
+With zero argument, kills the text before point on the current line.
When calling from a program, nil means \"no arg\",
a number counts as a prefix arg.
(goto-char (next-single-property-change (point) 'invisible))
(goto-char (next-overlay-change (point))))
(end-of-line)))
-\f
+
(defun insert-buffer (buffer)
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
(erase-buffer)
(save-excursion
(insert-buffer-substring oldbuf start end)))))
-\f
+
(put 'mark-inactive 'error-conditions '(mark-inactive error))
(put 'mark-inactive 'error-message "The mark is not active now")
(widen))
(goto-char position)
(switch-to-buffer buffer)))
-\f
-(defcustom next-line-add-newlines t
+
+(defcustom next-line-add-newlines nil
"*If non-nil, `next-line' inserts newline to avoid `end of buffer' error."
:type 'boolean
:group 'editing-basics)
((beginning-of-buffer end-of-buffer) (ding)))
(line-move (- arg)))
nil)
-\f
+
(defcustom track-eol nil
"*Non-nil means vertical motion starting at end of line keeps to ends of lines.
This means moving to the end of each line moved onto.
"Goal column %d (use \\[set-goal-column] with an arg to unset it)")
goal-column))
nil)
-\f
+
(defun scroll-other-window-down (lines)
"Scroll the \"other window\" down.
(end-of-buffer arg)
(recenter '(t)))
(select-window orig-window))))
-\f
+
(defun transpose-chars (arg)
"Interchange characters around point, moving forward one character.
With prefix arg ARG, effect is to take character before point
(+ transpose-subr-start1 (- len1 len2))))
(delete-region (point) (+ (point) len1))
(insert word2)))
-\f
-(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.")
-\f
+
(defun backward-word (arg)
"Move backward until encountering the end of a word.
-With argument, do this that many times.
-In programs, it is faster to call `forward-word' with negative arg."
+With argument, do this that many times."
(interactive "p")
(forward-word (- arg)))
(setq start (point)))
(buffer-substring-no-properties start end)))
(buffer-substring-no-properties start end)))))
-\f
+
(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."
regexp)
:group 'fill)
-(defvar comment-line-break-function 'indent-new-comment-line
+(defvar comment-line-break-function 'comment-indent-new-line
"*Mode-specific function which line breaks and continues a comment.
This function is only called during auto-filling of a comment section.
(error "set-fill-column requires an explicit argument")
(message "Fill column set to %d (was %d)" arg fill-column)
(setq fill-column arg)))
-\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,
(> (prefix-numeric-value arg) 0))
'overwrite-mode-binary))
(force-mode-line-update))
-\f
+
(defcustom line-number-mode t
"*Non-nil means display line number in mode line."
:type 'boolean
(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."
+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)
(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. The function should return non-nil if it
+succeeds.
+
+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)
(list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
'switch-to-buffer-other-frame yank-action send-actions))
-\f
+
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.")
(error "Value `%S' does not match type %S of %S"
val (car type) var))))
(set var val))
-\f
+
;; Define the major mode for lists of completions.
(defvar completion-list-mode-map nil
"Move to the next item in the completion list.
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))
- (end (point-max)))
+ (let ((beg (point-min)) (end (point-max)))
+ (while (and (> n 0) (not (eobp)))
;; If in a completion, move to the end of it.
- (if prop
- (goto-char (next-single-property-change (point) 'mouse-face nil end)))
+ (when (get-text-property (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 nil end)))
- (setq n (1- n)))
- (while (and (< n 0) (not (bobp)))
- (let ((prop (get-text-property (1- (point)) 'mouse-face))
- (end (point-min)))
- ;; If in a completion, move to the start of it.
- (if prop
+ (unless (get-text-property (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)))
+ ;; If in a completion, move to the start of it.
+ (when (and prop (eq prop (get-text-property (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 nil end))
- ;; Move to the start of that one.
- (goto-char (previous-single-property-change (point) 'mouse-face nil end)))
- (setq n (1+ n))))
+ (point) 'mouse-face nil beg)))
+ ;; Move to end of the previous completion.
+ (unless (or (bobp) (get-text-property (1- (point)) 'mouse-face))
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil beg)))
+ ;; Move to the start of that one.
+ (goto-char (previous-single-property-change
+ (point) 'mouse-face nil beg))
+ (setq n (1+ n))))))
(defun choose-completion ()
"Choose the completion that point is in or next to."
(goto-char (point-min))
(search-forward "\n\n")
(forward-line 1))))
-\f
+
;; Support keyboard commands to turn on various modifiers.
;; These functions -- which are not commands -- each add one modifier
(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
-\f
+
;;;; Keypad support.
;;; Make the keypad keys act like ordinary typing keys. If people add
(let* ((name (generate-new-buffer-name newname))
(buffer (make-indirect-buffer (current-buffer) name t)))
(when display-flag
- (pop-to-buffer buffer))
+ (pop-to-buffer buffer norecord))
buffer))
(define-key ctl-x-4-map "c" 'clone-indirect-buffer-other-window)
-\f
+
;;; Syntax stuff.
(defconst syntax-code-table
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)))
+
+;;; Handling of Backspace and Delete keys.
+
+(defcustom delete-key-deletes-forward nil
+ "Whether the Delete key should delete forward or not.
+
+On window systems, the default value of this option is chosen
+according to the keyboard used. If the keyboard has both a Backspace
+key and a Delete key, and both are mapped to their usual meanings, the
+option's default value is set to t, so that Backspace can be used to
+delete backward, and Delete can be used used to delete forward
+
+If not running under a window system, setting this option accomplishes
+a similar effect by mapping C-h, which is usually generated by the
+Backspace key, to DEL, and by mapping DEL to C-d via
+`keyboard-translate'. The former functionality of C-h is available on
+the F1 key. You should probably not use this setting if you don't
+have both Backspace, Delete and F1 keys."
+ :type 'boolean
+ :group 'editing-basics
+ :version "21.1"
+ :set (lambda (symbol value)
+ ;; The fboundp is because of a problem with :set when
+ ;; dumping Emacs. It doesn't really matter.
+ (if (fboundp 'delete-key-deletes-forward-mode)
+ (delete-key-deletes-forward-mode (or value 0))
+ (set-default symbol value))))
+
+
+(defun delete-key-deletes-forward-mode (&optional arg)
+ "Toggle Delete key deleting forward or backward.
+With numeric arg, turn the mode on if and only iff ARG is positive.
+For more details, see `delete-key-deletes-forward'."
+ (interactive "P")
+ (setq delete-key-deletes-forward
+ (if arg
+ (> (prefix-numeric-value arg) 0)
+ (not delete-key-deletes-forward)))
+
+ (cond ((or (memq window-system '(x w32 mac pc))
+ (memq system-type '(ms-dos windows-nt)))
+ (if delete-key-deletes-forward
+ (progn
+ (define-key global-map [delete] 'delete-char)
+ (define-key global-map [C-delete] 'kill-word)
+ (define-key esc-map [C-delete] 'kill-sexp)
+ (define-key global-map [C-M-delete] 'kill-sexp))
+ (define-key esc-map [C-delete] 'backward-kill-sexp)
+ (define-key global-map [C-M-delete] 'backward-kill-sexp)
+ (define-key global-map [C-delete] 'backward-kill-word)
+ (define-key global-map [delete] 'delete-backward-char)))
+ (t
+ (if delete-key-deletes-forward
+ (progn
+ (keyboard-translate ?\C-h ?\C-?)
+ (keyboard-translate ?\C-? ?\C-d))
+ (keyboard-translate ?\C-h ?\C-h)
+ (keyboard-translate ?\C-? ?\C-?))))
+
+ (run-hooks 'delete-key-deletes-forward-hook)
+ (if (interactive-p)
+ (message "Delete key deletes %s"
+ (if delete-key-deletes-forward "forward" "backward"))))
+
+
+;;; Misc
+
+(defun byte-compiling-files-p ()
+ "Return t if currently byte-compiling files."
+ (and (boundp 'byte-compile-current-file)
+ (stringp byte-compile-current-file)))
;;; simple.el ends here
HCoop / bpt / emacs.git / blobdiff