home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / archie.el < prev    next >
Encoding:
Text File  |  1993-06-14  |  27.6 KB  |  771 lines

  1. ;; Questions about this version to Jack Repenning <jackr@sgi.com>
  2. ;;
  3. ;; archie.el
  4. ;;   A mock-interface to Archie for Emacs.
  5. ;;
  6. ;;   -- original version by Brendan Kehoe (brendan@cs.widener.edu)
  7. ;;   ange-ftp extensions by Sanjay Mathur (mathur@nas.nasa.gov)
  8. ;;   ----- async support by Andy Norman (ange@hplb.hpl.hp.com)
  9. ;;   ----- convert-to-dired by (drw@bourbaki.mit.edu)
  10. ;;   ----- archie-server-preference-list by Jack Repenning (jackr@sgi.com)
  11. ;;   ----- merge with original archie mode by Piet van Oostrum <piet@cs.ruu.nl>
  12. ;;   ----- many enhancements thanks to the ange-ftp-lovers list
  13. ;;   ----- further archie-mode functions, cleanup, by Rob Austein
  14. ;;   ----- support for tree-dired "i"
  15. ;;   ----- use reporter.el to report bugs
  16. ;;   ----- protect against missing date fields
  17. ;;       Version: 3.0
  18. ;;         $ClearCase: archie.el@@/main/51 $
  19. ;;         sites:     /ftp@sgigate.sgi.com:/pub/archie-aux/archie.el
  20. ;;                    /ftp@alpha.gnu.ai.mit.edu:ange-ftp/archie.el
  21. ;;              /archive.cis.ohio-stat.edu:/pub/gnu/emacs/elisp-archive 
  22. ;; 
  23. ;; This file is not part of GNU Emacs but the same permissions apply.
  24. ;; 
  25. ;; GNU Emacs is free software; you can redistribute it and/or modify
  26. ;; it under the terms of the GNU General Public License as published by
  27. ;; the Free Software Foundation; either version 1, or (at your option)
  28. ;; any later version.
  29. ;;
  30. ;; GNU Emacs is distributed in the hope that it will be useful,
  31. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  32. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  33. ;; GNU General Public License for more details.
  34. ;;
  35. ;; You should have received a copy of the GNU General Public License
  36. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  37. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  38. ;;
  39. ;;
  40.  
  41. ;; Usage:
  42. ;;
  43. ;; M-x archie creates a separate buffer from which you can find, copy
  44. ;; or run dired on any of the entries (using ange-ftp) and redo the search
  45. ;; with modified string and/or search-type.
  46. ;; alternatively M-x archie creates a separate buffer in dired mode (q.v).
  47. ;;
  48. ;; Bugs:
  49. ;; If you have trouble with this mode, execute the command M-x
  50. ;; archie-submit-bug from an archie buffer, describe your problem in
  51. ;; the window provided, and mail it off.
  52. ;; In order for this to work, you will need Barry Warsaw's reporter.el
  53. ;; available in your load-path.
  54.  
  55. ;;
  56.  
  57. ;; Installation instructions:
  58. ;;
  59. ;; Install this file as archie.el somewhere in your load-path and add the
  60. ;; following two lines to ~/.emacs. (without the semicolon's, of course)
  61. ;;
  62. ;; (autoload 'archie "archie" "Archie interface" t)
  63. ;;
  64. ;; You may have to change the value of archie-program and archie-server
  65. ;; as appropriate for your site.
  66. ;; archie-search-type and archie-download-directory can be modified
  67. ;; to suit personal preferences.
  68. ;;
  69. ;; For use with this package, it is also convenient to set
  70. ;;  (setq ange-ftp-generate-anonymous-password t)
  71. ;;
  72. ;;  The crypt package (available in the LCD archives as
  73. ;;  ~/misc/crypt.el.Z) is useful with archie-find-file, since most
  74. ;;  archive sites store their files in a compressed form.
  75. ;;
  76. ;;  The built-in bug reporting system depends upon reporter.el, which
  77. ;;  you should have received along with this file.  Or, you can get it
  78. ;;  from the LCD archives, in ~/misc/reporter.el.Z.
  79.  
  80. ;; Getting archie.el
  81. ;; ===================
  82. ;; The latest public release version of this file should always be
  83. ;; available for anonymous ftp on the Emacs lisp archive machine.  The
  84. ;; path to the file is:
  85. ;;
  86. ;; archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archiveinterfaces/archie.el.Z 
  87. ;; 
  88. ;; For those of you without anon-ftp access, you can use the DEC's
  89. ;; ftpmail'er at the address ftpmail@decwrl.dec.com.  Send the
  90. ;; following message in the body of your mail to that address to get
  91. ;; c++-mode:
  92. ;;
  93. ;; reply <a valid net address back to you>
  94. ;; connect archive.cis.ohio-state.edu
  95. ;; binary
  96. ;; uuencode
  97. ;; chdir pub/gnu/emacs/elisp-archiveinterfaces
  98. ;; get archie.el.Z
  99. ;;
  100. ;; or just send the message "help" for more information on ftpmail.
  101. ;; Response times will vary with the number of requests in the queue.
  102. ;;
  103. ;; Similar directions apply for crypt and reporter.
  104.  
  105. ;;
  106. ;; This package is available in the LCD archive at
  107. ;; archive.cis.ohio-stat.edu:/pub/gnu/emacs/elisp-archive 
  108. ;;
  109. ;; LCD Archive Entry:
  110. ;; archie|Jack Repenning|jackr@dblues.wpd.sgi.com|
  111. ;; An Emacs interface to the archie program.|
  112. ;; 17-May-1993|3.0|~/interfaces/archie.el.Z|
  113. ;;
  114.  
  115. ;; Customization variables
  116.  
  117. (defvar archie-program "archie"
  118.   "Program that queries archie servers.")
  119.  
  120. (defvar archie-server-list
  121.   '(("archie.funet.fi"     .  "128.214.6.100   (European server in Finland)")
  122.     ("archie.rutgers.edu"  .  "128.6.18.15     (Rutgers University)")
  123.     ("archie.sura.net"     .  "128.167.254.179 (USA [MD])")
  124.     ("archie.unl.edu"      .  "129.93.1.14     (University of Nebraska in Lincoln)")
  125.     ("archiecs.huji.ac.il" .  "132.65.6.15     (Israel server)")
  126.     ("archie.au"           .  "139.130.4.6     (Australian server)")
  127.     ("archie.doc.ic.ac.uk" .  "146.169.11.3    (UK/England server)")
  128.     ("archie.ans.net"      .  "147.225.1.2     (ANS archie server)")
  129.     ("archie.wide.ad.jp"   .  "133.4.3.6       (Japanese server)"))
  130.   "List of known archie servers.")
  131.  
  132. (defvar archie-server nil
  133.    "*Server for \\[archie] searches.  If ``nil'' (the default), asks.
  134. Known archie servers are listed in archie-server-list.")
  135.  
  136. (defvar archie-download-directory nil
  137.   "*Default directory into which any files copied by archie-copy are
  138. copied. nil means to use /usr/tmp.")
  139.  
  140. (defvar archie-search-type "exact"
  141.   "*Search type for \\[archie] searches.  (Used to set command-line
  142. argument for archie program.)  See also archie-search-type-sticky.
  143.  
  144. Can be one of:
  145.         exact                   for exact matches (-e) (default)
  146.         regexp                  for a regexp (-r)
  147.         substring               for substring searches (-c) 
  148.         case-insensitive        for a case-insensitive substring search (-s)
  149.         exact-regexp            for an exact regexp (-er)
  150.         exact-substring         for an exact substring search (-es)
  151.         exact-case-insensitive  for exact case-insensitive search (-ec)
  152.         nil                     to ask every time")
  153.  
  154. (defvar archie-search-type-sticky t
  155.   "*Once you specify a search type, should it be made the new default
  156. (new value of archie-search-type)?")
  157.  
  158. (defvar archie-search-type-alist
  159.   ;; This is left as a defvar instead of defconst in case you don't like
  160.   ;; the keyword choice here, eg, you want "substring" to mean
  161.   ;; "case-insensitive-substring" (-s) as Allah clearly intended.
  162.   '(("substring" . "-c")
  163.     ("exact" . "-e")
  164.     ("regexp" . "-r")
  165.     ("case-insensitive" . "-s")
  166.     ("exact-substring" . "-ec")
  167.     ("exact-case-insensitive" . "-es")
  168.     ("exact-regexp" . "-er"))
  169.   "*Alist of search types for \\[archie] searches.")
  170.  
  171. (defun archie-search-type-alist ()
  172.   "Returns value of archie-internal-search-type-alist, updating it if
  173. necessary."
  174.   (if (eq archie-search-type-alist
  175.           (nthcdr (length archie-search-type-alist)
  176.                   archie-internal-search-type-alist))
  177.       archie-internal-search-type-alist
  178.     (setq archie-internal-search-type-alist
  179.           (nconc (mapcar (function (lambda (x) (cons (cdr x) (cdr x))))
  180.                          archie-search-type-alist)
  181.                  archie-search-type-alist))))
  182.  
  183. (defvar archie-do-convert-to-dired nil
  184.   "*If t archie buffers are converted to dired-mode, otherwise archie-mode
  185. is used.")
  186.  
  187. (defvar archie-search-hits "1000"
  188.   "*Maximum number of hits to ask for in search.")
  189.  
  190. (defvar archie-window-management 'at-end
  191.   "*When should \\[archie] display the window with the answer?
  192.         'at-start       When the search is initiated
  193.         'at-end         When the result is ready
  194.         'both           Both
  195.         otherwise       Never")
  196.  
  197. (defvar archie-server-preference-list nil
  198.   "*List of regexps for ordering archie results by server.  May be
  199. right-anchored with \"$\", e.g.:
  200.         '(\"erlangen\\.de$\"
  201.           \"tu-muenchen\\.de$\"
  202.           \"\\.de$\")")
  203.  
  204. (defvar archie-mode-hook nil
  205.   "Hooks to run after entering archie (non-dired) mode.")
  206.  
  207. (defvar archie-dired-mode-hook nil
  208.   "Hooks to run after entering archie-dired-mode.")
  209.  
  210. (defvar archie-anonymous-ftp-username "anonymous"
  211.   "Username to use for \"anonymous\" FTP connections.
  212. Set to \"anonymous\" by default, since more sites accept that than any
  213. other username (even \"ftp\", and no, not all machines in the world
  214. think they're synonyms).  For dired-mode archie, this only matters for
  215. hosts where you've got a non-anonymous username set.")
  216.  
  217. (defvar archie-display-hook nil
  218.   "Hook run after displaying the results buffer.")
  219.  
  220. (defvar archie-load-hook nil
  221.   "Hooks run after loading archie.el")
  222.  
  223.  
  224. ;; Variables you shouldn't have to customize
  225.  
  226. (defvar archie-file-version "$ClearCase: archie.el@@/main/51 $"
  227.   "Version string for this copy of archie.el")
  228.  
  229. (defvar archie-release "3.0"
  230.   "Release number")
  231.  
  232. (defvar archie-internal-search-type-alist nil
  233.   "Internal version of archie-search-type-alist (includes switches, as
  234. well as keywords).")
  235.  
  236. (defvar archie-dired-unusable-functions
  237.   (list
  238.    ;; Classic dired functions
  239.    'dired-backup-unflag
  240.    'dired-byte-recompile
  241.    'dired-chgrp
  242.    'dired-chmod
  243.    'dired-chown
  244.    'dired-clean-directory
  245.    'dired-compress
  246.    'dired-do-deletions
  247.    'dired-flag-auto-save-files
  248.    'dired-flag-backup-files
  249.    'dired-flag-file-deleted
  250.    'dired-rename-file
  251.    'dired-uncompress
  252.  
  253.    ;;; Tree-dired functions
  254.    'dired-backup-diff
  255.    ;; 'dired-backup-unflag
  256.    'dired-clean-directory
  257.    ;; 'dired-create-directory
  258.    ;; 'dired-diff
  259.    'dired-do-byte-compile
  260.    'dired-do-chgrp
  261.    ;; 'dired-do-chmod
  262.    'dired-do-chown
  263.    'dired-do-compress
  264.    ;; 'dired-do-copy
  265.    ;; 'dired-do-copy-regexp
  266.    'dired-do-delete
  267.    'dired-do-flagged-delete
  268.    'dired-do-hardlink
  269.    'dired-do-hardlink-regexp
  270.    ;; 'dired-do-kill
  271.    'dired-do-load
  272.    ;; 'dired-do-move ; amounts to dired-do-copy
  273.    'dired-do-print
  274.    ;; 'dired-do-redisplay
  275.    'dired-do-rename-regexp
  276.    ;; 'dired-do-shell-command   ; not likely the command knows what to
  277.                                 ; do with such a name, but what the hey
  278.    'dired-do-symlink
  279.    'dired-do-symlink-regexp
  280.    'dired-do-uncompress
  281.    'dired-downcase
  282.    ;; 'dired-find-file
  283.    ;; 'dired-find-file-other-window
  284.    'dired-flag-auto-save-files
  285.    'dired-flag-backup-files
  286.    'dired-flag-file-deleted
  287.    'dired-flag-regexp-files
  288.    'dired-hide-all              ; when ``i'' works ...
  289.    'dired-hide-subdir           ; when ``i'' works ...
  290.    ;; 'dired-kill-line-or-subdir
  291.    ;; 'dired-mark-directories
  292.    ;; 'dired-mark-executables
  293.    ;; 'dired-mark-files-regexp
  294.    ;; 'dired-mark-subdir-or-file
  295.    ;; 'dired-mark-symlinks
  296.    ;; 'dired-maybe-insert-subdir
  297.    ;; 'dired-next-dirline
  298.    ;; 'dired-next-line
  299.    ;; 'dired-next-marked-file
  300.    ;; 'dired-next-subdir
  301.    ;; 'dired-prev-dirline
  302.    ;; 'dired-prev-marked-file
  303.    ;; 'dired-prev-subdir
  304.    ;; 'dired-previous-line
  305.    ;; 'dired-quit
  306.    'dired-sort-toggle-or-edit
  307.    ;; 'dired-summary
  308.    ;; 'dired-tree-down
  309.    ;; 'dired-tree-up
  310.    ;; 'dired-undo
  311.    ;; 'dired-unflag-all-files
  312.    ;; 'dired-unmark-subdir-or-file
  313.    ;; 'dired-up-directory
  314.    'dired-upcase
  315.    ;; 'dired-view-file
  316.    ;; 'dired-why
  317.    ;; 'revert-buffer            ; replaced with archie-modify-query
  318.    )
  319.   "*List of dired functions that should be removed from the
  320. archie-dired-mode keymap.")
  321.  
  322. (defvar archie-l-output "[0-9]*Z *[0-9]* *\\([^ ]*\\) *\\(.*$\\)"
  323.   "Regular expression matching the results of archie -l query. The
  324.    two subexpressions match the host-name and the path respectively.")
  325.  
  326. (defvar archie-last-query nil)
  327. (defvar archie-last-type nil)
  328.  
  329. (defvar archie-mode-map
  330.   (let ((map (make-sparse-keymap)))
  331.     (define-key map "f" 'archie-find-file)
  332.     (define-key map "a" 'archie-modify-query)
  333.     (define-key map "c" 'archie-copy)
  334.     (define-key map "x" 'convert-archie-to-dired)
  335.     (define-key map "d" 'archie-dired)
  336.     (define-key map "v" 'archie-view-file)
  337.     (define-key map "n" 'archie-next-line)
  338.     (define-key map "s" 'archie-change-server)
  339.     (define-key map " " 'archie-next-line)
  340.     (define-key map "\C-n" 'archie-next-line)
  341.     (define-key map "p" 'archie-previous-line)
  342.     (define-key map "\C-?" 'archie-previous-line)
  343.     (define-key map "\C-p" 'archie-previous-line)
  344.     map)
  345.   "Local keymap used when in archie (non-dired) mode.")
  346.  
  347. (defvar archie-dired-mode-map nil
  348.   "Local keymap used when in archie-dired-mode.  Normally cloned from
  349. dired-mode-map, after dired-mode-hook is run.")
  350.  
  351. (defun archie-nyi (arg)
  352.   (interactive "P")
  353.   (message "Not yet implemented."))
  354.  
  355. (require 'dired)
  356. (if archie-dired-mode-map
  357.     nil
  358.   (setq archie-dired-mode-map
  359.     (copy-keymap dired-mode-map))
  360.   (mapcar
  361.    (function (lambda (fn)
  362.            (substitute-key-definition
  363.         fn
  364.         'archie-nyi
  365.         archie-dired-mode-map)))
  366.    archie-dired-unusable-functions)
  367.   (substitute-key-definition 'revert-buffer
  368.                  'archie-modify-query archie-dired-mode-map)
  369.   (define-key archie-dired-mode-map "s" 'archie-change-server))
  370.  
  371. (defun archie (type string)
  372.   "Search (with style TYPE, or prompt if arg) for STRING on an Archie
  373. server.
  374.  
  375. TYPE is the type of search to make -- by default, it's
  376. `archie-search-type'.  Possible values are exact, substring (case
  377. sensitive), case-insensitive and regexp (a regular expression).
  378. Interactively, a prefix arg will make it prompt for this. If
  379. archie-search-type is NIL, always prompts.  If
  380. archie-search-type-sticky is non-nil, each specified value is used as
  381. the next default; otherwise it reverts to archie-search-type.
  382.  
  383. STRING is the string (or regexp) for which to search.
  384.  
  385. If archie-do-convert-to-dired is non-NIL, the buffer is converted to a
  386. dired buffer.
  387.  
  388. The total number of search hits will be limited to (approximately)
  389. archie-search-hits.  If the prefix arg is >= 16 (e.g., ^U ^U
  390. \\[archie]), then you will be prompted for a new value for
  391. archie-search-hits."
  392.   (interactive (archie-get-query-args archie-search-type nil))
  393.   (let ((buf (generate-new-buffer string))
  394.         (flags (concat (or (cdr (assoc type (archie-search-type-alist)))
  395.                            (cdr (assoc archie-search-type
  396.                                        (archie-search-type-alist)))
  397.                            "-e"))))
  398.     (save-window-excursion
  399.       (set-buffer buf)
  400.       (setq archie-last-query string)
  401.       (setq archie-last-type type)
  402.       (setq buffer-read-only nil)
  403.       (erase-buffer)
  404.       (archie-mode)
  405.       (set
  406.        (make-local-variable 'archie-msg)
  407.        (message "Asking archie for %s match for \"%s\" ..." type string)))
  408.     (if (or (eq archie-window-management 'at-start)
  409.             (eq archie-window-management 'both))
  410.         (progn
  411.           (display-buffer buf)
  412.           (run-hooks 'archie-display-hook)))
  413.     (let ((proc (start-process "archie" ;name
  414.                                buf      ;buffer
  415.                                archie-program ;program
  416.                                "-h" (archie-server) ;program args
  417.                                "-m" archie-search-hits
  418.                                flags "-l"
  419.                                string)))
  420.       (process-kill-without-query proc)
  421.       (set-process-sentinel proc (function archie-process-sentinel)))))
  422.  
  423. (defun archie-process-sentinel (proc string)
  424.   (if (buffer-name (process-buffer proc))
  425.       (unwind-protect
  426.           (save-window-excursion
  427.             (set-buffer (process-buffer proc))
  428.             (let ((am archie-msg))
  429.               (message "%s converting." am)
  430.               (goto-char (point-min))
  431.               (archie-order-results)
  432.               (require 'ange-ftp)
  433.               (if archie-do-convert-to-dired (convert-archie-to-dired))
  434.               (setq buffer-read-only t)
  435.               (message "%s done." am)))
  436.         (if (or (eq archie-window-management 'at-end)
  437.                 (eq archie-window-management 'both))
  438.             (progn
  439.               (display-buffer (process-buffer proc))
  440.               (run-hooks 'archie-display-hook))))))
  441.  
  442. (defun archie-order-results ()
  443.   "Order archie results by archie-server-preference-list."
  444.   (goto-char (point-min))
  445.   (mapcar
  446.    (function
  447.     (lambda (server-re)
  448.       (let (match)
  449.         (if (string-match "\\$$" server-re)
  450.             (setq server-re
  451.                   (concat (substring server-re 0 -1) " ")))
  452.         (while
  453.             (save-excursion
  454.               (re-search-forward (concat "^[0-9Z]+\\s +[0-9]+ \\S *"
  455.                                          server-re
  456.                                          ".*")
  457.                                  nil t))
  458.           (setq match (buffer-substring (match-beginning 0) (1+ (match-end 0))))
  459.           (delete-region  (match-beginning 0) (1+ (match-end 0)))
  460.           (insert match)))))
  461.    archie-server-preference-list))
  462.  
  463. (defun convert-archie-to-dired ()
  464.   "Convert a buffer containing output in 'archie -l' format into a Dired-mode
  465. buffer in which the usual Dired commands can be used, via ange-ftp."
  466.   (interactive)
  467.   (if (not (fboundp 'ange-ftp-get-user)) (load "ange-ftp"))
  468.   (let (lines b s date size host file type year)
  469.     (setq year (substring (current-time-string) -4))
  470.     (setq lines (count-lines (point-min) (point-max)))
  471.     (setq buffer-read-only nil)
  472.     (goto-char (point-min))
  473.     (insert "  total " (int-to-string lines) ?\n)
  474.     (while (not (eobp))
  475.       (condition-case error
  476.           (progn
  477.             (setq b (point))
  478.             (beginning-of-line 2)
  479.             (setq s (buffer-substring b (point)))
  480.         (cond
  481.          ((string-match
  482.                  "^\\([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\\)Z +\\([0-9]+\\) \\([-_.a-zA-Z0-9]+\\) \\([^ \n]+\\)$"
  483.                  s)
  484.           t)
  485.          ((string-match
  486.                  "^ +\\([0-9]+\\) \\([-_.a-zA-Z0-9]+\\) \\([^ \n]+\\)$"
  487.                  s)
  488.           ;; date field missing (happens sometimes) - provide a
  489.           ;; nonsense one, so at least the entry is usable
  490.           (setq s (concat "19700101000000Z" s))
  491.           (string-match
  492.                  "^\\([0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]\\)Z +\\([0-9]+\\) \\([-_.a-zA-Z0-9]+\\) \\([^ \n]+\\)$"
  493.                  s))
  494.          (t
  495.                 (error "Line not from 'archie -l'")))
  496.             (setq date (substring s (match-beginning 1) (match-end 1)))
  497.             (setq size (substring s (match-beginning 2) (match-end 2)))
  498.             (setq host (substring s (match-beginning 3) (match-end 3)))
  499.             (setq file (substring s (match-beginning 4) (match-end 4)))
  500.             (if (string-equal (substring file -1) "/")
  501.                 (setq file (substring file 0 -1)
  502.                       type "d")
  503.               (setq type "-"))
  504.             (save-excursion
  505.               (insert "  "
  506.                       ;; - or d, depending on whether it's a file or a directory
  507.                       type
  508.                       "r--r--r--  1 ftp"
  509.                       ;; file size
  510.                       (make-string (- 8 (length size)) ? )
  511.                       size
  512.                       " "
  513.                       ;; creation date
  514.                       (condition-case error
  515.                           (aref
  516.                            ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
  517.                             "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
  518.                            (1- (string-to-int (substring date 4 6))))
  519.                         (error "Jan"))
  520.                       " "
  521.                       (if (= (aref date 6) ?0)
  522.                           (concat " " (substring date 7 8))
  523.                         (substring date 6 8))
  524.                       (if (string-equal (substring date 0 4) year)
  525.                           (concat " " (substring date 8 10) ":"
  526.                   (substring date 10 12))
  527.                         (concat "  " (substring date 0 4)))
  528.                       ;; file name, in Ange-FTP format
  529.                       (archie-get-user-prefix host) host ":" file
  530.                       ?\n))
  531.             (delete-region b (point))
  532.             (forward-line 1))
  533.         (error nil)))
  534.     (goto-char (point-min))
  535.     (save-excursion (insert "  /:\n"))
  536.     (setq default-directory "/")
  537.     (set-buffer-modified-p nil)
  538.     (dired-mode)
  539.     (use-local-map archie-dired-mode-map)
  540.     ;; Set subdir-alist so that Tree Dired will work:
  541.     (if (fboundp 'dired-build-subdir-alist)
  542.         ;; will work even with nested dired format (dired-nstd.el,v 1.15
  543.         ;; and later)
  544.     (progn
  545.       (make-local-variable 'dired-subdir-alist)
  546.       (dired-build-subdir-alist)
  547.       (dired-initial-position "/"))
  548.       ;; else we have an ancient tree dired (or classic dired, where
  549.       ;; this does no harm) 
  550.       (archie-dired-mode)
  551.       (set (make-local-variable 'dired-subdir-alist)
  552.            (list (cons default-directory (point-min-marker)))))))
  553.  
  554. (defun archie-get-user-prefix (host)
  555.   "Return a suitable string to affix to the archie filename for this HOST."
  556.   (if (not (fboundp 'ange-ftp-get-user)) (load "ange-ftp"))
  557.   (let ((prefix (concat " /" archie-anonymous-ftp-username "@")))
  558.     (if (or (not ange-ftp-default-user)
  559.             (stringp ange-ftp-default-user))
  560.         (let ((user (ange-ftp-get-user host)))
  561.           (if (or (string-equal user "anonymous")
  562.                   (string-equal user "ftp"))
  563.               (setq prefix " /"))))
  564.     prefix))
  565.  
  566. (defun archie-dired-mode ()
  567.   "Mode for handling archie output as a dired buffer.  Uses your own
  568. dired mode, as customized by any hooks.  Also runs your own
  569. archie-dired-mode-hook, if any, and uses this modified keymap:
  570. \\{archie-dired-mode-map}."
  571.   (if (not (fboundp 'dired-mode)) (load "dired"))
  572.   (dired-mode (concat "archie " (buffer-name)))
  573.   (setq default-directory "/usr/tmp/")
  574.   (if archie-dired-mode-map
  575.       nil
  576.     (setq archie-dired-mode-map
  577.           (copy-keymap (current-local-map)))
  578.     (mapcar
  579.      (function (lambda (fn)
  580.                  (substitute-key-definition fn nil archie-dired-mode-map)))
  581.      archie-dired-unusable-functions)
  582.     (substitute-key-definition 'revert-buffer
  583.                                'archie-modify-query archie-dired-mode-map)
  584.     (define-key archie-dired-mode-map "s" 'archie-change-server))
  585.   (use-local-map archie-dired-mode-map)
  586.   (setq major-mode 'archie-dired-mode)
  587.   (setq mode-name "Archie Dired")
  588.   (setq mode-line-buffer-indication '("Archie Dired: %17b"))
  589.   (run-hooks 'archie-dired-mode-hook))
  590.  
  591. (defun archie-get-filename ()
  592.     (beginning-of-line)
  593.     (if (looking-at archie-l-output)
  594.         (concat "/" archie-anonymous-ftp-username "@"
  595.                 (buffer-substring (match-beginning 1) (match-end 1))
  596.                 ":"
  597.                 (buffer-substring (match-beginning 2) (match-end 2)))
  598.       (error "Not archie -l output")))
  599.  
  600. (defun archie-next-line (arg)
  601.   (interactive "p")
  602.   (next-line arg)
  603.   (if (looking-at archie-l-output)
  604.       (goto-char (match-beginning 1))))
  605.  
  606. (defun archie-previous-line (arg)
  607.   (interactive "p")
  608.   (previous-line arg)
  609.   (if (looking-at archie-l-output)
  610.       (goto-char (match-beginning 1))))
  611.  
  612. (defun archie-find-file ()
  613.   "Find the file mentioned on the current line of archie -l output.
  614. Runs dired if the file is a directory and find-file-run-dired is
  615. non-nil."
  616.   (interactive)
  617.   (find-file (archie-get-filename)))
  618.  
  619. (defun archie-view-file ()
  620.   "View the file mentioned on the current line of archie -l output."
  621.   (interactive)
  622.   (view-file (archie-get-filename)))
  623.  
  624. (defun archie-copy ()
  625.   "Copy the file mentioned on the current line of archie -l output.
  626.    Prompts with the value implied by archie-download-directory
  627.    as the default directory in which to copy. The file-name part can be
  628.    empty, in which case the original name is used."
  629.   (interactive)
  630.   (let* ((from (archie-get-filename))
  631.          (from-nondir (file-name-nondirectory from))
  632.          (to nil))
  633.     (if (string-equal "" from-nondir)
  634.         (error "%s is a directory" from))
  635.     (setq to (read-file-name
  636.               (format "Copy %s to: " from-nondir)
  637.               (or archie-download-directory "/usr/tmp")))
  638.     (if (file-directory-p to)
  639.         (setq to (concat (file-name-as-directory to) from-nondir)))
  640.     (copy-file from to 1)))
  641.  
  642. (defun archie-dired ()
  643.   "Run dired on the file or directory mentioned on the current line
  644.    of archie -l output."
  645.   (interactive)
  646.   (dired (file-name-directory (archie-get-filename))))
  647.  
  648. (defun archie-get-query-args (type-defl string-defl)
  649.   "Queries user for search type (default: TYPE-DEFL) and string
  650.  (default: STRING-DEFL).  Use to prepare args for (interactive)."
  651.   (let* ((tmp-type (or (if (or current-prefix-arg (null archie-search-type))
  652.                            (completing-read
  653.                             "Search type: "
  654.                             (archie-search-type-alist)
  655.                             nil
  656.                             t
  657.                             type-defl))
  658.                        archie-search-type))
  659.          (tmp-string (read-string
  660.                       (concat "Ask Archie for " tmp-type  " match for: ")
  661.                       string-defl)))
  662.     (if archie-search-type-sticky
  663.         (setq archie-search-type tmp-type))
  664.     (if (and current-prefix-arg (<= 16 (car current-prefix-arg)))
  665.         (let (tstr)
  666.           (setq tstr (read-from-minibuffer "Reset archie-search-hits to: "))
  667.           (while (>= 0 (string-to-int tstr))
  668.             (setq tstr
  669.                   (read-from-minibuffer
  670.                    "Must be a number greater than zero.  Reset archie-search-hits to: ")))
  671.           (setq archie-search-hits tstr)))
  672.     (list tmp-type tmp-string)))
  673.  
  674. (defun archie-modify-query (type string)
  675.   "Re-do the last archie search, with modification of the string
  676. and/or search type."
  677.   (interactive (archie-get-query-args archie-last-type archie-last-query))
  678.   (archie type string))
  679.  
  680. (defun archie-server ()
  681.   "Return current server, or prompt for new one."
  682.   (interactive)
  683.   (if archie-server
  684.       archie-server
  685.     (call-interactively 'archie-change-server)))
  686.  
  687. (defun archie-change-server (new-server)
  688.   "Change the current archie server to be NEW-SERVER."
  689.   (interactive (list
  690.                 (completing-read
  691.                  (format "Change Archie server (current: %s): " archie-server)
  692.                  archie-server-list
  693.                  nil
  694.                  t)))
  695.   (setq archie-server new-server))
  696.  
  697. (defun archie-mode ()
  698.   "Major mode for interacting with the archie program.
  699. Type: \\[archie-find-file]  to find the file on the current line,
  700. or:  \\[archie-copy] to copy it
  701. or:  \\[archie-dired] to run dired.
  702. or:  \\[convert-archie-to-dired] to convert the buffer to dired.
  703.  
  704. To redo the last search with modification of the string and/or
  705. switches, type: \\[archie-modify-query].
  706.  
  707. If archie-download-directory is set to non-nil then its value is used
  708. as the default directory while prompting for the target file by the
  709. archie-copy command; otherwise, /usr/tmp.
  710.  
  711. \\{archie-mode-map}
  712.  
  713. Runs archie-mode-hook, if defined.
  714.  
  715. For problems, do \\[archie-submit-bug]."
  716.   (kill-all-local-variables)
  717.   (setq mode-name "Archie")
  718.   (setq major-mode 'archie-mode)
  719.   (use-local-map archie-mode-map)
  720.   (setq mode-line-process '(": %s"))
  721.   (run-hooks 'archie-mode-hook))
  722.  
  723.  
  724. ;;
  725.  
  726. (defvar archie-mode-help-address "archie@dblues.wpd.sgi.com"
  727.   "Address to receive archie.el bug reports.")
  728.  
  729. (defun archie-submit-bug ()
  730.   "Submit a bug report via email."
  731.   (interactive)
  732.   (require 'reporter)
  733.   (if (y-or-n-p "Do you want to submit a bug report on archie mode? ")
  734.       (reporter-submit-bug-report
  735.        archie-mode-help-address
  736.        (concat "archie.el " archie-release
  737.            " (" archie-file-version ")")
  738.        (list
  739.     'archie-program
  740.     'archie-server
  741.     'archie-download-directory
  742.     'archie-search-type
  743.     'archie-search-type-sticky
  744.     'archie-do-convert-to-dired
  745.     'archie-search-hits
  746.     'archie-window-management
  747.     'archie-anonymous-ftp-username
  748.     'archie-l-output
  749.     'archie-last-query
  750.     'archie-last-type
  751.     'archie-server-preference-list
  752.     'archie-mode-hook
  753.     'archie-dired-mode-hook
  754.     'archie-display-hook
  755.     'archie-load-hook
  756.     'archie-server-list
  757.     'archie-search-type-alist
  758.     'archie-internal-search-type-alist
  759.     'archie-dired-unusable-functions
  760.     'archie-mode-map
  761.     )
  762.        nil
  763.        nil
  764.        "Yo, Jack!")))
  765.  
  766.  
  767. (run-hooks 'archie-load-hook)
  768. (provide 'archie)
  769.  
  770.  
  771.