;;; subr.el --- basic lisp subroutines for Emacs
-;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001
+;; Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
(setq m (1+ m) p (cdr p)))
(if (<= n 0) p
(if (< n m) (nthcdr (- m n) x) x)))
- (while (cdr x)
+ (while (consp (cdr x))
(setq x (cdr x)))
x))
+(defun butlast (x &optional n)
+ "Returns a copy of LIST with the last N elements removed."
+ (if (and n (<= n 0)) x
+ (nbutlast (copy-sequence x) n)))
+
+(defun nbutlast (x &optional n)
+ "Modifies LIST to remove the last N elements."
+ (let ((m (length x)))
+ (or n (setq n 1))
+ (and (< n m)
+ (progn
+ (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
+ x))))
+
(defun remove (elt seq)
"Return a copy of SEQ with all occurences of ELT removed.
SEQ must be a list, vector, or string. The comparison is done with `equal'."
"Like `member', but ignores differences in case and text representation.
ELT must be a string. Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
- (let (element)
- (while (and list (not element))
- (if (eq t (compare-strings elt 0 nil (car list) 0 nil t))
- (setq element (car list)))
- (setq list (cdr list)))
- element))
+ (while (and list (not (eq t (compare-strings elt 0 nil (car list) 0 nil t))))
+ (setq list (cdr list)))
+ list)
\f
;;;; Keymap support.
(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."
+The value is a printing character (not upper case) or a symbol."
(if (consp event)
(setq event (car event)))
(if (symbolp event)
"Make the hook HOOK local to the current buffer.
The return value is HOOK.
+You never need to call this function now that `add-hook' does it for you
+if its LOCAL argument is non-nil.
+
When a hook is local, its local and global values
work in concert: running the hook actually runs all the hook
functions listed in *either* the local value *or* the global value
function, it is changed to a list of functions."
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
- (if local (make-local-hook hook)
+ (if local (unless (local-variable-if-set-p hook) (make-local-hook hook))
;; Detect the case where make-local-variable was used on a hook
;; and do what we used to do.
(unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
`make-local-hook', not `make-local-variable'."
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
- (if local (make-local-hook hook)
+ (if local (unless (local-variable-if-set-p hook) (make-local-hook hook))
;; Detect the case where make-local-variable was used on a hook
;; and do what we used to do.
(unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
This makes or adds to an entry on `after-load-alist'.
If FILE is already loaded, evaluate FORM right now.
It does nothing if FORM is already on the list for FILE.
-FILE should be the name of a library, with no directory name."
+FILE must match exactly. Normally FILE is the name of a library,
+with no directory or extension specified, since that is how `load'
+is normally called."
+ ;; Make sure `load-history' contains the files dumped with Emacs
+ ;; for the case that FILE is one of the files dumped with Emacs.
+ (load-symbol-file-load-history)
;; Make sure there is an element for FILE.
(or (assoc file after-load-alist)
(setq after-load-alist (cons (list file) after-load-alist)))
(let ((first (read-passwd prompt nil default))
(second (read-passwd "Confirm password: " nil default)))
(if (equal first second)
- (setq success first)
+ (progn
+ (and (arrayp second) (fillarray second ?\0))
+ (setq success first))
+ (and (arrayp first) (fillarray first ?\0))
+ (and (arrayp second) (fillarray second ?\0))
(message "Password not repeated accurately; please start over")
(sit-for 1))))
success)
(make-string (length pass) ?.))
(setq c (read-char-exclusive nil t))
(and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
+ (clear-this-command-keys)
(if (= c ?\C-u)
- (setq pass "")
+ (progn
+ (and (arrayp pass) (fillarray pass ?\0))
+ (setq pass ""))
(if (and (/= c ?\b) (/= c ?\177))
- (setq pass (concat pass (char-to-string c)))
+ (let* ((new-char (char-to-string c))
+ (new-pass (concat pass new-char)))
+ (and (arrayp pass) (fillarray pass ?\0))
+ (fillarray new-char ?\0)
+ (setq c ?\0)
+ (setq pass new-pass))
(if (> (length pass) 0)
- (setq pass (substring pass 0 -1))))))
- (clear-this-command-keys)
+ (let ((new-pass (substring pass 0 -1)))
+ (and (arrayp pass) (fillarray pass ?\0))
+ (setq pass new-pass))))))
(message nil)
(or pass default ""))))
\f
(combine-after-change-execute)))
-(defvar combine-run-hooks t
- "List of hooks delayed. Or t if we're not delaying hooks.")
-
-(defmacro combine-run-hooks (&rest body)
- "Execute BODY, but delay any `run-hooks' until the end."
- (let ((saved-combine-run-hooks (make-symbol "saved-combine-run-hooks"))
- (saved-run-hooks (make-symbol "saved-run-hooks")))
- `(let ((,saved-combine-run-hooks combine-run-hooks)
- (,saved-run-hooks (symbol-function 'run-hooks)))
- (unwind-protect
- (progn
- ;; If we're not delaying hooks yet, setup the delaying mode
- (unless (listp combine-run-hooks)
- (setq combine-run-hooks nil)
- (fset 'run-hooks
- ,(lambda (&rest hooks)
- (setq combine-run-hooks
- (append combine-run-hooks hooks)))))
- ,@body)
- ;; If we were not already delaying, then it's now time to set things
- ;; back to normal and to execute the delayed hooks.
- (unless (listp ,saved-combine-run-hooks)
- (setq ,saved-combine-run-hooks combine-run-hooks)
- (fset 'run-hooks ,saved-run-hooks)
- (setq combine-run-hooks t)
- (apply 'run-hooks ,saved-combine-run-hooks))))))
-
-
(defmacro with-syntax-table (table &rest body)
"Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
The syntax table of the current buffer is saved, BODY is evaluated, and the
(eq (car-safe object) 'lambda)
(and (symbolp object) (fboundp object))))
-;; 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)
+(defun interactive-form (function)
+ "Return the interactive form of FUNCTION.
+If function is a command (see `commandp'), value is a list of the form
+\(interactive SPEC). If function is not a command, return nil."
+ (setq function (indirect-function function))
+ (when (commandp function)
+ (cond ((byte-code-function-p function)
+ (when (> (length function) 5)
+ (let ((spec (aref function 5)))
+ (if spec
+ (list 'interactive spec)
+ (list 'interactive)))))
+ ((subrp function)
+ (subr-interactive-form function))
+ ((eq (car-safe function) 'lambda)
+ (setq function (cddr function))
+ (when (stringp (car function))
+ (setq function (cdr function)))
+ (let ((form (car function)))
+ (when (eq (car-safe form) 'interactive)
+ (copy-sequence form)))))))
(defun assq-delete-all (key alist)
"Delete from ALIST all elements whose car is KEY.