Mercurial > hg > xemacs-beta

comparison lisp/prim/subr.el @ 104:cf808b4c4290 r20-1b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b4
author cvs
date Mon, 13 Aug 2007 09:16:51 +0200
parents c7528f8e288d
children 360340f9fd5f
comparison
equal deleted inserted replaced
103:30eda07fe280 104:cf808b4c4290
329 (,@ forms)) 329 (,@ forms))
330 (prog1 330 (prog1
331 (buffer-string) 331 (buffer-string)
332 (erase-buffer))))) 332 (erase-buffer)))))
333 333
334 (defmacro with-temp-buffer (&rest forms)
335 "Create a temporary buffer, and evaluate FORMS there like `progn'."
336 (let ((temp-buffer (make-symbol "temp-buffer")))
337 `(let ((,temp-buffer
338 (get-buffer-create (generate-new-buffer-name " *temp*"))))
339 (unwind-protect
340 (save-excursion
341 (set-buffer ,temp-buffer)
342 ,@forms)
343 (and (buffer-name ,temp-buffer)
344 (kill-buffer ,temp-buffer))))))
345
346 ;; Moved from mule-coding.el.
347 (defmacro with-string-as-buffer-contents (str &rest body)
348 "With the contents of the current buffer being STR, run BODY.
349 Returns the new contents of the buffer, as modified by BODY.
350 The original current buffer is restored afterwards."
351 `(let ((curbuf (current-buffer))
352 (tempbuf (get-buffer-create " *string-as-buffer-contents*")))
353 (unwind-protect
354 (progn
355 (set-buffer tempbuf)
356 (buffer-disable-undo (current-buffer))
357 (erase-buffer)
358 (insert ,str)
359 ,@body
360 (buffer-string))
361 (erase-buffer tempbuf)
362 (set-buffer curbuf))))
363
334 (defun insert-face (string face) 364 (defun insert-face (string face)
335 "Insert STRING and highlight with FACE. Returns the extent created." 365 "Insert STRING and highlight with FACE. Returns the extent created."
336 (let ((p (point)) ext) 366 (let ((p (point)) ext)
337 (insert string) 367 (insert string)
338 (setq ext (make-extent p (point))) 368 (setq ext (make-extent p (point)))
540 ;;; it should work off of a hook on `provide'. Features are unique and 570 ;;; it should work off of a hook on `provide'. Features are unique and
541 ;;; the arguments to (load) are not. --Stig 571 ;;; the arguments to (load) are not. --Stig
542 572
543 ;;;; Specifying things to do after certain files are loaded. 573 ;;;; Specifying things to do after certain files are loaded.
544 574
545 ;(defun eval-after-load (file form) 575 (defun eval-after-load (file form)
546 ; "Arrange that, if FILE is ever loaded, FORM will be run at that time. 576 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
547 ;This makes or adds to an entry on `after-load-alist'. 577 This makes or adds to an entry on `after-load-alist'.
548 ;If FILE is already loaded, evaluate FORM right now. 578 If FILE is already loaded, evaluate FORM right now.
549 ;It does nothing if FORM is already on the list for FILE. 579 It does nothing if FORM is already on the list for FILE.
550 ;FILE should be the name of a library, with no directory name." 580 FILE should be the name of a library, with no directory name."
551 ; ;; Make sure there is an element for FILE. 581 ;; Make sure there is an element for FILE.
552 ; (or (assoc file after-load-alist) 582 (or (assoc file after-load-alist)
553 ; (setq after-load-alist (cons (list file) after-load-alist))) 583 (setq after-load-alist (cons (list file) after-load-alist)))
554 ; ;; Add FORM to the element if it isn't there. 584 ;; Add FORM to the element if it isn't there.
555 ; (let ((elt (assoc file after-load-alist))) 585 (let ((elt (assoc file after-load-alist)))
556 ; (or (member form (cdr elt)) 586 (or (member form (cdr elt))
557 ; (progn 587 (progn
558 ; (nconc elt (list form)) 588 (nconc elt (list form))
559 ; ;; If the file has been loaded already, run FORM right away. 589 ;; If the file has been loaded already, run FORM right away.
560 ; (and (assoc file load-history) 590 (and (assoc file load-history)
561 ; (eval form))))) 591 (eval form)))))
562 ; form) 592 form)
563 ; 593 (make-compatible 'eval-after-load "")
564 ;(defun eval-next-after-load (file) 594
565 ; "Read the following input sexp, and run it whenever FILE is loaded. 595 (defun eval-next-after-load (file)
566 ;This makes or adds to an entry on `after-load-alist'. 596 "Read the following input sexp, and run it whenever FILE is loaded.
567 ;FILE should be the name of a library, with no directory name." 597 This makes or adds to an entry on `after-load-alist'.
568 ; (eval-after-load file (read))) 598 FILE should be the name of a library, with no directory name."
599 (eval-after-load file (read)))
600 (make-compatible 'eval-next-after-load "")
569 601
570 ; alternate names (not obsolete) 602 ; alternate names (not obsolete)
571 (if (not (fboundp 'mod)) (define-function 'mod '%)) 603 (if (not (fboundp 'mod)) (define-function 'mod '%))
572 (define-function 'move-marker 'set-marker) 604 (define-function 'move-marker 'set-marker)
573 (define-function 'beep 'ding) ; preserve lingual purity 605 (define-function 'beep 'ding) ; preserve lingual purity