navi2ch-history.el

;;; navi2ch-history.el --- global history module for navi2ch -*- coding: iso-2022-7bit; -*-

;; Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 by Navi2ch Project

;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: network, 2ch

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;

;;; Code:
(provide 'navi2ch-history)
(defconst navi2ch-history-ident
  "$Id$")

(eval-when-compile (require 'cl))

(require 'navi2ch)

(defvar navi2ch-history-mode-map nil)
(unless navi2ch-history-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map navi2ch-bm-mode-map)
    ;; (define-key map "q" 'navi2ch-history-exit)
    (define-key map "\C-k" 'navi2ch-history-cut)
    (define-key map "\C-y" 'navi2ch-history-yank)
    (define-key map "d" 'navi2ch-history-cut)
    (define-key map "D" 'navi2ch-history-delete)
    (define-key map "md" 'navi2ch-history-cut-mark-article)
    (define-key map "mD" 'navi2ch-history-delete-mark-article)
    (define-key map "s" 'navi2ch-history-sync)
    (setq navi2ch-history-mode-map map)))

(defvar navi2ch-history-mode-menu-spec
  (navi2ch-bm-make-menu-spec
   "History"
   nil))

(defvar navi2ch-history-alist nil
  "history $B$rI=$9O"A[%j%9%H!#(B
'((key board article) ...) $B$H$$$&7A$r$7$F$$$k!#(B
key $B$O(B (concat uri artid)$B!#(B")
(defvar navi2ch-history-buffer-name "*navi2ch history*")

(defvar navi2ch-history-board
  '((name . "$BMzNr(B")
    (type . history)
    (id . "#hist")))
(defvar navi2ch-history-cut-stack nil)

;;; navi2ch-bm callbacks
(defun navi2ch-history-set-property (begin end item)
  (put-text-property begin end 'item item))

(defun navi2ch-history-get-property (point)
  (get-text-property (save-excursion (goto-char point)
				     (beginning-of-line)
				     (point))
		     'item))

(defun navi2ch-history-get-board (item)
  (nth 1 (assoc item navi2ch-history-alist)))

(defun navi2ch-history-get-article (item)
  (nth 2 (assoc item navi2ch-history-alist)))

(defun navi2ch-history-exit ()
  (run-hooks 'navi2ch-history-exit-hook))

;; regist board
(navi2ch-bm-regist-board 'history 'navi2ch-history
			 navi2ch-history-board)

;; add hook
(add-hook 'navi2ch-save-status-hook 'navi2ch-history-save-info)
(add-hook 'navi2ch-load-status-hook 'navi2ch-history-load-info)

;;; navi2ch-history functions
(defun navi2ch-history-get-key (board article)
  (concat (cdr (assq 'uri board))
	  (cdr (assq 'artid article))))

(defun navi2ch-history-add (board article)
  "BOARD $B$H(B ARTICLE $B$GI=$5$l$k(B $B%9%l%C%I$rDI2C!#(B"
  (let* ((key (navi2ch-history-get-key board article))
	 (article (list (assq 'subject article)
			(assq 'artid article)))
	 (old-node (assoc key navi2ch-history-alist))
	 (old-subject (cdr (assq 'subject (nth 2 old-node))))
	 (subject (cdr (assq 'subject article))))
    (setq navi2ch-history-alist (delete old-node navi2ch-history-alist))
    (setq navi2ch-history-alist
	  (cons (if (or subject (not old-subject))
		    (list key board article)
		  old-node)
		navi2ch-history-alist)))
  (when (and navi2ch-history-max-line
	     (> (length navi2ch-history-alist)
		navi2ch-history-max-line))
    (setcdr (nthcdr (1- navi2ch-history-max-line)
		    navi2ch-history-alist)
	    nil)))

(defun navi2ch-history-insert-subject (num item)
  (navi2ch-bm-insert-subject
   item num
   (or (cdr (assq 'subject (navi2ch-history-get-article item)))
       (navi2ch-history-get-key
	(navi2ch-history-get-board item)
	(navi2ch-history-get-article item)))
   (format "[%s]" (cdr (assq 'name (navi2ch-history-get-board item))))))

(defun navi2ch-history-insert-subjects ()
  (let ((i 1))
    (dolist (x navi2ch-history-alist)
      (navi2ch-history-insert-subject i (car x))
      (setq i (1+ i)))))

(defun navi2ch-history (&rest args)
  "history $B$rI=<($9$k!#(B"
  (navi2ch-history-mode)
  (navi2ch-bm-setup 'navi2ch-history)
  (navi2ch-history-sync))

(defun navi2ch-history-sync ()
  (interactive)
  (let ((buffer-read-only nil))
    (erase-buffer)
    (save-excursion
      (navi2ch-history-insert-subjects))))

(easy-menu-define navi2ch-history-mode-menu
  navi2ch-history-mode-map
  "Menu used in navi2ch-history"
  navi2ch-history-mode-menu-spec)

(defun navi2ch-history-setup-menu ()
  (easy-menu-add navi2ch-history-mode-menu))

(defun navi2ch-history-mode ()
  "\\{navi2ch-history-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'navi2ch-history-mode)
  (setq mode-name "Navi2ch History")
  (setq buffer-read-only t)
  (buffer-disable-undo)
  (use-local-map navi2ch-history-mode-map)
  (navi2ch-history-setup-menu)
  (run-hooks 'navi2ch-bm-mode-hook 'navi2ch-history-mode-hook))

(defun navi2ch-history-save-info ()
  (let ((info (mapcar
	       (lambda (x)
		 (let ((board (nth 1 x))
		       (article (nth 2 x)))
		   (list (list
			  (assq 'name board)
			  (assq 'uri board)
			  (assq 'id board))
			 (list
			  (assq 'subject article)
			  (assq 'artid article)))))
	       navi2ch-history-alist)))
    (navi2ch-save-info navi2ch-history-file info t)))

(defun navi2ch-history-load-info ()
  (setq navi2ch-history-alist
	(mapcar
	 (lambda (x)
	   (cons (navi2ch-history-get-key (car x) (cadr x)) x))
	 (navi2ch-load-info navi2ch-history-file))))

(defun navi2ch-history-delete ()
  "$B$=$N9T$r(B history $B$+$i:o=|$9$k!#(B"
  (interactive)
  (save-excursion
    (beginning-of-line)
    (let ((item (navi2ch-history-get-property (point))))
      (if item
	  (let ((pair (assoc item navi2ch-history-alist))
		(buffer-read-only nil))
	    (setq navi2ch-history-alist (delq pair navi2ch-history-alist))
	    (delete-region (point) (save-excursion (forward-line) (point)))
	    (navi2ch-bm-renumber))
	(message "Can't select this line!")))))

(defun navi2ch-history-delete-mark-article ()
  (interactive)
  (navi2ch-bm-exec-subr 'navi2ch-history-delete))

(defun navi2ch-history-cut ()
  (interactive)
  (save-excursion
    (beginning-of-line)
    (let ((item (navi2ch-history-get-property (point))))
      (if item
	  (progn
	    (push (assoc item navi2ch-history-alist) navi2ch-history-cut-stack)
	    (navi2ch-history-delete))
	(message "Can't select this line!")))))

(defun navi2ch-history-cut-mark-article ()
  (interactive)
  (navi2ch-bm-exec-subr 'navi2ch-history-cut))

(defun navi2ch-history-yank ()
  (interactive)
  (let ((pair (pop navi2ch-history-cut-stack)))
    (if pair
	(progn
	  (if (eobp)
	      (if navi2ch-history-alist
		  (setcdr (last navi2ch-history-alist)
			  (list pair))
		(setq navi2ch-history-alist (list pair)))
	    (let ((list (member (assoc (navi2ch-history-get-property (point))
				       navi2ch-history-alist)
				navi2ch-history-alist)))
	      (setcdr list (copy-sequence list))
	      (setcar list pair)))
	  (let ((buffer-read-only nil))
	    (navi2ch-history-insert-subject 0 (car pair)))
	  (navi2ch-bm-renumber))
      (message "Stack is empty"))))

(defun navi2ch-history-change (changed-list)
  "$BJQ99$5$l$?HD$NMzNr$r=$@5$9$k!#(B
CHANGED-LIST $B$K$D$$$F$O(B `navi2ch-list-get-changed-status' $B$r;2>H!#(B"
  (setq navi2ch-history-alist
	(mapcar
	 (lambda (node)
	   (let* ((board (cadr node))
		  (article (caddr node))
		  (changed (assoc (cdr (assq 'id board)) changed-list)))
	     (if changed
		 (let ((new-board (caddr changed)))
		   (list (navi2ch-history-get-key new-board article)
			 new-board
			 article))
	       node)))
	 navi2ch-history-alist))
  (navi2ch-history-save-info))

(run-hooks 'navi2ch-history-load-hook)
;;; navi2ch-history.el ends here