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