nndir.el 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899
  1. ;;; nndir.el --- single directory newsgroup access for Gnus
  2. ;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
  3. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
  4. ;; Keywords: news
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;;; Code:
  18. (require 'nnheader)
  19. (require 'nnmh)
  20. (require 'nnml)
  21. (require 'nnoo)
  22. (eval-when-compile (require 'cl))
  23. (nnoo-declare nndir
  24. nnml nnmh)
  25. (defvoo nndir-directory nil
  26. "Where nndir will look for groups."
  27. nnml-current-directory nnmh-current-directory)
  28. (defvoo nndir-nov-is-evil nil
  29. "*Non-nil means that nndir will never retrieve NOV headers."
  30. nnml-nov-is-evil)
  31. (defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group)
  32. (defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
  33. (defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
  34. (defvoo nndir-status-string "" nil nnmh-status-string)
  35. (defconst nndir-version "nndir 1.0")
  36. ;;; Interface functions.
  37. (nnoo-define-basics nndir)
  38. (deffoo nndir-open-server (server &optional defs)
  39. (setq nndir-directory
  40. (or (cadr (assq 'nndir-directory defs))
  41. server))
  42. (unless (assq 'nndir-directory defs)
  43. (push `(nndir-directory ,server) defs))
  44. (push `(nndir-current-group
  45. ,(file-name-nondirectory (directory-file-name nndir-directory)))
  46. defs)
  47. (push `(nndir-top-directory
  48. ,(file-name-directory (directory-file-name nndir-directory)))
  49. defs)
  50. (nnoo-change-server 'nndir server defs)
  51. (let (err)
  52. (cond
  53. ((not (condition-case arg
  54. (file-exists-p nndir-directory)
  55. (ftp-error (setq err (format "%s" arg)))))
  56. (nndir-close-server)
  57. (nnheader-report
  58. 'nndir (or err "No such file or directory: %s" nndir-directory)))
  59. ((not (file-directory-p (file-truename nndir-directory)))
  60. (nndir-close-server)
  61. (nnheader-report 'nndir "Not a directory: %s" nndir-directory))
  62. (t
  63. (nnheader-report 'nndir "Opened server %s using directory %s"
  64. server nndir-directory)
  65. t))))
  66. (nnoo-map-functions nndir
  67. (nnml-retrieve-headers 0 nndir-current-group 0 0)
  68. (nnml-request-article 0 nndir-current-group 0 0)
  69. (nnmh-request-group nndir-current-group 0 0)
  70. (nnml-close-group nndir-current-group 0)
  71. (nnml-request-list (nnoo-current-server 'nndir) nndir-directory)
  72. (nnml-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
  73. (provide 'nndir)
  74. ;;; nndir.el ends here