1;;; navi2ch-head.el --- View a local rule mode for navi2ch -*- coding: iso-2022-7bit; -*-
2
3;; Copyright (C) 2001, 2002, 2003, 2008 by Navi2ch Project
4
5;; Author: $BI($rBG$D<T(B
6;; Keywords: www, 2ch
7
8;; This file is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; This file is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs; see the file COPYING.  If not, write to
20;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21;; Boston, MA 02111-1307, USA.
22
23;;; Commentary:
24
25;;
26
27;;; Code:
28
29;;;; navi2ch-head.el
30
31;; Preamble
32(provide 'navi2ch-head)
33(defconst navi2ch-head-ident
34  "$Id$")
35
36(require 'navi2ch)
37
38(eval-when-compile
39  (autoload 'w3m-region "w3m")
40  (autoload 'w3m-minor-mode "w3m"))
41
42;; navi2ch-head-mode
43
44(defvar navi2ch-head-mode-map nil
45  "$B%m!<%+%k%k!<%k$N%S%e%o!<$N%-!<%^%C%W!#(B")
46(unless navi2ch-head-mode-map
47  (let ((map (make-sparse-keymap)))
48    (set-keymap-parent map navi2ch-global-view-map)
49    (define-key map "q" 'navi2ch-head-exit)
50    (define-key map "l" 'navi2ch-head-exit)
51    (define-key map "M" 'navi2ch-head-select-current-w3m-link)
52    (setq navi2ch-head-mode-map map)))
53
54(defvar navi2ch-head-file-name "head.txt")
55(defvar navi2ch-head-buffer-name "*navi2ch head*")
56(defvar navi2ch-head-current-board nil)
57(defvar navi2ch-head-current-article nil)
58
59(add-hook 'navi2ch-exit-hook 'navi2ch-head-kill-buffer)
60
61(defun navi2ch-head-mode ()
62  "\\{navi2ch-head-mode-map}"
63  (interactive)
64  (kill-all-local-variables)
65  (setq major-mode 'navi2ch-head-mode)
66  (setq mode-name "Navi2ch Head")
67  (setq buffer-read-only t)
68  (buffer-disable-undo)
69  (use-local-map navi2ch-head-mode-map)
70  (run-hooks 'navi2ch-head-mode-hook))
71
72;; Functions
73
74(defun navi2ch-head-save-time (time &optional board)
75  (or board (setq board navi2ch-head-current-board))
76  (when board
77    (navi2ch-save-info (navi2ch-board-get-file-name board "head.info") time)))
78
79(defun navi2ch-head-load-time (&optional board)
80  (or board (setq board navi2ch-head-current-board))
81  (navi2ch-load-info (navi2ch-board-get-file-name board "head.info")))
82
83(defun navi2ch-head-kill-buffer ()
84  (let ((buf (get-buffer navi2ch-head-buffer-name)))
85    (when buf
86      (delete-windows-on buf)
87      (kill-buffer buf))))
88
89(defun navi2ch-head-exit ()
90  "$B%m!<%+%k%k!<%k%P%C%U%!$r>C$9!#(B"
91  (interactive)
92  (run-hooks 'navi2ch-head-exit-hook)
93  (let ((exit (get-text-property (point-min) 'navi2ch-head-exit))
94	(board navi2ch-head-current-board)
95	(article navi2ch-head-current-article)
96	win buf)
97    (cond
98     ((eq exit 'navi2ch-article-mode)
99      (setq buf (get-buffer (navi2ch-article-get-buffer-name board article)))
100      (if buf
101	  (if (setq win (get-buffer-window buf))
102	      (select-window win)
103	    (switch-to-buffer buf))
104	(navi2ch-article-view-article board article)))
105     ((eq exit 'navi2ch-board-mode)
106      (setq buf (get-buffer navi2ch-board-buffer-name))
107      (if buf
108	  (if (setq win (get-buffer-window buf))
109	      (select-window win)
110	    (switch-to-buffer buf))
111	(navi2ch-bm-select-board board)))
112     ((eq exit 'navi2ch-list-mode)
113      (setq buf (get-buffer navi2ch-list-buffer-name))
114      (if buf
115	  (if (setq win (get-buffer-window buf))
116	      (select-window win)
117	    (switch-to-buffer buf))
118	(navi2ch-list))))
119    (navi2ch-head-kill-buffer)))
120
121(defun navi2ch-head-select-current-w3m-link (&optional browse-p)
122  "Emacs-w3m $B$N%j%s%/$r(B navi2ch $B$r;H$C$F$?$I$k!#(B"
123  (interactive "P")
124  (let ((url (get-text-property (point) 'w3m-href-anchor)))
125    (if url
126	(if (and (navi2ch-2ch-url-p url)
127		 (or (navi2ch-board-url-to-board url)
128		     (navi2ch-article-url-to-article url))
129		 (not browse-p))
130	    (navi2ch-goto-url url)
131	  (navi2ch-browse-url-internal url))
132      (message "No URL at point"))))
133
134(defun navi2ch-head-set-mode-line ()
135  (setq navi2ch-mode-line-identification
136	(format "[%s]" (cdr (assq 'name navi2ch-head-current-board))))
137  (navi2ch-set-mode-line-identification))
138
139;; Entry points from navi2ch-{article,board,list}-mode
140
141(define-key navi2ch-article-mode-map "H" 'navi2ch-head-get-head-txt)
142(define-key navi2ch-board-mode-map "H" 'navi2ch-head-get-head-txt)
143(define-key navi2ch-list-mode-map "H" 'navi2ch-head-get-head-txt)
144
145(defun navi2ch-head-get-head-txt (&optional force)
146  "$B%m!<%+%k%k!<%k$r;}$C$F$-$FI=<(!#(Bhead.txt $B$KJ]B8$7$A$c$&$h!#(B
147emacs-w3m $B$,$"$l$P(B w3m $B$GI=<($7$^$D!#(B"
148  (interactive "P")
149  (cond ((eq major-mode 'navi2ch-article-mode)
150	 (setq navi2ch-head-current-board navi2ch-article-current-board
151	       navi2ch-head-current-article navi2ch-article-current-article))
152	((eq major-mode 'navi2ch-board-mode)
153	 (setq navi2ch-head-current-board navi2ch-board-current-board
154	       navi2ch-head-current-article nil))
155	((eq major-mode 'navi2ch-list-mode)
156	 (setq navi2ch-head-current-board
157	       (get-text-property (navi2ch-line-beginning-position) 'board)
158	       navi2ch-head-current-article nil)
159	 (unless (eq (cdr (assq 'type navi2ch-head-current-board)) 'board)
160	   (setq navi2ch-head-current-board nil))))
161  (unless (or navi2ch-head-current-board navi2ch-head-current-article)
162    (error "Cannot get local rule here"))
163  (let* ((navi2ch-net-force-update (or navi2ch-net-force-update force))
164	 (board navi2ch-head-current-board)
165	 (uri (navi2ch-board-get-url board navi2ch-head-file-name))
166	 (file (navi2ch-board-get-file-name board navi2ch-head-file-name))
167	 (exit major-mode)
168	 (win (or (get-buffer-window navi2ch-head-buffer-name)
169		  (and (navi2ch-article-current-buffer)
170		       (get-buffer-window (navi2ch-article-current-buffer)))
171		  (get-buffer-window navi2ch-board-buffer-name)))
172	 time header)
173    (unless (or navi2ch-offline
174		;; navi2ch-multibbs-head-update $BI,MW!)(B
175		(eq (navi2ch-multibbs-get-bbstype board) 'localfile))
176      (setq time (navi2ch-head-load-time))
177      (setq header (navi2ch-net-update-file uri file time))
178      (setq time (and (not (navi2ch-net-get-state 'not-updated header))
179		      (not (navi2ch-net-get-state 'error header))
180		      (or (cdr (assq 'last-modified header))
181			  (cdr (assq 'date header)))))
182      (when time (navi2ch-head-save-time time)))
183    (when win (select-window win))
184    (set-buffer (get-buffer-create navi2ch-head-buffer-name))
185    (navi2ch-head-mode)
186    (let ((buffer-read-only nil))
187      (erase-buffer)
188      (when (file-exists-p file)
189	(navi2ch-insert-file-contents file))
190      (if (eq (point-max) (point-min))
191	  (insert "'H'$B$r2!$9!#(B\n"
192		  "  $B"-(B\n"
193		  "$BHD%m!<%+%k%k!<%k$r8+$k!#(B\n"
194		  "  $B"-(B\n"
195		  "$BHD%m!<%+%k%k!<%k$O$J$$(B!\n"
196		  "  $B"-(B\n"
197		  "((I_$B'U(I_(B)(IO<^3O0(B\n")
198	(when (locate-library "w3m")
199	  (require 'w3m)
200	  (w3m-region (point-min) (point-max) uri)
201	  (w3m-minor-mode 1)))
202      (goto-char (point-min))
203      (put-text-property (point) (1+ (point)) 'navi2ch-head-exit exit)
204      (set-buffer-modified-p nil))
205    (switch-to-buffer (current-buffer))
206    (navi2ch-head-set-mode-line)))
207
208(run-hooks 'navi2ch-head-load-hook)
209;;; navi2ch-head.el ends here
210