Return to subr.el CVS log

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

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/subr.el, revision 1.1

1.1     ! root        1: ;; Basic lisp subroutines for Emacs
        !             2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
        !             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 one-window-p (&optional arg)
        !            23:   "Returns non-nil if there is only one window.
        !            24: Optional arg NOMINI non-nil means don't count the minibuffer
        !            25: even if it is active."
        !            26:   (eq (selected-window)
        !            27:       (next-window (selected-window) (if arg 'arg))))
        !            28: 
        !            29: (defun read-quoted-char (&optional prompt)
        !            30:   "Like `read-char', except that if the first character read is an octal
        !            31: digit, we read up to two more octal digits and return the character
        !            32: represented by the octal number consisting of those digits.
        !            33: Optional argument PROMPT specifies a string to use to prompt the user."
        !            34:   (let ((count 0) (code 0) char)
        !            35:     (while (< count 3)
        !            36:       (let ((inhibit-quit (zerop count))
        !            37:            (help-form nil))
        !            38:        (and prompt (message "%s-" prompt))
        !            39:        (setq char (read-char))
        !            40:        (if inhibit-quit (setq quit-flag nil)))
        !            41:       (cond ((null char))
        !            42:            ((and (<= ?0 char) (<= char ?7))
        !            43:             (setq code (+ (* code 8) (- char ?0))
        !            44:                   count (1+ count))
        !            45:             (and prompt (message (setq prompt
        !            46:                                        (format "%s %c" prompt char)))))
        !            47:            ((> count 0)
        !            48:             (setq unread-command-char char count 259))
        !            49:            (t (setq code char count 259))))
        !            50:     (logand 255 code)))
        !            51: 
        !            52: (defun error (&rest args)
        !            53:   "Signal an error, making error message by passing all args to `format'."
        !            54:   (while t
        !            55:     (signal 'error (list (apply 'format args)))))
        !            56: 
        !            57: (defun undefined ()
        !            58:   (interactive)
        !            59:   (ding))
        !            60: 
        !            61: ;Prevent the \{...} documentation construct
        !            62: ;from mentioning keys that run this command.
        !            63: (put 'undefined 'suppress-keymap t)
        !            64: 
        !            65: (defun suppress-keymap (map &optional arg)
        !            66:   "Make MAP override all buffer-modifying commands to be undefined.
        !            67: Works by knowing which commands are normally buffer-modifying.
        !            68: Normally also makes digits set numeric arg,
        !            69: but optional second arg NODIGITS non-nil prevents this."
        !            70:   (let ((i ? ))
        !            71:     (while (< i 127)
        !            72:       (aset map i 'undefined)
        !            73:       (setq i (1+ i))))
        !            74:   (or arg
        !            75:       (let (loop)
        !            76:        (aset map ?- 'negative-argument)
        !            77:        ;; Make plain numbers do numeric args.
        !            78:        (setq loop ?0)
        !            79:        (while (<= loop ?9)
        !            80:          (aset map loop 'digit-argument)
        !            81:          (setq loop (1+ loop))))))
        !            82: 
        !            83: ;; now in fns.c
        !            84: ;(defun nth (n list)
        !            85: ;  "Returns the Nth element of LIST.
        !            86: ;N counts from zero.  If LIST is not that long, nil is returned."
        !            87: ;  (car (nthcdr n list)))
        !            88: ;
        !            89: ;(defun copy-alist (alist)
        !            90: ;  "Return a copy of ALIST.
        !            91: ;This is a new alist which represents the same mapping
        !            92: ;from objects to objects, but does not share the alist structure with ALIST.
        !            93: ;The objects mapped (cars and cdrs of elements of the alist)
        !            94: ;are shared, however."
        !            95: ;  (setq alist (copy-sequence alist))
        !            96: ;  (let ((tail alist))
        !            97: ;    (while tail
        !            98: ;      (if (consp (car tail))
        !            99: ;        (setcar tail (cons (car (car tail)) (cdr (car tail)))))
        !           100: ;      (setq tail (cdr tail))))
        !           101: ;  alist)
        !           102: 
        !           103: ;Moved to keymap.c
        !           104: ;(defun copy-keymap (keymap)
        !           105: ;  "Return a copy of KEYMAP"  
        !           106: ;  (while (not (keymapp keymap))
        !           107: ;    (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
        !           108: ;  (if (vectorp keymap)
        !           109: ;      (copy-sequence keymap)
        !           110: ;      (copy-alist keymap)))
        !           111: 
        !           112: (defun substitute-key-definition (olddef newdef keymap)
        !           113:   "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
        !           114: In other words, OLDDEF is replaced with NEWDEF where ever it appears."
        !           115:   (if (arrayp keymap)
        !           116:       (let ((len (length keymap))
        !           117:            (i 0))
        !           118:        (while (< i len)
        !           119:          (if (eq (aref keymap i) olddef)
        !           120:              (aset keymap i newdef))
        !           121:          (setq i (1+ i))))
        !           122:     (while keymap
        !           123:       (if (eq (cdr-safe (car-safe keymap)) olddef)
        !           124:          (setcdr (car keymap) newdef))
        !           125:       (setq keymap (cdr keymap)))))
        !           126: 
        !           127: ;; Avoids useless byte-compilation.
        !           128: ;; In the future, would be better to fix byte compiler
        !           129: ;; not to really compile in cases like this,
        !           130: ;; and use defun here.
        !           131: (fset 'ignore '(lambda (&rest ignore) nil))
        !           132: 
        !           133: 
        !           134: ; old names
        !           135: (fset 'make-syntax-table 'copy-syntax-table)
        !           136: (fset 'dot 'point)
        !           137: (fset 'dot-marker 'point-marker)
        !           138: (fset 'dot-min 'point-min)
        !           139: (fset 'dot-max 'point-max)
        !           140: (fset 'window-dot 'window-point)
        !           141: (fset 'set-window-dot 'set-window-point)
        !           142: (fset 'read-input 'read-string)
        !           143: (fset 'send-string 'process-send-string)
        !           144: (fset 'send-region 'process-send-region)
        !           145: (fset 'show-buffer 'set-window-buffer)
        !           146: 
        !           147: ; alternate names
        !           148: (fset 'string= 'string-equal)
        !           149: (fset 'string< 'string-lessp)
        !           150: (fset 'mod '%)
        !           151: (fset 'move-marker 'set-marker)
        !           152: (fset 'eql 'eq)
        !           153: (fset 'not 'null)
        !           154: (fset 'numberp 'integerp)
        !           155: (fset 'rplaca 'setcar)
        !           156: (fset 'rplacd 'setcdr)
        !           157: (fset 'beep 'ding) ;preserve lingual purtity
        !           158: (fset 'indent-to-column 'indent-to)
        !           159: (fset 'backward-delete-char 'delete-backward-char)
        !           160: 
        !           161: (defvar global-map nil
        !           162:   "Default global keymap mapping Emacs keyboard input into commands.
        !           163: The value is a keymap which is usually (but not necessarily) Emacs's
        !           164: global map.")
        !           165: 
        !           166: (defvar ctl-x-map nil
        !           167:   "Default keymap for C-x commands.
        !           168: The normal global definition of the character C-x indirects to this keymap.")
        !           169: 
        !           170: (defvar esc-map nil
        !           171:   "Default keymap for ESC (meta) commands.
        !           172: The normal global definition of the character ESC indirects to this keymap.")
        !           173: 
        !           174: (defvar mouse-map nil
        !           175:   "Keymap for mouse commands from the X window system.")
        !           176: 
        !           177: (defun run-hooks (&rest hooklist)
        !           178:   "Takes hook names and runs each one in turn.  Major mode functions use this.
        !           179: Each argument should be a symbol, a hook variable.
        !           180: These symbols are processed in the order specified.
        !           181: If a hook symbol has a non-nil value, that value may be a function
        !           182: or a list of functions to be called to run the hook.
        !           183: If the value is a function, it is called with no arguments.
        !           184: If it is a list, the elements are called, in order, with no arguments."
        !           185:   (while hooklist
        !           186:     (let ((sym (car hooklist)))
        !           187:       (and (boundp sym)
        !           188:           (symbol-value sym)
        !           189:           (let ((value (symbol-value sym)))
        !           190:             (if (and (listp value) (not (eq (car value) 'lambda)))
        !           191:                 (mapcar 'funcall value)
        !           192:               (funcall value)))))
        !           193:     (setq hooklist (cdr hooklist))))
        !           194: 
        !           195: (defun momentary-string-display (string pos &optional exit-char message) 
        !           196:   "Momentarily display STRING in the buffer at POS.
        !           197: Display remains until next character is typed.
        !           198: If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;
        !           199: otherwise it is then available as input (as a command if nothing else).
        !           200: Display MESSAGE (optional fourth arg) in the echo area.
        !           201: If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
        !           202:   (or exit-char (setq exit-char ?\ ))
        !           203:   (let ((buffer-read-only nil)
        !           204:        (modified (buffer-modified-p))
        !           205:        (name buffer-file-name)
        !           206:        insert-end)
        !           207:     (unwind-protect
        !           208:        (progn
        !           209:          (save-excursion
        !           210:            (goto-char pos)
        !           211:            ;; defeat file locking... don't try this at home, kids!
        !           212:            (setq buffer-file-name nil)
        !           213:            (insert-before-markers string)
        !           214:            (setq insert-end (point)))
        !           215:          (message (or message "Type %s to continue editing.")
        !           216:                   (single-key-description exit-char))
        !           217:          (let ((char (read-char)))
        !           218:            (or (eq char exit-char)
        !           219:                (setq unread-command-char char))))
        !           220:       (if insert-end
        !           221:          (save-excursion
        !           222:            (delete-region pos insert-end)))
        !           223:       (setq buffer-file-name name)
        !           224:       (set-buffer-modified-p modified))))

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