comparison lisp/subr.el @ 89909:68c22ea6027c

Sync to HEAD

89908:ee1402f7b568

;;; subr.el --- basic lisp subroutines for Emacs

;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002, 2003
;;   Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: internal


;;;; Lisp language features.

(defalias 'not 'null)

(defmacro lambda (&rest cdr)
  "Return a lambda expression.
A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
self-quoting; the result of evaluating the lambda expression is the
expression itself.  The lambda expression may then be treated as a

	   (,(car spec) ,start))
       (while (< ,(car spec) ,temp)
	 ,@body
	 (setq ,(car spec) (1+ ,(car spec))))
       ,@(cdr (cdr spec)))))

(defsubst caar (x)
  "Return the car of the car of X."
  (car (car x)))

    (and (< n m)
	 (progn
	   (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
	   x))))

(defun number-sequence (from &optional to inc)
  "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
INC is the increment used between numbers in the sequence.
So, the Nth element of the list is (+ FROM (* N INC)) where N counts from
zero.
If INC is nil, it defaults to 1 (one).
If TO is nil, it defaults to FROM.
If TO is less than FROM, the value is nil.
Note that FROM, TO and INC can be integer or float."
  (if (not to)
      (list from)
    (or inc (setq inc 1))
    (let (seq)
      (while (<= from to)
	(setq seq (cons from seq)
	      from (+ from inc)))
      (nreverse seq))))

(defun remove (elt seq)
  "Return a copy of SEQ with all occurrences of ELT removed.
SEQ must be a list, vector, or string.  The comparison is done with `equal'."

	(when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
	  (setq found t value (if (consp elt) (cdr elt) default))))
      (setq tail (cdr tail)))
    value))

(defun assoc-ignore-case (key alist)
  "Like `assoc', but ignores differences in case and text representation.
KEY 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 alist (not element))
      (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil t))
	  (setq element (car alist)))
      (setq alist (cdr alist)))
    element))

(defun assoc-ignore-representation (key alist)
  "Like `assoc', but ignores differences in text representation.
KEY must be a string.
Unibyte strings are converted to multibyte for comparison."
  (let (element)
    (while (and alist (not element))
      (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil))
	  (setq element (car alist)))
      (setq alist (cdr alist)))
    element))

(defun member-ignore-case (elt list)
  "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.

  (and (consp object)
       (eq (car object) 'mouse-movement)))

(defsubst event-start (event)
  "Return the starting position of EVENT.
If EVENT is a mouse press or a mouse click, this returns the location
of the event.
If EVENT is a drag, this returns the drag's starting position.
The return value is of the form
   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
The `posn-' functions access elements of such lists."
  (if (consp event) (nth 1 event)
    (list (selected-window) (point) '(0 . 0) 0)))

(defsubst event-end (event)
  "Return the ending location of EVENT.  EVENT should be a click or drag event.
If EVENT is a click event, this function is the same as `event-start'.
The return value is of the form
   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
The `posn-' functions access elements of such lists."
  (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
    (list (selected-window) (point) '(0 . 0) 0)))

(defsubst event-click-count (event)

The return value is a positive integer."
  (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))

(defsubst posn-window (position)
  "Return the window in POSITION.
POSITION should be a list of the form
   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
as returned by the `event-start' and `event-end' functions."
  (nth 0 position))

(defsubst posn-point (position)
  "Return the buffer location in POSITION.
POSITION should be a list of the form
   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
as returned by the `event-start' and `event-end' functions."
  (if (consp (nth 1 position))
      (car (nth 1 position))
    (nth 1 position)))

(defsubst posn-x-y (position)
  "Return the x and y coordinates in POSITION.
POSITION should be a list of the form
   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
as returned by the `event-start' and `event-end' functions."
  (nth 2 position))

(defun posn-col-row (position)
  "Return the column and row in POSITION, measured in characters.
POSITION should be a list of the form
   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
as returned by the `event-start' and `event-end' functions.
For a scroll-bar event, the result column is 0, and the row
corresponds to the vertical position of the click in the scroll bar."
  (let* ((pair   (nth 2 position))
	 (window (posn-window position)))
    (if (eq (if (consp (nth 1 position))
		(car (nth 1 position))
	      (nth 1 position))
	    'vertical-scroll-bar)
	(cons 0 (scroll-bar-scale pair (1- (window-height window))))
      (if (eq (if (consp (nth 1 position))
		  (car (nth 1 position))
		(nth 1 position))
	      'horizontal-scroll-bar)
	  (cons (scroll-bar-scale pair (window-width window)) 0)
	(let* ((frame (if (framep window) window (window-frame window)))
	       (x (/ (car pair) (frame-char-width frame)))
	       (y (/ (cdr pair) (+ (frame-char-height frame)
				   (or (frame-parameter frame 'line-spacing)
				       default-line-spacing
				       0)))))
	  (cons x y))))))

(defsubst posn-timestamp (position)
  "Return the timestamp of POSITION.
POSITION should be a list of the form
   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
as returned by the `event-start' and `event-end' functions."
  (nth 3 position))


;;;; Obsolescent names for functions.

(defalias 'dot 'point)

HOOK should be a symbol, and FUNCTION may be any valid function.  If
FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
list of hooks to run in HOOK, then nothing is done.  See `add-hook'.

The optional third argument, LOCAL, if non-nil, says to modify
the hook's buffer-local value rather than its default value.
This makes the hook buffer-local if needed."
  (or (boundp hook) (set hook nil))
  (or (default-boundp hook) (set-default hook nil))
  (if local (unless (local-variable-if-set-p hook)
	      (set (make-local-variable hook) (list t)))
    ;; 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)))
      (setq local t)))
  (let ((hook-value (if local (symbol-value hook) (default-value hook))))
    ;; Remove the function, for both the list and the non-list cases.
    (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
	(if (equal hook-value function) (setq hook-value nil))
      (setq hook-value (delete function (copy-sequence hook-value))))
    ;; If the function is on the global hook, we need to shadow it locally
    ;;(when (and local (member function (default-value hook))
    ;;	       (not (member (cons 'not function) hook-value)))
    ;;  (push (cons 'not function) hook-value))
    ;; Set the actual variable
    (if (not local)
	(set-default hook hook-value)
      (if (equal hook-value '(t))
	  (kill-local-variable hook)
	(set hook hook-value)))))

(defun add-to-list (list-var element &optional append)
  "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
The test for presence of ELEMENT is done with `equal'.
If ELEMENT is added, it is added at the beginning of the list,

	(while (not success)
	  (let ((first (read-passwd prompt nil default))
		(second (read-passwd "Confirm password: " nil default)))
	    (if (equal first second)
		(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)
    (let ((pass nil)
	  (c 0)

		    (setq c (read-char-exclusive nil t))
		    (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
	(clear-this-command-keys)
	(if (= c ?\C-u)
	    (progn
	      (and (arrayp pass) (fillarray pass ?\0))
	      (setq pass ""))
	  (if (and (/= c ?\b) (/= c ?\177))
	      (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)
		(let ((new-pass (substring pass 0 -1)))
		  (and (arrayp pass) (fillarray pass ?\0))
		  (setq pass new-pass))))))
      (message nil)
      (or pass default ""))))

;;; Atomic change groups.

(defmacro atomic-change-group (&rest body)
  "Perform BODY as an atomic change group.


;; For compatibility.
(defalias 'redraw-modeline 'force-mode-line-update)

(defun force-mode-line-update (&optional all)
  "Force the mode line of the current buffer to be redisplayed.
With optional non-nil ALL, force redisplay of all mode lines."
  (if all (save-excursion (set-buffer (other-buffer))))
  (set-buffer-modified-p (buffer-modified-p)))

(defun momentary-string-display (string pos &optional exit-char message)
  "Momentarily display STRING in the buffer at POS.

      (remove-list-of-text-properties start end yank-excluded-properties))))

(defvar yank-undo-function)

(defun insert-for-yank (string)
  "Insert STRING at point, stripping some text properties.
Strip text properties from the inserted text according to
`yank-excluded-properties'.  Otherwise just like (insert STRING).

If STRING has a non-nil `yank-handler' property on the first character,
the normal insert behaviour is modified in various ways.  The value of

  "Insert before point a part of buffer BUFFER, stripping some text properties.
BUFFER may be a buffer or a buffer name.  Arguments START and END are
character numbers specifying the substring.  They default to the
beginning and the end of BUFFER.  Strip text properties from the
inserted text according to `yank-excluded-properties'."
  (let ((opoint (point)))
    (insert-buffer-substring buf start end)
    (remove-yank-excluded-properties opoint (point))))



(defvar delay-mode-hooks nil
  "If non-nil, `run-mode-hooks' should delay running the hooks.")
(defvar delayed-mode-hooks nil
  "List of delayed mode hooks waiting to be run.")
(make-variable-buffer-local 'delayed-mode-hooks)

(defun run-mode-hooks (&rest hooks)
  "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
Execution is delayed if `delay-mode-hooks' is non-nil.
Major mode functions should use this."

 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
STRING should be given if the last search was by `string-match' on STRING."
  (if (match-beginning num)
      (if string
	  (let ((result
		 (substring string (match-beginning num) (match-end num))))
	    (set-text-properties 0 (length result) nil result)
	    result)
	(buffer-substring-no-properties (match-beginning num)
					(match-end num)))))

(defun looking-back (regexp &optional limit)
  "Return non-nil if text before point matches regular expression REGEXP.

configuration."
  (and (consp object)
       (eq (car object) 'frame-configuration)))

(defun functionp (object)
  "Non-nil iff OBJECT is a type of object that can be called as a function."
  (or (and (symbolp object) (fboundp object)
	   (condition-case nil
	       (setq object (indirect-function object))
	     (error nil))
	   (eq (car-safe object) 'autoload)
	   (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
      (subrp object) (byte-code-function-p object)
      (eq (car-safe object) 'lambda)))

(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.
Return the modified alist.
Elements of ALIST that are not conses are ignored."

;; If a minor mode is not defined with define-minor-mode,
;; add it here explicitly.
;; isearch-mode is deliberately excluded, since you should
;; not call it yourself.
(defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
					 overwrite-mode view-mode)
  "List of all minor mode functions.")

(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
  "Register a new minor mode.

  (put symbol 'composefunc composefunc)
  (put symbol 'sendfunc sendfunc)
  (put symbol 'abortfunc (or abortfunc 'kill-buffer))
  (put symbol 'hookvar (or hookvar 'mail-send-hook)))

;;; subr.el ends here

89909:68c22ea6027c

;;; subr.el --- basic lisp subroutines for Emacs

;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002, 03, 2004
;;   Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: internal


;;;; Lisp language features.

(defalias 'not 'null)

(defmacro noreturn (form)
  "Evaluates FORM, with the expectation that the evaluation will signal an error
instead of returning to its caller.  If FORM does return, an error is
signalled."
  `(prog1 ,form
     (error "Form marked with `noreturn' did return")))

(defmacro 1value (form)
  "Evaluates FORM, with the expectation that all the same value will be returned
from all evaluations of FORM.  This is the global do-nothing
version of `1value'.  There is also `testcover-1value' that
complains if FORM ever does return differing values."
  form)

(defmacro lambda (&rest cdr)
  "Return a lambda expression.
A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
self-quoting; the result of evaluating the lambda expression is the
expression itself.  The lambda expression may then be treated as a

	   (,(car spec) ,start))
       (while (< ,(car spec) ,temp)
	 ,@body
	 (setq ,(car spec) (1+ ,(car spec))))
       ,@(cdr (cdr spec)))))

(defmacro declare (&rest specs)
  "Do not evaluate any arguments and return nil.
Treated as a declaration when used at the right place in a
`defmacro' form.  \(See Info anchor `(elisp)Definition of declare'."
  nil)

(defsubst caar (x)
  "Return the car of the car of X."
  (car (car x)))

    (and (< n m)
	 (progn
	   (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
	   x))))

(defun delete-dups (list)
  "Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it.  LIST must be a proper list.
Of several `equal' occurrences of an element in LIST, the first
one is kept."
  (let ((tail list))
    (while tail
      (setcdr tail (delete (car tail) (cdr tail)))
      (setq tail (cdr tail))))
  list)

(defun number-sequence (from &optional to inc)
  "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
INC is the increment used between numbers in the sequence and defaults to 1.
So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from
zero.  TO is only included if there is an N for which TO = FROM + N * INC.
If TO is nil or numerically equal to FROM, return \(FROM).
If INC is positive and TO is less than FROM, or INC is negative
and TO is larger than FROM, return nil.
If INC is zero and TO is neither nil nor numerically equal to
FROM, signal an error.

This function is primarily designed for integer arguments.
Nevertheless, FROM, TO and INC can be integer or float.  However,
floating point arithmetic is inexact.  For instance, depending on
the machine, it may quite well happen that
\(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4),
whereas \(number-sequence 0.4 0.8 0.2) returns a list with three
elements.  Thus, if some of the arguments are floats and one wants
to make sure that TO is included, one may have to explicitly write
TO as \(+ FROM \(* N INC)) or use a variable whose value was
computed with this exact expression.  Alternatively, you can,
of course, also replace TO with a slightly larger value
\(or a slightly more negative value if INC is negative)."
  (if (or (not to) (= from to))
      (list from)
    (or inc (setq inc 1))
    (when (zerop inc) (error "The increment can not be zero"))
    (let (seq (n 0) (next from))
      (if (> inc 0)
          (while (<= next to)
            (setq seq (cons next seq)
                  n (1+ n)
                  next (+ from (* n inc))))
        (while (>= next to)
          (setq seq (cons next seq)
                n (1+ n)
                next (+ from (* n inc)))))
      (nreverse seq))))

(defun remove (elt seq)
  "Return a copy of SEQ with all occurrences of ELT removed.
SEQ must be a list, vector, or string.  The comparison is done with `equal'."

	(when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
	  (setq found t value (if (consp elt) (cdr elt) default))))
      (setq tail (cdr tail)))
    value))

(make-obsolete 'assoc-ignore-case 'assoc-string)
(defun assoc-ignore-case (key alist)
  "Like `assoc', but ignores differences in case and text representation.
KEY must be a string.  Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
  (assoc-string key alist t))

(make-obsolete 'assoc-ignore-representation 'assoc-string)
(defun assoc-ignore-representation (key alist)
  "Like `assoc', but ignores differences in text representation.
KEY must be a string.
Unibyte strings are converted to multibyte for comparison."
  (assoc-string key alist nil))

(defun member-ignore-case (elt list)
  "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.

  (and (consp object)
       (eq (car object) 'mouse-movement)))

(defsubst event-start (event)
  "Return the starting position of EVENT.
If EVENT is a mouse or key press or a mouse click, this returns the location
of the event.
If EVENT is a drag, this returns the drag's starting position.
The return value is of the form
   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
    IMAGE (DX . DY) (WIDTH . HEIGHT))
The `posn-' functions access elements of such lists."
  (if (consp event) (nth 1 event)
    (list (selected-window) (point) '(0 . 0) 0)))

(defsubst event-end (event)
  "Return the ending location of EVENT.
EVENT should be a click, drag, or key press event.
If EVENT is a click event, this function is the same as `event-start'.
The return value is of the form
   (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
    IMAGE (DX . DY) (WIDTH . HEIGHT))
The `posn-' functions access elements of such lists."
  (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
    (list (selected-window) (point) '(0 . 0) 0)))

(defsubst event-click-count (event)

The return value is a positive integer."
  (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))

(defsubst posn-window (position)
  "Return the window in POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 0 position))

(defsubst posn-area (position)
  "Return the window area recorded in POSITION, or nil for the text area.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (let ((area (if (consp (nth 1 position))
		  (car (nth 1 position))
		(nth 1 position))))
    (and (symbolp area) area)))

(defsubst posn-point (position)
  "Return the buffer location in POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (or (nth 5 position)
      (if (consp (nth 1 position))
	  (car (nth 1 position))
	(nth 1 position))))

(defun posn-set-point (position)
  "Move point to POSITION.
Select the corresponding window as well."
    (if (not (windowp (posn-window position)))
	(error "Position not in text area of window"))
    (select-window (posn-window position))
    (if (numberp (posn-point position))
	(goto-char (posn-point position))))

(defsubst posn-x-y (position)
  "Return the x and y coordinates in POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 2 position))

(defun posn-col-row (position)
  "Return the nominal column and row in POSITION, measured in characters.
The column and row values are approximations calculated from the x
and y coordinates in POSITION and the frame's default character width
and height.
For a scroll-bar event, the result column is 0, and the row
corresponds to the vertical position of the click in the scroll bar.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (let* ((pair   (posn-x-y position))
	 (window (posn-window position))
	 (area   (posn-area position)))
    (cond
     ((null window)
      '(0 . 0))
     ((eq area 'vertical-scroll-bar)
      (cons 0 (scroll-bar-scale pair (1- (window-height window)))))
     ((eq area 'horizontal-scroll-bar)
      (cons (scroll-bar-scale pair (window-width window)) 0))
     (t
      (let* ((frame (if (framep window) window (window-frame window)))
	     (x (/ (car pair) (frame-char-width frame)))
	     (y (/ (cdr pair) (+ (frame-char-height frame)
				 (or (frame-parameter frame 'line-spacing)
				     default-line-spacing
				     0)))))
	(cons x y))))))

(defun posn-actual-col-row (position)
  "Return the actual column and row in POSITION, measured in characters.
These are the actual row number in the window and character number in that row.
Return nil if POSITION does not contain the actual position; in that case
`posn-col-row' can be used to get approximate values.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 6 position))

(defsubst posn-timestamp (position)
  "Return the timestamp of POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 3 position))

(defsubst posn-string (position)
  "Return the string object of POSITION, or nil if a buffer position.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 4 position))

(defsubst posn-image (position)
  "Return the image object of POSITION, or nil if a not an image.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 7 position))

(defsubst posn-object (position)
  "Return the object (image or string) of POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (or (posn-image position) (posn-string position)))

(defsubst posn-object-x-y (position)
  "Return the x and y coordinates relative to the object of POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 8 position))

(defsubst posn-object-width-height (position)
  "Return the pixel width and height of the object of POSITION.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
  (nth 9 position))


;;;; Obsolescent names for functions.

(defalias 'dot 'point)

HOOK should be a symbol, and FUNCTION may be any valid function.  If
FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
list of hooks to run in HOOK, then nothing is done.  See `add-hook'.

The optional third argument, LOCAL, if non-nil, says to modify
the hook's buffer-local value rather than its default value."
  (or (boundp hook) (set hook nil))
  (or (default-boundp hook) (set-default hook nil))
  ;; Do nothing if LOCAL is t but this hook has no local binding.
  (unless (and local (not (local-variable-p hook)))
    ;; Detect the case where make-local-variable was used on a hook
    ;; and do what we used to do.
    (when (and (local-variable-p hook)
	       (not (and (consp (symbol-value hook))
			 (memq t (symbol-value hook)))))
      (setq local t))
    (let ((hook-value (if local (symbol-value hook) (default-value hook))))
      ;; Remove the function, for both the list and the non-list cases.
      (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
	  (if (equal hook-value function) (setq hook-value nil))
	(setq hook-value (delete function (copy-sequence hook-value))))
      ;; If the function is on the global hook, we need to shadow it locally
      ;;(when (and local (member function (default-value hook))
      ;;	       (not (member (cons 'not function) hook-value)))
      ;;  (push (cons 'not function) hook-value))
      ;; Set the actual variable
      (if (not local)
	  (set-default hook hook-value)
	(if (equal hook-value '(t))
	    (kill-local-variable hook)
	  (set hook hook-value))))))

(defun add-to-list (list-var element &optional append)
  "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
The test for presence of ELEMENT is done with `equal'.
If ELEMENT is added, it is added at the beginning of the list,

	(while (not success)
	  (let ((first (read-passwd prompt nil default))
		(second (read-passwd "Confirm password: " nil default)))
	    (if (equal first second)
		(progn
		  (and (arrayp second) (clear-string second))
		  (setq success first))
	      (and (arrayp first) (clear-string first))
	      (and (arrayp second) (clear-string second))
	      (message "Password not repeated accurately; please start over")
	      (sit-for 1))))
	success)
    (let ((pass nil)
	  (c 0)

		    (setq c (read-char-exclusive nil t))
		    (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
	(clear-this-command-keys)
	(if (= c ?\C-u)
	    (progn
	      (and (arrayp pass) (clear-string pass))
	      (setq pass ""))
	  (if (and (/= c ?\b) (/= c ?\177))
	      (let* ((new-char (char-to-string c))
		     (new-pass (concat pass new-char)))
		(and (arrayp pass) (clear-string pass))
		(clear-string new-char)
		(setq c ?\0)
		(setq pass new-pass))
	    (if (> (length pass) 0)
		(let ((new-pass (substring pass 0 -1)))
		  (and (arrayp pass) (clear-string pass))
		  (setq pass new-pass))))))
      (message nil)
      (or pass default ""))))

;; This should be used by `call-interactively' for `n' specs.
(defun read-number (prompt &optional default)
  (let ((n nil))
    (when default
      (setq prompt
	    (if (string-match "\\(\\):[^:]*" prompt)
		(replace-match (format " [%s]" default) t t prompt 1)
	      (concat prompt (format " [%s] " default)))))
    (while
	(progn
	  (let ((str (read-from-minibuffer prompt nil nil nil nil
					   (number-to-string default))))
	    (setq n (cond
		     ((zerop (length str)) default)
		     ((stringp str) (read str)))))
	  (unless (numberp n)
	    (message "Please enter a number.")
	    (sit-for 1)
	    t)))
    n))

;;; Atomic change groups.

(defmacro atomic-change-group (&rest body)
  "Perform BODY as an atomic change group.


;; For compatibility.
(defalias 'redraw-modeline 'force-mode-line-update)

(defun force-mode-line-update (&optional all)
  "Force redisplay of the current buffer's mode line and header line.
With optional non-nil ALL, force redisplay of all mode lines and
header lines.  This function also forces recomputation of the
menu bar menus and the frame title."
  (if all (save-excursion (set-buffer (other-buffer))))
  (set-buffer-modified-p (buffer-modified-p)))

(defun momentary-string-display (string pos &optional exit-char message)
  "Momentarily display STRING in the buffer at POS.

      (remove-list-of-text-properties start end yank-excluded-properties))))

(defvar yank-undo-function)

(defun insert-for-yank (string)
  "Calls `insert-for-yank-1' repetitively for each `yank-handler' segment.

See `insert-for-yank-1' for more details."
  (let (to)
    (while (setq to (next-single-property-change 0 'yank-handler string))
      (insert-for-yank-1 (substring string 0 to))
      (setq string (substring string to))))
  (insert-for-yank-1 string))

(defun insert-for-yank-1 (string)
  "Insert STRING at point, stripping some text properties.

Strip text properties from the inserted text according to
`yank-excluded-properties'.  Otherwise just like (insert STRING).

If STRING has a non-nil `yank-handler' property on the first character,
the normal insert behaviour is modified in various ways.  The value of

  "Insert before point a part of buffer BUFFER, stripping some text properties.
BUFFER may be a buffer or a buffer name.  Arguments START and END are
character numbers specifying the substring.  They default to the
beginning and the end of BUFFER.  Strip text properties from the
inserted text according to `yank-excluded-properties'."
  ;; Since the buffer text should not normally have yank-handler properties,
  ;; there is no need to handle them here.
  (let ((opoint (point)))
    (insert-buffer-substring buf start end)
    (remove-yank-excluded-properties opoint (point))))



(defvar delay-mode-hooks nil
  "If non-nil, `run-mode-hooks' should delay running the hooks.")
(defvar delayed-mode-hooks nil
  "List of delayed mode hooks waiting to be run.")
(make-variable-buffer-local 'delayed-mode-hooks)
(put 'delay-mode-hooks 'permanent-local t)

(defun run-mode-hooks (&rest hooks)
  "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
Execution is delayed if `delay-mode-hooks' is non-nil.
Major mode functions should use this."

 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
Zero means the entire text matched by the whole regexp or whole string.
STRING should be given if the last search was by `string-match' on STRING."
  (if (match-beginning num)
      (if string
	  (substring-no-properties string (match-beginning num)
				   (match-end num))
	(buffer-substring-no-properties (match-beginning num)
					(match-end num)))))

(defun looking-back (regexp &optional limit)
  "Return non-nil if text before point matches regular expression REGEXP.

configuration."
  (and (consp object)
       (eq (car object) 'frame-configuration)))

(defun functionp (object)
  "Non-nil if OBJECT is any kind of function or a special form.
Also non-nil if OBJECT is a symbol and its function definition is
\(recursively) a function or special form.  This does not include
macros."
  (or (and (symbolp object) (fboundp object)
	   (condition-case nil
	       (setq object (indirect-function object))
	     (error nil))
	   (eq (car-safe object) 'autoload)
	   (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
      (subrp object) (byte-code-function-p object)
      (eq (car-safe object) 'lambda)))

(defun assq-delete-all (key alist)
  "Delete from ALIST all elements whose car is KEY.
Return the modified alist.
Elements of ALIST that are not conses are ignored."

;; If a minor mode is not defined with define-minor-mode,
;; add it here explicitly.
;; isearch-mode is deliberately excluded, since you should
;; not call it yourself.
(defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
					 overwrite-mode view-mode
                                         hs-minor-mode)
  "List of all minor mode functions.")

(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
  "Register a new minor mode.

  (put symbol 'composefunc composefunc)
  (put symbol 'sendfunc sendfunc)
  (put symbol 'abortfunc (or abortfunc 'kill-buffer))
  (put symbol 'hookvar (or hookvar 'mail-send-hook)))

;;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
;;; subr.el ends here