Mercurial > hg > xemacs-beta

comparison lisp/subr.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents a4f53d9b3154
children d883f39b8495
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
295 (defun split-string (string &optional pattern) 295 (defun split-string (string &optional pattern)
296 "Return a list of substrings of STRING which are separated by PATTERN. 296 "Return a list of substrings of STRING which are separated by PATTERN.
297 If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." 297 If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
298 (or pattern 298 (or pattern
299 (setq pattern "[ \f\t\n\r\v]+")) 299 (setq pattern "[ \f\t\n\r\v]+"))
300 (let (parts (start 0) (len (length string))) 300 ;; The FSF version of this function takes care not to cons in case
301 (if (string-match pattern string) 301 ;; of infloop. Maybe we should synch?
302 (setq parts (cons (substring string 0 (match-beginning 0)) parts) 302 (let (parts (start 0))
303 start (match-end 0))) 303 (while (string-match pattern string start)
304 (while (and (< start len)
305 (string-match pattern string (if (> start (match-beginning 0))
306 start
307 (1+ start))))
308 (setq parts (cons (substring string start (match-beginning 0)) parts) 304 (setq parts (cons (substring string start (match-beginning 0)) parts)
309 start (match-end 0))) 305 start (match-end 0)))
310 (nreverse (cons (substring string start) parts)))) 306 (nreverse (cons (substring string start) parts))))
311 307
312 ;; #### #### #### AAaargh! Must be in C, because it is used insanely 308 ;; #### #### #### AAaargh! Must be in C, because it is used insanely
324 320
325 (defmacro with-output-to-string (&rest forms) 321 (defmacro with-output-to-string (&rest forms)
326 "Collect output to `standard-output' while evaluating FORMS and return 322 "Collect output to `standard-output' while evaluating FORMS and return
327 it as a string." 323 it as a string."
328 ;; 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
329 `(with-current-buffer (get-buffer-create 325 `(with-current-buffer (get-buffer-create " *string-output*")
330 (generate-new-buffer-name " *string-output*"))
331 (setq buffer-read-only nil) 326 (setq buffer-read-only nil)
332 (buffer-disable-undo (current-buffer)) 327 (buffer-disable-undo (current-buffer))
333 (erase-buffer) 328 (erase-buffer)
334 (let ((standard-output (current-buffer))) 329 (let ((standard-output (current-buffer)))
335 ,@forms) 330 ,@forms)
336 (prog1 331 (prog1
337 (buffer-string) 332 (buffer-string)
338 (erase-buffer)))) 333 (erase-buffer))))
339 334
340 (defmacro with-current-buffer (buffer &rest body) 335 (defmacro with-current-buffer (buffer &rest body)
341 "Temporarily make BUFFER the current buffer and execute the forms in BODY. 336 "Execute the forms in BODY with BUFFER as the current buffer.
342 The value returned is the value of the last form in BODY. 337 The value returned is the value of the last form in BODY.
343 See also `with-temp-buffer'." 338 See also `with-temp-buffer'."
344 `(save-current-buffer 339 `(save-current-buffer
345 (set-buffer ,buffer) 340 (set-buffer ,buffer)
346 ,@body)) 341 ,@body))
374 (with-current-buffer ,temp-buffer 369 (with-current-buffer ,temp-buffer
375 ,@forms) 370 ,@forms)
376 (and (buffer-name ,temp-buffer) 371 (and (buffer-name ,temp-buffer)
377 (kill-buffer ,temp-buffer)))))) 372 (kill-buffer ,temp-buffer))))))
378 373
374 ;; Moved from mule-coding.el.
379 (defmacro with-string-as-buffer-contents (str &rest body) 375 (defmacro with-string-as-buffer-contents (str &rest body)
380 "With the contents of the current buffer being STR, run BODY. 376 "With the contents of the current buffer being STR, run BODY.
381 Returns the new contents of the buffer, as modified by BODY. 377 Returns the new contents of the buffer, as modified by BODY.
382 The original current buffer is restored afterwards." 378 The original current buffer is restored afterwards."
383 `(with-temp-buffer 379 `(let ((tempbuf (get-buffer-create " *string-as-buffer-contents*")))
384 (insert ,str) 380 (with-current-buffer tempbuf
385 ,@body 381 (unwind-protect
386 (buffer-string))) 382 (progn
383 (buffer-disable-undo (current-buffer))
384 (erase-buffer)
385 (insert ,str)
386 ,@body
387 (buffer-string))
388 (erase-buffer tempbuf)))))
387 389
388 (defun insert-face (string face) 390 (defun insert-face (string face)
389 "Insert STRING and highlight with FACE. Return the extent created." 391 "Insert STRING and highlight with FACE. Return the extent created."
390 (let ((p (point)) ext) 392 (let ((p (point)) ext)
391 (insert string) 393 (insert string)