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