1;;; navi2ch-board-misc.el --- Miscellaneous Functions for Navi2ch Board Mode -*- coding: iso-2022-7bit; -*-
2
3;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2008, 2009, 2010
4;; by Navi2ch Project
5
6;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
7;; Keywords: 2ch, network
8
9;; This file is free software; you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation; either version 2, or (at your option)
12;; any later version.
13
14;; This file is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs; see the file COPYING.  If not, write to
21;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22;; Boston, MA 02111-1307, USA.
23
24;;; Commentary:
25
26;;
27
28;;; Code:
29(provide 'navi2ch-board-misc)
30(defconst navi2ch-board-misc-ident
31  "$Id$")
32
33(eval-when-compile
34  (require 'cl)
35  (defvar navi2ch-board-last-seen-alist)
36  (defvar navi2ch-board-subject-alist)
37  (defvar navi2ch-board-current-board))
38
39;; Avoid byte-compile warnings (contrib/izonmoji-mode.el).
40(eval-when-compile (defvar izonmoji-mode nil))
41
42(require 'navi2ch)
43
44(defvar navi2ch-bm-mode-map nil)
45(unless navi2ch-bm-mode-map
46  (let ((map (make-sparse-keymap)))
47    (set-keymap-parent map navi2ch-global-view-map)
48    (define-key map "\r" 'navi2ch-bm-select-article)
49    (unless (featurep 'xemacs)
50      (define-key map [follow-link] 'mouse-face))
51    (navi2ch-define-mouse-key map 2 'navi2ch-bm-mouse-select)
52    (define-key map " " 'navi2ch-bm-select-article-or-scroll-up)
53    (define-key map "." 'navi2ch-bm-display-article)
54    (define-key map "i" 'navi2ch-bm-fetch-article)
55    (define-key map "e" 'navi2ch-bm-textize-article)
56    (navi2ch-define-delete-keys map 'navi2ch-bm-select-article-or-scroll-down)
57    (define-key map "n" 'navi2ch-bm-next-line)
58    (define-key map "p" 'navi2ch-bm-previous-line)
59    (define-key map "U" 'navi2ch-bm-show-url)
60    (define-key map "l" 'navi2ch-bm-view-logo)
61    (define-key map "A" 'navi2ch-bm-add-global-bookmark)
62    (define-key map "g" 'navi2ch-bm-goto-board)
63    (define-key map "q" 'navi2ch-bm-exit)
64    (define-key map "S" 'navi2ch-bm-sort)
65    (define-key map "?" 'navi2ch-bm-search)
66    (define-key map "\C-c\C-m" 'navi2ch-message-pop-message-buffer)
67    (define-key map "R" 'navi2ch-bm-remove-article)
68    (define-key map "\C-c\C-r" 'navi2ch-bm-remove-article)
69    (define-key map "\C-o" 'navi2ch-bm-save-dat-file)
70    (define-key map "I" 'navi2ch-bm-fetch-maybe-new-articles)
71
72    ;; mark command
73    (define-key map "*" 'navi2ch-bm-mark)
74    (define-key map "u" 'navi2ch-bm-unmark)
75    (define-key map "m" nil)
76    (define-key map "mr" 'navi2ch-bm-mark-region)
77    (define-key map "ma" 'navi2ch-bm-mark-all)
78    (define-key map "mA" 'navi2ch-bm-add-global-bookmark-mark-article)
79    (define-key map "m." 'navi2ch-bm-display-mark-article)
80    (define-key map "mi" 'navi2ch-bm-fetch-mark-article)
81    (define-key map "me" 'navi2ch-bm-textize-mark-article)
82    (define-key map "mm" 'navi2ch-bm-mark-marks)
83    (define-key map "m?" 'navi2ch-bm-mark-by-query)
84    (define-key map "mb" 'navi2ch-bm-add-bookmark-mark-article)
85    (define-key map "mR" 'navi2ch-bm-remove-mark-article)
86    (setq navi2ch-bm-mode-map map)))
87
88(defvar navi2ch-bm-mode-menu-spec
89  '(["Toggle offline" navi2ch-toggle-offline]
90    ["Exit" navi2ch-bm-exit]
91    ["Sort" navi2ch-bm-sort]
92    ["Search" navi2ch-bm-search])
93  "Menu $B$N85(B")
94
95(defvar navi2ch-board-buffer-name "*navi2ch board*")
96
97;; set by navi2ch-bm-setup
98(defvar navi2ch-bm-get-property-function nil
99  "$B$=$N0LCV$N(B text-property $B$rF@$k4X?t!#0z?t$O(B POINT")
100(defvar navi2ch-bm-set-property-function nil
101  "text-property $B$r@_Dj$9$k4X?t!#0z?t$O(B BEGIN END ITEM")
102(defvar navi2ch-bm-get-board-function nil
103  "$BHD$rF@$k4X?t!#0z?t$O(B ITEM")
104(defvar navi2ch-bm-get-article-function nil
105  "$B%9%l$rF@$k4X?t!#0z?t$O(B ITEM")
106(defvar navi2ch-bm-exit-function nil)
107
108;; stub functions
109;; set by navi2ch-bm-setup
110(defun navi2ch-bm-get-property-internal (point))
111(defun navi2ch-bm-set-property-internal (begin end item))
112(defun navi2ch-bm-get-board-internal (item))
113(defun navi2ch-bm-get-article-internal (item))
114(defun navi2ch-bm-exit-internal ())
115
116(defvar navi2ch-bm-fetched-article-list nil)
117(defvar navi2ch-bm-board-type-alist nil)
118
119(defvar navi2ch-bm-state-char-table
120  (navi2ch-alist-to-hash
121   '((view   . ?V)
122     (cache  . ?C)
123     (update . ?U)
124     (down   . ?D)
125     (nil    . ? ))
126   :test 'eq))
127
128
129(eval-and-compile
130  (let ((state-list '(view cache update down nil))
131	(update-list '(nil new updated seen)))
132    (let ((func (lambda (f)
133		  (navi2ch-alist-to-hash
134		   (mapcar (lambda (state)
135			     (cons state
136				   (navi2ch-alist-to-hash
137				    (mapcar (lambda (update)
138					      (cons update
139						    (funcall f state update)))
140					    update-list)
141				    :test 'eq)))
142			   state-list)
143		   :test 'eq))))
144      (defconst navi2ch-bm-state-face-table
145	(funcall func
146		 (lambda (state update)
147		   (intern (format "navi2ch-bm%s-%s-face"
148				   (if update
149				       (format "-%s" update)
150				     "")
151				   (or state 'unread))))))
152      (defconst navi2ch-bm-state-mark-face-table
153	(funcall func
154		 (lambda (state update)
155		   (intern (format "navi2ch-bm%s-mark-face"
156				   (if update
157				       (format "-%s" update)
158				     "")))))))))
159
160(defconst navi2ch-bm-updated-mark-table
161  (navi2ch-alist-to-hash '((new     . ?%)
162			   (updated . ?+)
163			   (seen    . ?=)
164			   (nil     . ? ))
165			 :test 'eq))
166
167(defvar navi2ch-bm-move-downward t)
168
169;; add hook
170(add-hook 'navi2ch-save-status-hook 'navi2ch-bm-save-info)
171(add-hook 'navi2ch-load-status-hook 'navi2ch-bm-load-info)
172
173(defmacro navi2ch-bm-set-func (sym val)
174  `(let ((val-str (symbol-name ',val))
175         (sym-str (symbol-name ,sym))
176         func-str)
177     (when (string-match "navi2ch-bm-\\(.+\\)" val-str)
178       (setq func-str (format "%s-%s"
179			      sym-str (match-string 1 val-str)))
180       (set (intern (concat val-str "-function")) (intern func-str))
181       (fset (intern (concat val-str "-internal")) (intern func-str)))))
182
183(defun navi2ch-bm-setup (prefix)
184  (navi2ch-bm-set-func prefix navi2ch-bm-get-property)
185  (navi2ch-bm-set-func prefix navi2ch-bm-set-property)
186  (navi2ch-bm-set-func prefix navi2ch-bm-get-board)
187  (navi2ch-bm-set-func prefix navi2ch-bm-get-article)
188  ;; (navi2ch-bm-set-func prefix navi2ch-bm-get-subject)
189  (navi2ch-bm-set-func prefix navi2ch-bm-exit)
190  (setq navi2ch-bm-move-downward t))
191
192(defun navi2ch-bm-make-menu-spec (title menu-spec)
193  "$B%?%$%H%k$,(B TITLE $B$G(B $BFbMF$,(B `navi2ch-bm-mode-menu-spec' $B$H(B MENU-SPEC
194$B$r7R$2$?%a%K%e!<$r:n$k!#(B"
195  (append (list title)
196	  navi2ch-bm-mode-menu-spec
197	  '("----")
198	  menu-spec))
199
200;; (defvar navi2ch-list-navi2ch-category-alist nil) ; $B%3%s%Q%$%k$rDL$90Y(B
201
202(defun navi2ch-bm-regist-board (type open-func &optional board)
203  "TYPE $B$JHD$r3+$/4X?t(B OPEN-FUNC $B$r(B `navi2ch-bm-board-type-alist' $B$KEP(B
204$BO?$9$k!#$^$?!"F1;~$K(B BOARD $B$r(B `navi2ch-list-navi2ch-category-alist' $B$K(B
205$BEPO?$9$k!#(B"
206  (setq navi2ch-bm-board-type-alist
207	(navi2ch-put-alist type open-func
208			   navi2ch-bm-board-type-alist))
209  (when board
210    (add-to-list 'navi2ch-list-navi2ch-category-alist board)))
211
212(defun navi2ch-bm-select-board (board &optional force)
213  (let ((buf (get-buffer-create navi2ch-board-buffer-name))
214	(type (cdr (assq 'type board))))
215    (set-buffer buf)
216    (funcall (cdr (assq type navi2ch-bm-board-type-alist))
217	     board force)
218    (switch-to-buffer buf))
219  (run-hooks 'navi2ch-bm-select-board-hook)
220  (navi2ch-set-mode-line-identification))
221
222(defun navi2ch-bm-set-property (begin end item state &optional updated mark)
223  (navi2ch-bm-set-property-internal begin end item)
224  (let ((updated (or updated
225		     (get-text-property begin 'navi2ch-bm-updated)))
226	(face-table (if mark
227			navi2ch-bm-state-mark-face-table
228		      navi2ch-bm-state-face-table)))
229    (add-text-properties begin end
230			 (list 'navi2ch-bm-updated updated
231			       'navi2ch-bm-state state
232			       'navi2ch-bm-mark mark
233			       'mouse-face navi2ch-bm-mouse-face
234			       'face
235			       (gethash updated
236					(gethash state face-table))))))
237
238(defun navi2ch-bm-down-article-p (board article)
239  (cdr (or (assq 'down article)
240	   (assq 'down (navi2ch-article-load-info board article)))))
241
242(defun navi2ch-bm-get-state-from-article (board article)
243  (cond ((navi2ch-board-from-file-p board)
244	 (cond ((get-buffer (navi2ch-article-get-buffer-name
245			     board article))
246		'view)
247	       ((file-exists-p (navi2ch-article-get-file-name board article))
248		'cache)
249	       (t nil)))
250	((navi2ch-bm-fetched-article-p board article)
251	 'update)
252	((navi2ch-bm-down-article-p board article)
253	 'down)
254	(t
255	 (navi2ch-article-check-cached board article))))
256
257(defun navi2ch-bm-format-subject
258  (number updated-char state-char subject other)
259  (format (concat "%" (number-to-string navi2ch-bm-number-width)
260		  "d %c%c %s%s%s\n")
261	  number updated-char state-char subject
262	  (make-string (max (- navi2ch-bm-subject-width
263			       (string-width subject))
264			    1)
265		       ? )
266	  other))
267
268(defun navi2ch-bm-insert-subject (item number subject other
269				       &optional updated)
270  (let* ((article (navi2ch-bm-get-article-internal item))
271	 (board (navi2ch-bm-get-board-internal item))
272	 (point (point))
273	 (state (navi2ch-bm-get-state-from-article board article))
274	 (string (navi2ch-bm-format-subject
275		  number
276		  (gethash updated navi2ch-bm-updated-mark-table)
277		  (gethash state navi2ch-bm-state-char-table)
278		  (or subject navi2ch-bm-empty-subject)
279		  other)))
280    ;; for contrib/izonmoji-mode.el
281    (navi2ch-ifxemacs
282	(insert string)
283      (let ((buffer-display-table (if (and (boundp 'izonmoji-mode)
284					   izonmoji-mode)
285				      nil
286				    buffer-display-table)))
287	(insert string)))
288    (save-excursion
289      (goto-char point)
290      (set-text-properties (navi2ch-line-beginning-position)
291			   (1+ (navi2ch-line-end-position))
292			   nil)
293      (navi2ch-bm-set-property (navi2ch-line-beginning-position)
294			       (navi2ch-line-end-position)
295			       item state updated))))
296
297(defun navi2ch-bm-exit ()
298  (interactive)
299  (dolist (x (navi2ch-article-buffer-list))
300    (when x
301      (delete-windows-on x)))
302  (navi2ch-bm-exit-internal)
303  (run-hooks 'navi2ch-bm-exit-hook)
304  (when (get-buffer navi2ch-board-buffer-name)
305    (delete-windows-on navi2ch-board-buffer-name)
306    (bury-buffer navi2ch-board-buffer-name))
307  (when navi2ch-list-buffer-name
308    (let ((win (get-buffer-window navi2ch-list-buffer-name)))
309      (if win
310	  (select-window win)
311	(navi2ch-list)))))
312
313;;; goto-*-column
314(defsubst navi2ch-bm-goto-updated-mark-column ()
315  (beginning-of-line)
316  (when (looking-at " *[0-9]+ ")
317    (goto-char (match-end 0))))
318
319(defsubst navi2ch-bm-goto-state-column ()
320  (when (navi2ch-bm-goto-updated-mark-column)
321    (forward-char 1)))
322
323(defsubst navi2ch-bm-goto-mark-column ()
324  (when (navi2ch-bm-goto-updated-mark-column)
325    (forward-char 2)))
326
327(defun navi2ch-bm-goto-other-column ()
328  (let ((sbj (cdr
329              (assq 'subject
330		    (navi2ch-bm-get-article-internal
331                     (navi2ch-bm-get-property-internal (point)))))))
332    (navi2ch-bm-goto-mark-column)
333    (forward-char 1)
334    (unless sbj (setq sbj navi2ch-bm-empty-subject))
335    (when (and (not (string= sbj ""))
336               (search-forward sbj nil t))
337      (goto-char (match-end 0)))
338    (skip-chars-forward " ")))
339
340
341(defun navi2ch-bm-insert-state (item state &optional updated)
342  ;; (setq article (navi2ch-put-alist 'cache 'view article))
343  (let ((buffer-read-only nil))
344    (save-excursion
345      (navi2ch-bm-goto-state-column)
346      (backward-char 1)
347      (delete-char 2)
348      (insert (gethash updated navi2ch-bm-updated-mark-table)
349	      (gethash state navi2ch-bm-state-char-table))
350      (navi2ch-bm-set-property (navi2ch-line-beginning-position)
351			       (navi2ch-line-end-position)
352			       item state updated))))
353
354(defsubst navi2ch-bm-get-state (&optional point)
355  "$B$=$N0LCV$N(B state $B$rD4$Y$k!#(B"
356  (get-text-property (or point (point)) 'navi2ch-bm-state))
357
358(defsubst navi2ch-bm-get-updated-mark (&optional point)
359  "$B$=$N0LCV$N(B updated-mark $B$rD4$Y$k!#(B"
360  (get-text-property (or point (point)) 'navi2ch-bm-updated))
361
362(defun navi2ch-bm-select-article (&optional max-line)
363  (interactive "P")
364  (let* ((item (navi2ch-bm-get-property-internal (point)))
365         (board (navi2ch-bm-get-board-internal item))
366         (article (navi2ch-article-load-info board (navi2ch-bm-get-article-internal item)))
367         (buf (current-buffer))
368	 (window-configuration (current-window-configuration)))
369    (unwind-protect
370	(if article
371	    (progn
372	      (navi2ch-split-window 'article)
373	      (let (state)
374		(setq state
375		      (if (navi2ch-board-from-file-p board)
376			  (navi2ch-article-view-article-from-file
377			   (navi2ch-article-get-file-name board article))
378			(navi2ch-article-view-article
379			 board article nil nil max-line)))
380		(with-current-buffer buf
381		  (when (or state
382			    (navi2ch-bm-fetched-article-p board article)
383			    (eq (navi2ch-bm-get-state) 'view))
384		    (navi2ch-bm-remove-fetched-article board article)
385		    (if (eq major-mode 'navi2ch-board-mode)
386			(navi2ch-bm-insert-state item 'view 'seen)
387		      (navi2ch-bm-insert-state item 'view))))
388		(when (eq major-mode 'navi2ch-article-mode)
389		  (setq window-configuration (current-window-configuration)))))
390	  (message "Can't select this line!"))
391      (set-window-configuration window-configuration))))
392
393(defun navi2ch-bm-show-url ()
394  "$BHD$N(B url $B$rI=<($7$F!"$=$N(B url $B$r8+$k$+(B kill ring $B$K%3%T!<$9$k!#(B"
395  (interactive)
396  (let* ((board (navi2ch-bm-get-board-internal
397		 (navi2ch-bm-get-property-internal (point))))
398	 (url (navi2ch-board-to-url board)))
399    (if (not url)
400	(message "Can't select this line!")
401      (let ((char (navi2ch-read-char-with-retry
402		   (format "c)opy v)iew t)itle? URL: %s: " url)
403		   nil '(?c ?v ?t))))
404	(if (eq char ?t)
405	    (navi2ch-bm-copy-title board)
406	  (setq url (navi2ch-bm-show-url-subr board))
407	  (cond ((not url)
408		 (message "Can't select this line!"))
409		((eq char ?c)
410		 (kill-new url)
411		 (message "Copy: %s" url))
412		((eq char ?v)
413		 (navi2ch-browse-url-internal url)
414		 (message "View: %s" url))))))))
415
416(defun navi2ch-bm-show-url-subr (board)
417  "$B%a%K%e!<$rI=<($7$F!"(Burl $B$rF@$k!#(B"
418  (let ((char (navi2ch-read-char-with-retry
419	       (format "b)oard a)rticle l)ast%d: "
420		       navi2ch-article-show-url-number)
421	       nil '(?b ?a ?l)))
422	(article (navi2ch-bm-get-article-internal
423		  (navi2ch-bm-get-property-internal (point)))))
424    (cond ((eq char ?b) (navi2ch-board-to-url board))
425	  ((eq char ?a) (when article
426			  (navi2ch-article-to-url board article)))
427	  ((eq char ?l) (let ((l (format "l%d" navi2ch-article-show-url-number)))
428			  (when article
429			    (navi2ch-article-to-url board article l l)))))))
430
431(defun navi2ch-bm-copy-title (board)
432  "$B%a%K%e!<$rI=<($7$F!"%?%$%H%k$rF@$k!#(B"
433  (navi2ch-article-copy-title board
434			      (navi2ch-bm-get-article-internal
435			       (navi2ch-bm-get-property-internal
436				(point)))))
437
438(defun navi2ch-bm-display-article (&optional max-line)
439  (interactive "P")
440  (let ((win (selected-window)))
441    (navi2ch-bm-select-article max-line)
442    (select-window win)))
443
444(defun navi2ch-bm-remember-fetched-article (board article)
445  (let* ((uri (navi2ch-board-get-uri board))
446	 (list (assoc uri navi2ch-bm-fetched-article-list))
447	 (artid (cdr (assq 'artid article))))
448    (if list
449	(unless (member artid (cdr list))
450	  (push artid (cdr list)))
451      (push (list uri artid) navi2ch-bm-fetched-article-list))))
452
453(defun navi2ch-bm-fetched-article-p (board article)
454  (member (cdr (assq 'artid article))
455	  (cdr (assoc (navi2ch-board-get-uri board)
456		      navi2ch-bm-fetched-article-list))))
457
458(defun navi2ch-bm-remove-fetched-article (board article)
459  (let* ((uri (navi2ch-board-get-uri board))
460	 (list (assoc uri navi2ch-bm-fetched-article-list))
461	 (artid (cdr (assq 'artid article))))
462    (when (member artid list)
463      (setcdr list (delete artid (cdr list)))
464      (unless (cdr list)
465	(setq navi2ch-bm-fetched-article-list
466	      (delq list navi2ch-bm-fetched-article-list))))))
467
468(defun navi2ch-bm-fetch-article (&optional force)
469  (interactive "P")
470  (let* ((item (navi2ch-bm-get-property-internal (point)))
471         (board (navi2ch-bm-get-board-internal item))
472         (article (navi2ch-bm-get-article-internal item))
473         state)
474    (if (and article
475	     (not (navi2ch-board-from-file-p board)))
476	(let (summary artid element seen)
477	  (when (and navi2ch-board-check-article-update-suppression-length
478		     (not (navi2ch-bm-fetched-article-p board article)))
479	    (setq summary (navi2ch-article-load-article-summary board))
480	    (setq artid (cdr (assq 'artid article)))
481	    (setq element (cdr (assoc artid summary)))
482	    (setq seen (or (navi2ch-article-summary-element-seen element)
483			   (cdr (assoc artid navi2ch-board-last-seen-alist))
484			   0)))
485	  (setq state (navi2ch-article-fetch-article board article force))
486	  (when state
487	    (let ((state-mark 'update)
488		  (updated-mark (navi2ch-bm-get-updated-mark)))
489	      (when seen
490		(setq seen
491		      (and (catch 'break
492			     (<= (string-to-number
493				  (or (cdr (assoc artid navi2ch-board-subject-alist))
494				      (throw 'break t)))
495				 (+ seen navi2ch-board-check-article-update-suppression-length)))
496			   (navi2ch-article-check-message-suppression
497			    board
498			    article
499			    (1+ seen)
500			    (+ seen navi2ch-board-check-article-update-suppression-length)))))
501	      (if seen
502		  (progn
503		    (navi2ch-article-summary-element-set-seen element seen)
504		    (navi2ch-article-save-article-summary board summary)
505		    (setq state-mark (navi2ch-bm-get-state))
506		    (when (memq updated-mark '(new updated))
507		      (setq updated-mark 'seen))
508		    (message "No updates need seeing"))
509		(navi2ch-bm-remember-fetched-article board article))
510	      (navi2ch-bm-insert-state item state-mark updated-mark))))
511      (message "Can't select this line!"))
512    state))
513
514(defun navi2ch-bm-textize-article (&optional dir-or-file buffer)
515  (interactive)
516  (let* ((navi2ch-article-view-range nil)
517	 (navi2ch-article-auto-range nil)
518	 window)
519    (setq window (selected-window))
520    (navi2ch-bm-display-article)
521    (select-window (get-buffer-window (navi2ch-article-current-buffer)))
522    (when navi2ch-article-view-range
523      (setq navi2ch-article-view-range nil)
524      (navi2ch-article-redraw))
525    (navi2ch-article-textize-article dir-or-file buffer)
526    (select-window window)))
527
528(defun navi2ch-bm-select-article-or-scroll (way &optional max-line)
529  (let ((article (navi2ch-bm-get-article-internal
530		  (navi2ch-bm-get-property-internal (point)))))
531    (if (and (navi2ch-article-current-buffer)
532             (string= (cdr (assq 'artid article))
533                      (with-current-buffer (navi2ch-article-current-buffer)
534                        (cdr (assq 'artid navi2ch-article-current-article))))
535             (get-buffer-window (navi2ch-article-current-buffer)))
536        (let ((win (selected-window)))
537	  (unwind-protect
538	      (progn
539		(select-window
540		 (get-buffer-window (navi2ch-article-current-buffer)))
541		(cond
542		 ((eq way 'up)
543		  (navi2ch-article-scroll-up))
544		 ((eq way 'down)
545		  (navi2ch-article-scroll-down))))
546	    (select-window win)))
547      (navi2ch-bm-select-article max-line))))
548
549(defun navi2ch-bm-select-article-or-scroll-up (&optional max-line)
550  (interactive "P")
551  (navi2ch-bm-select-article-or-scroll 'up max-line))
552
553(defun navi2ch-bm-select-article-or-scroll-down (&optional max-line)
554  (interactive "P")
555  (navi2ch-bm-select-article-or-scroll 'down max-line))
556
557(defun navi2ch-bm-mouse-select (e)
558  (interactive "e")
559  (mouse-set-point e)
560  (save-excursion
561    (beginning-of-line)
562    (navi2ch-bm-select-article)))
563
564(defun navi2ch-bm-goto-board ()
565  (interactive)
566  (navi2ch-list-goto-board
567   (navi2ch-bm-get-board-internal
568    (navi2ch-bm-get-property-internal (point)))))
569
570(defun navi2ch-bm-renumber ()
571  (interactive)
572  (save-excursion
573    (goto-char (point-min))
574    (let ((buffer-read-only nil)
575          (i 1))
576      (while (not (eobp))
577        (let ((props (text-properties-at (point)))
578	      (num-string (format
579			   (concat "%" (number-to-string navi2ch-bm-number-width) "d")
580			   i)))
581          (delete-region (point)
582			 (save-excursion
583			   (navi2ch-bm-goto-state-column)
584			   (- (point) 2)))
585          (insert num-string)
586	  (set-text-properties (- (point) (length num-string))
587			       (point) props)
588          (forward-line 1)
589          (setq i (1+ i)))))))
590
591(defun navi2ch-bm-view-logo ()
592  "$B$=$NHD$N%m%4$r8+$k!#(B"
593  (interactive)
594  (let ((board (navi2ch-bm-get-board-internal
595		(navi2ch-bm-get-property-internal (point))))
596	(board-mode-p (eq major-mode 'navi2ch-board-mode))
597	file old-file)
598    (unless board-mode-p
599      (setq board (navi2ch-board-load-info board)))
600    (setq old-file (cdr (assq 'logo board)))
601    (if navi2ch-offline
602	(setq file old-file)
603      (setq file (navi2ch-net-download-logo board))
604      (when file
605	(setq file (file-name-nondirectory (navi2ch-net-download-logo board)))
606	(when (and old-file navi2ch-board-delete-old-logo
607		   (not (string-equal file old-file)))
608	  (delete-file (navi2ch-board-get-file-name board old-file)))
609	(if board-mode-p
610	    (setq navi2ch-board-current-board board)
611	  (navi2ch-board-save-info board))))
612    (if file
613	(apply 'start-process "navi2ch view logo"
614	       nil navi2ch-board-view-logo-program
615	       (append navi2ch-board-view-logo-args
616		       (list (navi2ch-board-get-file-name board file))))
617      (message "Can't find logo file"))))
618
619(defun navi2ch-bm-add-global-bookmark (&optional bookmark-id)
620  (interactive (list (navi2ch-bookmark-read-id "Bookmark ID: ")))
621  (let* ((item (navi2ch-bm-get-property-internal (point)))
622	 (board (navi2ch-bm-get-board-internal item))
623	 (article (navi2ch-bm-get-article-internal item)))
624    (if item
625	(navi2ch-bookmark-add
626	 bookmark-id
627	 board
628	 article)
629      (message "Can't select this line!"))))
630
631;;; move
632(defun navi2ch-bm-forward-line (&optional n)
633  (interactive "p")
634  (let ((ret (forward-line n)))
635    (when (eobp)
636      (forward-line -1)
637      (setq ret (1+ ret)))
638    ret))
639
640(defun navi2ch-bm-next-line (num)
641  (interactive "p")
642  (unless (zerop (navi2ch-bm-forward-line num))
643    (message "No more articles"))
644  (setq navi2ch-bm-move-downward t))
645
646(defun navi2ch-bm-previous-line (num)
647  (interactive "p")
648  (unless (zerop (navi2ch-bm-forward-line (- num)))
649    (message "No more articles"))
650  (setq navi2ch-bm-move-downward nil))
651
652;;; mark
653(defun navi2ch-bm-mark-subr (mark &optional arg interactive)
654  "mark $B$9$k!#(B
655INTERACTIVE $B$,(B non-nil $B$J$i(B mark $B$7$?$"$H0\F0$9$k!#(B
656ARG $B$,(B non-nil $B$J$i0\F0J}8~$r5U$K$9$k!#(B"
657  (let ((item (navi2ch-bm-get-property-internal (point)))
658	(state (navi2ch-bm-get-state (point)))
659	(table (and mark navi2ch-bm-state-mark-face-table)))
660    (when item
661      (let ((buffer-read-only nil)
662	    (pos (point)))
663	(navi2ch-bm-goto-mark-column)
664	(delete-char 1)
665	(insert (if mark ?* ? ))
666	(navi2ch-bm-set-property (navi2ch-line-beginning-position)
667				 (navi2ch-line-end-position)
668				 item state nil table)
669	(goto-char pos)))
670    (when (and navi2ch-bm-mark-and-move interactive)
671      (let (downward)
672	(cond ((eq navi2ch-bm-mark-and-move 'follow)
673	       (setq downward
674		     (if arg
675			 (not navi2ch-bm-move-downward)
676		       navi2ch-bm-move-downward)))
677	      ((eq navi2ch-bm-mark-and-move t)
678	       (setq downward (not arg))))
679	(navi2ch-bm-forward-line (if downward 1 -1))))))
680
681(defun navi2ch-bm-mark (&optional arg)
682  (interactive "P")
683  (navi2ch-bm-mark-subr t arg (interactive-p)))
684
685(defun navi2ch-bm-unmark (&optional arg)
686  (interactive "P")
687  (navi2ch-bm-mark-subr nil arg (interactive-p)))
688
689(defun navi2ch-bm-exec-subr (func &rest args)
690  (save-excursion
691    (goto-char (point-min))
692    (while (not (eobp))
693      (navi2ch-bm-goto-mark-column)
694      (if (looking-at "\\*")
695	  (progn
696	    (condition-case nil
697		(save-excursion
698		  (navi2ch-bm-unmark)
699		  (apply func args))
700	      (navi2ch-update-failed nil))
701	    (sit-for 0)
702	    (discard-input))
703	(forward-line)))))
704
705(defsubst navi2ch-bm-display-mark-article ()
706  (interactive)
707  (navi2ch-bm-exec-subr 'navi2ch-bm-display-article))
708
709(defun navi2ch-bm-fetch-mark-article (&optional force)
710  (interactive "P")
711  (unless navi2ch-offline
712    (navi2ch-bm-exec-subr #'navi2ch-bm-fetch-article force)))
713
714(defun navi2ch-bm-textize-mark-article (directory &optional file)
715  (interactive "DDirectory: \nFList file: ")
716  (let ((buffer (get-buffer-create (make-temp-name "*navi2ch "))))
717    (navi2ch-bm-exec-subr 'navi2ch-bm-textize-article directory buffer)
718    (with-current-buffer buffer
719      (when file
720	(navi2ch-write-region (point-min) (point-max) file)))
721    (kill-buffer buffer)))
722
723(defun navi2ch-bm-add-global-bookmark-mark-article (bookmark-id)
724  (interactive (list (navi2ch-bookmark-read-id "Bookmark ID: ")))
725  (navi2ch-bm-exec-subr 'navi2ch-bm-add-global-bookmark bookmark-id))
726
727
728;; add marked ones to the board bookmark
729(defun navi2ch-bm-add-bookmark-mark-article ()
730  (interactive)
731  (navi2ch-bm-exec-subr 'navi2ch-board-add-bookmark))
732
733(defun navi2ch-bm-mark-region-subr (begin end mark)
734  (save-excursion
735    (save-restriction
736      (narrow-to-region begin end)
737      (goto-char (point-min))
738      (while (not (eobp))
739        (navi2ch-bm-mark-subr mark)
740        (forward-line)))))
741
742(defun navi2ch-bm-mark-region (begin end &optional arg)
743  (interactive "r\nP")
744  (navi2ch-bm-mark-region-subr (save-excursion (goto-char begin)
745					       (beginning-of-line)
746					       (point))
747			       (save-excursion (goto-char (max (1- end)
748							       (point-min)))
749					       (end-of-line)
750					       (point))
751			       (not arg)))
752
753(defun navi2ch-bm-fetch-maybe-new-articles ()
754  "$B99?7$5$l$F$$$k2DG=@-$N$"$k%9%l$r(B fetch $B$9$k!#(B"
755  (interactive)
756  (unless navi2ch-offline
757    (navi2ch-bm-mark-states "[^=]")
758    (sit-for 0)
759    (navi2ch-bookmark-fetch-mark-article)))
760
761(defun navi2ch-bm-mark-all (&optional arg)
762  (interactive "P")
763  (navi2ch-bm-mark-region (point-min) (point-max) arg))
764
765(defun navi2ch-bm-mark-marks (mark &optional arg)
766  (interactive "cInput mark: \nP")
767  (navi2ch-bm-mark-states
768   (format ".%c" (upcase mark))
769   arg))
770
771(defun navi2ch-bm-mark-states (regexp &optional arg)
772  (save-excursion
773    (goto-char (point-min))
774    (while (not (eobp))
775      (navi2ch-bm-goto-updated-mark-column)
776      (when (looking-at regexp)
777	(navi2ch-bm-mark-subr (not arg)))
778      (forward-line))))
779
780;; mark by regexp query
781(defun navi2ch-bm-mark-by-query (query &optional arg)
782  (interactive "MQuery (regexp): ")
783  (save-excursion
784    (goto-char (point-min))
785    (while (re-search-forward query nil t)
786      (navi2ch-bm-mark-subr (not arg)))))
787
788;;; sort
789(defun navi2ch-bm-sort-subr (rev start-key-fun end-key-fun)
790  (let ((buffer-read-only nil))
791    (save-excursion
792      (goto-char (point-min))
793      (sort-subr rev 'forward-line 'end-of-line
794                 start-key-fun end-key-fun))))
795
796(defun navi2ch-bm-sort-by-number (&optional rev)
797  (interactive "P")
798  (navi2ch-bm-sort-subr
799   rev
800   (lambda ()
801     (beginning-of-line)
802     (save-match-data
803       (if (looking-at "^ *\\([0-9]+\\)")
804	   (string-to-number
805	    (buffer-substring (match-beginning 1) (match-end 1)))
806	 ;; not a number
807	 -1)))
808   nil))
809
810(defun navi2ch-bm-sort-by-state (&optional rev)
811  (interactive "P")
812  (navi2ch-bm-sort-subr
813   rev
814   (lambda ()
815     (navi2ch-bm-goto-state-column)
816     (backward-char)
817     (or (cdr (assoc (buffer-substring (point) (+ (point) 2))
818		     navi2ch-bm-sort-by-state-order))
819	 ;; $BL$CN$N>uBV!#(B
820	 1000))
821   nil))
822
823(defun navi2ch-bm-sort-by-subject (&optional rev)
824  (interactive "P")
825  (navi2ch-bm-sort-subr
826   rev
827   (lambda ()
828     (navi2ch-bm-goto-mark-column)
829     (forward-char 1))
830   'navi2ch-bm-goto-other-column))
831
832(defun navi2ch-bm-sort-by-other (&optional rev)
833  (interactive "P")
834  (navi2ch-bm-sort-subr
835   rev
836   (lambda ()
837     (navi2ch-bm-goto-other-column)
838     nil) ; end-key-fun $B$r8F$P$;$k$K$O(B nil $B$,M_$7$$$i$7$$!#$O$^$C$?(B($B5c(B)$B!#(B
839   'end-of-line))
840
841(defun navi2ch-bm-sort-by-date (&optional rev)
842  (interactive "P")
843  (navi2ch-bm-sort-subr
844   (not rev)
845   (lambda ()
846     (string-to-number
847      (cdr (assq 'artid
848		 (navi2ch-bm-get-article-internal
849		  (navi2ch-bm-get-property-internal (point)))))))
850   nil))
851
852(defun navi2ch-bm-sort (&optional arg)
853  (interactive "P")
854  (let ((ch (navi2ch-read-char-with-retry
855	     "Sort by n)umber s)tate t)itle o)ther d)ate? "
856	     nil '(?n ?s ?t ?o ?d))))
857    (message "Sorting...")
858    (funcall
859     (cond ((eq ch ?n) 'navi2ch-bm-sort-by-number)
860           ((eq ch ?s) 'navi2ch-bm-sort-by-state)
861           ((eq ch ?t) 'navi2ch-bm-sort-by-subject)
862           ((eq ch ?o) 'navi2ch-bm-sort-by-other)
863	   ((eq ch ?d) 'navi2ch-bm-sort-by-date))
864     arg)
865    (message "Sorting...done")))
866
867;;; search
868(defun navi2ch-bm-search-current-board-subject ()
869  (interactive)
870  (navi2ch-search-subject-subr
871   (list (navi2ch-bm-get-board-internal
872	  (navi2ch-bm-get-property-internal (point))))))
873
874(defun navi2ch-bm-search-current-board-article ()
875  (interactive)
876  (navi2ch-search-article-subr
877   (list (navi2ch-bm-get-board-internal
878	  (navi2ch-bm-get-property-internal (point))))))
879
880(defun navi2ch-bm-search-current-board-cache ()
881  (interactive)
882  (navi2ch-search-cache-subr
883   (list (navi2ch-bm-get-board-internal
884	  (navi2ch-bm-get-property-internal (point))))))
885
886(defun navi2ch-bm-search-current-board-orphan ()
887  (interactive)
888  (navi2ch-search-orphan-subr
889   (list (navi2ch-bm-get-board-internal
890	  (navi2ch-bm-get-property-internal (point))))))
891
892(defun navi2ch-bm-search ()
893  (interactive)
894  (let ((ch (navi2ch-read-char-with-retry
895	     "Search for: s)ubject a)rticle c)ache o)rphan: "
896	     nil '(?s ?a ?c ?o)))
897	(ch2 (navi2ch-read-char-with-retry
898	      "Search from: b)oard a)ll: " nil '(?b ?a))))
899    (cond ((eq ch ?s)
900           (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-subject))
901                 ((eq ch2 ?a) (navi2ch-search-all-subject))))
902          ((eq ch ?a)
903           (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-article))
904                 ((eq ch2 ?a) (navi2ch-search-all-article))))
905	  ((eq ch ?c)
906	   (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-cache))
907		 ((eq ch2 ?a) (navi2ch-search-all-cache))))
908	  ((eq ch ?o)
909	   (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-orphan))
910		 ((eq ch2 ?a) (navi2ch-search-all-orphan)))))))
911
912;;; save and load info
913(defun navi2ch-bm-save-info ()
914  (navi2ch-save-info navi2ch-bm-fetched-info-file
915		     navi2ch-bm-fetched-article-list
916		     t))
917
918(defun navi2ch-bm-load-info ()
919  (setq navi2ch-bm-fetched-article-list
920        (navi2ch-load-info navi2ch-bm-fetched-info-file)))
921
922(defun navi2ch-bm-update-article (board article &optional state updated)
923  "$BHD%P%C%U%!$N$&$A!"(BBOARD $B$H(B ARTICLE $B$K%^%C%A$9$k9T$r99?7$9$k!#(B"
924  (let ((buffer (get-buffer navi2ch-board-buffer-name)))
925    (when buffer
926      (with-current-buffer buffer
927	(let ((buffer-read-only nil))
928	  (save-excursion
929	    (goto-char (point-min))
930	    (while (not (eobp))
931	      (let* ((item (navi2ch-bm-get-property-internal (point)))
932		     (item-article (navi2ch-bm-get-article-internal item))
933		     (item-board (navi2ch-bm-get-board-internal item)))
934		(when (and (equal (cdr (assq 'id board))
935				  (cdr (assq 'id item-board)))
936			   (equal (cdr (assq 'artid article))
937				  (cdr (assq 'artid item-article))))
938		  (let ((state (or state
939				   (navi2ch-bm-get-state-from-article
940				    board article)))
941			(updated (or updated
942				     (navi2ch-bm-get-updated-mark))))
943		    (navi2ch-bm-insert-state item state updated)
944		    (navi2ch-bm-set-property (navi2ch-line-beginning-position)
945					     (navi2ch-line-end-position)
946					     item state updated))))
947	      (forward-line))))))))
948
949(defun navi2ch-bm-remove-article-subr (board articles)
950  "BOARD $B$H(B ARTICLES $B$G;XDj$5$l$k%9%l$N>pJs$r>C$9!#(B
951ARTILCES $B$,(B alist $B$N>l9g$O$=$N%9%l$N$_$r!"(Balist $B$N(B list $B$N>l9g$O;XDj$5(B
952$B$l$k$9$Y$F$N%9%l$rBP>]$K$9$k!#(B"
953  (let ((summary (navi2ch-article-load-article-summary board)))
954    (setq articles
955	  (cond ((cdr (assq 'artid articles)) ; $B%9%l(B alist
956		 (list articles))
957		((cdr (assq 'artid (car articles))) ; $B%9%l(B alist $B$N(B list
958		 articles)))
959    (dolist (article articles)
960      (let ((artid (cdr (assq 'artid article)))
961	    (buffer (get-buffer (navi2ch-article-get-buffer-name board
962								 article)))
963	    (info-file (navi2ch-article-get-info-file-name board article))
964	    elt)
965	(when buffer
966	  (delete-windows-on buffer)
967	  (kill-buffer buffer))
968	(dolist (file (list info-file
969			    (navi2ch-make-backup-file-name
970			     info-file)
971			    (navi2ch-article-get-file-name board article)
972			    (navi2ch-article-get-message-filter-cache-file-name
973			     board article)))
974	  (condition-case nil
975	      (if (file-exists-p file)
976		  (delete-file file))
977	    (file-error nil))
978	  (navi2ch-cache-remove file navi2ch-info-cache))
979	(navi2ch-bm-remove-fetched-article board article)
980	(while (setq elt (assoc artid summary))
981	  (setq summary (delq elt summary))))
982      (navi2ch-bm-update-article board article))
983    (navi2ch-article-save-article-summary board summary)))
984
985(defun navi2ch-bm-remove-article ()
986  (interactive)
987  (let* ((item (navi2ch-bm-get-property-internal (point)))
988	 (article (navi2ch-bm-get-article-internal item))
989	 (board (navi2ch-bm-get-board-internal item)))
990    (when (and board article)
991      (navi2ch-bm-remove-article-subr board article))))
992
993(defun navi2ch-bm-remove-mark-article ()
994  (interactive)
995  (navi2ch-bm-exec-subr 'navi2ch-bm-remove-article))
996
997(defun navi2ch-bm-save-dat-file ()
998  (interactive)
999  (let* ((item (navi2ch-bm-get-property-internal (point)))
1000	 (article (navi2ch-bm-get-article-internal item))
1001	 (board (navi2ch-bm-get-board-internal item)))
1002    (when (and board article)
1003      (navi2ch-article-save-dat-file board article))))
1004
1005(defun navi2ch-bm-url-at-point (point)
1006  "POINT $B$N2<$N%j%s%/$r;X$9(B URL $B$rF@$k!#(B"
1007  (let ((board (navi2ch-bm-get-board-internal
1008		(navi2ch-bm-get-property-internal point)))
1009	(article (navi2ch-bm-get-article-internal
1010		  (navi2ch-bm-get-property-internal point))))
1011    (navi2ch-article-to-url board article)))
1012
1013(run-hooks 'navi2ch-board-misc-load-hook)
1014;;; navi2ch-board-misc.el ends here
1015