lisp/subr.el

   1 ;;; subr.el --- basic lisp subroutines for Emacs
   2
   3 ;;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 ;;; Code:
  22
  23 \f
  24 ;;;; Lisp language features.
  25
  26 (defmacro lambda (&rest cdr)
  27   "Return a lambda expression.
  28 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
  29 self-quoting; the result of evaluating the lambda expression is the
  30 expression itself.  The lambda expression may then be treated as a
  31 function, i. e. stored as the function value of a symbol, passed to
  32 funcall or mapcar, etcetera.
  33 ARGS should take the same form as an argument list for a `defun'.
  34 DOCSTRING should be a string, as described for `defun'.  It may be omitted.
  35 INTERACTIVE should be a call to the function `interactive', which see.
  36 It may also be omitted.
  37 BODY should be a list of lisp expressions."
  38   ;; Note that this definition should not use backquotes; subr.el should not
  39   ;; depend on backquote.el.
  40   (list 'function (cons 'lambda cdr)))
  41
  42 ;;(defmacro defun-inline (name args &rest body)
  43 ;;  "Create an \"inline defun\" (actually a macro).
  44 ;;Use just like `defun'."
  45 ;;  (nconc (list 'defmacro name '(&rest args))
  46 ;;       (if (stringp (car body))
  47 ;;           (prog1 (list (car body))
  48 ;;             (setq body (or (cdr body) body))))
  49 ;;       (list (list 'cons (list 'quote
  50 ;;                               (cons 'lambda (cons args body)))
  51 ;;                   'args))))
  52
  53 \f
  54 ;;;; Window tree functions.
  55
  56 (defun one-window-p (&optional nomini)
  57   "Returns non-nil if there is only one window.
  58 Optional arg NOMINI non-nil means don't count the minibuffer
  59 even if it is active."
  60   (let ((base-window (selected-window)))
  61     (if (and nomini (eq base-window (minibuffer-window)))
  62         (setq base-window (next-window base-window)))
  63     (eq base-window
  64         (next-window base-window (if nomini 'arg)))))
  65
  66 (defun walk-windows (proc &optional minibuf all-frames)
  67   "Cycle through all visible windows, calling PROC for each one.
  68 PROC is called with a window as argument.
  69 Optional second arg MINIBUF t means count the minibuffer window
  70 even if not active.  If MINIBUF is neither t nor nil it means
  71 not to count the minibuffer even if it is active.
  72
  73 Optional third arg ALL-FRAMES, if t, means include all frames.
  74 ALL-FRAMES nil or omitted means cycle within the selected frame,
  75 but include the minibuffer window (if MINIBUF says so) that that
  76 frame uses, even if it is on another frame.
  77 If ALL-FRAMES is neither nil nor t, stick strictly to the selected frame."
  78   (let* ((walk-windows-start (selected-window))
  79          (walk-windows-current walk-windows-start))
  80     (while (progn
  81              (setq walk-windows-current
  82                    (next-window walk-windows-current minibuf all-frames))
  83              (funcall proc walk-windows-current)
  84              (not (eq walk-windows-current walk-windows-start))))))
  85
  86 \f
  87 ;;;; Keymap support.
  88
  89 (defun undefined ()
  90   (interactive)
  91   (ding))
  92
  93 ;Prevent the \{...} documentation construct
  94 ;from mentioning keys that run this command.
  95 (put 'undefined 'suppress-keymap t)
  96
  97 (defun suppress-keymap (map &optional nodigits)
  98   "Make MAP override all normally self-inserting keys to be undefined.
  99 Normally, as an exception, digits and minus-sign are set to make prefix args,
 100 but optional second arg NODIGITS non-nil treats them like other chars."
 101   (let ((i 0))
 102     (while (<= i 127)
 103       (if (eql (lookup-key global-map (char-to-string i)) 'self-insert-command)
 104           (define-key map (char-to-string i) 'undefined))
 105       (setq i (1+ i))))
 106   (or nodigits
 107       (let (loop)
 108         (define-key map "-" 'negative-argument)
 109         ;; Make plain numbers do numeric args.
 110         (setq loop ?0)
 111         (while (<= loop ?9)
 112           (define-key map (char-to-string loop) 'digit-argument)
 113           (setq loop (1+ loop))))))
 114
 115 ;Moved to keymap.c
 116 ;(defun copy-keymap (keymap)
 117 ;  "Return a copy of KEYMAP"
 118 ;  (while (not (keymapp keymap))
 119 ;    (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
 120 ;  (if (vectorp keymap)
 121 ;      (copy-sequence keymap)
 122 ;      (copy-alist keymap)))
 123
 124 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
 125   "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
 126 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
 127 If optional fourth argument OLDMAP is specified, we redefine
 128 in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
 129   (or prefix (setq prefix ""))
 130   (let* ((scan (or oldmap keymap))
 131          (vec1 (vector nil))
 132          (prefix1 (vconcat prefix vec1)))
 133     ;; Scan OLDMAP, finding each char or event-symbol that
 134     ;; has any definition, and act on it with hack-key.
 135     (while (consp scan)
 136       (if (consp (car scan))
 137           (let ((char (car (car scan)))
 138                 (defn (cdr (car scan))))
 139             ;; The inside of this let duplicates exactly
 140             ;; the inside of the following let that handles array elements.
 141             (aset vec1 0 char)
 142             (aset prefix1 (length prefix) char)
 143             (let (inner-def)
 144               ;; Skip past menu-prompt.
 145               (while (stringp (car-safe defn))
 146                 (setq defn (cdr defn)))
 147               (setq inner-def defn)
 148               (while (and (symbolp inner-def)
 149                           (fboundp inner-def))
 150                 (setq inner-def (symbol-function inner-def)))
 151               (if (eq defn olddef)
 152                   (define-key keymap prefix1 newdef)
 153                 (if (keymapp defn)
 154                     (substitute-key-definition olddef newdef keymap
 155                                                inner-def
 156                                                prefix1)))))
 157         (if (arrayp (car scan))
 158             (let* ((array (car scan))
 159                    (len (length array))
 160                    (i 0))
 161               (while (< i len)
 162                 (let ((char i) (defn (aref array i)))
 163                   ;; The inside of this let duplicates exactly
 164                   ;; the inside of the previous let.
 165                   (aset vec1 0 char)
 166                   (aset prefix1 (length prefix) char)
 167                   (let (inner-def)
 168                     ;; Skip past menu-prompt.
 169                     (while (stringp (car-safe defn))
 170                       (setq defn (cdr defn)))
 171                     (setq inner-def defn)
 172                     (while (and (symbolp inner-def)
 173                                 (fboundp inner-def))
 174                       (setq inner-def (symbol-function inner-def)))
 175                     (if (eq defn olddef)
 176                         (define-key keymap prefix1 newdef)
 177                       (if (keymapp defn)
 178                           (substitute-key-definition olddef newdef keymap
 179                                                      inner-def
 180                                                      prefix1)))))
 181                 (setq i (1+ i))))))
 182       (setq scan (cdr scan)))))
 183
 184 (defun define-key-after (keymap key definition after)
 185   "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
 186 This is like `define-key' except that the binding for KEY is placed
 187 just after the binding for the event AFTER, instead of at the beginning
 188 of the map.
 189 The order matters when the keymap is used as a menu."
 190   (or (keymapp keymap)
 191       (signal 'wrong-type-argument (list 'keymapp keymap)))
 192   (let ((tail keymap) done inserted
 193         (first (aref key 0)))
 194     (while (and (not done) tail)
 195       ;; Delete any earlier bindings for the same key.
 196       (if (eq (car-safe (car (cdr tail))) first)
 197           (setcdr tail (cdr (cdr tail))))
 198       ;; When we reach AFTER's binding, insert the new binding after.
 199       ;; If we reach an inherited keymap, insert just before that.
 200       ;; If we reach the end of this keymap, insert at the end.
 201       (if (or (eq (car-safe (car tail)) after)
 202               (eq (car (cdr tail)) 'keymap)
 203               (null (cdr tail)))
 204           (progn
 205             ;; Stop the scan only if we find a parent keymap.
 206             ;; Keep going past the inserted element
 207             ;; so we can delete any duplications that come later.
 208             (if (eq (car (cdr tail)) 'keymap)
 209                 (setq done t))
 210             ;; Don't insert more than once.
 211             (or inserted
 212                 (setcdr tail (cons (cons (aref key 0) definition) (cdr tail))))
 213             (setq inserted t)))
 214       (setq tail (cdr tail)))))
 215
 216 (defun keyboard-translate (from to)
 217   "Translate character FROM to TO at a low level.
 218 This function creates a `keyboard-translate-table' if necessary
 219 and then modifies one entry in it."
 220   (or (arrayp keyboard-translate-table)
 221       (setq keyboard-translate-table ""))
 222   (if (or (> from (length keyboard-translate-table))
 223           (> to   (length keyboard-translate-table)))
 224       (progn
 225         (let* ((i (length keyboard-translate-table))
 226                (table (make-string (- 256 i) 0)))
 227           (while (< i 256)
 228             (aset table i i)
 229             (setq i (1+ i)))
 230           (setq keyboard-translate-table table))))
 231   (aset keyboard-translate-table from to))
 232
 233 \f
 234 ;;;; The global keymap tree.
 235
 236 ;;; global-map, esc-map, and ctl-x-map have their values set up in
 237 ;;; keymap.c; we just give them docstrings here.
 238
 239 (defvar global-map nil
 240   "Default global keymap mapping Emacs keyboard input into commands.
 241 The value is a keymap which is usually (but not necessarily) Emacs's
 242 global map.")
 243
 244 (defvar esc-map nil
 245   "Default keymap for ESC (meta) commands.
 246 The normal global definition of the character ESC indirects to this keymap.")
 247
 248 (defvar ctl-x-map nil
 249   "Default keymap for C-x commands.
 250 The normal global definition of the character C-x indirects to this keymap.")
 251
 252 (defvar ctl-x-4-map (make-sparse-keymap)
 253   "Keymap for subcommands of C-x 4")
 254 (defalias 'ctl-x-4-prefix ctl-x-4-map)
 255 (define-key ctl-x-map "4" 'ctl-x-4-prefix)
 256
 257 (defvar ctl-x-5-map (make-sparse-keymap)
 258   "Keymap for frame commands.")
 259 (defalias 'ctl-x-5-prefix ctl-x-5-map)
 260 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
 261
 262 \f
 263 ;;;; Event manipulation functions.
 264
 265 ;; This code exists specifically to make sure that the
 266 ;; resulting number does not appear in the .elc file.
 267 ;; The number is negative on most machines, but not on all!
 268 (defconst listify-key-sequence-1
 269    (lsh 1 7))
 270 (setq listify-key-sequence-1 (logior (lsh 1 23) listify-key-sequence-1))
 271
 272 (defun listify-key-sequence (key)
 273   "Convert a key sequence to a list of events."
 274   (if (vectorp key)
 275       (append key nil)
 276     (mapcar (function (lambda (c)
 277                         (if (> c 127)
 278                             (logxor c listify-key-sequence-1)
 279                           c)))
 280             (append key nil))))
 281
 282 (defsubst eventp (obj)
 283   "True if the argument is an event object."
 284   (or (integerp obj)
 285       (and (symbolp obj)
 286            (get obj 'event-symbol-elements))
 287       (and (consp obj)
 288            (symbolp (car obj))
 289            (get (car obj) 'event-symbol-elements))))
 290
 291 (defun event-modifiers (event)
 292   "Returns a list of symbols representing the modifier keys in event EVENT.
 293 The elements of the list may include `meta', `control',
 294 `shift', `hyper', `super', `alt', `click', `drag', and `down'."
 295   (let ((type event))
 296     (if (listp type)
 297         (setq type (car type)))
 298     (if (symbolp type)
 299         (cdr (get type 'event-symbol-elements))
 300       (let ((list nil))
 301         (or (zerop (logand type (lsh 1 23)))
 302             (setq list (cons 'meta list)))
 303         (or (and (zerop (logand type (lsh 1 22)))
 304                  (>= (logand type 127) 32))
 305             (setq list (cons 'control list)))
 306         (or (and (zerop (logand type (lsh 1 21)))
 307                  (= (logand type 255) (downcase (logand type 255))))
 308             (setq list (cons 'shift list)))
 309         (or (zerop (logand type (lsh 1 20)))
 310             (setq list (cons 'hyper list)))
 311         (or (zerop (logand type (lsh 1 19)))
 312             (setq list (cons 'super list)))
 313         (or (zerop (logand type (lsh 1 18)))
 314             (setq list (cons 'alt list)))
 315         list))))
 316
 317 (defun event-basic-type (event)
 318   "Returns the basic type of the given event (all modifiers removed).
 319 The value is an ASCII printing character (not upper case) or a symbol."
 320   (if (consp event)
 321       (setq event (car event)))
 322   (if (symbolp event)
 323       (car (get event 'event-symbol-elements))
 324     (let ((base (logand event (1- (lsh 1 18)))))
 325       (downcase (if (< base 32) (logior base 64) base)))))
 326
 327 (defsubst mouse-movement-p (object)
 328   "Return non-nil if OBJECT is a mouse movement event."
 329   (and (consp object)
 330        (eq (car object) 'mouse-movement)))
 331
 332 (defsubst event-start (event)
 333   "Return the starting position of EVENT.
 334 If EVENT is a mouse press or a mouse click, this returns the location
 335 of the event.
 336 If EVENT is a drag, this returns the drag's starting position.
 337 The return value is of the form
 338    (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
 339 The `posn-' functions access elements of such lists."
 340   (nth 1 event))
 341
 342 (defsubst event-end (event)
 343   "Return the ending location of EVENT.  EVENT should be a click or drag event.
 344 If EVENT is a click event, this function is the same as `event-start'.
 345 The return value is of the form
 346    (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
 347 The `posn-' functions access elements of such lists."
 348   (nth (if (consp (nth 2 event)) 2 1) event))
 349
 350 (defsubst posn-window (position)
 351   "Return the window in POSITION.
 352 POSITION should be a list of the form
 353    (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
 354 as returned by the `event-start' and `event-end' functions."
 355   (nth 0 position))
 356
 357 (defsubst posn-point (position)
 358   "Return the buffer location in POSITION.
 359 POSITION should be a list of the form
 360    (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
 361 as returned by the `event-start' and `event-end' functions."
 362   (if (consp (nth 1 position))
 363       (car (nth 1 position))
 364     (nth 1 position)))
 365
 366 (defsubst posn-col-row (position)
 367   "Return the row and column in POSITION.
 368 POSITION should be a list of the form
 369    (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
 370 as returned by the `event-start' and `event-end' functions."
 371   (nth 2 position))
 372
 373 (defsubst posn-timestamp (position)
 374   "Return the timestamp of POSITION.
 375 POSITION should be a list of the form
 376    (WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
 377 as returned by the `event-start' and `event-end' functions."
 378   (nth 3 position))
 379
 380 \f
 381 ;;;; Obsolescent names for functions.
 382
 383 (defalias 'make-syntax-table 'copy-syntax-table)
 384 (defalias 'dot 'point)
 385 (defalias 'dot-marker 'point-marker)
 386 (defalias 'dot-min 'point-min)
 387 (defalias 'dot-max 'point-max)
 388 (defalias 'window-dot 'window-point)
 389 (defalias 'set-window-dot 'set-window-point)
 390 (defalias 'read-input 'read-string)
 391 (defalias 'send-string 'process-send-string)
 392 (defalias 'send-region 'process-send-region)
 393 (defalias 'show-buffer 'set-window-buffer)
 394 (defalias 'buffer-flush-undo 'buffer-disable-undo)
 395 (defalias 'eval-current-buffer 'eval-buffer)
 396 (defalias 'compiled-function-p 'byte-code-function-p)
 397
 398 ;;; This name isn't mentioned in the manual, and we've been hoping to
 399 ;;; phase it out, but there's still a lot of code out there, even for
 400 ;;; Emacs 18.59, which uses mod.  I'm going to let the byte compiler's
 401 ;;; make-obsolete function to poke people a little more, and leave the
 402 ;;; `mod' name around for a while longer.
 403 (defalias 'mod '%)
 404
 405 ;; Some programs still use this as a function.
 406 (defun baud-rate ()
 407   "Obsolete function returning the value of the `baud-rate' variable.
 408 Please convert your programs to use the variable `baud-rate' directly."
 409   baud-rate)
 410
 411 \f
 412 ;;;; Alternate names for functions - these are not being phased out.
 413
 414 (defalias 'string= 'string-equal)
 415 (defalias 'string< 'string-lessp)
 416 (defalias 'move-marker 'set-marker)
 417 (defalias 'eql 'eq)
 418 (defalias 'not 'null)
 419 (defalias 'rplaca 'setcar)
 420 (defalias 'rplacd 'setcdr)
 421 (defalias 'beep 'ding) ;preserve lingual purity
 422 (defalias 'indent-to-column 'indent-to)
 423 (defalias 'backward-delete-char 'delete-backward-char)
 424 (defalias 'search-forward-regexp (symbol-function 're-search-forward))
 425 (defalias 'search-backward-regexp (symbol-function 're-search-backward))
 426 (defalias 'int-to-string 'number-to-string)
 427
 428 ;;; Should this be an obsolete name?  If you decide it should, you get
 429 ;;; to go through all the sources and change them.
 430 (defalias 'string-to-int 'string-to-number)
 431 \f
 432 ;;;; Hook manipulation functions.
 433
 434 (defun run-hooks (&rest hooklist)
 435   "Takes hook names and runs each one in turn.  Major mode functions use this.
 436 Each argument should be a symbol, a hook variable.
 437 These symbols are processed in the order specified.
 438 If a hook symbol has a non-nil value, that value may be a function
 439 or a list of functions to be called to run the hook.
 440 If the value is a function, it is called with no arguments.
 441 If it is a list, the elements are called, in order, with no arguments."
 442   (while hooklist
 443     (let ((sym (car hooklist)))
 444       (and (boundp sym)
 445            (symbol-value sym)
 446            (let ((value (symbol-value sym)))
 447              (if (and (listp value) (not (eq (car value) 'lambda)))
 448                  (mapcar 'funcall value)
 449                (funcall value)))))
 450     (setq hooklist (cdr hooklist))))
 451
 452 ;; Tell C code how to call this function.
 453 (defconst run-hooks 'run-hooks
 454   "Variable by which C primitives find the function `run-hooks'.
 455 Don't change it.")
 456
 457 (defun add-hook (hook function &optional append)
 458   "Add to the value of HOOK the function FUNCTION unless already present (it
 459 becomes the first hook on the list unless optional APPEND is non-nil, in
 460 which case it becomes the last).  HOOK should be a symbol, and FUNCTION may be
 461 any valid function.  HOOK's value should be a list of functions, not a single
 462 function.  If HOOK is void, it is first set to nil."
 463   (or (boundp hook) (set hook nil))
 464   (or (if (consp function)
 465           ;; Clever way to tell whether a given lambda-expression
 466           ;; is equal to anything in the hook.
 467           (let ((tail (assoc (cdr function) (symbol-value hook))))
 468             (equal function tail))
 469         (memq function (symbol-value hook)))
 470       (set hook
 471            (if append
 472                (nconc (symbol-value hook) (list function))
 473              (cons function (symbol-value hook))))))
 474
 475 \f
 476 ;;;; Specifying things to do after certain files are loaded.
 477
 478 (defun eval-after-load (file form)
 479   "Arrange that, if FILE is ever loaded, FORM will be run at that time.
 480 This makes or adds to an entry on `after-load-alist'.
 481 FILE should be the name of a library, with no directory name."
 482   (or (assoc file after-load-alist)
 483       (setq after-load-alist (cons (list file) after-load-alist)))
 484   (nconc (assoc file after-load-alist) (list form))
 485   form)
 486
 487 (defun eval-next-after-load (file)
 488   "Read the following input sexp, and run it whenever FILE is loaded.
 489 This makes or adds to an entry on `after-load-alist'.
 490 FILE should be the name of a library, with no directory name."
 491   (eval-after-load file (read)))
 492
 493 \f
 494 ;;;; Input and display facilities.
 495
 496 (defun read-quoted-char (&optional prompt)
 497   "Like `read-char', except that if the first character read is an octal
 498 digit, we read up to two more octal digits and return the character
 499 represented by the octal number consisting of those digits.
 500 Optional argument PROMPT specifies a string to use to prompt the user."
 501   (let ((count 0) (code 0) char)
 502     (while (< count 3)
 503       (let ((inhibit-quit (zerop count))
 504             (help-form nil))
 505         (and prompt (message "%s-" prompt))
 506         (setq char (read-char))
 507         (if inhibit-quit (setq quit-flag nil)))
 508       (cond ((null char))
 509             ((and (<= ?0 char) (<= char ?7))
 510              (setq code (+ (* code 8) (- char ?0))
 511                    count (1+ count))
 512              (and prompt (message (setq prompt
 513                                         (format "%s %c" prompt char)))))
 514             ((> count 0)
 515              (setq unread-command-events (list char) count 259))
 516             (t (setq code char count 259))))
 517     (logand 255 code)))
 518
 519 (defun force-mode-line-update (&optional all)
 520   "Force the mode-line of the current buffer to be redisplayed.
 521 With optional non-nil ALL then force then force redisplay of all mode-lines."
 522   (if all (save-excursion (set-buffer (other-buffer))))
 523   (set-buffer-modified-p (buffer-modified-p)))
 524
 525 (defun momentary-string-display (string pos &optional exit-char message)
 526   "Momentarily display STRING in the buffer at POS.
 527 Display remains until next character is typed.
 528 If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;
 529 otherwise it is then available as input (as a command if nothing else).
 530 Display MESSAGE (optional fourth arg) in the echo area.
 531 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
 532   (or exit-char (setq exit-char ?\ ))
 533   (let ((buffer-read-only nil)
 534         (modified (buffer-modified-p))
 535         (name buffer-file-name)
 536         insert-end)
 537     (unwind-protect
 538         (progn
 539           (save-excursion
 540             (goto-char pos)
 541             ;; defeat file locking... don't try this at home, kids!
 542             (setq buffer-file-name nil)
 543             (insert-before-markers string)
 544             (setq insert-end (point)))
 545           (message (or message "Type %s to continue editing.")
 546                    (single-key-description exit-char))
 547           (let ((char (read-event)))
 548             (or (eq char exit-char)
 549                 (setq unread-command-events (list char)))))
 550       (if insert-end
 551           (save-excursion
 552             (delete-region pos insert-end)))
 553       (setq buffer-file-name name)
 554       (set-buffer-modified-p modified))))
 555
 556 \f
 557 ;;;; Miscellanea.
 558
 559 (defun ignore (&rest ignore)
 560   "Do nothing.
 561 Accept any number of arguments, but ignore them."
 562   nil)
 563
 564 (defun error (&rest args)
 565   "Signal an error, making error message by passing all args to `format'."
 566   (while t
 567     (signal 'error (list (apply 'format args)))))
 568
 569 (defun user-original-login-name ()
 570   "Return user's login name from original login.
 571 This tries to remain unaffected by `su', by looking in environment variables."
 572   (or (getenv "LOGNAME") (getenv "USER") (user-login-name)))
 573
 574 (defun start-process-shell-command (name buffer &rest args)
 575   "Start a program in a subprocess.  Return the process object for it.
 576 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
 577 NAME is name for process.  It is modified if necessary to make it unique.
 578 BUFFER is the buffer or (buffer-name) to associate with the process.
 579  Process output goes at end of that buffer, unless you specify
 580  an output stream or filter function to handle the output.
 581  BUFFER may be also nil, meaning that this process is not associated
 582  with any buffer
 583 Third arg is command name, the name of a shell command.
 584 Remaining arguments are the arguments for the command.
 585 Wildcards and redirection are handle as usual in the shell."
 586   (if (eq system-type 'vax-vms)
 587       (apply 'start-process name buffer args)
 588     (start-process name buffer shell-file-name "-c"
 589                    (concat "exec " (mapconcat 'identity args " ")))))
 590
 591 (defmacro save-match-data (&rest body)
 592   "Execute the BODY forms, restoring the global value of the match data."
 593   (let ((original (make-symbol "match-data")))
 594     (list
 595      'let (list (list original '(match-data)))
 596      (list 'unwind-protect
 597            (cons 'progn body)
 598            (list 'store-match-data original)))))
 599
 600 ;; now in fns.c
 601 ;(defun nth (n list)
 602 ;  "Returns the Nth element of LIST.
 603 ;N counts from zero.  If LIST is not that long, nil is returned."
 604 ;  (car (nthcdr n list)))
 605 ;
 606 ;(defun copy-alist (alist)
 607 ;  "Return a copy of ALIST.
 608 ;This is a new alist which represents the same mapping
 609 ;from objects to objects, but does not share the alist structure with ALIST.
 610 ;The objects mapped (cars and cdrs of elements of the alist)
 611 ;are shared, however."
 612 ;  (setq alist (copy-sequence alist))
 613 ;  (let ((tail alist))
 614 ;    (while tail
 615 ;      (if (consp (car tail))
 616 ;         (setcar tail (cons (car (car tail)) (cdr (car tail)))))
 617 ;      (setq tail (cdr tail))))
 618 ;  alist)
 619
 620 ;;; subr.el ends here
 621