Return to subr.el CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp

Annotation of 43BSD/contrib/emacs/lisp/subr.el, revision 1.1.1.1

1.1       root        1: ;; Basic lisp subroutines for Emacs
                      2: ;; Copyright (C) 1985 Richard M. Stallman.
                      3: 
                      4: ;; This file is part of GNU Emacs.
                      5: 
                      6: ;; GNU Emacs is distributed in the hope that it will be useful,
                      7: ;; but WITHOUT ANY WARRANTY.  No author or distributor
                      8: ;; accepts responsibility to anyone for the consequences of using it
                      9: ;; or for whether it serves any particular purpose or works at all,
                     10: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
                     11: ;; License for full details.
                     12: 
                     13: ;; Everyone is granted permission to copy, modify and redistribute
                     14: ;; GNU Emacs, but only under the conditions described in the
                     15: ;; GNU Emacs General Public License.   A copy of this license is
                     16: ;; supposed to have been given to you along with GNU Emacs so you
                     17: ;; can know your rights and responsibilities.  It should be in a
                     18: ;; file named COPYING.  Among other things, the copyright notice
                     19: ;; and this notice must be preserved on all copies.
                     20: 
                     21: 
                     22: (defun read-quoted-char (&optional prompt)
                     23:   "Like  read-char, except that if the first character read is an octal
                     24: digit, we read up to two more octal digits and return the character
                     25: represented by the octal number consisting of those digits"
                     26:   (let ((count 0) (code 0) char)
                     27:     (while (< count 3)
                     28:       (let ((inhibit-quit (zerop count))
                     29:            (help-form nil))
                     30:        (and prompt (message "%s-" prompt))
                     31:        (setq char (read-char))
                     32:        (if inhibit-quit (setq quit-flag nil)))
                     33:       (cond ((null char))
                     34:            ((and (<= ?0 char) (<= char ?7))
                     35:             (setq code (+ (* code 8) (- char ?0))
                     36:                   count (1+ count))
                     37:             (and prompt (message (setq prompt
                     38:                                        (format "%s %c" prompt char)))))
                     39:            ((> count 0)
                     40:             (setq unread-command-char char count 259))
                     41:            (t (setq code char count 259))))
                     42:     (logand 255 code)))
                     43: 
                     44: (defun error (&rest format-args)
                     45:   "Signal an error, making error message by passing all args to  format."
                     46:   (while t
                     47:     (signal 'error (list (apply 'format format-args)))))
                     48: 
                     49: (defun undefined ()
                     50:   (interactive)
                     51:   (ding))
                     52: 
                     53: ;Prevent the \{...} documentation construct
                     54: ;from mentioning keys that run this command.
                     55: (put 'undefined 'suppress-keymap t)
                     56: 
                     57: (defun suppress-keymap (map &optional nodigits)
                     58:   "Make MAP override all buffer-modifying commands to be undefined.
                     59: Works by knowing which commands are normally buffer-modifying.
                     60: Normally also makes digits set numeric arg,
                     61: but optional second arg NODIGITS non-nil prevents this."
                     62:   (let ((i ? ))
                     63:     (while (< i 127)
                     64:       (aset map i 'undefined)
                     65:       (setq i (1+ i))))
                     66:   (or nodigits
                     67:       (let (loop)
                     68:        (aset map ?- 'negative-argument)
                     69:        ;; Make plain numbers do numeric args.
                     70:        (setq loop ?0)
                     71:        (while (<= loop ?9)
                     72:          (aset map loop 'digit-argument)
                     73:          (setq loop (1+ loop))))))
                     74: 
                     75: (defun copy-alist (alist)
                     76:   "Return a copy of ALIST.
                     77: This is a new alist which represents the same mapping
                     78: from objects to objects, but does not share the alist structure with ALIST.
                     79: The objects mapped (cars and cdrs of elements of the alist)
                     80: are shared, however."
                     81:   (setq alist (copy-sequence alist))
                     82:   (let ((tail alist))
                     83:     (while tail
                     84:       (if (consp (car tail))
                     85:          (setcar tail (cons (car (car tail)) (cdr (car tail)))))
                     86:       (setq tail (cdr tail))))
                     87:   alist)
                     88: 
                     89: (defun copy-keymap (keymap)
                     90:   "Return a copy of KEYMAP"  
                     91:   (while (not (keymapp keymap))
                     92:     (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
                     93:   (if (vectorp keymap)
                     94:       (copy-sequence keymap)
                     95:       (copy-alist keymap)))
                     96: 
                     97: (fset 'beep 'ding) ;preserve lingual purtity
                     98: 
                     99: ;; Avoids useless byte-compilation.
                    100: ;; In the future, would be better to fix byte compiler
                    101: ;; not to really compile in cases like this,
                    102: ;; and use defun here.
                    103: (fset 'ignore '(lambda (&rest ignore) nil))
                    104: 
                    105: ; old name
                    106: (fset 'make-syntax-table 'copy-syntax-table)
                    107: 
                    108: 
                    109: (defun run-hooks (&rest hooklist)
                    110:   "Takes hook names and runs each one in turn.  Major mode functions use this.
                    111: Each argument should be a symbol, a hook variable.
                    112: These symbols are processed in the order specified.
                    113: If a hook symbol has a non-nil value, that value is called
                    114: with no arguments to run the hook."
                    115:   (while hooklist
                    116:     (let ((sym (car hooklist)))
                    117:       (and (boundp sym)
                    118:           (symbol-value sym)
                    119:           (funcall (symbol-value sym))))
                    120:     (setq hooklist (cdr hooklist))))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.