Mercurial > hg > xemacs-beta

comparison lisp/prim/subr.el @ 163:0132846995bd r20-3b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b8
author cvs
date Mon, 13 Aug 2007 09:43:35 +0200
parents 28f395d8dc7a
children 5a88923fcbfe
comparison
equal deleted inserted replaced
162:4de2936b4e77 163:0132846995bd
235 just before emacs is actually killed.") 235 just before emacs is actually killed.")
236 236
237 ;; not obsolete. 237 ;; not obsolete.
238 (define-function 'rplaca 'setcar) 238 (define-function 'rplaca 'setcar)
239 (define-function 'rplacd 'setcdr) 239 (define-function 'rplacd 'setcdr)
240
241 ;; XEmacs
242 (defun mapvector (__function __seq)
243 "Apply FUNCTION to each element of SEQ, making a vector of the results.
244 The result is a vector of the same length as SEQ.
245 SEQ may be a list, a vector or a string."
246 (let* ((len (length __seq))
247 (vec (make-vector len 'nil))
248 (i 0))
249 (while (< i len)
250 (aset vec i (funcall __function (cond ((listp __seq)
251 (nth i __seq))
252 (t (aref __seq i)))))
253 (setq i (+ i 1)))
254 vec))
255 240
256 ;;;; String functions. 241 ;;;; String functions.
257 242
258 ;; XEmacs 243 ;; XEmacs
259 (defun replace-in-string (str regexp newtext &optional literal) 244 (defun replace-in-string (str regexp newtext &optional literal)
320 305
321 (defmacro with-output-to-string (&rest forms) 306 (defmacro with-output-to-string (&rest forms)
322 "Collect output to `standard-output' while evaluating FORMS and return 307 "Collect output to `standard-output' while evaluating FORMS and return
323 it as a string." 308 it as a string."
324 ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu> w/ mods from Stig 309 ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu> w/ mods from Stig
325 (` (save-excursion 310 (` (with-current-buffer (get-buffer-create " *string-output*")
326 (set-buffer (get-buffer-create " *string-output*"))
327 (setq buffer-read-only nil) 311 (setq buffer-read-only nil)
328 (buffer-disable-undo (current-buffer)) 312 (buffer-disable-undo (current-buffer))
329 (erase-buffer) 313 (erase-buffer)
330 (let ((standard-output (current-buffer))) 314 (let ((standard-output (current-buffer)))
331 (,@ forms)) 315 (,@ forms))
364 "Create a temporary buffer, and evaluate FORMS there like `progn'." 348 "Create a temporary buffer, and evaluate FORMS there like `progn'."
365 (let ((temp-buffer (make-symbol "temp-buffer"))) 349 (let ((temp-buffer (make-symbol "temp-buffer")))
366 `(let ((,temp-buffer 350 `(let ((,temp-buffer
367 (get-buffer-create (generate-new-buffer-name " *temp*")))) 351 (get-buffer-create (generate-new-buffer-name " *temp*"))))
368 (unwind-protect 352 (unwind-protect
369 (save-excursion 353 (with-current-buffer ,temp-buffer
370 (set-buffer ,temp-buffer)
371 ,@forms) 354 ,@forms)
372 (and (buffer-name ,temp-buffer) 355 (and (buffer-name ,temp-buffer)
373 (kill-buffer ,temp-buffer)))))) 356 (kill-buffer ,temp-buffer))))))
374 357
375 ;; Moved from mule-coding.el. 358 ;; Moved from mule-coding.el.
376 (defmacro with-string-as-buffer-contents (str &rest body) 359 (defmacro with-string-as-buffer-contents (str &rest body)
377 "With the contents of the current buffer being STR, run BODY. 360 "With the contents of the current buffer being STR, run BODY.
378 Returns the new contents of the buffer, as modified by BODY. 361 Returns the new contents of the buffer, as modified by BODY.
379 The original current buffer is restored afterwards." 362 The original current buffer is restored afterwards."
380 `(let ((curbuf (current-buffer)) 363 `(let ((tempbuf (get-buffer-create " *string-as-buffer-contents*")))
381 (tempbuf (get-buffer-create " *string-as-buffer-contents*"))) 364 (with-current-buffer tempbuf
382 (unwind-protect 365 (unwind-protect
383 (progn 366 (progn
384 (set-buffer tempbuf) 367 (buffer-disable-undo (current-buffer))
385 (buffer-disable-undo (current-buffer)) 368 (erase-buffer)
386 (erase-buffer) 369 (insert ,str)
387 (insert ,str) 370 ,@body
388 ,@body 371 (buffer-string))
389 (buffer-string)) 372 (erase-buffer tempbuf)))))
390 (erase-buffer tempbuf)
391 (set-buffer curbuf))))
392 373
393 (defun insert-face (string face) 374 (defun insert-face (string face)
394 "Insert STRING and highlight with FACE. Returns the extent created." 375 "Insert STRING and highlight with FACE. Returns the extent created."
395 (let ((p (point)) ext) 376 (let ((p (point)) ext)
396 (insert string) 377 (insert string)