Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnheader.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents d95e72db5c07
children d620409f5eb8
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
54 54
55 (eval-and-compile 55 (eval-and-compile
56 (autoload 'nnmail-message-id "nnmail") 56 (autoload 'nnmail-message-id "nnmail")
57 (autoload 'mail-position-on-field "sendmail") 57 (autoload 'mail-position-on-field "sendmail")
58 (autoload 'message-remove-header "message") 58 (autoload 'message-remove-header "message")
59 (autoload 'cancel-function-timers "timers")) 59 (autoload 'cancel-function-timers "timers")
60 (autoload 'gnus-point-at-eol "gnus-util")
61 (autoload 'gnus-buffer-live-p "gnus-util"))
60 62
61 ;;; Header access macros. 63 ;;; Header access macros.
62 64
63 (defmacro mail-header-number (header) 65 (defmacro mail-header-number (header)
64 "Return article number in HEADER." 66 "Return article number in HEADER."
140 142
141 (defun make-full-mail-header (&optional number subject from date id 143 (defun make-full-mail-header (&optional number subject from date id
142 references chars lines xref) 144 references chars lines xref)
143 "Create a new mail header structure initialized with the parameters given." 145 "Create a new mail header structure initialized with the parameters given."
144 (vector number subject from date id references chars lines xref)) 146 (vector number subject from date id references chars lines xref))
145 147
146 ;; fake message-ids: generation and detection 148 ;; fake message-ids: generation and detection
147 149
148 (defvar nnheader-fake-message-id 1) 150 (defvar nnheader-fake-message-id 1)
149 151
150 (defsubst nnheader-generate-fake-message-id () 152 (defsubst nnheader-generate-fake-message-id ()
279 (nnheader-nov-field)) ; misc 281 (nnheader-nov-field)) ; misc
280 ))) 282 )))
281 283
282 (defun nnheader-insert-nov (header) 284 (defun nnheader-insert-nov (header)
283 (princ (mail-header-number header) (current-buffer)) 285 (princ (mail-header-number header) (current-buffer))
284 (insert 286 (insert
285 "\t" 287 "\t"
286 (or (mail-header-subject header) "(none)") "\t" 288 (or (mail-header-subject header) "(none)") "\t"
287 (or (mail-header-from header) "(nobody)") "\t" 289 (or (mail-header-from header) "(nobody)") "\t"
288 (or (mail-header-date header) "") "\t" 290 (or (mail-header-date header) "") "\t"
289 (or (mail-header-id header) 291 (or (mail-header-id header)
311 (defun nnheader-nov-delete-outside-range (beg end) 313 (defun nnheader-nov-delete-outside-range (beg end)
312 "Delete all NOV lines that lie outside the BEG to END range." 314 "Delete all NOV lines that lie outside the BEG to END range."
313 ;; First we find the first wanted line. 315 ;; First we find the first wanted line.
314 (nnheader-find-nov-line beg) 316 (nnheader-find-nov-line beg)
315 (delete-region (point-min) (point)) 317 (delete-region (point-min) (point))
316 ;; Then we find the last wanted line. 318 ;; Then we find the last wanted line.
317 (when (nnheader-find-nov-line end) 319 (when (nnheader-find-nov-line end)
318 (forward-line 1)) 320 (forward-line 1))
319 (delete-region (point) (point-max))) 321 (delete-region (point) (point-max)))
320 322
321 (defun nnheader-find-nov-line (article) 323 (defun nnheader-find-nov-line (article)
527 (put 'nnheader-temp-write 'edebug-form-spec '(form body)) 529 (put 'nnheader-temp-write 'edebug-form-spec '(form body))
528 530
529 (defvar jka-compr-compression-info-list) 531 (defvar jka-compr-compression-info-list)
530 (defvar nnheader-numerical-files 532 (defvar nnheader-numerical-files
531 (if (boundp 'jka-compr-compression-info-list) 533 (if (boundp 'jka-compr-compression-info-list)
532 (concat "\\([0-9]+\\)\\(" 534 (concat "\\([0-9]+\\)\\("
533 (mapconcat (lambda (i) (aref i 0)) 535 (mapconcat (lambda (i) (aref i 0))
534 jka-compr-compression-info-list "\\|") 536 jka-compr-compression-info-list "\\|")
535 "\\)?") 537 "\\)?")
536 "[0-9]+$") 538 "[0-9]+$")
537 "Regexp that match numerical files.") 539 "Regexp that match numerical files.")
550 (string-to-int (match-string 0 file)))) 552 (string-to-int (match-string 0 file))))
551 553
552 (defun nnheader-directory-files-safe (&rest args) 554 (defun nnheader-directory-files-safe (&rest args)
553 ;; It has been reported numerous times that `directory-files' 555 ;; It has been reported numerous times that `directory-files'
554 ;; fails with an alarming frequency on NFS mounted file systems. 556 ;; fails with an alarming frequency on NFS mounted file systems.
555 ;; This function executes that function twice and returns 557 ;; This function executes that function twice and returns
556 ;; the longest result. 558 ;; the longest result.
557 (let ((first (apply 'directory-files args)) 559 (let ((first (apply 'directory-files args))
558 (second (apply 'directory-files args))) 560 (second (apply 'directory-files args)))
559 (if (> (length first) (length second)) 561 (if (> (length first) (length second))
560 first 562 first
577 (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " ")) 579 (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " "))
578 580
579 (defun nnheader-translate-file-chars (file) 581 (defun nnheader-translate-file-chars (file)
580 (if (null nnheader-file-name-translation-alist) 582 (if (null nnheader-file-name-translation-alist)
581 ;; No translation is necessary. 583 ;; No translation is necessary.
582 file 584 file
583 ;; We translate -- but only the file name. We leave the directory 585 ;; We translate -- but only the file name. We leave the directory
584 ;; alone. 586 ;; alone.
585 (let* ((i 0) 587 (let* ((i 0)
586 trans leaf path len) 588 trans leaf path len)
587 (if (string-match "/[^/]+\\'" file) 589 (if (string-match "/[^/]+\\'" file)
625 (if (string-match "%" format) 627 (if (string-match "%" format)
626 (insert (apply 'format format args)) 628 (insert (apply 'format format args))
627 (apply 'insert format args)) 629 (apply 'insert format args))
628 t)) 630 t))
629 631
630 (defun nnheader-mail-file-mbox-p (file)
631 "Say whether FILE looks like an Unix mbox file."
632 (when (and (file-exists-p file)
633 (file-readable-p file)
634 (file-regular-p file))
635 (save-excursion
636 (nnheader-set-temp-buffer " *mail-file-mbox-p*")
637 (nnheader-insert-file-contents file)
638 (goto-char (point-min))
639 (prog1
640 (looking-at message-unix-mail-delimiter)
641 (kill-buffer (current-buffer))))))
642
643 (defun nnheader-replace-chars-in-string (string from to) 632 (defun nnheader-replace-chars-in-string (string from to)
644 "Replace characters in STRING from FROM to TO." 633 "Replace characters in STRING from FROM to TO."
645 (let ((string (substring string 0)) ;Copy string. 634 (let ((string (substring string 0)) ;Copy string.
646 (len (length string)) 635 (len (length string))
647 (idx 0)) 636 (idx 0))
652 (setq idx (1+ idx))) 641 (setq idx (1+ idx)))
653 string)) 642 string))
654 643
655 (defun nnheader-file-to-group (file &optional top) 644 (defun nnheader-file-to-group (file &optional top)
656 "Return a group name based on FILE and TOP." 645 "Return a group name based on FILE and TOP."
657 (nnheader-replace-chars-in-string 646 (nnheader-replace-chars-in-string
658 (if (not top) 647 (if (not top)
659 file 648 file
660 (condition-case () 649 (condition-case ()
661 (substring (expand-file-name file) 650 (substring (expand-file-name file)
662 (length 651 (length
663 (expand-file-name 652 (expand-file-name
664 (file-name-as-directory top)))) 653 (file-name-as-directory top))))
665 (error ""))) 654 (error "")))
666 ?/ ?.)) 655 ?/ ?.))
667 656
721 (if (and (car path) 710 (if (and (car path)
722 (file-exists-p 711 (file-exists-p
723 (setq dir (concat 712 (setq dir (concat
724 (file-name-directory 713 (file-name-directory
725 (directory-file-name (car path))) 714 (directory-file-name (car path)))
726 "etc/" package 715 "etc/" package
727 (if file "" "/")))) 716 (if file "" "/"))))
728 (or file (file-directory-p dir))) 717 (or file (file-directory-p dir)))
729 (setq result dir 718 (setq result dir
730 path nil) 719 path nil)
731 (setq path (cdr path)))) 720 (setq path (cdr path))))
790 (buffer-disable-undo (current-buffer)) 779 (buffer-disable-undo (current-buffer))
791 (set-buffer cur) 780 (set-buffer cur)
792 (goto-char (point-min)) 781 (goto-char (point-min))
793 (while (,(if regexp 're-search-forward 'search-forward) 782 (while (,(if regexp 're-search-forward 'search-forward)
794 ,from nil t) 783 ,from nil t)
795 (insert-buffer-substring 784 (insert-buffer-substring
796 cur start (prog1 (match-beginning 0) (set-buffer new))) 785 cur start (prog1 (match-beginning 0) (set-buffer new)))
797 (goto-char (point-max)) 786 (goto-char (point-max))
798 ,(when to `(insert ,to)) 787 ,(when to `(insert ,to))
799 (set-buffer cur) 788 (set-buffer cur)
800 (setq start (point))) 789 (setq start (point)))
801 (insert-buffer-substring 790 (insert-buffer-substring
802 cur start (prog1 (point-max) (set-buffer new))) 791 cur start (prog1 (point-max) (set-buffer new)))
803 (copy-to-buffer cur (point-min) (point-max)) 792 (copy-to-buffer cur (point-min) (point-max))
804 (kill-buffer (current-buffer)) 793 (kill-buffer (current-buffer))
805 (set-buffer cur))) 794 (set-buffer cur)))
806 795