Mercurial > hg > xemacs-beta

comparison lisp/subr.el @ 361:7347b34c275b r21-1-10

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-10
author cvs
date Mon, 13 Aug 2007 10:58:40 +0200
parents 8429d81ab209
children a4f53d9b3154
comparison
equal deleted inserted replaced
360:0f00b38cfccb 361:7347b34c275b
320 320
321 (defmacro with-output-to-string (&rest forms) 321 (defmacro with-output-to-string (&rest forms)
322 "Collect output to `standard-output' while evaluating FORMS and return 322 "Collect output to `standard-output' while evaluating FORMS and return
323 it as a string." 323 it as a string."
324 ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu> w/ mods from Stig 324 ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu> w/ mods from Stig
325 `(with-current-buffer (get-buffer-create " *string-output*") 325 `(with-current-buffer (get-buffer-create
326 (generate-new-buffer-name " *string-output*"))
326 (setq buffer-read-only nil) 327 (setq buffer-read-only nil)
327 (buffer-disable-undo (current-buffer)) 328 (buffer-disable-undo (current-buffer))
328 (erase-buffer) 329 (erase-buffer)
329 (let ((standard-output (current-buffer))) 330 (let ((standard-output (current-buffer)))
330 ,@forms) 331 ,@forms)
369 (with-current-buffer ,temp-buffer 370 (with-current-buffer ,temp-buffer
370 ,@forms) 371 ,@forms)
371 (and (buffer-name ,temp-buffer) 372 (and (buffer-name ,temp-buffer)
372 (kill-buffer ,temp-buffer)))))) 373 (kill-buffer ,temp-buffer))))))
373 374
374 ;; Moved from mule-coding.el.
375 (defmacro with-string-as-buffer-contents (str &rest body) 375 (defmacro with-string-as-buffer-contents (str &rest body)
376 "With the contents of the current buffer being STR, run BODY. 376 "With the contents of the current buffer being STR, run BODY.
377 Returns the new contents of the buffer, as modified by BODY. 377 Returns the new contents of the buffer, as modified by BODY.
378 The original current buffer is restored afterwards." 378 The original current buffer is restored afterwards."
379 `(let ((tempbuf (get-buffer-create " *string-as-buffer-contents*"))) 379 `(with-temp-buffer
380 (with-current-buffer tempbuf 380 (insert ,str)
381 (unwind-protect 381 ,@body
382 (progn 382 (buffer-string)))
383 (buffer-disable-undo (current-buffer))
384 (erase-buffer)
385 (insert ,str)
386 ,@body
387 (buffer-string))
388 (erase-buffer tempbuf)))))
389 383
390 (defun insert-face (string face) 384 (defun insert-face (string face)
391 "Insert STRING and highlight with FACE. Return the extent created." 385 "Insert STRING and highlight with FACE. Return the extent created."
392 (let ((p (point)) ext) 386 (let ((p (point)) ext)
393 (insert string) 387 (insert string)