/[emacs]/emacs/lisp/gnus/pop3.el
ViewVC logotype

Diff of /emacs/lisp/gnus/pop3.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21.2.2 by miles, Thu Sep 9 09:36:26 2004 UTC revision 1.21.2.3 by miles, Thu Oct 14 08:50:05 2004 UTC
# Line 37  Line 37 
37    
38  (require 'mail-utils)  (require 'mail-utils)
39    
40  (defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)  (defgroup pop3 nil
41    "*POP3 maildrop.")    "Post Office Protocol"
42  (defvar pop3-mailhost (or (getenv "MAILHOST") nil)    :group 'mail
43    "*POP3 mailhost.")    :group 'mail-source)
44  (defvar pop3-port 110  
45    "*POP3 port.")  (defcustom pop3-maildrop (or (user-login-name)
46                                 (getenv "LOGNAME")
47                                 (getenv "USER"))
48      "*POP3 maildrop."
49      :version "21.4" ;; Oort Gnus
50      :type 'string
51      :group 'pop3)
52    
53    (defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
54                                 "pop3")
55      "*POP3 mailhost."
56      :version "21.4" ;; Oort Gnus
57      :type 'string
58      :group 'pop3)
59    
60    (defcustom pop3-port 110
61      "*POP3 port."
62      :version "21.4" ;; Oort Gnus
63      :type 'number
64      :group 'pop3)
65    
66    (defcustom pop3-password-required t
67      "*Non-nil if a password is required when connecting to POP server."
68      :version "21.4" ;; Oort Gnus
69      :type 'boolean
70      :group 'pop3)
71    
72  (defvar pop3-password-required t  ;; Should this be customizable?
   "*Non-nil if a password is required when connecting to POP server.")  
73  (defvar pop3-password nil  (defvar pop3-password nil
74    "*Password to use when connecting to POP server.")    "*Password to use when connecting to POP server.")
75    
76  (defvar pop3-authentication-scheme 'pass  (defcustom pop3-authentication-scheme 'pass
77    "*POP3 authentication scheme.    "*POP3 authentication scheme.
78  Defaults to 'pass, for the standard USER/PASS authentication.  Other valid  Defaults to 'pass, for the standard USER/PASS authentication.  Other valid
79  values are 'apop.")  values are 'apop."
80      :version "21.4" ;; Oort Gnus
81  (defvar pop3-leave-mail-on-server nil    :type '(choice (const :tag "USER/PASS" pass)
82    "*Non-nil if the mail is to be left on the POP server after fetching.")                   (const :tag "APOP" apop))
83      :group 'pop3)
84    
85    (defcustom pop3-leave-mail-on-server nil
86      "*Non-nil if the mail is to be left on the POP server after fetching."
87      :version "21.4" ;; Oort Gnus
88      :type 'boolean
89      :group 'pop3)
90    
91  (defvar pop3-timestamp nil  (defvar pop3-timestamp nil
92    "Timestamp returned when initially connected to the POP server.    "Timestamp returned when initially connected to the POP server.
# Line 71  Used for APOP authentication.") Line 102  Used for APOP authentication.")
102           (crashbuf (get-buffer-create " *pop3-retr*"))           (crashbuf (get-buffer-create " *pop3-retr*"))
103           (n 1)           (n 1)
104           message-count           message-count
105           (pop3-password pop3-password)           (pop3-password pop3-password))
          )  
106      ;; for debugging only      ;; for debugging only
107      (if pop3-debug (switch-to-buffer (process-buffer process)))      (if pop3-debug (switch-to-buffer (process-buffer process)))
108      ;; query for password      ;; query for password
# Line 114  Used for APOP authentication.") Line 144  Used for APOP authentication.")
144    "Return the number of messages in the maildrop."    "Return the number of messages in the maildrop."
145    (let* ((process (pop3-open-server pop3-mailhost pop3-port))    (let* ((process (pop3-open-server pop3-mailhost pop3-port))
146           message-count           message-count
147           (pop3-password pop3-password)           (pop3-password pop3-password))
          )  
148      ;; for debugging only      ;; for debugging only
149      (if pop3-debug (switch-to-buffer (process-buffer process)))      (if pop3-debug (switch-to-buffer (process-buffer process)))
150      ;; query for password      ;; query for password
# Line 159  Returns the process associated with the Line 188  Returns the process associated with the
188      (insert output)))      (insert output)))
189    
190  (defun pop3-send-command (process command)  (defun pop3-send-command (process command)
191      (set-buffer (process-buffer process))    (set-buffer (process-buffer process))
192      (goto-char (point-max))    (goto-char (point-max))
193  ;;    (if (= (aref command 0) ?P)    ;; (if (= (aref command 0) ?P)
194  ;;      (insert "PASS <omitted>\r\n")    ;;     (insert "PASS <omitted>\r\n")
195  ;;      (insert command "\r\n"))    ;;   (insert command "\r\n"))
196      (setq pop3-read-point (point))    (setq pop3-read-point (point))
197      (goto-char (point-max))    (goto-char (point-max))
198      (process-send-string process (concat command "\r\n"))    (process-send-string process (concat command "\r\n")))
     )  
199    
200  (defun pop3-read-response (process &optional return)  (defun pop3-read-response (process &optional return)
201    "Read the response from the server.    "Read the response from the server.
# Line 355  This function currently does nothing.") Line 383  This function currently does nothing.")
383        (while (not (re-search-forward "^\\.\r\n" nil t))        (while (not (re-search-forward "^\\.\r\n" nil t))
384          ;; Fixme: Shouldn't depend on nnheader.          ;; Fixme: Shouldn't depend on nnheader.
385          (nnheader-accept-process-output process)          (nnheader-accept-process-output process)
         ;; bill@att.com ... to save wear and tear on the heap  
         ;; uncommented because the condensed version below is a problem for  
         ;; some.  
         (if (> (buffer-size)  20000) (sleep-for 1))  
         (if (> (buffer-size)  50000) (sleep-for 1))  
         (if (> (buffer-size) 100000) (sleep-for 1))  
         (if (> (buffer-size) 200000) (sleep-for 1))  
         (if (> (buffer-size) 500000) (sleep-for 1))  
         ;; bill@att.com  
         ;; condensed into:  
         ;; (sometimes causes problems for really large messages.)  
 ;       (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))  
386          (goto-char start))          (goto-char start))
387        (setq pop3-read-point (point-marker))        (setq pop3-read-point (point-marker))
388  ;; this code does not seem to work for some POP servers...        ;; this code does not seem to work for some POP servers...
389  ;; and I cannot figure out why not.        ;; and I cannot figure out why not.
390  ;      (goto-char (match-beginning 0))        ;;      (goto-char (match-beginning 0))
391  ;      (backward-char 2)        ;;      (backward-char 2)
392  ;      (if (not (looking-at "\r\n"))        ;;      (if (not (looking-at "\r\n"))
393  ;         (insert "\r\n"))        ;;          (insert "\r\n"))
394  ;      (re-search-forward "\\.\r\n")        ;;      (re-search-forward "\\.\r\n")
395        (goto-char (match-beginning 0))        (goto-char (match-beginning 0))
396        (setq end (point-marker))        (setq end (point-marker))
397        (pop3-clean-region start end)        (pop3-clean-region start end)

Legend:
Removed from v.1.21.2.2  
changed lines
  Added in v.1.21.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26