Mercurial > hg > xemacs-beta

comparison lisp/subr.el @ 424:11054d720c21 r21-2-20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 41dbb7a9d5f2
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
221 (defvar kill-buffer-hook nil 221 (defvar kill-buffer-hook nil
222 "Function or functions to be called when a buffer is killed. 222 "Function or functions to be called when a buffer is killed.
223 The value of this variable may be buffer-local. 223 The value of this variable may be buffer-local.
224 The buffer about to be killed is current when this hook is run.") 224 The buffer about to be killed is current when this hook is run.")
225 225
226 ;; called by Frecord_buffer()
227 (defvar record-buffer-hook nil
228 "Function or functions to be called when a buffer is recorded.
229 The value of this variable may be buffer-local.
230 The buffer being recorded is passed as an argument to the hook.")
231
226 ;; in C in FSFmacs 232 ;; in C in FSFmacs
227 (defvar kill-emacs-hook nil 233 (defvar kill-emacs-hook nil
228 "Function or functions to be called when `kill-emacs' is called, 234 "Function or functions to be called when `kill-emacs' is called,
229 just before emacs is actually killed.") 235 just before emacs is actually killed.")
230 236
236 ;; (setcar conscell newcar) 242 ;; (setcar conscell newcar)
237 ;; conscell) 243 ;; conscell)
238 ;; ...and analogously for RPLACD. 244 ;; ...and analogously for RPLACD.
239 (define-function 'rplaca 'setcar) 245 (define-function 'rplaca 'setcar)
240 (define-function 'rplacd 'setcdr) 246 (define-function 'rplacd 'setcdr)
247
248 (defun copy-symbol (symbol &optional copy-properties)
249 "Return a new uninterned symbol with the same name as SYMBOL.
250 If COPY-PROPERTIES is non-nil, the new symbol will have a copy of
251 SYMBOL's value, function, and property lists."
252 (let ((new (make-symbol (symbol-name symbol))))
253 (when copy-properties
254 ;; This will not copy SYMBOL's chain of forwarding objects, but
255 ;; I think that's OK. Callers should not expect such magic to
256 ;; keep working in the copy in the first place.
257 (and (boundp symbol)
258 (set new (symbol-value symbol)))
259 (and (fboundp symbol)
260 (fset new (symbol-function symbol)))
261 (setplist new (copy-list (symbol-plist symbol))))
262 new))
241 263
242 ;;;; String functions. 264 ;;;; String functions.
243 265
244 ;; XEmacs 266 ;; XEmacs
245 (defun replace-in-string (str regexp newtext &optional literal) 267 (defun replace-in-string (str regexp newtext &optional literal)
567 "Do nothing and return nil. 589 "Do nothing and return nil.
568 This function accepts any number of arguments, but ignores them." 590 This function accepts any number of arguments, but ignores them."
569 (interactive) 591 (interactive)
570 nil) 592 nil)
571 593
572 (define-function 'mapc-internal 'mapc)
573 (make-obsolete 'mapc-internal 'mapc)
574
575 (define-function 'eval-in-buffer 'with-current-buffer) 594 (define-function 'eval-in-buffer 'with-current-buffer)
576 (make-obsolete 'eval-in-buffer 'with-current-buffer) 595 (make-obsolete 'eval-in-buffer 'with-current-buffer)
577 596
578 ;;; The real defn is in abbrev.el but some early callers 597 ;;; The real defn is in abbrev.el but some early callers
579 ;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded... 598 ;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded...
630 If BUFFER is specified, the contents of that buffer are returned. 649 If BUFFER is specified, the contents of that buffer are returned.
631 650
632 The arguments OLD-END and OLD-BUFFER are supported for backward 651 The arguments OLD-END and OLD-BUFFER are supported for backward
633 compatibility with pre-21.2 XEmacsen times when arguments to this 652 compatibility with pre-21.2 XEmacsen times when arguments to this
634 function were (buffer-string &optional START END BUFFER)." 653 function were (buffer-string &optional START END BUFFER)."
635 (if (or (null buffer) 654 (cond
636 (bufferp buffer) 655 ((or (stringp buffer) (bufferp buffer))
637 (stringp buffer)) 656 ;; Most definitely the new way.
638 ;; The new way 657 (buffer-substring nil nil buffer))
639 (buffer-substring nil nil buffer) 658 ((or (stringp old-buffer) (bufferp old-buffer)
640 ;; The old way 659 (natnump buffer) (natnump old-end))
641 (buffer-substring buffer old-end old-buffer))) 660 ;; Definitely the old way.
661 (buffer-substring buffer old-end old-buffer))
662 (t
663 ;; Probably the old way.
664 (buffer-substring buffer old-end old-buffer))))
642 665
643 ;; This was not present before. I think Jamie had some objections 666 ;; This was not present before. I think Jamie had some objections
644 ;; to this, so I'm leaving this undefined for now. --ben 667 ;; to this, so I'm leaving this undefined for now. --ben
645 668
646 ;;; The objection is this: there is more than one way to load the same file. 669 ;;; The objection is this: there is more than one way to load the same file.