navi2ch-directory.el

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