Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-ftp.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8fc7fe29b841
children c0c698873ce1
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; tm-ftp.el --- tm-view internal method for anonymous ftp 1 ;;;
2 2 ;;; tm-ftp: anonymous ftp processor for tm-view
3 ;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. 3 ;;;
4 4 ;;; by MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp> (1994/11/ 5)
5 ;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp> 5 ;;;
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 6 ;;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> (1994/11/ 8)
7 ;; Created: 1994/11/5 7 ;;; and OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp> (1994/11/11)
8 ;; Version: $Id: tm-ftp.el,v 1.5 1997/02/16 01:29:33 steve Exp $ 8 ;;;
9 ;; Keywords: anonymous ftp, MIME, multimedia, mail, news 9 ;;; $Id: tm-ftp.el,v 1.1.1.1 1996/12/18 22:43:38 steve Exp $
10 10 ;;;
11 ;; This file is part of tm (Tools for MIME).
12
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
17
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
27
28 ;;; Code:
29 11
30 (require 'tm-view) 12 (require 'tm-view)
13 (require 'ange-ftp)
31 14
32 (defvar mime-view-ftp-module 15 (defvar mime/dired-function
33 (if (< emacs-major-version 19)
34 'ange-ftp)
35 "*Module for ftp file access.")
36
37 (and mime-view-ftp-module
38 (require mime-view-ftp-module)
39 )
40
41 (defvar mime-article/dired-function
42 (if mime/use-multi-frame 16 (if mime/use-multi-frame
43 (function dired-other-frame) 17 (function dired-other-frame)
44 (function mime-article/dired-function-for-one-frame) 18 (function dired)
45 )) 19 ))
46 20
47 (defun mime-article/dired-function-for-one-frame (dir) 21 (defun mime/decode-message/external-ftp (beg end cal)
48 (let ((win (or (get-buffer-window mime::article/preview-buffer) 22 (let ((access-type (cdr (assoc "access-type" cal)))
49 (get-largest-window)))) 23 (site (cdr (assoc "site" cal)))
50 (select-window win) 24 (directory (cdr (assoc "directory" cal)))
51 (dired dir) 25 (name (cdr (assoc "name" cal)))
52 )) 26 (mode (cdr (assoc "mode" cal)))
53 27 (pathname))
54 (defun mime-article/decode-message/external-ftp (beg end cal) 28 (setq pathname
55 (let* ((access-type (cdr (assoc "access-type" cal))) 29 (concat "/anonymous@" site ":" directory))
56 (site (cdr (assoc "site" cal))) 30 (message (concat "Accessing " pathname "/" name "..."))
57 (directory (cdr (assoc "directory" cal))) 31 (switch-to-buffer mime::article/preview-buffer)
58 (name (cdr (assoc "name" cal))) 32 (funcall mime/dired-function pathname)
59 (mode (cdr (assoc "mode" cal)))
60 (pathname (concat "/anonymous@" site ":" directory))
61 )
62 (message (concat "Accessing " (expand-file-name name pathname) "..."))
63 (funcall mime-article/dired-function pathname)
64 (goto-char (point-min)) 33 (goto-char (point-min))
65 (search-forward name) 34 (search-forward name)
66 )) 35 ))
67 36
68 (set-atype 'mime/content-decoding-condition 37 (set-atype 'mime/content-decoding-condition
69 '((type . "message/external-body") 38 '((type . "message/external-body")
70 ("access-type" . "anon-ftp") 39 ("access-type" . "anon-ftp")
71 (method . mime-article/decode-message/external-ftp) 40 (method . mime/decode-message/external-ftp)
72 )) 41 ))
73 42
74
75 ;;; @ end
76 ;;;
77
78 (provide 'tm-ftp) 43 (provide 'tm-ftp)
79
80 ;;; tm-ftp.el ends here