;;; subr.el --- basic lisp subroutines for Emacs
-;;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Code:
;; 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)))
+(defmacro unless (cond &rest body)
+ "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
+ (cons 'if (cons cond (cons nil body))))
\f
;;;; Keymap support.
"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)))))
+(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
((and (<= ?0 char) (<= char ?7))
(setq code (+ (* code 8) (- char ?0))
count (1+ count))
- (and prompt (message (setq prompt
- (format "%s %c" prompt char)))))
+ (and prompt (setq prompt (message "%s %c" prompt char))))
((> count 0)
(setq unread-command-events (list char) count 259))
(t (setq code char count 259))))
On those systems, it is automatically local in every buffer.
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 minibuf frame)
+ "Return windows currently displaying BUFFER, or nil if none.
+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)))))
+ minibuf frame)
+ windows))
+
(defun ignore (&rest ignore)
"Do nothing and return nil.
This function accepts any number of arguments, but ignores them."
(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)
(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
+ (nconc buffer-invisibility-spec (list arg))))))
+
+(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.
; alist)
;;; subr.el ends here
-