Mercurial > hg > xemacs-beta

comparison lisp/format.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents 3ecd8885ac67
children 517f6887fbc0
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
310 (interactive 310 (interactive
311 (list (format-read (format "Translate buffer to format (default %s): " 311 (list (format-read (format "Translate buffer to format (default %s): "
312 buffer-file-format)))) 312 buffer-file-format))))
313 (format-encode-region (point-min) (point-max) format)) 313 (format-encode-region (point-min) (point-max) format))
314 314
315 (defun format-encode-region (beg end &optional format) 315 (defun format-encode-region (start end &optional format)
316 "Translate the region into some FORMAT. 316 "Translate the region into some FORMAT.
317 FORMAT defaults to `buffer-file-format', it is a symbol naming 317 FORMAT defaults to `buffer-file-format', it is a symbol naming
318 one of the formats defined in `format-alist', or a list of such symbols." 318 one of the formats defined in `format-alist', or a list of such symbols."
319 (interactive 319 (interactive
320 (list (region-beginning) (region-end) 320 (list (region-beginning) (region-end)
332 (modify (nth 5 info)) 332 (modify (nth 5 info))
333 ;; result 333 ;; result
334 ) 334 )
335 (if to-fn 335 (if to-fn
336 (if modify 336 (if modify
337 (setq end (format-encode-run-method to-fn beg end 337 (setq end (format-encode-run-method to-fn start end
338 (current-buffer))) 338 (current-buffer)))
339 (format-insert-annotations 339 (format-insert-annotations
340 (funcall to-fn beg end (current-buffer))))) 340 (funcall to-fn start end (current-buffer)))))
341 (setq format (cdr format))))))) 341 (setq format (cdr format)))))))
342 342
343 (defun format-write-file (filename format) 343 (defun format-write-file (filename format)
344 "Write current buffer into a FILE using some FORMAT. 344 "Write current buffer into a FILE using some FORMAT.
345 Makes buffer visit that file and sets the format as the default for future 345 Makes buffer visit that file and sets the format as the default for future
372 (let ((format-alist nil)) 372 (let ((format-alist nil))
373 (find-file filename)) 373 (find-file filename))
374 (if format 374 (if format
375 (format-decode-buffer format))) 375 (format-decode-buffer format)))
376 376
377 (defun format-insert-file (filename format &optional beg end) 377 (defun format-insert-file (filename format &optional start end)
378 "Insert the contents of file FILE using data format FORMAT. 378 "Insert the contents of file FILE using data format FORMAT.
379 If FORMAT is nil then do not do any format conversion. 379 If FORMAT is nil then do not do any format conversion.
380 The optional third and fourth arguments BEG and END specify 380 The optional third and fourth arguments START and END specify
381 the part of the file to read. 381 the part of the file to read.
382 382
383 The return value is like the value of `insert-file-contents': 383 The return value is like the value of `insert-file-contents':
384 a list (ABSOLUTE-FILE-NAME . SIZE)." 384 a list (ABSOLUTE-FILE-NAME . SIZE)."
385 (interactive 385 (interactive
388 (fmt (format-read (format "Read file `%s' in format: " 388 (fmt (format-read (format "Read file `%s' in format: "
389 (file-name-nondirectory file))))) 389 (file-name-nondirectory file)))))
390 (list file fmt))) 390 (list file fmt)))
391 (let (value size) 391 (let (value size)
392 (let ((format-alist nil)) 392 (let ((format-alist nil))
393 (setq value (insert-file-contents filename nil beg end)) 393 (setq value (insert-file-contents filename nil start end))
394 (setq size (nth 1 value))) 394 (setq size (nth 1 value)))
395 (if format 395 (if format
396 (setq size (format-decode format size) 396 (setq size (format-decode format size)
397 value (cons (car value) size))) 397 value (cons (car value) size)))
398 value)) 398 value))
410 ;;; 410 ;;;
411 ;;; Below are some functions that may be useful in writing encoding and 411 ;;; Below are some functions that may be useful in writing encoding and
412 ;;; decoding functions for use in format-alist. 412 ;;; decoding functions for use in format-alist.
413 ;;; 413 ;;;
414 414
415 (defun format-replace-strings (alist &optional reverse beg end) 415 (defun format-replace-strings (alist &optional reverse start end)
416 "Do multiple replacements on the buffer. 416 "Do multiple replacements on the buffer.
417 ALIST is a list of (from . to) pairs, which should be proper arguments to 417 ALIST is a list of (from . to) pairs, which should be proper arguments to
418 `search-forward' and `replace-match' respectively. 418 `search-forward' and `replace-match' respectively.
419 Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that 419 Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that
420 you can use the same list in both directions if it contains only literal 420 you can use the same list in both directions if it contains only literal
421 strings. 421 strings.
422 Optional args BEGIN and END specify a region of the buffer to operate on." 422 Optional args BEGIN and END specify a region of the buffer to operate on."
423 (save-excursion 423 (save-excursion
424 (save-restriction 424 (save-restriction
425 (or beg (setq beg (point-min))) 425 (or start (setq start (point-min)))
426 (if end (narrow-to-region (point-min) end)) 426 (if end (narrow-to-region (point-min) end))
427 (while alist 427 (while alist
428 (let ((from (if reverse (cdr (car alist)) (car (car alist)))) 428 (let ((from (if reverse (cdr (car alist)) (car (car alist))))
429 (to (if reverse (car (cdr alist)) (cdr (car alist))))) 429 (to (if reverse (car (cdr alist)) (cdr (car alist)))))
430 (goto-char beg) 430 (goto-char start)
431 (while (search-forward from nil t) 431 (while (search-forward from nil t)
432 (goto-char (match-beginning 0)) 432 (goto-char (match-beginning 0))
433 (insert to) 433 (insert to)
434 (set-text-properties (- (point) (length to)) (point) 434 (set-text-properties (- (point) (length to)) (point)
435 (text-properties-at (point))) 435 (text-properties-at (point)))