(delete elt (copy-sequence seq))))
(defun remq (elt list)
- "Return a copy of LIST with all occurences of ELT removed.
+ "Return a copy of LIST with all occurrences of ELT removed.
The comparison is done with `eq'."
(if (memq elt list)
(delq elt (copy-sequence list))
(defun assoc-ignore-representation (key alist)
"Like `assoc', but ignores differences in text representation.
-KEY must be a string.
+KEY must be a string.
Unibyte strings are converted to multibyte for comparison."
(let (element)
(while (and alist (not element))
"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)
;Moved to keymap.c
;(defun copy-keymap (keymap)
-; "Return a copy of KEYMAP"
+; "Return a copy of KEYMAP"
; (while (not (keymapp keymap))
; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
; (if (vectorp keymap)
;; Don't document PREFIX in the doc string because we don't want to
;; advertise it. It's meant for recursive calls only. Here's its
;; meaning
-
+
;; If optional argument PREFIX is specified, it should be a key
;; prefix, a string. Redefined bindings will then be bound to the
;; original key, with PREFIX added at the front.
(aset keyboard-translate-table from to))
\f
-;;;; The global keymap tree.
+;;;; The global keymap tree.
;;; global-map, esc-map, and ctl-x-map have their values set up in
;;; keymap.c; we just give them docstrings here.
(defalias 'sref 'aref)
(make-obsolete 'sref 'aref "20.4")
-(make-obsolete 'char-bytes "now always returns 1 (maintained for backward compatibility)." "20.4")
+(make-obsolete 'char-bytes "now always returns 1." "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")
(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)
\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)
+ (while files
+ (if (member 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)
(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.
+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))
+;; process plist management
+
+(defun process-get (process propname)
+ "Return the value of PROCESS' PROPNAME property.
+This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
+ (plist-get (process-plist process) propname))
+
+(defun process-put (process propname value)
+ "Change PROCESS' PROPNAME property to VALUE.
+It can be retrieved with `(process-get PROCESS PROPNAME)'."
+ (set-process-plist process
+ (plist-put (process-plist process) propname value)))
+
\f
;;;; Input and display facilities.
Legitimate radix values are 8, 10 and 16.")
(custom-declare-variable-early
- 'read-quoted-char-radix 8
+ 'read-quoted-char-radix 8
"*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
Legitimate radix values are 8, 10 and 16."
: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-key (and prompt (format "%s-" prompt))))
+ (setq char (read-event (and prompt (format "%s-" prompt)) t))
(if inhibit-quit (setq quit-flag nil)))
+ ;; Translate TAB key into control-I ASCII character, and so on.
+ ;; Note: `read-char' does it using the `ascii-character' property.
+ ;; We could try and use read-key-sequence instead, but then C-q ESC
+ ;; or C-q C-x might not return immediately since ESC or C-x might be
+ ;; bound to some prefix in function-key-map or key-translation-map.
+ (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 (this-single-command-raw-keys)
+ (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 (this-single-command-raw-keys)
+ (setq unread-command-events (listify-key-sequence (this-single-command-raw-keys))
done t))
(t (setq code char
done t)))
(dolist (elt handle)
(with-current-buffer (car elt)
(setq elt (cdr elt))
- (let ((old-car
+ (let ((old-car
(if (consp elt) (car elt)))
(old-cdr
(if (consp elt) (cdr elt))))
(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))))))
+ (when cat
+ (let (run-end2 original)
+ (remove-list-of-text-properties (point) run-end '(category))
+ (while (< (point) run-end)
+ (setq run-end2 (next-property-change (point) nil run-end))
+ (setq original (text-properties-at (point)))
+ (set-text-properties (point) run-end2 (symbol-plist cat))
+ (add-text-properties (point) run-end2 original)
+ (goto-char run-end2))))
+ (goto-char run-end)))))
(if (eq yank-excluded-properties t)
(set-text-properties start end nil)
- (remove-list-of-text-properties start end
- yank-excluded-properties))))
+ (remove-list-of-text-properties start end yank-excluded-properties))))
(defun insert-for-yank (&rest strings)
"Insert STRINGS at point, stripping some text properties.
(defmacro with-local-quit (&rest body)
"Execute BODY with `inhibit-quit' temporarily bound to nil."
+ (declare (debug t) (indent 0))
`(condition-case nil
(let ((inhibit-quit nil))
,@body)
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
- (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
+ (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
=> \" bar foo\"
"
(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
that can be added."
- (cond
- ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t))
- (setq buffer-invisibility-spec (list arg)))
- (t
- (setq buffer-invisibility-spec
- (cons arg buffer-invisibility-spec)))))
+ (if (eq buffer-invisibility-spec t)
+ (setq buffer-invisibility-spec (list t)))
+ (setq buffer-invisibility-spec
+ (cons arg buffer-invisibility-spec)))
(defun remove-from-invisibility-spec (arg)
"Remove elements from `buffer-invisibility-spec'."
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))
- nil)
- (file-already-exists t))
- ;; the file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)
- file))
+ (let ((umask (default-file-modes))
+ file)
+ (unwind-protect
+ (progn
+ ;; Create temp files with strict access rights. It's easy to
+ ;; loosen them later, whereas it's impossible to close the
+ ;; time-window of loose permissions otherwise.
+ (set-default-file-modes ?\700)
+ (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))
+ nil)
+ (file-already-exists t))
+ ;; the file was somehow created by someone else between
+ ;; `make-temp-name' and `write-region', let's try again.
+ nil)
+ file)
+ ;; Reset the umask.
+ (set-default-file-modes umask))))
\f
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
;; Add the name to the minor-mode-alist.
(when name
(let ((existing (assq toggle minor-mode-alist)))
- (when (and (stringp name) (not (get-text-property 0 'local-map name)))
- (setq name
- (propertize name
- 'local-map mode-line-minor-mode-keymap
- 'help-echo "mouse-3: minor mode menu")))
(if existing
(setcdr existing (list name))
(let ((tail minor-mode-alist) found)
(concat
(or (get toggle :menu-tag)
(if (stringp name) name (symbol-name toggle)))
- (let ((mode-name (if (stringp name) name
- (if (symbolp name) (symbol-value name)))))
- (if mode-name
- (concat " (" mode-name ")"))))
+ (let ((mode-name (if (symbolp name) (symbol-value name))))
+ (if (and (stringp mode-name) (string-match "[^ ]+" mode-name))
+ (concat " (" (match-string 0 mode-name) ")"))))
toggle-fun
:button (cons :toggle toggle))))
- ;; Add the map to the minor-mode-map-alist.
+ ;; Add the map to the minor-mode-map-alist.
(when keymap
(let ((existing (assq toggle minor-mode-map-alist)))
(if existing
;; where the clone is reduced to the empty string (we want the overlay to
;; stay when the clone's content is the empty string and we want to use
;; `evaporate' to make sure those overlays get deleted when needed).
- ;;
+ ;;
(let* ((pt-end (+ (point) (- end start)))
(start-margin (if (or (not spreadp) (bobp) (<= start (point-min)))
0 1))
;;(overlay-put ol1 'face 'underline)
(overlay-put ol1 'evaporate t)
(overlay-put ol1 'text-clones dups)
- ;;
+ ;;
(overlay-put ol2 'modification-hooks '(text-clone-maintain))
(when spreadp (overlay-put ol2 'text-clone-spreadp t))
(when syntax (overlay-put ol2 'text-clone-syntax syntax))
;;(overlay-put ol2 'face 'underline)
(overlay-put ol2 'evaporate t)
(overlay-put ol2 'text-clones dups)))
-\f
+
(defun play-sound (sound)
"SOUND is a list of the form `(sound KEYWORD VALUE...)'.
The following keywords are recognized:
(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