;;; subr.el --- basic lisp subroutines for Emacs
-;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+;;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Code:
-(defun one-window-p (&optional arg)
+\f
+;;;; Lisp language features.
+
+(defmacro lambda (&rest cdr)
+ "Return a lambda expression.
+A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
+self-quoting; the result of evaluating the lambda expression is the
+expression itself. The lambda expression may then be treated as a
+function, i. e. stored as the function value of a symbol, passed to
+funcall or mapcar, etcetera.
+ARGS should take the same form as an argument list for a `defun'.
+DOCSTRING should be a string, as described for `defun'. It may be omitted.
+INTERACTIVE should be a call to the function `interactive', which see.
+It may also be omitted.
+BODY should be a list of lisp expressions."
+ ;; Note that this definition should not use backquotes; subr.el should not
+ ;; 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))))
+
+\f
+;;;; Window tree functions.
+
+(defun one-window-p (&optional nomini)
"Returns non-nil if there is only one window.
Optional arg NOMINI non-nil means don't count the minibuffer
even if it is active."
- (eq (selected-window)
- (next-window (selected-window) (if arg 'arg))))
+ (let ((base-window (selected-window)))
+ (if (and nomini (eq base-window (minibuffer-window)))
+ (setq base-window (next-window base-window)))
+ (eq base-window
+ (next-window base-window (if nomini 'arg)))))
-(defun walk-windows (proc &optional minibuf all-screens)
+(defun walk-windows (proc &optional minibuf all-frames)
"Cycle through all visible windows, calling PROC for each one.
PROC is called with a window as argument.
Optional second arg MINIBUF t means count the minibuffer window
even if not active. If MINIBUF is neither t nor nil it means
not to count the minibuffer even if it is active.
-Optional third arg ALL-SCREENS t means include all windows in all screens;
-otherwise cycle within the selected screen."
+
+Optional third arg ALL-FRAMES, if t, means include all frames.
+ALL-FRAMES nil or omitted means cycle within the selected frame,
+but include the minibuffer window (if MINIBUF says so) that that
+frame uses, even if it is on another frame.
+If ALL-FRAMES is neither nil nor t, stick strictly to the selected frame."
(let* ((walk-windows-start (selected-window))
(walk-windows-current walk-windows-start))
(while (progn
(setq walk-windows-current
- (next-window walk-windows-current minibuf all-screens))
+ (next-window walk-windows-current minibuf all-frames))
(funcall proc walk-windows-current)
(not (eq walk-windows-current walk-windows-start))))))
-(defun read-quoted-char (&optional prompt)
- "Like `read-char', except that if the first character read is an octal
-digit, we read up to two more octal digits and return the character
-represented by the octal number consisting of those digits.
-Optional argument PROMPT specifies a string to use to prompt the user."
- (let ((count 0) (code 0) char)
- (while (< count 3)
- (let ((inhibit-quit (zerop count))
- (help-form nil))
- (and prompt (message "%s-" prompt))
- (setq char (read-char))
- (if inhibit-quit (setq quit-flag nil)))
- (cond ((null char))
- ((and (<= ?0 char) (<= char ?7))
- (setq code (+ (* code 8) (- char ?0))
- count (1+ count))
- (and prompt (message (setq prompt
- (format "%s %c" prompt char)))))
- ((> count 0)
- (setq unread-command-char char count 259))
- (t (setq code char count 259))))
- (logand 255 code)))
-
-(defun error (&rest args)
- "Signal an error, making error message by passing all args to `format'."
- (while t
- (signal 'error (list (apply 'format args)))))
+\f
+;;;; Keymap support.
(defun undefined ()
(interactive)
(define-key map (char-to-string loop) 'digit-argument)
(setq loop (1+ loop))))))
-;; now in fns.c
-;(defun nth (n list)
-; "Returns the Nth element of LIST.
-;N counts from zero. If LIST is not that long, nil is returned."
-; (car (nthcdr n list)))
-;
-;(defun copy-alist (alist)
-; "Return a copy of ALIST.
-;This is a new alist which represents the same mapping
-;from objects to objects, but does not share the alist structure with ALIST.
-;The objects mapped (cars and cdrs of elements of the alist)
-;are shared, however."
-; (setq alist (copy-sequence alist))
-; (let ((tail alist))
-; (while tail
-; (if (consp (car tail))
-; (setcar tail (cons (car (car tail)) (cdr (car tail)))))
-; (setq tail (cdr tail))))
-; alist)
-
;Moved to keymap.c
;(defun copy-keymap (keymap)
; "Return a copy of KEYMAP"
; (copy-sequence keymap)
; (copy-alist keymap)))
-(defun substitute-key-definition (olddef newdef keymap)
+(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
"Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
In other words, OLDDEF is replaced with NEWDEF where ever it appears.
-Prefix keymaps reached from KEYMAP are not checked recursively;
-perhaps they ought to be."
- (if (arrayp keymap)
- (let ((len (length keymap))
- (i 0))
- (while (< i len)
- (if (eq (aref keymap i) olddef)
- (aset keymap i newdef))
- (setq i (1+ i))))
- (while keymap
- (if (eq (cdr-safe (car-safe keymap)) olddef)
- (setcdr (car keymap) newdef))
- (setq keymap (cdr keymap)))))
-
-;; Avoids useless byte-compilation.
-;; In the future, would be better to fix byte compiler
-;; not to really compile in cases like this,
-;; and use defun here.
-(fset 'ignore '(lambda (&rest ignore)
- "Do nothing.
-Accept any number of arguments, but ignore them."
- nil))
+If optional fourth argument OLDMAP is specified, we redefine
+in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
+ (or prefix (setq prefix ""))
+ (let* ((scan (or oldmap keymap))
+ (vec1 (vector nil))
+ (prefix1 (vconcat prefix vec1)))
+ ;; Scan OLDMAP, finding each char or event-symbol that
+ ;; has any definition, and act on it with hack-key.
+ (while (consp scan)
+ (if (consp (car scan))
+ (let ((char (car (car scan)))
+ (defn (cdr (car scan))))
+ ;; The inside of this let duplicates exactly
+ ;; the inside of the following let that handles array elements.
+ (aset vec1 0 char)
+ (aset prefix1 (length prefix) char)
+ (let (inner-def)
+ ;; Skip past menu-prompt.
+ (while (stringp (car-safe 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 (eq defn olddef)
+ (define-key keymap prefix1 newdef)
+ (if (keymapp defn)
+ (substitute-key-definition olddef newdef keymap
+ inner-def
+ prefix1)))))
+ (if (arrayp (car scan))
+ (let* ((array (car scan))
+ (len (length array))
+ (i 0))
+ (while (< i len)
+ (let ((char i) (defn (aref array i)))
+ ;; The inside of this let duplicates exactly
+ ;; the inside of the previous let.
+ (aset vec1 0 char)
+ (aset prefix1 (length prefix) char)
+ (let (inner-def)
+ ;; Skip past menu-prompt.
+ (while (stringp (car-safe 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 (eq defn olddef)
+ (define-key keymap prefix1 newdef)
+ (if (keymapp defn)
+ (substitute-key-definition olddef newdef keymap
+ inner-def
+ prefix1)))))
+ (setq i (1+ i))))))
+ (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.
+KEY must contain just one event type--it must be a string or vector
+of length 1."
+ (or (keymapp keymap)
+ (signal 'wrong-type-argument (list 'keymapp keymap)))
+ (if (> (length key) 1)
+ (error "multi-event key specified in `define-key-after'"))
+ (let ((tail keymap) done inserted
+ (first (aref key 0)))
+ (while (and (not done) tail)
+ ;; Delete any earlier bindings for the same key.
+ (if (eq (car-safe (car (cdr tail))) first)
+ (setcdr tail (cdr (cdr tail))))
+ ;; 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)
+ (eq (car (cdr tail)) 'keymap)
+ (null (cdr tail)))
+ (progn
+ ;; Stop the scan only if we find a parent keymap.
+ ;; Keep going past the inserted element
+ ;; so we can delete any duplications that come later.
+ (if (eq (car (cdr tail)) 'keymap)
+ (setq done t))
+ ;; Don't insert more than once.
+ (or inserted
+ (setcdr tail (cons (cons (aref key 0) definition) (cdr tail))))
+ (setq inserted t)))
+ (setq tail (cdr tail)))))
+
+(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))))
+ (aset keyboard-translate-table from to))
\f
-; old names
-(fset 'make-syntax-table 'copy-syntax-table)
-(fset 'dot 'point)
-(fset 'dot-marker 'point-marker)
-(fset 'dot-min 'point-min)
-(fset 'dot-max 'point-max)
-(fset 'window-dot 'window-point)
-(fset 'set-window-dot 'set-window-point)
-(fset 'read-input 'read-string)
-(fset 'send-string 'process-send-string)
-(fset 'send-region 'process-send-region)
-(fset 'show-buffer 'set-window-buffer)
-(fset 'buffer-flush-undo 'buffer-disable-undo)
-(fset 'eval-current-buffer 'eval-buffer)
-
-; alternate names
-(fset 'string= 'string-equal)
-(fset 'string< 'string-lessp)
-(fset 'move-marker 'set-marker)
-(fset 'eql 'eq)
-(fset 'not 'null)
-(fset 'numberp 'integerp)
-(fset 'rplaca 'setcar)
-(fset 'rplacd 'setcdr)
-(fset 'beep 'ding) ;preserve lingual purtity
-(fset 'indent-to-column 'indent-to)
-(fset 'backward-delete-char 'delete-backward-char)
-(fset 'search-forward-regexp (symbol-function 're-search-forward))
-(fset 'search-backward-regexp (symbol-function 're-search-backward))
-\f
-;;; global-map, esc-map, and ctl-x-map have their values set up
-;;; in keymap.c.
+;;;; 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.
+
(defvar global-map nil
"Default global keymap mapping Emacs keyboard input into commands.
The value is a keymap which is usually (but not necessarily) Emacs's
(defvar ctl-x-4-map (make-sparse-keymap)
"Keymap for subcommands of C-x 4")
-(fset 'ctl-x-4-prefix ctl-x-4-map)
+(defalias 'ctl-x-4-prefix ctl-x-4-map)
(define-key ctl-x-map "4" 'ctl-x-4-prefix)
-(defvar ctl-x-3-map (make-sparse-keymap)
- "Keymap for screen commands.")
-(fset 'ctl-x-3-prefix ctl-x-3-map)
-(define-key ctl-x-map "3" 'ctl-x-3-prefix)
+(defvar ctl-x-5-map (make-sparse-keymap)
+ "Keymap for frame commands.")
+(defalias 'ctl-x-5-prefix ctl-x-5-map)
+(define-key ctl-x-map "5" 'ctl-x-5-prefix)
\f
+;;;; Event manipulation functions.
+
+;; This code exists specifically to make sure that the
+;; resulting number does not appear in the .elc file.
+;; The number is negative on most machines, but not on all!
+(defconst listify-key-sequence-1
+ (lsh 1 7))
+(setq listify-key-sequence-1 (logior (lsh 1 23) listify-key-sequence-1))
+
+(defun listify-key-sequence (key)
+ "Convert a key sequence to a list of events."
+ (if (vectorp key)
+ (append key nil)
+ (mapcar (function (lambda (c)
+ (if (> c 127)
+ (logxor c listify-key-sequence-1)
+ c)))
+ (append key nil))))
+
+(defsubst eventp (obj)
+ "True if the argument is an event object."
+ (or (integerp obj)
+ (and (symbolp obj)
+ (get obj 'event-symbol-elements))
+ (and (consp obj)
+ (symbolp (car obj))
+ (get (car obj) 'event-symbol-elements))))
+
+(defun event-modifiers (event)
+ "Returns a list of symbols representing the modifier keys in event EVENT.
+The elements of the list may include `meta', `control',
+`shift', `hyper', `super', `alt', `click', `drag', and `down'."
+ (let ((type event))
+ (if (listp type)
+ (setq type (car type)))
+ (if (symbolp type)
+ (cdr (get type 'event-symbol-elements))
+ (let ((list nil))
+ (or (zerop (logand type (lsh 1 23)))
+ (setq list (cons 'meta list)))
+ (or (and (zerop (logand type (lsh 1 22)))
+ (>= (logand type 127) 32))
+ (setq list (cons 'control list)))
+ (or (and (zerop (logand type (lsh 1 21)))
+ (= (logand type 255) (downcase (logand type 255))))
+ (setq list (cons 'shift list)))
+ (or (zerop (logand type (lsh 1 20)))
+ (setq list (cons 'hyper list)))
+ (or (zerop (logand type (lsh 1 19)))
+ (setq list (cons 'super list)))
+ (or (zerop (logand type (lsh 1 18)))
+ (setq list (cons 'alt list)))
+ list))))
+
+(defun event-basic-type (event)
+ "Returns the basic type of the given event (all modifiers removed).
+The value is an ASCII printing character (not upper case) or a symbol."
+ (if (consp event)
+ (setq event (car event)))
+ (if (symbolp event)
+ (car (get event 'event-symbol-elements))
+ (let ((base (logand event (1- (lsh 1 18)))))
+ (downcase (if (< base 32) (logior base 64) base)))))
+
+(defsubst mouse-movement-p (object)
+ "Return non-nil if OBJECT is a mouse movement event."
+ (and (consp object)
+ (eq (car object) 'mouse-movement)))
+
+(defsubst event-start (event)
+ "Return the starting position of EVENT.
+If EVENT is a mouse press or a mouse click, this returns the location
+of the event.
+If EVENT is a drag, this returns the drag's starting position.
+The return value is of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+The `posn-' functions access elements of such lists."
+ (nth 1 event))
+
+(defsubst event-end (event)
+ "Return the ending location of EVENT. EVENT should be a click or drag event.
+If EVENT is a click event, this function is the same as `event-start'.
+The return value is of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+The `posn-' functions access elements of such lists."
+ (nth (if (consp (nth 2 event)) 2 1) event))
+
+(defsubst posn-window (position)
+ "Return the window in POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+as returned by the `event-start' and `event-end' functions."
+ (nth 0 position))
+
+(defsubst posn-point (position)
+ "Return the buffer location in POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+as returned by the `event-start' and `event-end' functions."
+ (if (consp (nth 1 position))
+ (car (nth 1 position))
+ (nth 1 position)))
+
+(defsubst posn-col-row (position)
+ "Return the row and column in POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+as returned by the `event-start' and `event-end' functions."
+ (nth 2 position))
+
+(defsubst posn-timestamp (position)
+ "Return the timestamp of POSITION.
+POSITION should be a list of the form
+ (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
+as returned by the `event-start' and `event-end' functions."
+ (nth 3 position))
+
+\f
+;;;; Obsolescent names for functions.
+
+(defalias 'make-syntax-table 'copy-syntax-table)
+(defalias 'dot 'point)
+(defalias 'dot-marker 'point-marker)
+(defalias 'dot-min 'point-min)
+(defalias 'dot-max 'point-max)
+(defalias 'window-dot 'window-point)
+(defalias 'set-window-dot 'set-window-point)
+(defalias 'read-input 'read-string)
+(defalias 'send-string 'process-send-string)
+(defalias 'send-region 'process-send-region)
+(defalias 'show-buffer 'set-window-buffer)
+(defalias 'buffer-flush-undo 'buffer-disable-undo)
+(defalias 'eval-current-buffer 'eval-buffer)
+(defalias 'compiled-function-p 'byte-code-function-p)
+
+;;; This name isn't mentioned in the manual, and we've been hoping to
+;;; phase it out, but there's still a lot of code out there, even for
+;;; Emacs 18.59, which uses mod. I'm going to let the byte compiler's
+;;; make-obsolete function to poke people a little more, and leave the
+;;; `mod' name around for a while longer.
+(defalias 'mod '%)
+
+;; 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."
+ baud-rate)
+
+\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)
+(defalias 'beep 'ding) ;preserve lingual purity
+(defalias 'indent-to-column 'indent-to)
+(defalias 'backward-delete-char 'delete-backward-char)
+(defalias 'search-forward-regexp (symbol-function 're-search-forward))
+(defalias 'search-backward-regexp (symbol-function 're-search-backward))
+(defalias 'int-to-string 'number-to-string)
+
+;;; Should this be an obsolete name? If you decide it should, you get
+;;; to go through all the sources and change them.
+(defalias 'string-to-int 'string-to-number)
+\f
+;;;; Hook manipulation functions.
+
(defun run-hooks (&rest hooklist)
"Takes hook names and runs each one in turn. Major mode functions use this.
Each argument should be a symbol, a hook variable.
"Variable by which C primitives find the function `run-hooks'.
Don't change it.")
-(defun add-hook (hook function)
- "Add to the value of HOOK the function FUNCTION unless already present.
-HOOK should be a symbol, and FUNCTION may be any valid function.
-HOOK's value should be a list of functions, not a single function.
-If HOOK is void, it is first set to nil."
+(defun add-hook (hook function &optional append)
+ "Add to the value of HOOK the function FUNCTION unless already present (it
+becomes the first hook on the list unless optional APPEND is non-nil, in
+which case it becomes the last). HOOK should be a symbol, and FUNCTION may be
+any valid function. HOOK's value should be a list of functions, not a single
+function. If HOOK is void, it is first set to nil."
(or (boundp hook) (set hook nil))
(or (if (consp function)
;; Clever way to tell whether a given lambda-expression
(let ((tail (assoc (cdr function) (symbol-value hook))))
(equal function tail))
(memq function (symbol-value hook)))
- (set hook (cons function (symbol-value hook)))))
+ (set hook
+ (if append
+ (nconc (symbol-value hook) (list function))
+ (cons function (symbol-value hook))))))
+
\f
+;;;; Specifying things to do after certain files are loaded.
+
+(defun eval-after-load (file form)
+ "Arrange that, if FILE is ever loaded, FORM will be run at that time.
+This makes or adds to an entry on `after-load-alist'.
+FILE should be the name of a library, with no directory name."
+ (or (assoc file after-load-alist)
+ (setq after-load-alist (cons (list file) after-load-alist)))
+ (nconc (assoc file after-load-alist) (list form))
+ form)
+
+(defun eval-next-after-load (file)
+ "Read the following input sexp, and run it whenever FILE is loaded.
+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
+;;;; Input and display facilities.
+
+(defun read-quoted-char (&optional prompt)
+ "Like `read-char', except that if the first character read is an octal
+digit, we read up to two more octal digits and return the character
+represented by the octal number consisting of those digits.
+Optional argument PROMPT specifies a string to use to prompt the user."
+ (let ((count 0) (code 0) char)
+ (while (< count 3)
+ (let ((inhibit-quit (zerop count))
+ (help-form nil))
+ (and prompt (message "%s-" prompt))
+ (setq char (read-char))
+ (if inhibit-quit (setq quit-flag nil)))
+ (cond ((null char))
+ ((and (<= ?0 char) (<= char ?7))
+ (setq code (+ (* code 8) (- char ?0))
+ count (1+ count))
+ (and prompt (message (setq prompt
+ (format "%s %c" prompt char)))))
+ ((> count 0)
+ (setq unread-command-events (list char) count 259))
+ (t (setq code char count 259))))
+ (logand 255 code)))
+
+(defun force-mode-line-update (&optional all)
+ "Force the mode-line of the current buffer to be redisplayed.
+With optional non-nil ALL then force then force redisplay of all mode-lines."
+ (if all (save-excursion (set-buffer (other-buffer))))
+ (set-buffer-modified-p (buffer-modified-p)))
+
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
Display remains until next character is typed.
(setq insert-end (point)))
(message (or message "Type %s to continue editing.")
(single-key-description exit-char))
- (let ((char (read-char)))
+ (let ((char (read-event)))
(or (eq char exit-char)
- (setq unread-command-char char))))
+ (setq unread-command-events (list char)))))
(if insert-end
(save-excursion
(delete-region pos insert-end)))
(setq buffer-file-name name)
(set-buffer-modified-p modified))))
+\f
+;;;; Miscellanea.
+
+(defun ignore (&rest ignore)
+ "Do nothing.
+Accept any number of arguments, but ignore them."
+ nil)
+
+(defun error (&rest args)
+ "Signal an error, making error message by passing all args to `format'."
+ (while t
+ (signal 'error (list (apply 'format args)))))
+
+(defun user-original-login-name ()
+ "Return user's login name from original login.
+This tries to remain unaffected by `su', by looking in environment variables."
+ (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
+
(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.
(apply 'start-process name buffer args)
(start-process name buffer shell-file-name "-c"
(concat "exec " (mapconcat 'identity args " ")))))
-\f
-(defun eval-after-load (file form)
- "Arrange that, if FILE is ever loaded, FORM will be run at that time.
-This makes or adds to an entry on `after-load-alist'.
-FILE should be the name of a library, with no directory name."
- (or (assoc file after-load-alist)
- (setq after-load-alist (cons (list file) after-load-alist)))
- (nconc (assoc file after-load-alist) (list form))
- form)
-
-(defun eval-next-after-load (file)
- "Read the following input sexp, and run it whenever FILE is loaded.
-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)))
-(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))))
-\f
-(defun user-original-login-name ()
- "Return user's login name from original login.
-This tries to remain unaffected by `su', by looking in environment variables."
- (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
-\f
-(defun force-mode-line-update (&optional all)
- "Force the mode-line of the current buffer to be redisplayed.
-With optional non-nil ALL then force then force redisplay of all mode-lines."
- (if all (save-excursion (set-buffer (other-buffer))))
- (set-buffer-modified-p (buffer-modified-p)))
-
-(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 (boundp 'keyboard-translate-table)
- (let ((table (make-string 256))
- (i 0))
- (while (< i 256)
- (aset table i i)
- (setq i (1+ i)))
- (setq keyboard-translate-table table)))
- (aset keyboard-translate-table from to))
+(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)))))
-\f
-(defmacro lambda (&rest cdr)
- "Macro which allows one to write (lambda ...) for anonymous functions
-instead of having to write (function (lambda ...)) or '(lambda ...), the
-latter of which won't get byte-compiled."
- (` (function (lambda (,@ cdr)))))
+;; now in fns.c
+;(defun nth (n list)
+; "Returns the Nth element of LIST.
+;N counts from zero. If LIST is not that long, nil is returned."
+; (car (nthcdr n list)))
+;
+;(defun copy-alist (alist)
+; "Return a copy of ALIST.
+;This is a new alist which represents the same mapping
+;from objects to objects, but does not share the alist structure with ALIST.
+;The objects mapped (cars and cdrs of elements of the alist)
+;are shared, however."
+; (setq alist (copy-sequence alist))
+; (let ((tail alist))
+; (while tail
+; (if (consp (car tail))
+; (setcar tail (cons (car (car tail)) (cdr (car tail)))))
+; (setq tail (cdr tail))))
+; alist)
;;; subr.el ends here
+