comparison lisp/gnus/pop3.el @ 28835:f451114521a7

Import changes from current Gnus. (pop3-open-server): Bind coding systems before creating buffer and fix creating its name. (pop3-string-to-list): Function deleted. Change callers to use split-string.
author Dave Love <fx@gnu.org>
date Mon, 08 May 2000 17:59:06 +0000
parents 3ff1b0a2c6b7
children 9968f55ad26e
comparison
equal deleted inserted replaced
28834:636c8cafb7d4 28835:f451114521a7
112 t) 112 t)
113 113
114 (defun pop3-open-server (mailhost port) 114 (defun pop3-open-server (mailhost port)
115 "Open TCP connection to MAILHOST on PORT. 115 "Open TCP connection to MAILHOST on PORT.
116 Returns the process associated with the connection." 116 Returns the process associated with the connection."
117 (let ((process-buffer 117 (let ((coding-system-for-read 'binary)
118 (get-buffer-create (format "trace of POP session to %s" mailhost)))
119 (process)
120 (coding-system-for-read 'binary)
121 (coding-system-for-write 'binary) 118 (coding-system-for-write 'binary)
122 ) 119 process)
123 (save-excursion 120 (save-excursion
124 (set-buffer process-buffer) 121 (set-buffer (get-buffer-create (concat " trace of POP session to "
122 mailhost)))
125 (erase-buffer) 123 (erase-buffer)
126 (setq pop3-read-point (point-min)) 124 (setq pop3-read-point (point-min))
127 ) 125 (setq process (open-network-stream "POP"(current-buffer) mailhost port))
128 (setq process 126 (let ((response (pop3-read-response process t)))
129 (open-network-stream "POP" process-buffer mailhost port)) 127 (setq pop3-timestamp
130 (let ((response (pop3-read-response process t))) 128 (substring response (or (string-match "<" response) 0)
131 (setq pop3-timestamp 129 (+ 1 (or (string-match ">" response) -1)))))
132 (substring response (or (string-match "<" response) 0) 130 process)))
133 (+ 1 (or (string-match ">" response) -1)))))
134 process
135 ))
136 131
137 ;; Support functions 132 ;; Support functions
138 133
139 (defun pop3-process-filter (process output) 134 (defun pop3-process-filter (process output)
140 (save-excursion 135 (save-excursion
174 (if return 169 (if return
175 (buffer-substring (point) match-end) 170 (buffer-substring (point) match-end)
176 t) 171 t)
177 ))))) 172 )))))
178 173
179 (defun pop3-string-to-list (string &optional regexp)
180 "Chop up a string into a list."
181 (let ((list)
182 (regexp (or regexp " "))
183 (string (if (string-match "\r" string)
184 (substring string 0 (match-beginning 0))
185 string)))
186 (store-match-data nil)
187 (while string
188 (if (string-match regexp string)
189 (setq list (cons (substring string 0 (- (match-end 0) 1)) list)
190 string (substring string (match-end 0)))
191 (setq list (cons string list)
192 string nil)))
193 (nreverse list)))
194
195 (defvar pop3-read-passwd nil) 174 (defvar pop3-read-passwd nil)
196 (defun pop3-read-passwd (prompt) 175 (defun pop3-read-passwd (prompt)
197 (if (not pop3-read-passwd) 176 (if (not pop3-read-passwd)
198 (if (fboundp 'read-passwd) 177 (if (fboundp 'read-passwd)
199 (setq pop3-read-passwd 'read-passwd) 178 (setq pop3-read-passwd 'read-passwd)
225 (if (not (or (looking-at "From .?") ; Unix mail 204 (if (not (or (looking-at "From .?") ; Unix mail
226 (looking-at "\001\001\001\001\n") ; MMDF 205 (looking-at "\001\001\001\001\n") ; MMDF
227 (looking-at "BABYL OPTIONS:") ; Babyl 206 (looking-at "BABYL OPTIONS:") ; Babyl
228 )) 207 ))
229 (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) 208 (let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
230 (date (pop3-string-to-list (or (mail-fetch-field "Date") 209 (date (split-string (or (mail-fetch-field "Date")
231 (message-make-date)))) 210 (message-make-date))
211 " "))
232 (From_)) 212 (From_))
233 ;; sample date formats I have seen 213 ;; sample date formats I have seen
234 ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) 214 ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
235 ;; Date: 08 Jul 1996 23:22:24 -0400 215 ;; Date: 08 Jul 1996 23:22:24 -0400
236 ;; should be 216 ;; should be
312 292
313 (defun pop3-stat (process) 293 (defun pop3-stat (process)
314 "Return the number of messages in the maildrop and the maildrop's size." 294 "Return the number of messages in the maildrop and the maildrop's size."
315 (pop3-send-command process "STAT") 295 (pop3-send-command process "STAT")
316 (let ((response (pop3-read-response process t))) 296 (let ((response (pop3-read-response process t)))
317 (list (string-to-int (nth 1 (pop3-string-to-list response))) 297 (list (string-to-int (nth 1 (split-string response " ")))
318 (string-to-int (nth 2 (pop3-string-to-list response)))) 298 (string-to-int (nth 2 (split-string response " "))))
319 )) 299 ))
320 300
321 (defun pop3-list (process &optional msg) 301 (defun pop3-list (process &optional msg)
322 "Scan listing of available messages. 302 "Scan listing of available messages.
323 This function currently does nothing.") 303 This function currently does nothing.")
375 355
376 (defun pop3-last (process) 356 (defun pop3-last (process)
377 "Return highest accessed message-id number for the session." 357 "Return highest accessed message-id number for the session."
378 (pop3-send-command process "LAST") 358 (pop3-send-command process "LAST")
379 (let ((response (pop3-read-response process t))) 359 (let ((response (pop3-read-response process t)))
380 (string-to-int (nth 1 (pop3-string-to-list response))) 360 (string-to-int (nth 1 (split-string response " ")))
381 )) 361 ))
382 362
383 (defun pop3-rset (process) 363 (defun pop3-rset (process)
384 "Remove all delete marks from current maildrop." 364 "Remove all delete marks from current maildrop."
385 (pop3-send-command process "RSET") 365 (pop3-send-command process "RSET")