archie.el

sock5代理服务器源代码

The total number of search hits will be limited to (approximately)
archie-search-hits.  If the prefix arg is >= 16 (e.g., ^U ^U
\\[archie]), then you will be prompted for a new value for
archie-search-hits."
  (interactive (archie-get-query-args archie-search-type nil))
  (let ((buf (generate-new-buffer string))
        (flags (concat (or (cdr (assoc type (archie-search-type-alist)))
                           (cdr (assoc archie-search-type
                                       (archie-search-type-alist)))
                           "-e"))))
    (save-window-excursion
      (set-buffer buf)
      (setq archie-last-query string)
      (setq archie-last-type type)
      (setq buffer-read-only nil)
      (erase-buffer)
      (archie-mode)
      (set
       (make-local-variable 'archie-msg)
       (message "Asking archie for %s match for \"%s\" ..." type string)))
    (if (or (eq archie-window-management 'at-start)
            (eq archie-window-management 'both))
        (progn
          (display-buffer buf)
          (run-hooks 'archie-display-hook)))
    (let ((proc (start-process "archie" ;name
                               buf      ;buffer
                               archie-program ;program
                               "-h" archie-server ;program args
                               "-m" archie-search-hits
                               flags "-l" "-"
                               string)))
      (process-kill-without-query proc)
      (set-process-sentinel proc (function archie-process-sentinel)))))

(defun archie-process-sentinel (proc string)
  (if (buffer-name (process-buffer proc))
      (unwind-protect
          (save-window-excursion
            (set-buffer (process-buffer proc))
            (let ((am archie-msg))
              (message "%s converting." am)
              (goto-char (point-min))
              (archie-order-results)
              (require 'ange-ftp)
              (if archie-do-convert-to-dired (convert-archie-to-dired))
              (setq buffer-read-only t)
              (message "%s done." am)))
        (if (or (eq archie-window-management 'at-end)
                (eq archie-window-management 'both))
            (progn
              (display-buffer (process-buffer proc))
              (run-hooks 'archie-display-hook))))))

(defun archie-order-results ()
  "Order archie results by archie-server-preference-list."
  (goto-char (point-min))
  (mapcar
   (function
    (lambda (server-re)
      (let (match)
        (if (string-match "\\$$" server-re)
            (setq server-re
                  (concat (substring server-re 0 -1) " ")))
        (while
            (save-excursion
              (re-search-forward (concat "^[0-9Z]+\\s +[0-9]+ \\S *"
                                         server-re
                                         ".*")
                                 nil t))
          (setq match (buffer-substring (match-beginning 0) (1+ (match-end 0))))
          (delete-region  (match-beginning 0) (1+ (match-end 0)))
          (insert match)))))
   archie-server-preference-list))

(defun convert-archie-to-dired ()
  "Convert a buffer containing output in 'archie -l' format into a Dired-mode
buffer in which the usual Dired commands can be used, via ange-ftp."
  (interactive)
  (if (not (fboundp 'ange-ftp-get-user)) (load "ange-ftp"))
  (let (lines b s date size host file type year)
    (setq year (substring (current-time-string) -4))
    (setq lines (count-lines (point-min) (point-max)))
    (setq buffer-read-only nil)
    (goto-char (point-min))
    (insert "  total " (int-to-string lines) ?\n)
    (while (not (eobp))
      (condition-case error
          (progn
            (setq b (point))
            (beginning-of-line 2)
            (setq s (buffer-substring b (point)))
            (or (string-match
                 "^\\([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]+\\)$"
                 s)
                (error "Line not from 'archie -l'"))
            (setq date (substring s (match-beginning 1) (match-end 1)))
            (setq size (substring s (match-beginning 2) (match-end 2)))
            (setq host (substring s (match-beginning 3) (match-end 3)))
            (setq file (substring s (match-beginning 4) (match-end 4)))
            (if (string-equal (substring file -1) "/")
                (setq file (substring file 0 -1)
                      type "d")
              (setq type "-"))
            (save-excursion
              (insert "  "
                      ;; - or d, depending on whether it's a file or a directory
                      type
                      "r--r--r--  1 ftp"
                      ;; file size
                      (make-string (- 8 (length size)) ? )
                      size
                      " "
                      ;; creation date
                      (condition-case error
                          (aref
                           ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
                            "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
                           (1- (string-to-int (substring date 4 6))))
                        (error "Jan"))
                      " "
                      (if (= (aref date 6) ?0)
                          (concat " " (substring date 7 8))
                        (substring date 6 8))
                      (if (string-equal (substring date 0 4) year)
                          (concat " " (substring date 8 10) ":" (substring date 10 12))
                        (concat "  " (substring date 0 4)))
                      ;; file name, in Ange-FTP format
                      (archie-get-user-prefix host) host ":" file
                      ?\n))
            (delete-region b (point))
            (forward-line 1))
        (error (forward-line 1))))
    (archie-dired-mode)
    (goto-char (point-min))
    ;; Set subdir-alist so that Tree Dired will work:
    (if (fboundp 'dired-simple-subdir-alist)
        ;; will work even with nested dired format (dired-nstd.el,v 1.15
        ;; and later)
        (dired-simple-subdir-alist)
      ;; else we have an ancient tree dired (or classic dired, where
      ;; this does no harm) 
      (set (make-local-variable 'dired-subdir-alist)
           (list (cons default-directory (point-min-marker)))))))

(defun archie-get-user-prefix (host)
  "Return a suitable string to affix to the archie filename for this HOST."
  (if (not (fboundp 'ange-ftp-get-user)) (load "ange-ftp"))
  (let ((prefix (concat " /" archie-anonymous-ftp-username "@")))
    (if (or (not ange-ftp-default-user)
            (stringp ange-ftp-default-user))
        (let ((user (ange-ftp-get-user host)))
          (if (or (string-equal user "anonymous")
                  (string-equal user "ftp"))
              (setq prefix " /"))))
    prefix))

(defun archie-dired-mode ()
  "Mode for handling archie output as a dired buffer.  Uses your own
dired mode, as customized by any hooks.  Also runs your own
archie-dired-mode-hook, if any, and uses this modified keymap:
\\{archie-dired-mode-map}."
  (if (not (fboundp 'dired-mode)) (load "dired"))
  (dired-mode (concat "archie " (buffer-name)))
  (setq default-directory "/usr/tmp/")
  (if archie-dired-mode-map
      nil
    (setq archie-dired-mode-map
          (copy-keymap (current-local-map)))
    (mapcar
     (function (lambda (fn)
                 (substitute-key-definition fn nil archie-dired-mode-map)))
     archie-dired-unusable-functions)
    (substitute-key-definition 'revert-buffer
                               'archie-modify-query archie-dired-mode-map)
    (define-key archie-dired-mode-map "s" 'archie-change-server))
  (use-local-map archie-dired-mode-map)
  (setq major-mode 'archie-dired-mode)
  (setq mode-name "Archie Dired")
  (setq mode-line-buffer-indication '("Archie Dired: %17b"))
  (run-hooks 'archie-dired-mode-hook))

(defun archie-get-filename ()
    (beginning-of-line)
    (if (looking-at archie-l-output)
        (concat "/" archie-anonymous-ftp-username "@"
                (buffer-substring (match-beginning 1) (match-end 1))
                ":"
                (buffer-substring (match-beginning 2) (match-end 2)))
      (error "Not archie -l output")))

(defun archie-next-line (arg)
  (interactive "p")
  (next-line arg)
  (if (looking-at archie-l-output)
      (goto-char (match-beginning 1))))

(defun archie-previous-line (arg)
  (interactive "p")
  (previous-line arg)
  (if (looking-at archie-l-output)
      (goto-char (match-beginning 1))))

(defun archie-find-file ()
  "Find the file mentioned on the current line of archie -l output.
Runs dired if the file is a directory and find-file-run-dired is
non-nil."
  (interactive)
  (find-file (archie-get-filename)))

(defun archie-view-file ()
  "View the file mentioned on the current line of archie -l output."
  (interactive)
  (view-file (archie-get-filename)))

(defun archie-copy ()
  "Copy the file mentioned on the current line of archie -l output.
   Prompts with the value implied by archie-download-directory
   as the default directory in which to copy. The file-name part can be
   empty, in which case the original name is used."
  (interactive)
  (let* ((from (archie-get-filename))
         (from-nondir (file-name-nondirectory from))
         (to nil))
    (if (string-equal "" from-nondir)
        (error "%s is a directory" from))
    (setq to (read-file-name
              (format "Copy %s to: " from-nondir)
              (or archie-download-directory "/usr/tmp")))
    (if (file-directory-p to)
        (setq to (concat (file-name-as-directory to) from-nondir)))
    (copy-file from to 1)))

(defun archie-dired ()
  "Run dired on the file or directory mentioned on the current line
   of archie -l output."
  (interactive)
  (dired (file-name-directory (archie-get-filename))))

(defun archie-get-query-args (type-defl string-defl)
  "Queries user for search type (default: TYPE-DEFL) and string
 (default: STRING-DEFL).  Use to prepare args for (interactive)."
  (let* ((tmp-type (or (if (or current-prefix-arg (null archie-search-type))
                           (completing-read
                            "Search type: "
                            (archie-search-type-alist)
                            nil
                            t
                            type-defl))
                       archie-search-type))
         (tmp-string (read-string
                      (concat "Ask Archie for " tmp-type  " match for: ")
                      string-defl)))
    (if archie-search-type-sticky
        (setq archie-search-type tmp-type))
    (if (and current-prefix-arg (<= 16 (car current-prefix-arg)))
        (let (tstr)
          (setq tstr (read-from-minibuffer "Reset archie-search-hits to: "))
          (while (>= 0 (string-to-int tstr))
            (setq tstr
                  (read-from-minibuffer
                   "Must be a number greater than zero.  Reset archie-search-hits to: ")))
          (setq archie-search-hits tstr)))
    (list tmp-type tmp-string)))

(defun archie-modify-query (type string)
  "Re-do the last archie search, with modification of the string
and/or search type."
  (interactive (archie-get-query-args archie-last-type archie-last-query))
  (archie type string))

(defun archie-server ()
  "Return current server, or prompt for new one."
  (interactive)
  (if archie-server
      archie-server
    (call-interactively 'archie-change-server)))

(defun archie-change-server (new-server)
  "Change the current archie server to be NEW-SERVER."
  (interactive (list
                (completing-read
                 (format "Change Archie server (current: %s): " archie-server)
                 archie-server-list
                 nil
                 t)))
  (setq archie-server new-server))

(defun archie-mode ()
  "Major mode for interacting with the archie program.
Type: \\[archie-find-file]  to find the file on the current line,
or:  \\[archie-copy] to copy it
or:  \\[archie-dired] to run dired.
or:  \\[convert-archie-to-dired] to convert the buffer to dired.

To redo the last search with modification of the string and/or
switches, type: \\[archie-modify-query].

If archie-download-directory is set to non-nil then its value is used
as the default directory while prompting for the target file by the
archie-copy command; otherwise, /usr/tmp.

\\{archie-mode-map}

Runs archie-mode-hook, if defined."
  (kill-all-local-variables)
  (setq mode-name "Archie")
  (setq major-mode 'archie-mode)
  (use-local-map archie-mode-map)
  (setq mode-line-process '(": %s"))
  (run-hooks 'archie-mode-hook))

(run-hooks 'archie-load-hook)
(provide 'archie)