X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fsubr.el;h=0bbb8558c0093bd0a3ff96f57bf858020446d509;hb=fd3b637227a2cc7bce0abebc2f314ffd2398b18c;hp=69af79bb79219c60b29a9b69a593c08c7d3517de;hpb=fc475e6669a613cd6d98eb5511c749a23b63c7ac;p=chise%2Fxemacs-chise.git- diff --git a/lisp/subr.el b/lisp/subr.el index 69af79b..0bbb855 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -88,9 +88,6 @@ Used for compatibility among different emacs variants." ;; XEmacs: not used. ;; XEmacs: -(define-function 'not 'null) -(define-function-when-void 'numberp 'integerp) ; different when floats - (defun local-variable-if-set-p (sym buffer) "Return t if SYM would be local to BUFFER after it is set. A nil value for BUFFER is *not* the same as (current-buffer), but @@ -226,6 +223,12 @@ other hooks, such as major mode hooks, can do the job." 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, @@ -242,6 +245,22 @@ just before emacs is actually killed.") (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 @@ -297,10 +316,14 @@ Otherwise treat \\ in NEWTEXT string as special: If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (or pattern (setq pattern "[ \f\t\n\r\v]+")) - ;; The FSF version of this function takes care not to cons in case - ;; of infloop. Maybe we should synch? - (let (parts (start 0)) - (while (string-match pattern string start) + (let (parts (start 0) (len (length string))) + (if (string-match pattern string) + (setq parts (cons (substring string 0 (match-beginning 0)) parts) + start (match-end 0))) + (while (and (< start len) + (string-match pattern string (if (> start (match-beginning 0)) + start + (1+ start)))) (setq parts (cons (substring string start (match-beginning 0)) parts) start (match-end 0))) (nreverse (cons (substring string start) parts)))) @@ -333,7 +356,7 @@ it as a string." (erase-buffer)))) (defmacro with-current-buffer (buffer &rest body) - "Execute the forms in BODY with BUFFER as the current buffer. + "Temporarily make BUFFER the current buffer and execute the forms in BODY. The value returned is the value of the last form in BODY. See also `with-temp-buffer'." `(save-current-buffer @@ -568,9 +591,6 @@ This function accepts any number of arguments, but ignores them." (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) @@ -586,12 +606,14 @@ This function accepts any number of arguments, but ignores them." (cons (cons name defs) abbrev-table-name-list))))))) -(defun functionp (object) - "Non-nil if OBJECT can be called as a function." - (or (and (symbolp object) (fboundp object)) - (subrp object) - (compiled-function-p object) - (eq (car-safe object) 'lambda))) +;;; `functionp' has been moved into C. + +;;(defun functionp (object) +;; "Non-nil if OBJECT can be called as a function." +;; (or (and (symbolp object) (fboundp object)) +;; (subrp object) +;; (compiled-function-p object) +;; (eq (car-safe object) 'lambda))) @@ -615,6 +637,32 @@ If FUNCTION is not interactive, nil will be returned." (t (error "Non-funcallable object: %s" function)))) +;; This function used to be an alias to `buffer-substring', except +;; that FSF Emacs 20.4 added a BUFFER argument in an incompatible way. +;; The new FSF's semantics makes more sense, but we try to support +;; both for backward compatibility. +(defun buffer-string (&optional buffer old-end old-buffer) + "Return the contents of the current buffer as a string. +If narrowing is in effect, this function returns only the visible part +of the buffer. + +If BUFFER is specified, the contents of that buffer are returned. + +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)." + (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 @@ -668,6 +716,5 @@ FILE should be the name of a library, with no directory name." (define-function 'remove-directory 'delete-directory) (define-function 'set-match-data 'store-match-data) (define-function 'send-string-to-terminal 'external-debugging-output) -(define-function 'buffer-string 'buffer-substring) ;;; subr.el ends here