1;;; navi2ch-directory.el --- List directory files Module for Navi2ch -*- coding: iso-2022-7bit; -*-
2
3;; Copyright (C) 2002, 2003, 2004, 2005, 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-directory)
29(defconst navi2ch-directory-ident
30  "$Id$")
31
32(eval-when-compile (require 'cl))
33
34(require 'navi2ch)
35
36(defvar navi2ch-directory-mode-map nil)
37(unless navi2ch-directory-mode-map
38  (let ((map (make-sparse-keymap)))
39    (set-keymap-parent map navi2ch-bm-mode-map)
40    (define-key map "s" 'navi2ch-directory-sync)
41    (setq navi2ch-directory-mode-map map)))
42
43(defvar navi2ch-directory-mode-menu-spec
44  (navi2ch-bm-make-menu-spec
45   "Directory"
46   nil))
47
48(defvar navi2ch-directory-board
49  '((name . "$B%U%!%$%k0lMw(B")
50    (type . directory)
51    (id . "#directory")))
52
53(defvar navi2ch-directory-current-board nil)
54(defvar navi2ch-directory-subject-list nil)
55
56;;; navi2ch-bm callbacks
57(defun navi2ch-directory-set-property (begin end item)
58  (put-text-property begin end 'item item))
59
60(defun navi2ch-directory-get-property (point)
61  (get-text-property
62   (save-excursion (goto-char point)
63		   (beginning-of-line)
64		   (point))
65   'item))
66
67(defun navi2ch-directory-get-article (item)
68  item)
69
70(defun navi2ch-directory-get-board (item)
71  navi2ch-directory-current-board)
72
73(defun navi2ch-directory-exit ()
74  (run-hooks 'navi2ch-directory-exit-hook))
75
76;; regist board
77(navi2ch-bm-regist-board 'directory 'navi2ch-directory
78			 navi2ch-directory-board)
79
80;;; navi2ch-directory functions
81(defun navi2ch-directory-insert-subjects ()
82  (let ((i 1))
83    (dolist (article navi2ch-directory-subject-list)
84      (navi2ch-bm-insert-subject
85       article i
86       (cdr (assq 'subject article))
87       (format "[%s]" (cdr (assq 'artid article))))
88      (setq i (1+ i)))))
89
90(defun navi2ch-directory-set-current-board (directory)
91  (setq directory (expand-file-name directory))
92  (setq navi2ch-directory-current-board
93	(list (cons 'name navi2ch-board-name-from-file)
94	      (cons 'uri (navi2ch-filename-to-url directory))
95	      (cons 'id "navi2ch"))))
96
97(defun navi2ch-directory-set-subject-list (directory)
98  (setq directory (file-name-as-directory
99		   (expand-file-name directory)))
100  (setq navi2ch-directory-subject-list
101	(mapcar
102	 (lambda (file)
103	   (setq file (concat directory file))
104	   (list
105	    (cons 'subject
106		  (cdr (assq 'subject
107			     (navi2ch-article-get-first-message-from-file
108			      file))))
109	    (cons 'artid
110		  (navi2ch-article-file-name-to-artid file))))
111	 (sort (directory-files directory nil navi2ch-article-local-dat-regexp t)
112	       (lambda (x y)
113		 (not (navi2ch-right-aligned-string< x y)))))))
114
115(defun navi2ch-directory-find-directory (directory)
116  (interactive "DDirectory: ")
117  (when (file-directory-p directory)
118    (setq directory (expand-file-name directory))
119    (setq default-directory directory)
120    (navi2ch-directory-set-current-board directory)
121    (navi2ch-directory-set-subject-list directory)
122    (navi2ch-bm-select-board navi2ch-directory-board)))
123
124(defun navi2ch-directory (&rest args)
125  "directory $B$rI=<($9$k!#(B"
126  (navi2ch-directory-mode)
127  (navi2ch-bm-setup 'navi2ch-directory)
128  (navi2ch-directory-sync))
129
130
131(defun navi2ch-directory-sync ()
132  (interactive)
133  (let ((buffer-read-only nil))
134    (erase-buffer)
135    (save-excursion
136      (navi2ch-directory-insert-subjects))))
137
138(easy-menu-define navi2ch-directory-mode-menu
139  navi2ch-directory-mode-map
140  "Menu used in navi2ch-directory"
141  navi2ch-directory-mode-menu-spec)
142
143(defun navi2ch-directory-setup-menu ()
144  (easy-menu-add navi2ch-directory-mode-menu))
145
146(defun navi2ch-directory-mode ()
147  "\\{navi2ch-directory-mode-map}"
148  (interactive)
149  (kill-all-local-variables)
150  (setq major-mode 'navi2ch-directory-mode)
151  (setq mode-name "Navi2ch Directory")
152  (setq buffer-read-only t)
153  (buffer-disable-undo)
154  (use-local-map navi2ch-directory-mode-map)
155  (navi2ch-directory-setup-menu)
156  (run-hooks 'navi2ch-bm-mode-hook 'navi2ch-directory-mode-hook))
157
158(run-hooks 'navi2ch-directory-load-hook)
159;;; navi2ch-directory.el ends here
160