navi2ch-articles.el

   1 ;;; navi2ch-articles.el --- Article List Module for Navi2ch -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2008 by Navi2ch Project
   4
   5 ;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
   6 ;; Keywords: 2ch, network
   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 (provide 'navi2ch-articles)
  29 (defconst navi2ch-articles-ident
  30   "$Id$")
  31
  32 (eval-when-compile
  33   (require 'cl-lib)
  34   (require 'navi2ch-decls)
  35   (require 'navi2ch-inline))
  36
  37 (require 'navi2ch-vars)
  38
  39 (defvar navi2ch-articles-mode-map nil)
  40 (unless navi2ch-articles-mode-map
  41   (let ((map (make-sparse-keymap)))
  42     (set-keymap-parent map navi2ch-bm-mode-map)
  43     ;; (define-key navi2ch-articles-mode-map "q" 'navi2ch-articles-exit)
  44     (define-key map "d" 'navi2ch-articles-delete)
  45     (define-key map "md" 'navi2ch-articles-delete-mark-aritcle)
  46     (define-key map "R" 'navi2ch-articles-remove-article)
  47     (define-key map "mR" 'navi2ch-articles-remove-mark-article)
  48     (define-key map "s" 'navi2ch-articles-sync)
  49     (setq navi2ch-articles-mode-map map)))
  50
  51 (defvar navi2ch-articles-mode-menu-spec
  52   (navi2ch-bm-make-menu-spec
  53    "Articles"
  54    nil))
  55
  56 (defvar navi2ch-articles-board
  57   '((name . "\e$BI=<(%9%l0lMw\e(B")
  58     (type . articles)
  59     (id . "#articles")))
  60
  61 ;;; navi2ch-bm callbacks
  62 (defun navi2ch-articles-set-property (begin end item)
  63   (put-text-property begin end 'buffer item))
  64
  65 (defun navi2ch-articles-get-property (point)
  66   (get-text-property point 'buffer))
  67
  68 (defun navi2ch-articles-get-article (item)
  69   (when (and item
  70              (buffer-live-p item))
  71     (with-current-buffer item
  72       navi2ch-article-current-article)))
  73
  74 (defun navi2ch-articles-get-board (item)
  75   (when (and item
  76              (buffer-live-p item))
  77     (with-current-buffer item
  78       navi2ch-article-current-board)))
  79
  80 (defun navi2ch-articles-exit ()
  81   (run-hooks 'navi2ch-articles-exit-hook))
  82
  83 ;; regist board
  84 (navi2ch-bm-regist-board 'articles 'navi2ch-articles
  85                          navi2ch-articles-board)
  86
  87 ;;; navi2ch-articles functions
  88 (defun navi2ch-articles-insert-subjects ()
  89   (let ((i 1))
  90     (dolist (x (navi2ch-article-buffer-list))
  91       (let ((article (navi2ch-articles-get-article x))
  92             (board (navi2ch-articles-get-board x)))
  93         (navi2ch-bm-insert-subject
  94          x i
  95          (cdr (assq 'subject article))
  96          (format "[%s]" (cdr (assq 'name board))))
  97         (setq i (1+ i))))))
  98
  99 (defun navi2ch-articles-delete ()
 100   "\e$B$=$N9T$r\e(B articles \e$B$+$i:o=|$7$F!"$=$N\e(B article buffer \e$B$b>C$9!#\e(B"
 101   (interactive)
 102   (let ((buf (save-excursion (beginning-of-line)
 103                              (navi2ch-articles-get-property (point)))))
 104     (if buf
 105         (let ((buffer-read-only nil))
 106           (kill-buffer buf)
 107           (delete-region (save-excursion (beginning-of-line) (point))
 108                          (save-excursion (forward-line) (point)))
 109           (and (eobp) (not (bobp))
 110                (forward-line -1)))
 111       (message "Can't select this line!"))))
 112
 113 (defun navi2ch-articles-delete-mark-aritcle ()
 114   (interactive)
 115   (navi2ch-bm-exec-subr 'navi2ch-articles-delete))
 116
 117 (defun navi2ch-articles-remove-article ()
 118   (interactive)
 119   (navi2ch-bm-remove-article)
 120   (navi2ch-articles-delete))
 121
 122 (defun navi2ch-articles-remove-mark-article ()
 123   (interactive)
 124   (navi2ch-bm-exec-subr 'navi2ch-articles-remove-article))
 125
 126 (defun navi2ch-articles (&rest args)
 127   "articles \e$B$rI=<($9$k!#\e(B"
 128   (navi2ch-articles-mode)
 129   (navi2ch-bm-setup 'navi2ch-articles)
 130   (navi2ch-articles-sync))
 131
 132 (defun navi2ch-articles-sync ()
 133   (interactive)
 134   (let ((buffer-read-only nil))
 135     (erase-buffer)
 136     (save-excursion
 137       (navi2ch-articles-insert-subjects))))
 138
 139 (easy-menu-define navi2ch-articles-mode-menu
 140   navi2ch-articles-mode-map
 141   "Menu used in navi2ch-articles"
 142   navi2ch-articles-mode-menu-spec)
 143
 144 (defun navi2ch-articles-setup-menu ()
 145   (easy-menu-add navi2ch-articles-mode-menu))
 146
 147 (defun navi2ch-articles-mode ()
 148   "\\{navi2ch-articles-mode-map}"
 149   (interactive)
 150   (kill-all-local-variables)
 151   (setq major-mode 'navi2ch-articles-mode)
 152   (setq mode-name "Navi2ch Articles")
 153   (setq buffer-read-only t)
 154   (buffer-disable-undo)
 155   (use-local-map navi2ch-articles-mode-map)
 156   (navi2ch-articles-setup-menu)
 157   (run-hooks 'navi2ch-bm-mode-hook 'navi2ch-articles-mode-hook))
 158
 159 (run-hooks 'navi2ch-articles-load-hook)
 160 ;;; navi2ch-articles.el ends here