1 ;; ¿·µ¬¼èÆÀ¤Î¤ß async¡£
6 (defvar navi2ch-async-get t)
9 (defvar navi2ch-async-process-buffer " *navi2ch async process*")
11 ;; buffer-local ¤Ê vector¤Ë¤Ç¤â¤¹¤ë¡©
12 (defvar navi2ch-async-process nil)
13 (defvar navi2ch-async-output-buffer nil)
14 (defvar navi2ch-async-status nil) ;navi2ch-net-status?
15 (defvar navi2ch-async-header nil) ;navi2ch-net-header?
16 (defvar navi2ch-async-first nil)
17 (defvar navi2ch-async-number nil)
18 (defvar navi2ch-async-filter-position nil)
19 (defvar navi2ch-async-gzip-p nil)
21 (defmacro navi2ch-async-net-ignore-errors (&rest body)
22 "BODY ¤òɾ²Á¤·¡¢¤½¤ÎÃͤòÊÖ¤¹¡£
23 BODY ¤Îɾ²ÁÃæ¤Ë¥¨¥é¡¼¤¬µ¯¤³¤ë¤È nil ¤òÊÖ¤¹¡£"
28 (navi2ch-async-net-cleanup-process)
32 (message "Error: %s" (error-message-string err))
38 (navi2ch-async-net-cleanup-process)
40 (signal (car err) (cdr err)))))
43 ;; (defmacro navi2ch-async-net-ignore-errors (&rest body)
44 ;; "BODY ¤òɾ²Á¤·¡¢¤½¤ÎÃͤòÊÖ¤¹¡£
45 ;; BODY ¤Îɾ²ÁÃæ¤Ë¥¨¥é¡¼¤¬µ¯¤³¤ë¤È nil ¤òÊÖ¤¹¡£"
46 ;; `,(cons 'progn body))
48 (defun navi2ch-async-net-cleanup ()
49 (navi2ch-async-net-cleanup-process)
50 (navi2ch-async-net-cleanup-vars))
52 (defun navi2ch-async-net-cleanup-process ()
53 (let ((proc navi2ch-async-process))
55 (set-process-filter proc 'ignore)
56 (set-process-sentinel proc 'ignore)
57 (when (eq (process-status proc) 'open)
58 (delete-process proc))
59 (setq navi2ch-async-process nil))))
61 (defun navi2ch-async-net-cleanup-vars ()
62 (setq navi2ch-async-status nil
63 navi2ch-async-header nil
64 navi2ch-async-first nil
65 navi2ch-async-number nil
66 navi2ch-async-filter-position nil
67 navi2ch-async-gzip-p nil))
70 (defmacro navi2ch-async-filter (&rest body)
71 `(let ((pbuf (process-buffer process)) ;; MUST use 'process'
73 (if (and (bufferp pbuf)
74 (buffer-name pbuf)) ;; check a killed buffer
75 ;; must use buffer-name instead of current-buffer
76 ;; so that get-buffer can detect killed buffer.
79 ;; buffer surely exists.
80 (set-buffer (process-buffer process)) ;; necessary
81 (navi2ch-async-net-ignore-errors ,@body))
83 ;; the body sometimes kills obuf.
84 (set-buffer obuf))))))
86 (defun navi2ch-async-article-filter (process string)
88 (goto-char (point-max))
90 (if (null navi2ch-async-status)
91 (navi2ch-async-get-header)
92 (when (string= navi2ch-async-status "200")
93 (navi2ch-async-article-insert-lines 10) ;xxx
94 (when (and navi2ch-async-number
95 (buffer-live-p navi2ch-async-output-buffer))
96 (with-current-buffer navi2ch-async-output-buffer
97 (when (and (listp navi2ch-article-message-list)
98 (assq navi2ch-async-number navi2ch-article-message-list))
99 (navi2ch-article-goto-number navi2ch-async-number)
100 (setq navi2ch-async-number nil))))))))
103 (defun navi2ch-async-article-sentinel (process event)
105 ((and navi2ch-async-status
106 (string= navi2ch-async-status "200"))
108 (navi2ch-async-filter
109 (navi2ch-async-article-insert-lines)
110 (setq cont (navi2ch-string-as-multibyte
111 (buffer-substring-no-properties
113 (goto-char (point-min))
114 (re-search-forward "\r\n\r?\n" nil t))
116 (when (buffer-live-p navi2ch-async-output-buffer)
117 (with-current-buffer navi2ch-async-output-buffer
118 (let* ((article navi2ch-article-current-article)
119 (board navi2ch-article-current-board)
120 (file (navi2ch-article-get-file-name board article))
121 (dir (file-name-directory file)))
122 (unless (file-exists-p dir)
123 (make-directory dir t))
124 (let ((coding-system-for-write 'binary)
125 (coding-system-for-read 'binary))
128 (when (file-exists-p file)
129 (insert-file-contents file)
130 (goto-char (point-max)))
132 (navi2ch-article-save-info board article navi2ch-async-first)
133 (run-hooks 'navi2ch-article-after-sync-hook)
134 (when navi2ch-async-number
135 (navi2ch-article-goto-number navi2ch-async-number))
136 (navi2ch-article-set-summary-element board article nil)))))
137 (message "inserting current messages...done"))
139 (message "Async ¤Îµ¡Ç½ÉÔ¤Ǥ¹¡£
\8e½
\8eÏ
\8e¿")
140 (let ((navi2ch-async-get nil))
141 (when (buffer-live-p navi2ch-async-output-buffer)
142 (with-current-buffer navi2ch-async-output-buffer
143 (unless (listp navi2ch-article-message-list)
144 (setq navi2ch-article-message-list nil))
145 (navi2ch-article-sync))))))
146 (navi2ch-async-net-cleanup))
148 (defun navi2ch-async-article-sync (&optional force first number)
149 "¥¹¥ì¤ò¹¹¿·¤¹¤ë¡£force ¤Ê¤é¶¯À©¡£
150 first ¤¬ nil ¤Ê¤é¤Ð¡¢¥Õ¥¡¥¤¥ë¤¬¹¹¿·¤µ¤ì¤Æ¤Ê¤±¤ì¤Ð²¿¤â¤·¤Ê¤¤"
152 (when (not (navi2ch-board-from-file-p navi2ch-article-current-board))
153 (run-hooks 'navi2ch-article-before-sync-hook)
154 (let* ((article navi2ch-article-current-article)
155 (board navi2ch-article-current-board)
156 (navi2ch-net-force-update (or navi2ch-net-force-update
158 (file (navi2ch-article-get-file-name board article))
161 (setq article (navi2ch-article-load-info)
162 navi2ch-article-message-list
163 (navi2ch-article-get-message-list file)))
164 (navi2ch-article-set-mode-line)
165 (if (and (cdr (assq 'kako article))
167 (not (and force ; force ¤¬»ØÄꤵ¤ì¤Ê¤¤¸Â¤êsync¤·¤Ê¤¤
168 (y-or-n-p "re-sync kako article?"))))
169 (setq navi2ch-article-current-article article)
170 (setq navi2ch-async-output-buffer (current-buffer)
171 navi2ch-async-number (or number (cdr (assq 'number article)))
172 navi2ch-async-first first
173 ;; navi2ch-async-output-buffer ¤¬¾Ã¤µ¤ì¤Ê¤¤¤è¤¦¤Ë¡£
174 ;; see navi2ch-article-view-article()
175 navi2ch-article-message-list 'async)
176 (navi2ch-async-article-update-file board article force))
177 (setq navi2ch-article-hide-mode nil
178 navi2ch-article-important-mode nil))
179 t ;for board-mode state
182 (defun navi2ch-async-article-update-file (board article force)
184 (unless (listp navi2ch-article-message-list)
185 (setq navi2ch-article-message-list nil))
186 (if navi2ch-async-process
187 (message "Another process is running.")
188 (message "inserting current messages...")
189 (setq navi2ch-article-view-range nil) ;display all in async
190 (let* ((article navi2ch-article-current-article)
191 (board navi2ch-article-current-board)
192 (process-connection-type nil)
193 (inherit-process-coding-system
194 navi2ch-net-inherit-process-coding-system)
195 (url (navi2ch-article-get-url board article))
196 (list (navi2ch-net-split-url url navi2ch-net-http-proxy))
197 (host (cdr (assq 'host list)))
198 (file (cdr (assq 'file list)))
199 (port (cdr (assq 'port list)))
200 (host2ch (cdr (assq 'host2ch list)))
201 (pbuf (get-buffer-create navi2ch-async-process-buffer))
206 (setq navi2ch-async-status nil
207 navi2ch-async-header nil)
208 (navi2ch-set-buffer-multibyte nil))
209 (message "now connecting...")
210 (setq proc (open-network-stream "navi2ch-async-test" pbuf host port))
211 (message "%sdone" (current-message))
212 (process-kill-without-query proc)
213 (set-process-coding-system proc 'binary 'binary)
214 (set-process-filter proc 'navi2ch-async-article-filter)
215 (set-process-sentinel proc 'navi2ch-async-article-sentinel)
216 (message "sending request...")
217 (process-send-string proc
220 "MIME-Version: 1.0\r\n"
222 "Pragma: no-cache\r\n"
223 "User-Agent: " navi2ch-net-user-agent
226 "GET" file "HTTP/1.0" host2ch))
227 (message "%sdone" (current-message))
228 (setq navi2ch-async-process proc)))))
230 (define-key navi2ch-global-map "\C-c\C-k" 'navi2ch-async-process-stop)
231 (defun navi2ch-async-process-stop ()
233 (if (not (processp navi2ch-async-process))
234 (message "No process is running.")
235 (navi2ch-async-net-cleanup)
236 (message "Process is stopped.")))
238 ;; ¿·µ¬¼èÆÀ¤Î¤ß async¡£
239 (defadvice navi2ch-article-sync (around async-sync activate)
240 (if (or (not navi2ch-async-get)
241 force ;C-u s in article-mode
242 (cdr (assq 'kako navi2ch-article-current-article)) ;kako
243 (not (eq (cdr (assq 'bbstype navi2ch-article-current-board))
245 (file-exists-p (navi2ch-article-get-file-name
246 navi2ch-article-current-board
247 navi2ch-article-current-article)))
249 (setq ad-return-value
250 (navi2ch-async-article-sync force first number))))
252 ;; If navi2ch-article-view-article's arg NUMBER is specified,
253 ;; (setq navi2ch-article-message-list 'async) causes error
254 ;; in navi2ch-article-goto-number.
255 (defadvice navi2ch-article-goto-number (around async-hack activate)
256 "Bind `navi2ch-article-message-list' to nil when async."
257 (let ((navi2ch-article-message-list (and (listp navi2ch-article-message-list)
258 navi2ch-article-message-list)))
262 (defun navi2ch-async-get-header ()
264 (goto-char (point-min))
265 (when (re-search-forward "\r\n\r?\n" nil t)
266 (let ((end (match-end 0))
268 (goto-char (point-min))
270 (when (looking-at "HTTP/1\\.[01] \\([0-9]+\\)")
271 (setq navi2ch-async-status (match-string 1)))
272 (while (re-search-forward "^\\([^\r\n:]+\\): \\(.+\\)\r\n" end t)
273 (setq list (cons (cons (match-string 1) (match-string 2))
275 (let ((date (assoc-ignore-case "Date" list)))
276 (when (and date (stringp (cdr date)))
277 (setq navi2ch-net-last-date (cdr date))))
278 (when (buffer-live-p navi2ch-async-output-buffer)
279 (with-current-buffer navi2ch-async-output-buffer
280 (setq navi2ch-article-current-article
281 (navi2ch-put-alist 'time
282 (or (cdr (assoc "Last-Modified" list))
283 (cdr (assoc "Date" list)))
284 navi2ch-article-current-article))))
285 (setq navi2ch-async-header (nreverse list))
286 (setq navi2ch-async-filter-position end)))))
289 ;; navi2ch-article-get-message-list
290 (defun navi2ch-async-article-get-message-list-buffer (dat)
291 (let ((board navi2ch-article-current-board)
292 (sep navi2ch-article-separator)
293 (i (1+ (if (listp navi2ch-article-message-list)
294 (length navi2ch-article-message-list)
299 (decode-coding-region (point-min) (point-max) navi2ch-coding-system)
300 (goto-char (point-min))
302 (setq sep (navi2ch-article-get-separator)))
303 (goto-char (point-min))
307 (let ((str (buffer-substring-no-properties
309 (progn (forward-line 1)
311 (unless (string= str "") str)))
314 (unless navi2ch-article-separator
315 (setq navi2ch-article-separator sep)) ; it's a buffer local variable...
316 (nreverse message-list)))
318 (defun navi2ch-async-article-insert-lines (&optional num)
319 (when (buffer-live-p navi2ch-async-output-buffer)
321 (goto-char navi2ch-async-filter-position)
322 (when (> (- (buffer-size) (forward-line (buffer-size))) (or num 0))
324 (let ((dat (navi2ch-string-as-multibyte
325 (buffer-substring-no-properties
326 navi2ch-async-filter-position (point))))
328 (setq navi2ch-async-filter-position (point))
329 (set-buffer navi2ch-async-output-buffer)
331 (setq mlist (navi2ch-async-article-get-message-list-buffer dat)
332 navi2ch-article-message-list
333 (append (and (listp navi2ch-article-message-list)
334 navi2ch-article-message-list)
336 (when (listp navi2ch-article-message-list)
337 ;; navi2ch-article-current-article ¤Ï subject ¤ò»ý¤Ã¤Æ¤Ê¤¤¤«¤â¡£
338 (unless (cdr (assq 'subject navi2ch-article-current-article))
339 (let ((msg (cdr (car navi2ch-article-message-list))))
340 (setq navi2ch-article-current-article
345 (navi2ch-article-parse-message msg)
347 navi2ch-article-current-article))))
348 (let ((buffer-read-only nil))
349 (goto-char (point-max))
350 (navi2ch-async-article-insert-messages mlist nil))
351 (navi2ch-article-set-mode-line))))))))
353 ;; message ½Ð¤µ¤Ê¤¤¤è¤¦¤Ë¤·¤¿¤À¤±¡£
354 (defun navi2ch-async-article-insert-messages (list range)
355 "LIST ¤òÀ°·Á¤·¤ÆÁÞÆþ¤¹¤ë"
356 ;; (message "inserting current messages...")
357 (let ((len (length list))
358 (hide (cdr (assq 'hide navi2ch-article-current-article)))
359 (imp (cdr (assq 'important navi2ch-article-current-article))))
364 (cond (navi2ch-article-hide-mode
366 (navi2ch-article-important-mode
369 (and (navi2ch-article-inside-range-p num range len)
370 (not (memq num hide))))))
371 (when (stringp alist)
372 (setq alist (navi2ch-article-parse-message alist)))
375 (let ((filtered (navi2ch-article-apply-message-filters alist)))
377 (cond ((stringp filtered)
378 (navi2ch-put-alist 'name filtered alist)
379 (navi2ch-put-alist 'data filtered alist)
380 (navi2ch-put-alist 'mail
381 (if (string-match "sage"
382 (cdr (assq 'mail alist)))
388 ((eq filtered 'important)
390 (if (and (eq filter-result 'hide)
391 (not navi2ch-article-hide-mode))
393 (setq hide (cons num hide))
394 (setq navi2ch-article-current-article
395 (navi2ch-put-alist 'hide
397 navi2ch-article-current-article)))
398 (when (and (eq filter-result 'important)
399 (not navi2ch-article-important-mode))
400 (setq imp (cons num imp))
401 (setq navi2ch-article-current-article
402 (navi2ch-put-alist 'important
404 navi2ch-article-current-article)))
405 (setcdr x (navi2ch-put-alist 'point (point-marker) alist))
406 ;; (setcdr x (navi2ch-put-alist 'point (point) alist))
407 (navi2ch-article-insert-message num alist))))))
408 ;; (garbage-collect) ; navi2ch-parse-message ¤ÏÂçÎ̤˥´¥ß¤ò»Ä¤¹
409 ;; (message "inserting current messages...done")))
412 (provide 'navi2ch-async)
414 ;;; navi2ch-async.el ends here