navi2ch-head.el

   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: \e$BI($rBG$D<T\e(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 (eval-when-compile
  37   (require 'cl-lib)
  38   (require 'navi2ch-decls)
  39   (require 'navi2ch-inline))
  40
  41 (require 'navi2ch-vars)
  42
  43 (eval-when-compile
  44   (autoload 'w3m-region "w3m")
  45   (autoload 'w3m-minor-mode "w3m"))
  46
  47 ;; navi2ch-head-mode
  48
  49 (defvar navi2ch-head-mode-map nil
  50   "\e$B%m!<%+%k%k!<%k$N%S%e%o!<$N%-!<%^%C%W!#\e(B")
  51 (unless navi2ch-head-mode-map
  52   (let ((map (make-sparse-keymap)))
  53     (set-keymap-parent map navi2ch-global-view-map)
  54     (define-key map "q" 'navi2ch-head-exit)
  55     (define-key map "l" 'navi2ch-head-exit)
  56     (define-key map "M" 'navi2ch-head-select-current-w3m-link)
  57     (setq navi2ch-head-mode-map map)))
  58
  59 (defvar navi2ch-head-file-name "head.txt")
  60 (defvar navi2ch-head-buffer-name "*navi2ch head*")
  61 (defvar navi2ch-head-current-board nil)
  62 (defvar navi2ch-head-current-article nil)
  63
  64 (add-hook 'navi2ch-exit-hook 'navi2ch-head-kill-buffer)
  65
  66 (defun navi2ch-head-mode ()
  67   "\\{navi2ch-head-mode-map}"
  68   (interactive)
  69   (kill-all-local-variables)
  70   (setq major-mode 'navi2ch-head-mode)
  71   (setq mode-name "Navi2ch Head")
  72   (setq buffer-read-only t)
  73   (buffer-disable-undo)
  74   (use-local-map navi2ch-head-mode-map)
  75   (run-hooks 'navi2ch-head-mode-hook))
  76
  77 ;; Functions
  78
  79 (defun navi2ch-head-save-time (time &optional board)
  80   (or board (setq board navi2ch-head-current-board))
  81   (when board
  82     (navi2ch-save-info (navi2ch-board-get-file-name board "head.info") time)))
  83
  84 (defun navi2ch-head-load-time (&optional board)
  85   (or board (setq board navi2ch-head-current-board))
  86   (navi2ch-load-info (navi2ch-board-get-file-name board "head.info")))
  87
  88 (defun navi2ch-head-kill-buffer ()
  89   (let ((buf (get-buffer navi2ch-head-buffer-name)))
  90     (when buf
  91       (delete-windows-on buf)
  92       (kill-buffer buf))))
  93
  94 (defun navi2ch-head-exit ()
  95   "\e$B%m!<%+%k%k!<%k%P%C%U%!$r>C$9!#\e(B"
  96   (interactive)
  97   (run-hooks 'navi2ch-head-exit-hook)
  98   (let ((exit (get-text-property (point-min) 'navi2ch-head-exit))
  99         (board navi2ch-head-current-board)
 100         (article navi2ch-head-current-article)
 101         win buf)
 102     (cond
 103      ((eq exit 'navi2ch-article-mode)
 104       (setq buf (get-buffer (navi2ch-article-get-buffer-name board article)))
 105       (if buf
 106           (if (setq win (get-buffer-window buf))
 107               (select-window win)
 108             (switch-to-buffer buf))
 109         (navi2ch-article-view-article board article)))
 110      ((eq exit 'navi2ch-board-mode)
 111       (setq buf (get-buffer navi2ch-board-buffer-name))
 112       (if buf
 113           (if (setq win (get-buffer-window buf))
 114               (select-window win)
 115             (switch-to-buffer buf))
 116         (navi2ch-bm-select-board board)))
 117      ((eq exit 'navi2ch-list-mode)
 118       (setq buf (get-buffer navi2ch-list-buffer-name))
 119       (if buf
 120           (if (setq win (get-buffer-window buf))
 121               (select-window win)
 122             (switch-to-buffer buf))
 123         (navi2ch-list))))
 124     (navi2ch-head-kill-buffer)))
 125
 126 (defun navi2ch-head-select-current-w3m-link (&optional browse-p)
 127   "Emacs-w3m \e$B$N%j%s%/$r\e(B navi2ch \e$B$r;H$C$F$?$I$k!#\e(B"
 128   (interactive "P")
 129   (let ((url (get-text-property (point) 'w3m-href-anchor)))
 130     (if url
 131         (if (and (navi2ch-2ch-url-p url)
 132                  (or (navi2ch-board-url-to-board url)
 133                      (navi2ch-article-url-to-article url))
 134                  (not browse-p))
 135             (navi2ch-goto-url url)
 136           (navi2ch-browse-url-internal url))
 137       (message "No URL at point"))))
 138
 139 (defun navi2ch-head-set-mode-line ()
 140   (setq navi2ch-mode-line-identification
 141         (format "[%s]" (cdr (assq 'name navi2ch-head-current-board))))
 142   (navi2ch-set-mode-line-identification))
 143
 144 ;; Entry points from navi2ch-{article,board,list}-mode
 145
 146 (define-key navi2ch-article-mode-map "H" 'navi2ch-head-get-head-txt)
 147 (define-key navi2ch-board-mode-map "H" 'navi2ch-head-get-head-txt)
 148 (define-key navi2ch-list-mode-map "H" 'navi2ch-head-get-head-txt)
 149
 150 (defun navi2ch-head-get-head-txt (&optional force)
 151   "\e$B%m!<%+%k%k!<%k$r;}$C$F$-$FI=<(!#\e(Bhead.txt \e$B$KJ]B8$7$A$c$&$h!#\e(B
 152 emacs-w3m \e$B$,$"$l$P\e(B w3m \e$B$GI=<($7$^$D!#\e(B"
 153   (interactive "P")
 154   (cond ((eq major-mode 'navi2ch-article-mode)
 155          (setq navi2ch-head-current-board navi2ch-article-current-board
 156                navi2ch-head-current-article navi2ch-article-current-article))
 157         ((eq major-mode 'navi2ch-board-mode)
 158          (setq navi2ch-head-current-board navi2ch-board-current-board
 159                navi2ch-head-current-article nil))
 160         ((eq major-mode 'navi2ch-list-mode)
 161          (setq navi2ch-head-current-board
 162                (get-text-property (navi2ch-line-beginning-position) 'board)
 163                navi2ch-head-current-article nil)
 164          (unless (eq (cdr (assq 'type navi2ch-head-current-board)) 'board)
 165            (setq navi2ch-head-current-board nil))))
 166   (unless (or navi2ch-head-current-board navi2ch-head-current-article)
 167     (error "Cannot get local rule here"))
 168   (let* ((navi2ch-net-force-update (or navi2ch-net-force-update force))
 169          (board navi2ch-head-current-board)
 170          (uri (navi2ch-board-get-url board navi2ch-head-file-name))
 171          (file (navi2ch-board-get-file-name board navi2ch-head-file-name))
 172          (exit major-mode)
 173          (win (or (get-buffer-window navi2ch-head-buffer-name)
 174                   (and (navi2ch-article-current-buffer)
 175                        (get-buffer-window (navi2ch-article-current-buffer)))
 176                   (get-buffer-window navi2ch-board-buffer-name)))
 177          time header)
 178     (unless (or navi2ch-offline
 179                 ;; navi2ch-multibbs-head-update \e$BI,MW!)\e(B
 180                 (eq (navi2ch-multibbs-get-bbstype board) 'localfile))
 181       (setq time (navi2ch-head-load-time))
 182       (setq header (navi2ch-net-update-file uri file time))
 183       (setq time (and (not (navi2ch-net-get-state 'not-updated header))
 184                       (not (navi2ch-net-get-state 'error header))
 185                       (or (cdr (assq 'last-modified header))
 186                           (cdr (assq 'date header)))))
 187       (when time (navi2ch-head-save-time time)))
 188     (when win (select-window win))
 189     (set-buffer (get-buffer-create navi2ch-head-buffer-name))
 190     (navi2ch-head-mode)
 191     (let ((buffer-read-only nil))
 192       (erase-buffer)
 193       (when (file-exists-p file)
 194         (navi2ch-insert-file-contents file))
 195       (if (eq (point-max) (point-min))
 196           (insert "'H'\e$B$r2!$9!#\e(B\n"
 197                   "  \e$B"-\e(B\n"
 198                   "\e$BHD%m!<%+%k%k!<%k$r8+$k!#\e(B\n"
 199                   "  \e$B"-\e(B\n"
 200                   "\e$BHD%m!<%+%k%k!<%k$O$J$$\e(B!\n"
 201                   "  \e$B"-\e(B\n"
 202                   "(\e(I_\e$B'U\e(I_\e(B)\e(IO<^3O0\e(B\n")
 203         (when (locate-library "w3m")
 204           (require 'w3m)
 205           (w3m-region (point-min) (point-max) uri)
 206           (w3m-minor-mode 1)))
 207       (goto-char (point-min))
 208       (put-text-property (point) (1+ (point)) 'navi2ch-head-exit exit)
 209       (set-buffer-modified-p nil))
 210     (switch-to-buffer (current-buffer))
 211     (navi2ch-head-set-mode-line)))
 212
 213 (run-hooks 'navi2ch-head-load-hook)
 214 ;;; navi2ch-head.el ends here