;; depend on backquote.el.
(list 'function (cons 'lambda cdr)))
-;;(defmacro defun-inline (name args &rest body)
-;; "Create an \"inline defun\" (actually a macro).
-;;Use just like `defun'."
-;; (nconc (list 'defmacro name '(&rest args))
-;; (if (stringp (car body))
-;; (prog1 (list (car body))
-;; (setq body (or (cdr body) body))))
-;; (list (list 'cons (list 'quote
-;; (cons 'lambda (cons args body)))
-;; 'args))))
-
+(defmacro when (cond &rest body)
+ "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
+ (list 'if cond (cons 'progn body)))
+(put 'when 'lisp-indent-function 1)
+(put 'when 'edebug-form-spec '(&rest form))
+
+(defmacro unless (cond &rest body)
+ "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
+ (cons 'if (cons cond (cons nil body))))
+(put 'unless 'lisp-indent-function 1)
+(put 'unless 'edebug-form-spec '(&rest form))
\f
;;;; Keymap support.
(while (and (symbolp inner-def)
(fboundp inner-def))
(setq inner-def (symbol-function inner-def)))
- (if (eq defn olddef)
+ (if (or (eq defn olddef)
+ ;; Compare with equal if definition is a key sequence.
+ ;; That is useful for operating on function-key-map.
+ (and (or (stringp defn) (vectorp defn))
+ (equal defn olddef)))
(define-key keymap prefix1 (nconc (nreverse skipped) newdef))
(if (and (keymapp defn)
;; Avoid recursively scanning
(substitute-key-definition olddef newdef keymap
inner-def
prefix1)))))
- (if (arrayp (car scan))
+ (if (vectorp (car scan))
(let* ((array (car scan))
(len (length array))
(i 0))
(while (and (symbolp inner-def)
(fboundp inner-def))
(setq inner-def (symbol-function inner-def)))
- (if (eq defn olddef)
+ (if (or (eq defn olddef)
+ (and (or (stringp defn) (vectorp defn))
+ (equal defn olddef)))
(define-key keymap prefix1
(nconc (nreverse skipped) newdef))
(if (and (keymapp defn)
(substitute-key-definition olddef newdef keymap
inner-def
prefix1)))))
- (setq i (1+ i))))))
+ (setq i (1+ i))))
+ (if (char-table-p (car scan))
+ (map-char-table
+ (function (lambda (char defn)
+ (let ()
+ ;; The inside of this let duplicates exactly
+ ;; the inside of the previous let,
+ ;; except that it uses set-char-table-range
+ ;; instead of define-key.
+ (aset vec1 0 char)
+ (aset prefix1 (length prefix) char)
+ (let (inner-def skipped)
+ ;; Skip past menu-prompt.
+ (while (stringp (car-safe defn))
+ (setq skipped (cons (car defn) skipped))
+ (setq defn (cdr defn)))
+ (and (consp defn) (consp (car defn))
+ (setq defn (cdr defn)))
+ (setq inner-def defn)
+ (while (and (symbolp inner-def)
+ (fboundp inner-def))
+ (setq inner-def (symbol-function inner-def)))
+ (if (or (eq defn olddef)
+ (and (or (stringp defn) (vectorp defn))
+ (equal defn olddef)))
+ (define-key keymap prefix1
+ (nconc (nreverse skipped) newdef))
+ (if (and (keymapp defn)
+ (let ((elt (lookup-key keymap prefix1)))
+ (or (null elt)
+ (keymapp elt)))
+ (not (memq inner-def
+ key-substitution-in-progress)))
+ (substitute-key-definition olddef newdef keymap
+ inner-def
+ prefix1)))))))
+ (car scan)))))
(setq scan (cdr scan)))))
(defun define-key-after (keymap key definition after)
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
This is like `define-key' except that the binding for KEY is placed
just after the binding for the event AFTER, instead of at the beginning
-of the map.
-The order matters when the keymap is used as a menu.
+of the map. Note that AFTER must be an event type (like KEY), NOT a command
+\(like DEFINITION).
+
+If AFTER is t, the new binding goes at the end of the keymap.
+
KEY must contain just one event type--that is to say, it must be
-a string or vector of length 1."
+a string or vector of length 1.
+
+The order of bindings in a keymap matters when it is used as a menu."
+
(or (keymapp keymap)
(signal 'wrong-type-argument (list 'keymapp keymap)))
(if (> (length key) 1)
;; When we reach AFTER's binding, insert the new binding after.
;; If we reach an inherited keymap, insert just before that.
;; If we reach the end of this keymap, insert at the end.
- (if (or (eq (car-safe (car tail)) after)
+ (if (or (and (eq (car-safe (car tail)) after)
+ (not (eq after t)))
(eq (car (cdr tail)) 'keymap)
(null (cdr tail)))
(progn
(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
+saving keyboard macros (see `insert-kbd-macro')."
+ (read-kbd-macro keys))
+
+(put 'keyboard-translate-table 'char-table-extra-slots 0)
+
(defun keyboard-translate (from to)
"Translate character FROM to TO at a low level.
This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it."
- (or (arrayp keyboard-translate-table)
- (setq keyboard-translate-table ""))
- (if (or (> from (length keyboard-translate-table))
- (> to (length keyboard-translate-table)))
- (progn
- (let* ((i (length keyboard-translate-table))
- (table (concat keyboard-translate-table
- (make-string (- 256 i) 0))))
- (while (< i 256)
- (aset table i i)
- (setq i (1+ i)))
- (setq keyboard-translate-table table))))
+ (or (char-table-p keyboard-translate-table)
+ (setq keyboard-translate-table
+ (make-char-table 'keyboard-translate-table nil)))
(aset keyboard-translate-table from to))
\f
(defalias 'buffer-flush-undo 'buffer-disable-undo)
(defalias 'eval-current-buffer 'eval-buffer)
(defalias 'compiled-function-p 'byte-code-function-p)
+(defalias 'define-function 'defalias)
;; Some programs still use this as a function.
(defun baud-rate ()
Please convert your programs to use the variable `baud-rate' directly."
baud-rate)
+(defalias 'focus-frame 'ignore)
+(defalias 'unfocus-frame 'ignore)
\f
;;;; Alternate names for functions - these are not being phased out.
(defalias 'string= 'string-equal)
(defalias 'string< 'string-lessp)
(defalias 'move-marker 'set-marker)
-(defalias 'eql 'eq)
(defalias 'not 'null)
(defalias 'rplaca 'setcar)
(defalias 'rplacd 'setcdr)
\f
;;;; Hook manipulation functions.
-;; We used to have this variable so that C code knew how to run hooks. That
-;; calling convention is made obsolete now the hook running functions are in C.
-(defconst run-hooks 'run-hooks
- "Variable by which C primitives find the function `run-hooks'.
-Don't change it. Don't use it either; use the hook running C primitives.")
-
(defun make-local-hook (hook)
"Make the hook HOOK local to the current buffer.
When a hook is local, its local and global values
(t (setq code char count 259))))
;; Turn a meta-character into a character with the 0200 bit set.
(logior (if (/= (logand code ?\M-\^@) 0) 128 0)
- (logand 255 code))))
+ code)))
(defun force-mode-line-update (&optional all)
"Force the mode-line of the current buffer to be redisplayed.
On other systems, this variable is normally always nil.")
;; This should probably be written in C (i.e., without using `walk-windows').
-(defun get-buffer-window-list (buffer &optional frame)
+(defun get-buffer-window-list (buffer &optional minibuf frame)
"Return windows currently displaying BUFFER, or nil if none.
-See `get-buffer-window' for the meaning of FRAME."
- (let (windows)
+See `walk-windows' for the meaning of MINIBUF and FRAME."
+ (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
(walk-windows (function (lambda (window)
(if (eq (window-buffer window) buffer)
(setq windows (cons window windows)))))
- nil frame)
+ minibuf frame)
windows))
(defun ignore (&rest ignore)
(t
(start-process name buffer shell-file-name shell-command-switch
(mapconcat 'identity args " ")))))
+\f
+(defmacro with-current-buffer (buffer &rest body)
+ "Execute the forms in BODY with BUFFER as the current buffer.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ `(save-current-buffer
+ (set-buffer ,buffer)
+ ,@body))
+
+(defmacro with-temp-file (file &rest forms)
+ "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
+The value of the last form in FORMS is returned, like `progn'.
+See also `with-temp-buffer'."
+ (let ((temp-file (make-symbol "temp-file"))
+ (temp-buffer (make-symbol "temp-buffer")))
+ `(let ((,temp-file ,file)
+ (,temp-buffer
+ (get-buffer-create (generate-new-buffer-name " *temp file*"))))
+ (unwind-protect
+ (prog1
+ (with-current-buffer ,temp-buffer
+ ,@forms)
+ (with-current-buffer ,temp-buffer
+ (widen)
+ (write-region (point-min) (point-max) ,temp-file nil 0)))
+ (and (buffer-name ,temp-buffer)
+ (kill-buffer ,temp-buffer))))))
+
+(defmacro with-temp-buffer (&rest forms)
+ "Create a temporary buffer, and evaluate FORMS there like `progn'.
+See also `with-temp-file' and `with-output-to-string'."
+ (let ((temp-buffer (make-symbol "temp-buffer")))
+ `(let ((,temp-buffer
+ (get-buffer-create (generate-new-buffer-name " *temp*"))))
+ (unwind-protect
+ (with-current-buffer ,temp-buffer
+ ,@forms)
+ (and (buffer-name ,temp-buffer)
+ (kill-buffer ,temp-buffer))))))
+
+(defmacro with-output-to-string (&rest body)
+ "Execute BODY, return the text it sent to `standard-output', as a string."
+ `(let ((standard-output
+ (get-buffer-create (generate-new-buffer-name " *string-output*"))))
+ (let ((standard-output standard-output))
+ ,@body)
+ (with-current-buffer standard-output
+ (prog1
+ (buffer-string)
+ (kill-buffer nil)))))
+
+(defmacro combine-after-change-calls (&rest body)
+ "Execute BODY, but don't call the after-change functions till the end.
+If BODY makes changes in the buffer, they are recorded
+and the functions on `after-change-functions' are called several times
+when BODY is finished.
+The return value is the value of the last form in BODY.
+
+If `before-change-functions' is non-nil, then calls to the after-change
+functions can't be deferred, so in that case this macro has no effect.
+
+Do not alter `after-change-functions' or `before-change-functions'
+in BODY."
+ `(unwind-protect
+ (let ((combine-after-change-calls t))
+ . ,body)
+ (combine-after-change-execute)))
+\f
+(defvar save-match-data-internal)
+
+;; We use save-match-data-internal as the local variable because
+;; that works ok in practice (people should not use that variable elsewhere).
+;; We used to use an uninterned symbol; the compiler handles that properly
+;; now, but it generates slower code.
(defmacro save-match-data (&rest body)
"Execute the BODY forms, restoring the global value of the match data."
- (let ((original (make-symbol "match-data")))
- (list 'let (list (list original '(match-data)))
- (list 'unwind-protect
- (cons 'progn body)
- (list 'store-match-data original)))))
+ `(let ((save-match-data-internal (match-data)))
+ (unwind-protect
+ (progn ,@body)
+ (store-match-data save-match-data-internal))))
(defun match-string (num &optional string)
"Return string of text matched by last search.
(substring string (match-beginning num) (match-end num))
(buffer-substring (match-beginning num) (match-end num)))))
+(defun split-string (string &optional separators)
+ "Splits STRING into substrings where there are matches for SEPARATORS.
+Each match for SEPARATORS is a splitting point.
+The substrings between the splitting points are made into a list
+which is returned.
+If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
+ (let ((rexp (or separators "[ \f\t\n\r\v]+"))
+ (start 0)
+ (list nil))
+ (while (string-match rexp string start)
+ (or (eq (match-beginning 0) 0)
+ (setq list
+ (cons (substring string start (match-beginning 0))
+ list)))
+ (setq start (match-end 0)))
+ (or (eq start (length string))
+ (setq list
+ (cons (substring string start)
+ list)))
+ (nreverse list)))
+\f
(defun shell-quote-argument (argument)
"Quote an argument for passing as argument to an inferior shell."
(if (eq system-type 'ms-dos)
argument
(if (eq system-type 'windows-nt)
(concat "\"" argument "\"")
- ;; Quote everything except POSIX filename characters.
- ;; This should be safe enough even for really weird shells.
- (let ((result "") (start 0) end)
- (while (string-match "[^-0-9a-zA-Z_./]" argument start)
- (setq end (match-beginning 0)
- result (concat result (substring argument start end)
- "\\" (substring argument end (1+ end)))
- start (1+ end)))
- (concat result (substring argument start))))))
+ (if (equal argument "")
+ "''"
+ ;; Quote everything except POSIX filename characters.
+ ;; This should be safe enough even for really weird shells.
+ (let ((result "") (start 0) end)
+ (while (string-match "[^-0-9a-zA-Z_./]" argument start)
+ (setq end (match-beginning 0)
+ result (concat result (substring argument start end)
+ "\\" (substring argument end (1+ end)))
+ start (1+ end)))
+ (concat result (substring argument start)))))))
(defun make-syntax-table (&optional oldtable)
"Return a new syntax table.
-It inherits all letters and control characters from the standard
-syntax table; other characters are copied from the standard syntax table."
+If OLDTABLE is non-nil, copy OLDTABLE.
+Otherwise, create a syntax table which inherits
+all letters and control characters from the standard syntax table;
+other characters are copied from the standard syntax table."
(if oldtable
(copy-syntax-table oldtable)
(let ((table (copy-syntax-table))
(aset table i nil)
(setq i (1+ i)))
table)))
+
+(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)))))
+
+(defun remove-from-invisibility-spec (arg)
+ "Remove elements from `buffer-invisibility-spec'."
+ (if buffer-invisibility-spec
+ (setq buffer-invisibility-spec (delete arg buffer-invisibility-spec))))
\f
(defun global-set-key (key command)
"Give KEY a global binding as COMMAND.
(and (consp object)
(eq (car object) 'frame-configuration)))
+(defun functionp (object)
+ "Non-nil of OBJECT is a type of object that can be called as a function."
+ (or (subrp object) (compiled-function-p object)
+ (eq (car-safe object) 'lambda)
+ (and (symbolp object) (fboundp object))))
+
;; now in fns.c
;(defun nth (n list)
; "Returns the Nth element of LIST.
; alist)
;;; subr.el ends here
-