;;; subr.el --- basic lisp subroutines for Emacs
-;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001
+;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002
;; Free Software Foundation, Inc.
+;; Maintainer: FSF
+;; Keywords: internal
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
(defun custom-declare-variable-early (&rest arguments)
(setq custom-declare-variable-list
(cons arguments custom-declare-variable-list)))
+
+\f
+(defun macro-declaration-function (macro decl)
+ "Process a declaration found in a macro definition.
+This is set as the value of the variable `macro-declaration-function'.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The return value of this function is not used."
+ (dolist (d (cdr decl))
+ (cond ((and (consp d) (eq (car d) 'indent))
+ (put macro 'lisp-indent-function (cadr d)))
+ ((and (consp d) (eq (car d) 'debug))
+ (put macro 'edebug-form-spec (cadr d)))
+ (t
+ (message "Unknown declaration %s" d)))))
+
+(setq macro-declaration-function 'macro-declaration-function)
+
\f
;;;; Lisp language features.
LISTNAME must be a symbol whose value is a list.
If the value is nil, `pop' returns nil but does not actually
change the list."
- (list 'prog1 (list 'car listname)
- (list 'setq listname (list 'cdr listname))))
+ (list 'car
+ (list 'prog1 listname
+ (list 'setq listname (list 'cdr listname)))))
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil."
(delq elt (copy-sequence list))
list))
+(defun copy-tree (tree &optional vecp)
+ "Make a copy of TREE.
+If TREE is a cons cell, this recursively copies both its car and its cdr.
+Contrast to `copy-sequence', which copies only along the cdrs. With second
+argument VECP, this copies vectors as well as conses."
+ (if (consp tree)
+ (let (result)
+ (while (consp tree)
+ (let ((newcar (car tree)))
+ (if (or (consp (car tree)) (and vecp (vectorp (car tree))))
+ (setq newcar (copy-tree (car tree) vecp)))
+ (push newcar result))
+ (setq tree (cdr tree)))
+ (nconc (nreverse result) tree))
+ (if (and vecp (vectorp tree))
+ (let ((i (length (setq tree (copy-sequence tree)))))
+ (while (>= (setq i (1- i)) 0)
+ (aset tree i (copy-tree (aref tree i) vecp)))
+ tree)
+ tree)))
+
(defun assoc-default (key alist &optional test default)
"Find object KEY in a pseudo-alist ALIST.
ALIST is a list of conses or objects. Each element (or the element's car,
(defun member-ignore-case (elt list)
"Like `member', but ignores differences in case and text representation.
ELT must be a string. Upper-case and lower-case letters are treated as equal.
-Unibyte strings are converted to multibyte for comparison."
- (while (and list (not (eq t (compare-strings elt 0 nil (car list) 0 nil t))))
+Unibyte strings are converted to multibyte for comparison.
+Non-strings in LIST are ignored."
+ (while (and list
+ (not (and (stringp (car list))
+ (eq t (compare-strings elt 0 nil (car list) 0 nil t)))))
(setq list (cdr list)))
list)
"Make MAP override all normally self-inserting keys to be undefined.
Normally, as an exception, digits and minus-sign are set to make prefix args,
but optional second arg NODIGITS non-nil treats them like other chars."
- (substitute-key-definition 'self-insert-command 'undefined map global-map)
+ (define-key map [remap self-insert-command] 'undefined)
(or nodigits
(let (loop)
(define-key map "-" 'negative-argument)
(setq inserted t)))
(setq tail (cdr tail)))))
+
(defmacro kbd (keys)
"Convert KEYS to the internal Emacs key representation.
KEYS should be a string constant in the format used for
The return value is of the form
(WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
The `posn-' functions access elements of such lists."
- (nth 1 event))
+ (if (consp event) (nth 1 event)
+ (list (selected-window) (point) '(0 . 0) 0)))
(defsubst event-end (event)
"Return the ending location of EVENT. EVENT should be a click or drag event.
The return value is of the form
(WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
The `posn-' functions access elements of such lists."
- (nth (if (consp (nth 2 event)) 2 1) event))
+ (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
+ (list (selected-window) (point) '(0 . 0) 0)))
(defsubst event-click-count (event)
"Return the multi-click count of EVENT, a click or drag event.
The return value is a positive integer."
- (if (integerp (nth 2 event)) (nth 2 event) 1))
+ (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
(defsubst posn-window (position)
"Return the window in POSITION.
(defalias 'sref 'aref)
(make-obsolete 'sref 'aref "20.4")
-(make-obsolete 'char-bytes "Now this function always returns 1" "20.4")
+(make-obsolete 'char-bytes "now always returns 1 (maintained for backward compatibility)." "20.4")
+(make-obsolete 'chars-in-region "use (abs (- BEG END))." "20.3")
+(make-obsolete 'dot 'point "before 19.15")
+(make-obsolete 'dot-max 'point-max "before 19.15")
+(make-obsolete 'dot-min 'point-min "before 19.15")
+(make-obsolete 'dot-marker 'point-marker "before 19.15")
+(make-obsolete 'buffer-flush-undo 'buffer-disable-undo "before 19.15")
+(make-obsolete 'baud-rate "use the baud-rate variable instead." "before 19.15")
+(make-obsolete 'compiled-function-p 'byte-code-function-p "before 19.15")
+(make-obsolete 'define-function 'defalias "20.1")
(defun insert-string (&rest args)
"Mocklisp-compatibility insert function.
is converted into a string by expressing it in decimal."
(dolist (el args)
(insert (if (integerp el) (number-to-string el) el))))
-
-(make-obsolete 'insert-string 'insert "21.3")
+(make-obsolete 'insert-string 'insert "21.4")
+(defun makehash (&optional test) (make-hash-table :test (or test 'eql)))
+(make-obsolete 'makehash 'make-hash-table "21.4")
;; Some programs still use this as a function.
(defun baud-rate ()
- "Obsolete function returning the value of the `baud-rate' variable.
-Please convert your programs to use the variable `baud-rate' directly."
+ "Return the value of the `baud-rate' variable."
baud-rate)
(defalias 'focus-frame 'ignore)
(defalias 'unfocus-frame 'ignore)
+
+\f
+;;;; Obsolescence declarations for variables.
+
+(make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
+(make-obsolete-variable 'mode-line-inverse-video "use the appropriate faces instead." "21.1")
+(make-obsolete-variable 'unread-command-char
+ "use `unread-command-events' instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1."
+ "before 19.15")
+(make-obsolete-variable 'executing-macro 'executing-kbd-macro "before 19.34")
+(make-obsolete-variable 'post-command-idle-hook
+ "use timers instead, with `run-with-idle-timer'." "before 19.34")
+(make-obsolete-variable 'post-command-idle-delay
+ "use timers instead, with `run-with-idle-timer'." "before 19.34")
+
\f
;;;; Alternate names for functions - these are not being phased out.
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
(defalias 'int-to-string 'number-to-string)
(defalias 'store-match-data 'set-match-data)
+(defalias 'make-variable-frame-localizable 'make-variable-frame-local)
;; These are the XEmacs names:
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
(make-local-variable hook)
(set hook (list t)))
hook)
-(make-obsolete 'make-local-hook "Not necessary any more." "21.1")
+(make-obsolete 'make-local-hook "not necessary any more." "21.1")
(defun add-hook (hook function &optional append local)
"Add to the value of HOOK the function FUNCTION.
;; (not (member (cons 'not function) hook-value)))
;; (push (cons 'not function) hook-value))
;; Set the actual variable
- (if local (set hook hook-value) (set-default hook hook-value))))
+ (if (not local)
+ (set-default hook hook-value)
+ (if (equal hook-value '(t))
+ (kill-local-variable hook)
+ (set hook hook-value)))))
(defun add-to-list (list-var element &optional append)
"Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
\f
;;; Load history
-(defvar symbol-file-load-history-loaded nil
- "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
-That file records the part of `load-history' for preloaded files,
-which is cleared out before dumping to make Emacs smaller.")
-
-(defun load-symbol-file-load-history ()
- "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
-That file records the part of `load-history' for preloaded files,
-which is cleared out before dumping to make Emacs smaller."
- (unless symbol-file-load-history-loaded
- (load (expand-file-name
- ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
- (if (eq system-type 'ms-dos)
- "fns.el"
- (format "fns-%s.el" emacs-version))
- exec-directory)
- ;; The file name fns-%s.el already has a .el extension.
- nil nil t)
- (setq symbol-file-load-history-loaded t)))
+;;; (defvar symbol-file-load-history-loaded nil
+;;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
+;;; That file records the part of `load-history' for preloaded files,
+;;; which is cleared out before dumping to make Emacs smaller.")
+
+;;; (defun load-symbol-file-load-history ()
+;;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
+;;; That file records the part of `load-history' for preloaded files,
+;;; which is cleared out before dumping to make Emacs smaller."
+;;; (unless symbol-file-load-history-loaded
+;;; (load (expand-file-name
+;;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
+;;; (if (eq system-type 'ms-dos)
+;;; "fns.el"
+;;; (format "fns-%s.el" emacs-version))
+;;; exec-directory)
+;;; ;; The file name fns-%s.el already has a .el extension.
+;;; nil nil t)
+;;; (setq symbol-file-load-history-loaded t)))
(defun symbol-file (function)
"Return the input source from which FUNCTION was loaded.
either an absolute file name, or a library name
\(with no directory name and no `.el' or `.elc' at the end).
It can also be nil, if the definition is not associated with any file."
- (load-symbol-file-load-history)
- (let ((files load-history)
- file functions)
- (while files
- (if (memq function (cdr (car files)))
- (setq file (car (car files)) files nil))
- (setq files (cdr files)))
- file))
+ (if (and (symbolp function) (fboundp function)
+ (eq 'autoload (car-safe (symbol-function function))))
+ (nth 1 (symbol-function function))
+ (let ((files load-history)
+ file functions)
+ (while files
+ (if (memq function (cdr (car files)))
+ (setq file (car (car files)) files nil))
+ (setq files (cdr files)))
+ file)))
\f
;;;; Specifying things to do after certain files are loaded.
(featurep file)
;; Make sure `load-history' contains the files dumped with
;; Emacs for the case that FILE is one of them.
- (load-symbol-file-load-history)
+ ;; (load-symbol-file-load-history)
(assoc file load-history))
(eval form))))
form)
This makes or adds to an entry on `after-load-alist'.
FILE should be the name of a library, with no directory name."
(eval-after-load file (read)))
+\f
+;;; make-network-process wrappers
+
+(if (featurep 'make-network-process)
+ (progn
+
+(defun open-network-stream (name buffer host service)
+ "Open a TCP connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to."
+ (make-network-process :name name :buffer buffer
+ :host host :service service))
+
+(defun open-network-stream-nowait (name buffer host service &optional sentinel filter)
+ "Initiate connection to a TCP connection for a service to a host.
+It returns nil if non-blocking connects are not supported; otherwise,
+it returns a subprocess-object to represent the connection.
+
+This function is similar to `open-network-stream', except that this
+function returns before the connection is established. When the
+connection is completed, the sentinel function will be called with
+second arg matching `open' (if successful) or `failed' (on error).
+
+Args are NAME BUFFER HOST SERVICE SENTINEL FILTER.
+NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'.
+Optional args, SENTINEL and FILTER specifies the sentinel and filter
+functions to be used for this network stream."
+ (if (featurep 'make-network-process '(:nowait t))
+ (make-network-process :name name :buffer buffer :nowait t
+ :host host :service service
+ :filter filter :sentinel sentinel)))
+
+(defun open-network-stream-server (name buffer service &optional sentinel filter)
+ "Create a network server process for a TCP service.
+It returns nil if server processes are not supported; otherwise,
+it returns a subprocess-object to represent the server.
+
+When a client connects to the specified service, a new subprocess
+is created to handle the new connection, and the sentinel function
+is called for the new process.
+
+Args are NAME BUFFER SERVICE SENTINEL FILTER.
+NAME is name for the server process. Client processes are named by
+appending the ip-address and port number of the client to NAME.
+BUFFER is the buffer (or buffer-name) to associate with the server
+process. Client processes will not get a buffer if a process filter
+is specified or BUFFER is nil; otherwise, a new buffer is created for
+the client process. The name is similar to the process name.
+Third arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to. It may also be t to selected
+an unused port number for the server.
+Optional args, SENTINEL and FILTER specifies the sentinel and filter
+functions to be used for the client processes; the server process
+does not use these function."
+ (if (featurep 'make-network-process '(:server t))
+ (make-network-process :name name :buffer buffer
+ :service service :server t :noquery t
+ :sentinel sentinel :filter filter)))
+
+)) ;; (featurep 'make-network-process)
+
+
+;; compatibility
+
+(defun process-kill-without-query (process &optional flag)
+ "Say no query needed if PROCESS is running when Emacs is exited.
+Optional second argument if non-nil says to require a query.
+Value is t if a query was formerly required.
+New code should not use this function; use `process-query-on-exit-flag'
+or `set-process-query-on-exit-flag' instead."
+ (let ((old (process-query-on-exit-flag process)))
+ (set-process-query-on-exit-flag process nil)
+ old))
\f
;;;; Input and display facilities.
:type '(choice (const 8) (const 10) (const 16))
:group 'editing-basics)
+(defun read-key (&optional prompt)
+ "Read a key from the keyboard.
+Contrary to `read-event' this will not return a raw event but will
+obey `function-key-map' and `key-translation-map' instead."
+ (let ((overriding-terminal-local-map (make-sparse-keymap)))
+ (aref (read-key-sequence prompt nil t) 0)))
+
(defun read-quoted-char (&optional prompt)
"Like `read-char', but do not allow quitting.
Also, if the first character read is an octal digit,
or the octal character code.
RET terminates the character code and is discarded;
any other non-digit terminates the character code and is then used as input."))
- (setq char (read-event (and prompt (format "%s-" prompt)) t))
+ (setq char (read-key (and prompt (format "%s-" prompt))))
(if inhibit-quit (setq quit-flag nil)))
- ;; Translate TAB key into control-I ASCII character, and so on.
- (and char
- (let ((translated (lookup-key function-key-map (vector char))))
- (if (arrayp translated)
- (setq char (aref translated 0)))))
(cond ((null char))
((not (integerp char))
- (setq unread-command-events (list char)
+ (setq unread-command-events (listify-key-sequence (this-single-command-raw-keys))
done t))
((/= (logand char ?\M-\^@) 0)
;; Turn a meta-character into a character with the 0200 bit set.
((and (not first) (eq char ?\C-m))
(setq done t))
((not first)
- (setq unread-command-events (list char)
+ (setq unread-command-events (listify-key-sequence (this-single-command-raw-keys))
done t))
(t (setq code char
done t)))
(message nil)
(or pass default ""))))
\f
+;;; Atomic change groups.
+
(defmacro atomic-change-group (&rest body)
"Perform BODY as an atomic change group.
This means that if BODY exits abnormally,
all of its changes to the current buffer are undone.
-This works regadless of whether undo is enabled in the buffer.
+This works regardless of whether undo is enabled in the buffer.
This mechanism is transparent to ordinary use of undo;
if undo is enabled in the buffer and BODY succeeds, the
;; Revert the undo info to what it was when we grabbed the state.
(setq buffer-undo-list elt)))))
\f
+;; For compatibility.
+(defalias 'redraw-modeline 'force-mode-line-update)
+
(defun force-mode-line-update (&optional all)
"Force the mode line of the current buffer to be redisplayed.
With optional non-nil ALL, force redisplay of all mode lines."
(defalias 'user-original-login-name 'user-login-name)
+(defvar yank-excluded-properties)
+
+(defun remove-yank-excluded-properties (start end)
+ "Remove `yank-excluded-properties' between START and END positions.
+Replaces `category' properties with their defined properties."
+ (let ((inhibit-read-only t))
+ ;; Replace any `category' property with the properties it stands for.
+ (unless (memq yank-excluded-properties '(t nil))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (let ((cat (get-text-property (point) 'category))
+ run-end)
+ (when cat
+ (setq run-end
+ (next-single-property-change (point) 'category nil end))
+ (remove-list-of-text-properties (point) run-end '(category))
+ (add-text-properties (point) run-end (symbol-plist cat))
+ (goto-char (or run-end end)))
+ (setq run-end
+ (next-single-property-change (point) 'category nil end))
+ (goto-char (or run-end end))))))
+ (if (eq yank-excluded-properties t)
+ (set-text-properties start end nil)
+ (remove-list-of-text-properties start end
+ yank-excluded-properties))))
+
+(defun insert-for-yank (&rest strings)
+ "Insert STRINGS at point, stripping some text properties.
+Strip text properties from the inserted text
+according to `yank-excluded-properties'.
+Otherwise just like (insert STRINGS...)."
+ (let ((opoint (point)))
+ (apply 'insert strings)
+ (remove-yank-excluded-properties opoint (point))))
+
+(defun insert-buffer-substring-no-properties (buf &optional start end)
+ "Insert before point a substring of buffer BUFFER, without text properties.
+BUFFER may be a buffer or a buffer name.
+Arguments START and END are character numbers specifying the substring.
+They default to the beginning and the end of BUFFER."
+ (let ((opoint (point)))
+ (insert-buffer-substring buf start end)
+ (let ((inhibit-read-only t))
+ (set-text-properties opoint (point) nil))))
+
+(defun insert-buffer-substring-as-yank (buf &optional start end)
+ "Insert before point a part of buffer BUFFER, stripping some text properties.
+BUFFER may be a buffer or a buffer name. Arguments START and END are
+character numbers specifying the substring. They default to the
+beginning and the end of BUFFER. Strip text properties from the
+inserted text according to `yank-excluded-properties'."
+ (let ((opoint (point)))
+ (insert-buffer-substring buf start end)
+ (remove-yank-excluded-properties opoint (point))))
+
+\f
+;; Synchronous shell commands.
+
(defun start-process-shell-command (name buffer &rest args)
"Start a program in a subprocess. Return the process object for it.
Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
(set-buffer ,old-buffer)
(set-syntax-table ,old-table))))))
\f
+;;; Matching and substitution
+
(defvar save-match-data-internal)
;; We use save-match-data-internal as the local variable because
(cons 'progn body)
'(set-match-data save-match-data-internal))))
-(defun substring-no-properties (string &optional from to)
- "Return a substring of STRING, with no text properties.
-The substring starts at index FROM and ends before TO.
-If FROM is nil or omitted, it defaults to the beginning of STRING.
-If TO is nil or omitted, it defaults to the end of STRING.
-If FROM or TO is negative, it counts from the end.
-
-Simply (substring-no-properties STRING) copies a string without
-its properties."
- (let ((str (substring string (or from 0) to)))
- (set-text-properties 0 (length str) nil str)
- str))
-
(defun match-string (num &optional string)
"Return string of text matched by last search.
NUM specifies which parenthesized expression in the last regexp.
(set-char-table-parent table (or oldtable (standard-syntax-table)))
table))
+(defun syntax-after (pos)
+ "Return the syntax of the char after POS."
+ (unless (or (< pos (point-min)) (>= pos (point-max)))
+ (let ((st (if parse-sexp-lookup-properties
+ (get-char-property pos 'syntax-table))))
+ (if (consp st) st
+ (aref (or st (syntax-table)) (char-after pos))))))
+
(defun add-to-invisibility-spec (arg)
"Add elements to `buffer-invisibility-spec'.
See documentation for `buffer-invisibility-spec' for the kind of elements
(defun functionp (object)
"Non-nil iff OBJECT is a type of object that can be called as a function."
(or (and (symbolp object) (fboundp object)
- (setq object (indirect-function object))
+ (condition-case nil
+ (setq object (indirect-function object))
+ (error nil))
(eq (car-safe object) 'autoload)
(not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
(subrp object) (byte-code-function-p object)
(setq tail (cdr tail)))
alist))
-(defun make-temp-file (prefix &optional dir-flag)
+(defun make-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
-of PREFIX, and expanding against `temporary-file-directory' if necessary,
+of PREFIX, and expanding against `temporary-file-directory' if necessary),
is guaranteed to point to a newly created empty file.
You can then use `write-region' to write new data into the file.
-If DIR-FLAG is non-nil, create a new empty directory instead of a file."
+If DIR-FLAG is non-nil, create a new empty directory instead of a file.
+
+If SUFFIX is non-nil, add that at the end of the file name."
(let (file)
(while (condition-case ()
(progn
(setq file
(make-temp-name
(expand-file-name prefix temporary-file-directory)))
+ (if suffix
+ (setq file (concat file suffix)))
(if dir-flag
(make-directory file)
(write-region "" nil file nil 'silent nil 'excl))
(nconc found (list (cons toggle keymap)) rest))
(setq minor-mode-map-alist (cons (cons toggle keymap)
minor-mode-map-alist))))))))
-
-;; XEmacs compatibility/convenience.
-(if (fboundp 'play-sound)
- (defun play-sound-file (file &optional volume device)
- "Play sound stored in FILE.
-VOLUME and DEVICE correspond to the keywords of the sound
-specification for `play-sound'."
- (interactive "fPlay sound file: ")
- (let ((sound (list :file file)))
- (if volume
- (plist-put sound :volume volume))
- (if device
- (plist-put sound :device device))
- (push 'sound sound)
- (play-sound sound))))
-
+\f
;; Clones ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun text-clone-maintain (ol1 after beg end &optional len)
(overlay-put ol2 'evaporate t)
(overlay-put ol2 'text-clones dups)))
+(defun play-sound (sound)
+ "SOUND is a list of the form `(sound KEYWORD VALUE...)'.
+The following keywords are recognized:
+
+ :file FILE - read sound data from FILE. If FILE isn't an
+absolute file name, it is searched in `data-directory'.
+
+ :data DATA - read sound data from string DATA.
+
+Exactly one of :file or :data must be present.
+
+ :volume VOL - set volume to VOL. VOL must an integer in the
+range 0..100 or a float in the range 0..1.0. If not specified,
+don't change the volume setting of the sound device.
+
+ :device DEVICE - play sound on DEVICE. If not specified,
+a system-dependent default device name is used."
+ (unless (fboundp 'play-sound-internal)
+ (error "This Emacs binary lacks sound support"))
+ (play-sound-internal sound))
+
+(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)))
+
;;; subr.el ends here