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     ! 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.