Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnmail.el @ 104:cf808b4c4290 r20-1b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b4
author cvs
date Mon, 13 Aug 2007 09:16:51 +0200
parents 4be1180a9e89
children 360340f9fd5f
comparison
equal deleted inserted replaced
103:30eda07fe280 104:cf808b4c4290
530 (when (and (file-exists-p nnmail-crash-box) 530 (when (and (file-exists-p nnmail-crash-box)
531 (zerop (nnheader-file-size (file-truename nnmail-crash-box)))) 531 (zerop (nnheader-file-size (file-truename nnmail-crash-box))))
532 (delete-file nnmail-crash-box)) 532 (delete-file nnmail-crash-box))
533 (let ((inbox (file-truename (expand-file-name inbox))) 533 (let ((inbox (file-truename (expand-file-name inbox)))
534 (tofile (file-truename (expand-file-name nnmail-crash-box))) 534 (tofile (file-truename (expand-file-name nnmail-crash-box)))
535 movemail popmail errors) 535 movemail popmail errors result)
536 (if (setq popmail (string-match 536 (if (setq popmail (string-match
537 "^po:" (file-name-nondirectory inbox))) 537 "^po:" (file-name-nondirectory inbox)))
538 (setq inbox (file-name-nondirectory inbox)) 538 (setq inbox (file-name-nondirectory inbox))
539 (setq movemail t) 539 (setq movemail t)
540 ;; On some systems, /usr/spool/mail/foo is a directory 540 ;; On some systems, /usr/spool/mail/foo is a directory
580 (setq errors (generate-new-buffer " *nnmail loss*")) 580 (setq errors (generate-new-buffer " *nnmail loss*"))
581 (buffer-disable-undo errors) 581 (buffer-disable-undo errors)
582 (let ((default-directory "/")) 582 (let ((default-directory "/"))
583 (if (nnheader-functionp nnmail-movemail-program) 583 (if (nnheader-functionp nnmail-movemail-program)
584 (funcall nnmail-movemail-program inbox tofile) 584 (funcall nnmail-movemail-program inbox tofile)
585 (apply 585 (setq result
586 'call-process 586 (apply
587 (append 587 'call-process
588 (list 588 (append
589 (expand-file-name 589 (list
590 nnmail-movemail-program exec-directory) 590 (expand-file-name
591 nil errors nil inbox tofile) 591 nnmail-movemail-program exec-directory)
592 (when nnmail-internal-password 592 nil errors nil inbox tofile)
593 (list nnmail-internal-password)))))) 593 (when nnmail-internal-password
594 (if (not (buffer-modified-p errors)) 594 (list nnmail-internal-password)))))))
595 (if (and (not (buffer-modified-p errors))
596 (zerop result))
595 ;; No output => movemail won 597 ;; No output => movemail won
596 (progn 598 (progn
597 (unless popmail 599 (unless popmail
598 (when (file-exists-p tofile) 600 (when (file-exists-p tofile)
599 (set-file-modes tofile nnmail-default-file-modes))) 601 (set-file-modes tofile nnmail-default-file-modes)))
615 (delete-region (point) (point-max)) 617 (delete-region (point) (point-max))
616 (goto-char (point-min)) 618 (goto-char (point-min))
617 (when (looking-at "movemail: ") 619 (when (looking-at "movemail: ")
618 (delete-region (point-min) (match-end 0))) 620 (delete-region (point-min) (match-end 0)))
619 (unless (yes-or-no-p 621 (unless (yes-or-no-p
620 (format "movemail: %s. Continue? " 622 (format "movemail: %s (%d return). Continue? "
621 (buffer-string))) 623 (buffer-string) result))
622 (error "%s" (buffer-string))) 624 (error "%s" (buffer-string)))
623 (setq tofile nil))))))) 625 (setq tofile nil)))))))
624 (message "Getting mail from %s...done" inbox) 626 (message "Getting mail from %s...done" inbox)
625 (and errors 627 (and errors
626 (buffer-name errors) 628 (buffer-name errors)
705 (replace-match "X-From-Line: ") ) 707 (replace-match "X-From-Line: ") )
706 (run-hooks 'nnmail-prepare-incoming-header-hook) 708 (run-hooks 'nnmail-prepare-incoming-header-hook)
707 (goto-char (point-max)) 709 (goto-char (point-max))
708 ;; Find the Message-ID header. 710 ;; Find the Message-ID header.
709 (save-excursion 711 (save-excursion
710 (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) 712 (if (re-search-backward
713 "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
711 (setq message-id (buffer-substring (match-beginning 1) 714 (setq message-id (buffer-substring (match-beginning 1)
712 (match-end 1))) 715 (match-end 1)))
713 ;; There is no Message-ID here, so we create one. 716 ;; There is no Message-ID here, so we create one.
714 (save-excursion 717 (save-excursion
715 (when (re-search-backward "^Message-ID:" nil t) 718 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
716 (beginning-of-line) 719 (beginning-of-line)
717 (insert "Original-"))) 720 (insert "Original-")))
718 (forward-line -1) 721 (forward-line -1)
719 (insert "Message-ID: " (setq message-id (nnmail-message-id)) 722 (insert "Message-ID: " (setq message-id (nnmail-message-id))
720 "\n"))) 723 "\n")))
779 (= (following-char) ?\n))) 782 (= (following-char) ?\n)))
780 (save-excursion 783 (save-excursion
781 (forward-line 1) 784 (forward-line 1)
782 (while (looking-at ">From ") 785 (while (looking-at ">From ")
783 (forward-line 1)) 786 (forward-line 1))
784 (looking-at "[^ \t:]+[ \t]*:"))) 787 (looking-at "[^ \n\t:]+[ \n\t]*:")))
785 (setq found 'yes))))) 788 (setq found 'yes)))))
786 (beginning-of-line) 789 (beginning-of-line)
787 (eq found 'yes))) 790 (eq found 'yes)))
788 791
789 (defun nnmail-search-unix-mail-delim-backward () 792 (defun nnmail-search-unix-mail-delim-backward ()
808 (= (following-char) ?\n))) 811 (= (following-char) ?\n)))
809 (save-excursion 812 (save-excursion
810 (forward-line 1) 813 (forward-line 1)
811 (while (looking-at ">From ") 814 (while (looking-at ">From ")
812 (forward-line 1)) 815 (forward-line 1))
813 (looking-at "[^ \t:]+[ \t]*:"))) 816 (looking-at "[^ \n\t:]+[ \n\t]*:")))
814 (setq found 'yes))))) 817 (setq found 'yes)))))
815 (beginning-of-line) 818 (beginning-of-line)
816 (eq found 'yes))) 819 (eq found 'yes)))
817 820
818 (defun nnmail-process-unix-mail-format (func artnum-func) 821 (defun nnmail-process-unix-mail-format (func artnum-func)
838 (not (eobp))) 841 (not (eobp)))
839 (forward-line 1) 842 (forward-line 1)
840 (point)))) 843 (point))))
841 ;; Find the Message-ID header. 844 ;; Find the Message-ID header.
842 (goto-char (point-min)) 845 (goto-char (point-min))
843 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) 846 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
844 (setq message-id (match-string 1)) 847 (setq message-id (match-string 1))
845 (save-excursion 848 (save-excursion
846 (when (re-search-forward "^Message-ID:" nil t) 849 (when (re-search-forward "^Message-ID[ \t]*:" nil t)
847 (beginning-of-line) 850 (beginning-of-line)
848 (insert "Original-"))) 851 (insert "Original-")))
849 ;; There is no Message-ID here, so we create one. 852 ;; There is no Message-ID here, so we create one.
850 (forward-line 1) 853 (forward-line 1)
851 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) 854 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
922 (not (eobp))) 925 (not (eobp)))
923 (forward-line 1) 926 (forward-line 1)
924 (point)))) 927 (point))))
925 ;; Find the Message-ID header. 928 ;; Find the Message-ID header.
926 (goto-char (point-min)) 929 (goto-char (point-min))
927 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) 930 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
928 (setq message-id (match-string 1)) 931 (setq message-id (match-string 1))
929 ;; There is no Message-ID here, so we create one. 932 ;; There is no Message-ID here, so we create one.
930 (save-excursion 933 (save-excursion
931 (when (re-search-backward "^Message-ID:" nil t) 934 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
932 (beginning-of-line) 935 (beginning-of-line)
933 (insert "Original-"))) 936 (insert "Original-")))
934 (forward-line 1) 937 (forward-line 1)
935 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) 938 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
936 (run-hooks 'nnmail-prepare-incoming-header-hook) 939 (run-hooks 'nnmail-prepare-incoming-header-hook)
1441 ((eq action 'warn) 1444 ((eq action 'warn)
1442 ;; We insert a warning. 1445 ;; We insert a warning.
1443 (let ((case-fold-search t) 1446 (let ((case-fold-search t)
1444 (newid (nnmail-message-id))) 1447 (newid (nnmail-message-id)))
1445 (goto-char (point-min)) 1448 (goto-char (point-min))
1446 (when (re-search-forward "^message-id:" nil t) 1449 (when (re-search-forward "^message-id[ \t]*:" nil t)
1447 (beginning-of-line) 1450 (beginning-of-line)
1448 (insert "Original-")) 1451 (insert "Original-"))
1449 (beginning-of-line) 1452 (beginning-of-line)
1450 (insert 1453 (insert
1451 "Message-ID: " newid "\n" 1454 "Message-ID: " newid "\n"
1570 (apply 'format prompt args) 1573 (apply 'format prompt args)
1571 prompt))) 1574 prompt)))
1572 (unless nnmail-read-passwd 1575 (unless nnmail-read-passwd
1573 (if (load "passwd" t) 1576 (if (load "passwd" t)
1574 (setq nnmail-read-passwd 'read-passwd) 1577 (setq nnmail-read-passwd 'read-passwd)
1575 (autoload 'ange-ftp-read-passwd "ange-ftp") 1578 (unless (fboundp 'ange-ftp-read-passwd)
1579 (autoload 'ange-ftp-read-passwd "ange-ftp"))
1576 (setq nnmail-read-passwd 'ange-ftp-read-passwd))) 1580 (setq nnmail-read-passwd 'ange-ftp-read-passwd)))
1577 (funcall nnmail-read-passwd prompt))) 1581 (funcall nnmail-read-passwd prompt)))
1578 1582
1579 (defun nnmail-check-syntax () 1583 (defun nnmail-check-syntax ()
1580 "Check (and modify) the syntax of the message in the current buffer." 1584 "Check (and modify) the syntax of the message in the current buffer."
1581 (save-restriction 1585 (save-restriction
1582 (message-narrow-to-head) 1586 (message-narrow-to-head)
1583 (let ((case-fold-search t)) 1587 (let ((case-fold-search t))
1584 (unless (re-search-forward "^Message-ID:" nil t) 1588 (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
1585 (insert "Message-ID: " (nnmail-message-id) "\n"))))) 1589 (insert "Message-ID: " (nnmail-message-id) "\n")))))
1586 1590
1587 (defun nnmail-write-region (start end filename &optional append visit lockname) 1591 (defun nnmail-write-region (start end filename &optional append visit lockname)
1588 "Do a `write-region', and then set the file modes." 1592 "Do a `write-region', and then set the file modes."
1589 (write-region start end filename append visit lockname) 1593 (write-region start end filename append visit lockname)