comparison lisp/subr.el @ 90789:c0409ee15cee

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 670-674) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 209-210) - Merge from emacs--devo--0 - Update from CVS Revision: [e-mail]/emacs--unicode--0--patch-185

90788:a12805fdabe8

that complains if FORM ever does return differing values."
  form)

(defmacro def-edebug-spec (symbol spec)
  "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
\(naming a function), or a list."
  `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))

(defmacro lambda (&rest cdr)
  "Return a lambda expression.

  (list 'car
	(list 'prog1 listname
	      (list 'setq listname (list 'cdr listname)))))

(defmacro when (cond &rest body)
  "If COND yields non-nil, do BODY, else return nil."
  (declare (indent 1) (debug t))
  (list 'if cond (cons 'progn body)))

(defmacro unless (cond &rest body)
  "If COND yields nil, do BODY, else return nil."
  (declare (indent 1) (debug t))
  (cons 'if (cons cond (cons nil body))))

(defvar --dolist-tail-- nil
  "Temporary variable used in `dolist' expansion.")

EXIT-CHAR it is swallowed; otherwise it is then available as
input (as a command if nothing else).
Display MESSAGE (optional fourth arg) in the echo area.
If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
  (or exit-char (setq exit-char ?\s))
  (let ((momentary-overlay (make-overlay pos pos nil t)))
    (overlay-put momentary-overlay 'before-string
		 (propertize string 'face 'momentary))
    (unwind-protect
	(progn
	  ;; If the message end is off screen, recenter now.
	  (if (< (window-end nil t) (+ pos (length string)))
	      (recenter (/ (window-height) 2)))
	  ;; If that pushed message start off the screen,
	  ;; scroll to start it at the top of the screen.
	  (save-excursion
	    (move-to-window-line 0)
	    (if (> (point) pos)
		(goto-char pos)
	      (recenter 0)))
	  (message (or message "Type %s to continue editing.")
		   (single-key-description exit-char))
	  (let (char)
	    (if (integerp exit-char)
		(condition-case nil

	      ;; list.
	      (setq char (read-event))
	      (or (eq char exit-char)
		  (eq char (event-convert-list exit-char))
		  (setq unread-command-events (list char))))))
      (delete-overlay momentary-overlay))))


;;;; Overlay operations

(defun copy-overlay (o)

90789:c0409ee15cee

that complains if FORM ever does return differing values."
  form)

(defmacro def-edebug-spec (symbol spec)
  "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
Both SYMBOL and SPEC are unevaluated.  The SPEC can be 0, t, a symbol
\(naming a function), or a list."
  `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))

(defmacro lambda (&rest cdr)
  "Return a lambda expression.

  (list 'car
	(list 'prog1 listname
	      (list 'setq listname (list 'cdr listname)))))

(defmacro when (cond &rest body)
  "If COND yields non-nil, do BODY, else return nil.
When COND yields non-nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.

\(fn COND BODY ...)"
  (declare (indent 1) (debug t))
  (list 'if cond (cons 'progn body)))

(defmacro unless (cond &rest body)
  "If COND yields nil, do BODY, else return nil.
When COND yields nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.

\(fn COND BODY ...)"
  (declare (indent 1) (debug t))
  (cons 'if (cons cond (cons nil body))))

(defvar --dolist-tail-- nil
  "Temporary variable used in `dolist' expansion.")

EXIT-CHAR it is swallowed; otherwise it is then available as
input (as a command if nothing else).
Display MESSAGE (optional fourth arg) in the echo area.
If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
  (or exit-char (setq exit-char ?\s))
  (let ((inhibit-read-only t)
	;; Don't modify the undo list at all.
	(buffer-undo-list t)
	(modified (buffer-modified-p))
	(name buffer-file-name)
	insert-end)
    (unwind-protect
	(progn
	  (save-excursion
	    (goto-char pos)
	    ;; To avoid trouble with out-of-bounds position
	    (setq pos (point))
	    ;; defeat file locking... don't try this at home, kids!
	    (setq buffer-file-name nil)
	    (insert-before-markers string)
	    (setq insert-end (point))
	    ;; If the message end is off screen, recenter now.
	    (if (< (window-end nil t) insert-end)
		(recenter (/ (window-height) 2)))
	    ;; If that pushed message start off the screen,
	    ;; scroll to start it at the top of the screen.
	    (move-to-window-line 0)
	    (if (> (point) pos)
		(progn
		  (goto-char pos)
		  (recenter 0))))
	  (message (or message "Type %s to continue editing.")
		   (single-key-description exit-char))
	  (let (char)
	    (if (integerp exit-char)
		(condition-case nil

	      ;; list.
	      (setq char (read-event))
	      (or (eq char exit-char)
		  (eq char (event-convert-list exit-char))
		  (setq unread-command-events (list char))))))
      (if insert-end
	  (save-excursion
	    (delete-region pos insert-end)))
      (setq buffer-file-name name)
      (set-buffer-modified-p modified))))


;;;; Overlay operations

(defun copy-overlay (o)