;; the end of the previous line.
(let ((flag (and (not (bobp))
(bolp)
+ ;; Make sure there are no markers here.
+ (not (buffer-has-markers-at (1- (point))))
;; Make sure the newline before point isn't intangible.
(not (get-char-property (1- (point)) 'intangible))
;; Make sure the newline before point isn't read-only.
(if flag (backward-char 1))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
- (let* ((from (- (point) (if arg (prefix-numeric-value arg) 1)))
- (sticky (get-text-property from 'rear-nonsticky)))
- (put-text-property from (point) 'hard 't)
- ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
- (if (and (listp sticky) (not (memq 'hard sticky)))
- (put-text-property from (point) 'rear-nonsticky
- (cons 'hard sticky)))))
+ (set-hard-newline-properties
+ (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
;; If the newline leaves the previous line blank,
;; and we have a left margin, delete that from the blank line.
(or flag
(move-to-left-margin nil t)))
nil)
+(defun set-hard-newline-properties (from to)
+ (let ((sticky (get-text-property from 'rear-nonsticky)))
+ (put-text-property from to 'hard 't)
+ ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
+ (if (and (listp sticky) (not (memq 'hard sticky)))
+ (put-text-property from (point) 'rear-nonsticky
+ (cons 'hard sticky)))))
+
(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
to get different commands to edit and resubmit."
(interactive "p")
(let ((elt (nth (1- arg) command-history))
- (minibuffer-history-position arg)
- (minibuffer-history-sexp-flag t)
newcmd)
(if elt
(progn
(setq newcmd
- (let ((print-level nil))
+ (let ((print-level nil)
+ (minibuffer-history-position arg)
+ (minibuffer-history-sexp-flag t))
(read-from-minibuffer
"Redo: " (prin1-to-string elt) read-expression-map t
(cons 'command-history arg))))
(forward-line (1- arg)))))
;Put this on C-x u, so we can force that rather than C-_ into startup msg
-(define-function 'advertised-undo 'undo)
+(defalias 'advertised-undo 'undo)
(defun undo (&optional arg)
"Undo some previous changes.
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
))
- (shell-command-on-region (point) (point) command nil)
+ (shell-command-on-region (point) (point) command output-buffer)
))))))
;; We have a sentinel to prevent insertion of a termination message
(set-buffer buffer)
(goto-char (point-min)))
(display-buffer buffer))))))))
+
+(defun shell-command-to-string (command)
+ "Execute shell command COMMAND and return its output as a string."
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (call-process shell-file-name nil t nil shell-command-switch command))))
\f
-(defconst universal-argument-map
+(defvar universal-argument-map
(let ((map (make-sparse-keymap)))
(define-key map [t] 'universal-argument-other-key)
(define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
\\[universal-argument] following the digits or minus sign ends the argument.
\\[universal-argument] without digits or minus sign provides 4 as argument.
Repeating \\[universal-argument] without digits or minus sign
- multiplies the argument by 4 each time."
+ multiplies the argument by 4 each time.
+For some commands, just \\[universal-argument] by itself serves as a flag
+which is different in effect from any particular numeric argument.
+These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
(setq prefix-arg (list 4))
(setq universal-argument-num-events (length (this-command-keys)))
interaction; you may want to use them instead of manipulating the kill
ring directly.")
-(defconst kill-ring-max 30
+(defvar kill-ring-max 30
"*Maximum length of kill ring before oldest elements are thrown away.")
(defvar kill-ring-yank-pointer nil
;; If the buffer is read-only, we should beep, in case the person
;; just isn't aware of this. However, there's no harm in putting
;; the region's text in the kill ring, anyway.
- ((or (and buffer-read-only (not inhibit-read-only))
- (text-property-not-all beg end 'read-only nil))
+ ((and (not inhibit-read-only)
+ (or buffer-read-only
+ (text-property-not-all beg end 'read-only nil)))
(copy-region-as-kill beg end)
;; This should always barf, and give us the correct error.
(if kill-read-only-ok
(make-variable-buffer-local 'mark-ring)
(put 'mark-ring 'permanent-local t)
-(defconst mark-ring-max 16
+(defvar mark-ring-max 16
"*Maximum size of mark ring. Start discarding off end if gets this big.")
(defvar global-mark-ring nil
"The list of saved global marks, most recent first.")
-(defconst global-mark-ring-max 16
+(defvar global-mark-ring-max 16
"*Maximum size of global mark ring. \
Start discarding off end if gets this big.")
(if (null (mark t)) (ding))
(setq mark-ring (cdr mark-ring)))))
-(define-function 'exchange-dot-and-mark 'exchange-point-and-mark)
+(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
(defun exchange-point-and-mark ()
"Put the mark where point is now, and point where the mark is now.
This command works even when the mark is not active,
(line-move (- arg)))
nil)
-(defconst track-eol nil
+(defvar 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.
The beginning of a blank line does not count as the end of a line.")
(goto-char (previous-single-property-change (point) 'invisible))
(goto-char (previous-overlay-change (point)))))
(setq arg (1+ arg))))
- (move-to-column (or goal-column temporary-goal-column)))
+ (let ((buffer-invisibility-spec nil))
+ (move-to-column (or goal-column temporary-goal-column))))
;; Remember where we moved to, go back home,
;; then do the motion over again
;; in just one step, with intangibility and point-motion hooks
(delete-char (length word1))
(insert word2)))
\f
-(defconst comment-column 32
+(defvar 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.")
(make-variable-buffer-local 'comment-column)
-(defconst comment-start nil
+(defvar comment-start nil
"*String to insert to start a new comment, or nil if no comment syntax.")
-(defconst comment-start-skip nil
+(defvar 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.")
-(defconst comment-end ""
+(defvar comment-end ""
"*String to insert to end a new comment.
Should be an empty string if comments are terminated by end-of-line.")
-(defconst comment-indent-hook nil
+(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.")
-(defconst comment-indent-function
+(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.")
-(defconst block-comment-start nil
+(defvar 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.")
-(defconst block-comment-end nil
+(defvar 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.")
;; This is questionable if comment-end ends in
;; whitespace. That is pretty brain-damaged,
;; though.
- (skip-chars-backward " \t")
- (if (and (>= (- (point) (point-min)) (length ce))
- (save-excursion
- (backward-char (length ce))
- (looking-at (regexp-quote ce))))
+ (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)))
(buffer-substring start end)))
(buffer-substring start end)))))
\f
-(defconst fill-prefix nil
+(defvar 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.")
(make-variable-buffer-local 'fill-prefix)
-(defconst auto-fill-inhibit-regexp nil
+(defvar auto-fill-inhibit-regexp nil
"*Regexp to match lines which should not be auto-filled.")
;; This function is the auto-fill-function of a buffer
(let ((fill-point
(let ((opoint (point))
bounce
- (first t))
+ (first t)
+ after-prefix)
(save-excursion
+ (beginning-of-line)
+ (setq after-prefix (point))
+ (and fill-prefix
+ (looking-at (regexp-quote fill-prefix))
+ (setq after-prefix (match-end 0)))
(move-to-column (1+ fc))
;; Move back to a word boundary.
(while (or first
;; If we find nowhere on the line to break it,
;; break after one word. Set bounce to t
;; so we will not keep going in this while loop.
- (if (bolp)
+ (if (<= (point) after-prefix)
(progn
(re-search-forward "[ \t]" opoint t)
(setq bounce t)))
(setq give-up t)))
;; No place to break => stop trying.
(setq give-up t))))
- ;; justify last line
+ ;; Justify last line.
(justify-current-line justify 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.
+Some major modes set this.")
+
(defun auto-fill-mode (&optional arg)
- "Toggle auto-fill mode.
-With arg, turn Auto-Fill mode on if and only if arg is positive.
-In Auto-Fill mode, inserting a space at a column beyond `current-fill-column'
-automatically breaks the line at a previous space."
+ "Toggle Auto Fill mode.
+With arg, turn Auto Fill mode on if and only if arg is positive.
+In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
+automatically breaks the line at a previous space.
+
+The value of `normal-auto-fill-function' specifies the function to use
+for `auto-fill-function' when turning Auto Fill mode on."
(interactive "P")
(prog1 (setq auto-fill-function
(if (if (null arg)
(not auto-fill-function)
(> (prefix-numeric-value arg) 0))
- 'do-auto-fill
+ normal-auto-fill-function
nil))
(force-mode-line-update)))
(error "set-fill-column requires an explicit argument")))
(message "fill-column set to %d" fill-column))
\f
-(defconst comment-multi-line nil
+(defvar 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].")
nil means don't show it (but the open-paren can still be shown
when it is off screen.")
-(defconst blink-matching-paren-distance 12000
+(defvar blink-matching-paren-distance 12000
"*If non-nil, is maximum distance to search for matching open-paren.")
-(defconst blink-matching-delay 1
+(defvar blink-matching-delay 1
"*The number of seconds that `blink-matching-open' will delay at a match.")
-(defconst blink-matching-paren-dont-ignore-comments nil
+(defvar blink-matching-paren-dont-ignore-comments nil
"*Non-nil means `blink-matching-paren' should not ignore comments.")
(defun blink-matching-open ()
(define-key global-map "\e\e\e" 'keyboard-escape-quit)
\f
+(defvar 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
+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
+
+Additional valid symbols may be available; check with the author of
+your package for details.")
+
+(defun define-mail-user-agent (symbol composefunc sendfunc
+ &optional abortfunc hookvar)
+ "Define a symbol to identify a mail-sending package for `mail-user-agent'.
+
+SYMBOL can be any Lisp symbol. Its function definition and/or
+value as a variable do not matter for this usage; we use only certain
+properties on its property list, to encode the rest of the arguments.
+
+COMPOSEFUNC is program callable function that composes an outgoing
+mail message buffer. This function should set up the basics of the
+buffer without requiring user interaction. It should populate the
+standard mail headers, leaving the `to:' and `subject:' headers blank
+by default.
+
+COMPOSEFUNC should accept several optional arguments--the same
+arguments that `compose-mail' takes. See that function's documentation.
+
+SENDFUNC is the command a user would run to send the message.
+
+Optional ABORTFUNC is the command a user would run to abort the
+message. For mail packages that don't have a separate abort function,
+this can be `kill-buffer' (the equivalent of omitting this argument).
+
+Optional HOOKVAR is a hook variable that gets run before the message
+is actually sent. Callers that use the `mail-user-agent' may
+install a hook function temporarily on this hook variable.
+If HOOKVAR is nil, `mail-send-hook' is used.
+
+The properties used on SYMBOL are `composefunc', `sendfunc',
+`abortfunc', and `hookvar'."
+ (put symbol 'composefunc composefunc)
+ (put symbol 'sendfunc sendfunc)
+ (put symbol 'abortfunc (or abortfunc 'kill-buffer))
+ (put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+(defun assoc-ignore-case (key alist)
+ "Like `assoc', but assumes KEY is a string and ignores case when comparing."
+ (let (element)
+ (while (and alist (not element))
+ (if (equal key (downcase (car (car alist))))
+ (setq element (car alist)))
+ (setq alist (cdr alist)))
+ element))
+
+(define-mail-user-agent 'sendmail-user-agent
+ '(lambda (&optional to subject other-headers continue
+ switch-function yank-action send-actions)
+ (if switch-function
+ (let ((special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (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))))
+ (or (mail continue to subject in-reply-to cc yank-action send-actions)
+ continue
+ (error "Message aborted"))))
+ 'mail-send-and-exit)
+
+(define-mail-user-agent 'mh-e-user-agent
+ 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
+ 'mh-before-send-letter-hook)
+
+(defun compose-mail (&optional to subject other-headers continue
+ switch-function yank-action send-actions)
+ "Start composing a mail message to send.
+This uses the user's chosen mail composition package
+as selected with the variable `mail-user-agent'.
+The optional arguments TO and SUBJECT specify recipients
+and the initial Subject field, respectively.
+
+OTHER-HEADERS is an alist specifying additional
+header fields. Elements look like (HEADER . VALUE) where both
+HEADER and VALUE are strings.
+
+CONTINUE, if non-nil, says to continue editing a message already
+being composed.
+
+SWITCH-FUNCTION, if non-nil, is a function to use to
+switch to and display the buffer used for mail composition.
+
+YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
+to insert the raw text of the message being replied to.
+It has the form (FUNCTION . ARGS). The user agent will apply
+FUNCTION to ARGS, to insert the raw text of the original message.
+\(The user agent will also run `mail-citation-hook', *after* the
+original text has been inserted in this way.)
+
+SEND-ACTIONS is a list of actions to call when the message is sent.
+Each action has the form (FUNCTION . ARGS)."
+ (interactive)
+ (let ((function (get mail-user-agent 'composefunc)))
+ (funcall function to subject other-headers continue
+ switch-function yank-action send-actions)))
+\f
(defun set-variable (var val)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
When using this interactively, supply a Lisp expression for VALUE.
Go to the window from which completion was requested."
(interactive)
(let ((buf completion-reference-buffer))
- (delete-window (selected-window))
- (if (get-buffer-window buf)
- (select-window (get-buffer-window buf)))))
+ (if (one-window-p t)
+ (if (window-dedicated-p (selected-window))
+ (delete-frame (selected-frame)))
+ (delete-window (selected-window))
+ (if (get-buffer-window buf)
+ (select-window (get-buffer-window buf))))))
(defun previous-completion (n)
"Move to the previous item in the completion list."