Mercurial > hg > xemacs-beta
diff lisp/subr.el @ 424:11054d720c21 r21-2-20
Import from CVS: tag r21-2-20
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:26:11 +0200 |
parents | 41dbb7a9d5f2 |
children |
line wrap: on
line diff
--- a/lisp/subr.el Mon Aug 13 11:25:03 2007 +0200 +++ b/lisp/subr.el Mon Aug 13 11:26:11 2007 +0200 @@ -223,6 +223,12 @@ The value of this variable may be buffer-local. The buffer about to be killed is current when this hook is run.") +;; called by Frecord_buffer() +(defvar record-buffer-hook nil + "Function or functions to be called when a buffer is recorded. +The value of this variable may be buffer-local. +The buffer being recorded is passed as an argument to the hook.") + ;; in C in FSFmacs (defvar kill-emacs-hook nil "Function or functions to be called when `kill-emacs' is called, @@ -239,6 +245,22 @@ (define-function 'rplaca 'setcar) (define-function 'rplacd 'setcdr) +(defun copy-symbol (symbol &optional copy-properties) + "Return a new uninterned symbol with the same name as SYMBOL. +If COPY-PROPERTIES is non-nil, the new symbol will have a copy of +SYMBOL's value, function, and property lists." + (let ((new (make-symbol (symbol-name symbol)))) + (when copy-properties + ;; This will not copy SYMBOL's chain of forwarding objects, but + ;; I think that's OK. Callers should not expect such magic to + ;; keep working in the copy in the first place. + (and (boundp symbol) + (set new (symbol-value symbol))) + (and (fboundp symbol) + (fset new (symbol-function symbol))) + (setplist new (copy-list (symbol-plist symbol)))) + new)) + ;;;; String functions. ;; XEmacs @@ -569,9 +591,6 @@ (interactive) nil) -(define-function 'mapc-internal 'mapc) -(make-obsolete 'mapc-internal 'mapc) - (define-function 'eval-in-buffer 'with-current-buffer) (make-obsolete 'eval-in-buffer 'with-current-buffer) @@ -632,13 +651,17 @@ The arguments OLD-END and OLD-BUFFER are supported for backward compatibility with pre-21.2 XEmacsen times when arguments to this function were (buffer-string &optional START END BUFFER)." - (if (or (null buffer) - (bufferp buffer) - (stringp buffer)) - ;; The new way - (buffer-substring nil nil buffer) - ;; The old way - (buffer-substring buffer old-end old-buffer))) + (cond + ((or (stringp buffer) (bufferp buffer)) + ;; Most definitely the new way. + (buffer-substring nil nil buffer)) + ((or (stringp old-buffer) (bufferp old-buffer) + (natnump buffer) (natnump old-end)) + ;; Definitely the old way. + (buffer-substring buffer old-end old-buffer)) + (t + ;; Probably the old way. + (buffer-substring buffer old-end old-buffer)))) ;; This was not present before. I think Jamie had some objections ;; to this, so I'm leaving this undefined for now. --ben