|
22
|
1 ;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
3 ;;
|
|
|
4 ;; File: efs-coke.el
|
|
|
5 ;; Release: $efs release: 1.15 $
|
|
42
|
6 ;; Version: #Revision: 1.1 $
|
|
22
|
7 ;; RCS:
|
|
|
8 ;; Description: Coke Machine support for efs
|
|
|
9 ;; Author: Sandy Rutherford <sandy@imb550.sissa.it>
|
|
|
10 ;; Created: Fri Oct 14 23:55:04 1994 by sandy on ibm550
|
|
|
11 ;; Modified: Sun Nov 27 12:16:47 1994 by sandy on gandalf
|
|
|
12 ;; Language: Emacs-Lisp
|
|
|
13 ;;
|
|
|
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
15
|
|
|
16 ;;; This file is part of efs. See efs.el for copyright
|
|
|
17 ;;; (it's copylefted) and warrranty (there isn't one) information.
|
|
|
18
|
|
|
19 (provide 'efs-coke)
|
|
|
20 (require 'efs)
|
|
|
21
|
|
|
22 (defconst efs-coke-version
|
|
|
23 (concat (substring "$efs release: 1.15 $" 14 -2)
|
|
|
24 "/"
|
|
42
|
25 (substring "#Revision: 1.1 $" 11 -2)))
|
|
22
|
26
|
|
|
27 ;;;; ------------------------------------------------------------
|
|
|
28 ;;;; Coke Machine support
|
|
|
29 ;;;; ------------------------------------------------------------
|
|
|
30 ;;;
|
|
|
31 ;;; Works for the MIT vending machine FTP server.
|
|
|
32 ;;; Hopefully, a vending machine RFC is on its way, so we won't
|
|
|
33 ;;; need to support a wide variation of vending machine protocols.
|
|
|
34
|
|
|
35 (efs-defun efs-send-pwd coke (host user &optional xpwd)
|
|
|
36 ;; Directories on vending machines?
|
|
|
37 "/")
|
|
|
38
|
|
|
39 (efs-defun efs-fix-path coke (path &optional reverse)
|
|
|
40 (if (= ?/ (aref path 0))
|
|
|
41 (if reverse path (substring path 1))
|
|
|
42 (if reverse (concat "/" path) path)))
|
|
|
43
|
|
|
44 (efs-defun efs-fix-dir-path coke (dir-path)
|
|
|
45 ;; Make a beverage path for a dir listing.
|
|
|
46 (if (or (string-equal dir-path "/") (string-equal dir-path "/."))
|
|
|
47 "*"
|
|
|
48 dir-path))
|
|
|
49
|
|
|
50 (efs-defun efs-parse-listing coke
|
|
|
51 (host user dir path &optional switches)
|
|
|
52 ;; Parse the current buffer which is assumed to be in coke machine
|
|
|
53 ;; ftp dir format.
|
|
|
54 ;; HOST = remote host name
|
|
|
55 ;; USER = remote user name
|
|
|
56 ;; DIR = remote directory as a remote full path
|
|
|
57 ;; PATH = directory as an efs full path
|
|
|
58 ;; SWITCHES are never used here, but they
|
|
|
59 ;; must be specified in the argument list for compatibility
|
|
|
60 ;; with the unix version of this function.
|
|
|
61 (let ((tbl (efs-make-hashtable)))
|
|
|
62 (goto-char (point-min))
|
|
|
63 (efs-save-match-data
|
|
|
64 (while (re-search-forward "^\\(SOLD OUT \\)?\\[[0-9]+\\] +\\([^:\n]+\\)"
|
|
|
65 nil t)
|
|
|
66 (efs-put-hash-entry (buffer-substring (match-beginning 2)
|
|
|
67 (match-end 2))
|
|
|
68 (list nil) tbl)
|
|
|
69 (forward-line 1)))
|
|
|
70 ;; Don't need to bother with ..
|
|
|
71 (efs-put-hash-entry "." '(t) tbl)
|
|
|
72 tbl))
|
|
|
73
|
|
|
74 (efs-defun efs-allow-child-lookup coke (host user dir file)
|
|
|
75 ;; Returns t if FILE in directory DIR could possibly be a subdir
|
|
|
76 ;; according to its file-name syntax, and therefore a child listing should
|
|
|
77 ;; be attempted.
|
|
|
78
|
|
|
79 ;; Coke machine file system is flat. Hopefully not the coke.
|
|
|
80 (and (string-equal "/" dir) (string-equal "." file)))
|
|
|
81
|
|
|
82 (defun efs-coke-insert-beverage-contents (buffer file line)
|
|
|
83 ;; Inserts the contents of a beverage (determined by the FTP server
|
|
|
84 ;; response LINE) into BUFFER, and then drinks it.
|
|
|
85 ;; FILE is the name of the file.
|
|
|
86 (efs-save-buffer-excursion
|
|
|
87 (set-buffer buffer)
|
|
|
88 (if (zerop (buffer-size))
|
|
|
89 (progn
|
|
|
90 (insert "\n\n\n\n " (substring line 4) "\n")
|
|
|
91 (set-buffer-modified-p nil)
|
|
|
92 (set-process-sentinel
|
|
|
93 (start-process "efs-coke-gulp-buffer" (current-buffer) "sleep" "3")
|
|
|
94 (function
|
|
|
95 (lambda (proc str)
|
|
|
96 (efs-save-buffer-excursion
|
|
|
97 (let ((buff (process-buffer proc)))
|
|
|
98 (and buff (get-buffer buff)
|
|
|
99 (progn
|
|
|
100 (set-buffer buff)
|
|
|
101 (erase-buffer)
|
|
|
102 (insert "\n\n\n\n GULP!!!\n")
|
|
|
103 (sit-for 1)
|
|
|
104 (set-buffer-modified-p nil)
|
|
|
105 (kill-buffer (current-buffer)))))))))
|
|
|
106 (if (featurep 'dired)
|
|
|
107 (dired-fun-in-all-buffers
|
|
|
108 (file-name-directory file) 'dired-revert)))
|
|
|
109 (message "You haven't finished your last drink in buffer %s!"
|
|
|
110 (current-buffer))
|
|
|
111 (ding)
|
|
|
112 (sit-for 1))))
|
|
|
113
|
|
|
114 ;;; Dired support
|
|
|
115
|
|
|
116 (efs-defun efs-dired-manual-move-to-filename coke
|
|
|
117 (&optional raise-error bol eol)
|
|
|
118 ;; In dired, move to first char of filename on this line.
|
|
|
119 ;; Returns position (point) or nil if no filename on this line.
|
|
|
120 ;; This is the COKE version.
|
|
|
121 (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
|
|
|
122 (if bol
|
|
|
123 (goto-char bol)
|
|
|
124 (skip-chars-backward "^\n\r")
|
|
|
125 (setq bol (point)))
|
|
|
126 (if (looking-at "\\(. \\)?\\(SOLD OUT \\)?\\[[0-9]+\\] +\\([^:\n]+\\): ")
|
|
|
127 (goto-char (match-beginning 3))
|
|
|
128 (and raise-error (error "No file on this line"))))
|
|
|
129
|
|
|
130 (efs-defun efs-dired-manual-move-to-end-of-filename coke
|
|
|
131 (&optional no-error bol eol)
|
|
|
132 ;; Assumes point is at beginning of filename.
|
|
|
133 ;; So, it should be called only after (dired-move-to-filename t).
|
|
|
134 ;; On failure, signals an error or returns nil.
|
|
|
135 ;; This is the COKE version.
|
|
|
136 (let ((opoint (point)))
|
|
|
137 (and selective-display
|
|
|
138 (null no-error)
|
|
|
139 (eq (char-after
|
|
|
140 (1- (or bol (save-excursion
|
|
|
141 (skip-chars-backward "^\r\n")
|
|
|
142 (point)))))
|
|
|
143 ?\r)
|
|
|
144 ;; File is hidden or omitted.
|
|
|
145 (cond
|
|
|
146 ((dired-subdir-hidden-p (dired-current-directory))
|
|
|
147 (error
|
|
|
148 (substitute-command-keys
|
|
|
149 "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
|
|
|
150 ((error
|
|
|
151 (substitute-command-keys
|
|
|
152 "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
|
|
|
153 )))))
|
|
|
154 (if (search-forward ": " eol t)
|
|
|
155 (goto-char (- (match-end 0) 2))
|
|
|
156 (if no-error
|
|
|
157 nil
|
|
|
158 (error "No file on this line"))
|
|
|
159 (point))))
|
|
|
160
|
|
|
161 (efs-defun efs-dired-insert-headerline coke (dir)
|
|
|
162 (let* ((parsed (efs-ftp-path dir))
|
|
|
163 (host (car parsed))
|
|
|
164 (user (nth 1 parsed))
|
|
|
165 (accounting
|
|
|
166 (efs-send-cmd
|
|
|
167 host user '(quote pwd)
|
|
|
168 (format "Getting accounting data for %s@%s user host" user host))))
|
|
|
169 (insert " " user "@" host "\n "
|
|
|
170 (if (car accounting)
|
|
|
171 "Account status unavailable"
|
|
|
172 (substring (nth 1 accounting) 4)))
|
|
|
173 (delete-region (point) (progn (skip-chars-backward ":.,;") (point)))
|
|
|
174 (insert ":\n \n")))
|
|
|
175
|
|
|
176 ;;; end of efs-coke.el
|
