navi2ch-history.el

   1 ;;; navi2ch-history.el --- global history module for navi2ch -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 by Navi2ch Project
   4
   5 ;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
   6 ;; Keywords: network, 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 (provide 'navi2ch-history)
  29 (defconst navi2ch-history-ident
  30   "$Id$")
  31
  32 (eval-when-compile
  33   (require 'cl-lib)
  34   (require 'navi2ch-decls)
  35   (require 'navi2ch-inline))
  36 (require 'navi2ch-vars)
  37
  38 (defvar navi2ch-history-mode-map nil)
  39 (unless navi2ch-history-mode-map
  40   (let ((map (make-sparse-keymap)))
  41     (set-keymap-parent map navi2ch-bm-mode-map)
  42     ;; (define-key map "q" 'navi2ch-history-exit)
  43     (define-key map "\C-k" 'navi2ch-history-cut)
  44     (define-key map "\C-y" 'navi2ch-history-yank)
  45     (define-key map "d" 'navi2ch-history-cut)
  46     (define-key map "D" 'navi2ch-history-delete)
  47     (define-key map "md" 'navi2ch-history-cut-mark-article)
  48     (define-key map "mD" 'navi2ch-history-delete-mark-article)
  49     (define-key map "s" 'navi2ch-history-sync)
  50     (setq navi2ch-history-mode-map map)))
  51
  52 (defvar navi2ch-history-mode-menu-spec
  53   (navi2ch-bm-make-menu-spec
  54    "History"
  55    nil))
  56
  57 (defvar navi2ch-history-alist nil
  58   "history \e$B$rI=$9O"A[%j%9%H!#\e(B
  59 '((key board article) ...) \e$B$H$$$&7A$r$7$F$$$k!#\e(B
  60 key \e$B$O\e(B (concat uri artid)\e$B!#\e(B")
  61 (defvar navi2ch-history-buffer-name "*navi2ch history*")
  62
  63 (defvar navi2ch-history-board
  64   '((name . "\e$BMzNr\e(B")
  65     (type . history)
  66     (id . "#hist")))
  67 (defvar navi2ch-history-cut-stack nil)
  68
  69 ;;; navi2ch-bm callbacks
  70 (defun navi2ch-history-set-property (begin end item)
  71   (put-text-property begin end 'item item))
  72
  73 (defun navi2ch-history-get-property (point)
  74   (get-text-property (save-excursion (goto-char point)
  75                                      (beginning-of-line)
  76                                      (point))
  77                      'item))
  78
  79 (defun navi2ch-history-assoc-item (item)
  80   (or (assoc item navi2ch-history-alist)
  81       (and (string-match "^https:\\(.*\\)" item)
  82            (assoc (concat (if (string-prefix-p "https:" item)
  83                               "http:" "https:")
  84                           (match-string 1 item))
  85                   navi2ch-history-alist))))
  86
  87 (defun navi2ch-history-get-board (item)
  88   (nth 1 (navi2ch-history-assoc-item item)))
  89
  90 (defun navi2ch-history-get-article (item)
  91   (nth 2 (navi2ch-history-assoc-item item)))
  92
  93 (defun navi2ch-history-exit ()
  94   (run-hooks 'navi2ch-history-exit-hook))
  95
  96 ;; regist board
  97 (navi2ch-bm-regist-board 'history 'navi2ch-history
  98                          navi2ch-history-board)
  99
 100 ;; add hook
 101 (add-hook 'navi2ch-save-status-hook 'navi2ch-history-save-info)
 102 (add-hook 'navi2ch-load-status-hook 'navi2ch-history-load-info)
 103
 104 ;;; navi2ch-history functions
 105 (defun navi2ch-history-get-key (board article)
 106   (concat (cdr (assq 'uri board))
 107           (cdr (assq 'artid article))))
 108
 109 (defun navi2ch-history-add (board article)
 110   "BOARD \e$B$H\e(B ARTICLE \e$B$GI=$5$l$k\e(B \e$B%9%l%C%I$rDI2C!#\e(B"
 111   (let* ((key (navi2ch-history-get-key board article))
 112          (article (list (assq 'subject article)
 113                         (assq 'artid article)))
 114          (old-node (navi2ch-history-assoc-item key))
 115          (old-subject (cdr (assq 'subject (nth 2 old-node))))
 116          (subject (cdr (assq 'subject article))))
 117     (setq navi2ch-history-alist (delete old-node navi2ch-history-alist))
 118     (setq navi2ch-history-alist
 119           (cons (if (or subject (not old-subject))
 120                     (list key board article)
 121                   old-node)
 122                 navi2ch-history-alist)))
 123   (when (and navi2ch-history-max-line
 124              (> (length navi2ch-history-alist)
 125                 navi2ch-history-max-line))
 126     (setcdr (nthcdr (1- navi2ch-history-max-line)
 127                     navi2ch-history-alist)
 128             nil)))
 129
 130 (defun navi2ch-history-insert-subject (num item)
 131   (navi2ch-bm-insert-subject
 132    item num
 133    (or (cdr (assq 'subject (navi2ch-history-get-article item)))
 134        (navi2ch-history-get-key
 135         (navi2ch-history-get-board item)
 136         (navi2ch-history-get-article item)))
 137    (format "[%s]" (cdr (assq 'name (navi2ch-history-get-board item))))))
 138
 139 (defun navi2ch-history-insert-subjects ()
 140   (let ((i 1))
 141     (dolist (x navi2ch-history-alist)
 142       (navi2ch-history-insert-subject i (car x))
 143       (setq i (1+ i)))))
 144
 145 (defun navi2ch-history (&rest args)
 146   "history \e$B$rI=<($9$k!#\e(B"
 147   (navi2ch-history-mode)
 148   (navi2ch-bm-setup 'navi2ch-history)
 149   (navi2ch-history-sync))
 150
 151 (defun navi2ch-history-sync ()
 152   (interactive)
 153   (let ((buffer-read-only nil))
 154     (erase-buffer)
 155     (save-excursion
 156       (navi2ch-history-insert-subjects))))
 157
 158 (easy-menu-define navi2ch-history-mode-menu
 159   navi2ch-history-mode-map
 160   "Menu used in navi2ch-history"
 161   navi2ch-history-mode-menu-spec)
 162
 163 (defun navi2ch-history-setup-menu ()
 164   (easy-menu-add navi2ch-history-mode-menu))
 165
 166 (defun navi2ch-history-mode ()
 167   "\\{navi2ch-history-mode-map}"
 168   (interactive)
 169   (kill-all-local-variables)
 170   (setq major-mode 'navi2ch-history-mode)
 171   (setq mode-name "Navi2ch History")
 172   (setq buffer-read-only t)
 173   (buffer-disable-undo)
 174   (use-local-map navi2ch-history-mode-map)
 175   (navi2ch-history-setup-menu)
 176   (run-hooks 'navi2ch-bm-mode-hook 'navi2ch-history-mode-hook))
 177
 178 (defun navi2ch-history-save-info ()
 179   (let ((info (mapcar
 180                (lambda (x)
 181                  (let ((board (nth 1 x))
 182                        (article (nth 2 x)))
 183                    (list (list
 184                           (assq 'name board)
 185                           (assq 'uri board)
 186                           (assq 'id board))
 187                          (list
 188                           (assq 'subject article)
 189                           (assq 'artid article)))))
 190                navi2ch-history-alist)))
 191     (navi2ch-save-info navi2ch-history-file info t)))
 192
 193 (defun navi2ch-history-load-info ()
 194   (setq navi2ch-history-alist
 195         (mapcar
 196          (lambda (x)
 197            (cons (navi2ch-history-get-key (car x) (cadr x)) x))
 198          (navi2ch-load-info navi2ch-history-file))))
 199
 200 (defun navi2ch-history-delete ()
 201   "\e$B$=$N9T$r\e(B history \e$B$+$i:o=|$9$k!#\e(B"
 202   (interactive)
 203   (save-excursion
 204     (beginning-of-line)
 205     (let ((item (navi2ch-history-get-property (point))))
 206       (if item
 207           (let ((pair (navi2ch-history-assoc-item item))
 208                 (buffer-read-only nil))
 209             (setq navi2ch-history-alist (delq pair navi2ch-history-alist))
 210             (delete-region (point) (save-excursion (forward-line) (point)))
 211             (navi2ch-bm-renumber))
 212         (message "Can't select this line!")))))
 213
 214 (defun navi2ch-history-delete-mark-article ()
 215   (interactive)
 216   (navi2ch-bm-exec-subr 'navi2ch-history-delete))
 217
 218 (defun navi2ch-history-cut ()
 219   (interactive)
 220   (save-excursion
 221     (beginning-of-line)
 222     (let ((item (navi2ch-history-get-property (point))))
 223       (if item
 224           (progn
 225             (push (navi2ch-history-assoc-item item) navi2ch-history-cut-stack)
 226             (navi2ch-history-delete))
 227         (message "Can't select this line!")))))
 228
 229 (defun navi2ch-history-cut-mark-article ()
 230   (interactive)
 231   (navi2ch-bm-exec-subr 'navi2ch-history-cut))
 232
 233 (defun navi2ch-history-yank ()
 234   (interactive)
 235   (let ((pair (pop navi2ch-history-cut-stack)))
 236     (if pair
 237         (progn
 238           (if (eobp)
 239               (if navi2ch-history-alist
 240                   (setcdr (last navi2ch-history-alist)
 241                           (list pair))
 242                 (setq navi2ch-history-alist (list pair)))
 243             (let ((list (member (navi2ch-history-assoc-item (navi2ch-history-get-property (point)))
 244                                 navi2ch-history-alist)))
 245               (setcdr list (copy-sequence list))
 246               (setcar list pair)))
 247           (let ((buffer-read-only nil))
 248             (navi2ch-history-insert-subject 0 (car pair)))
 249           (navi2ch-bm-renumber))
 250       (message "Stack is empty"))))
 251
 252 (defun navi2ch-history-change (changed-list)
 253   "\e$BJQ99$5$l$?HD$NMzNr$r=$@5$9$k!#\e(B
 254 CHANGED-LIST \e$B$K$D$$$F$O\e(B `navi2ch-list-get-changed-status' \e$B$r;2>H!#\e(B"
 255   (setq navi2ch-history-alist
 256         (mapcar
 257          (lambda (node)
 258            (let* ((board (cadr node))
 259                   (article (caddr node))
 260                   (changed (assoc (cdr (assq 'id board)) changed-list)))
 261              (if changed
 262                  (let ((new-board (caddr changed)))
 263                    (list (navi2ch-history-get-key new-board article)
 264                          new-board
 265                          article))
 266                node)))
 267          navi2ch-history-alist))
 268   (navi2ch-history-save-info))
 269
 270 (run-hooks 'navi2ch-history-load-hook)
 271 ;;; navi2ch-history.el ends here