Mercurial > emacs
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") |