From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 1 Jun 2000 01:00:53 +0000 (+0000)
Subject: Removing files no longer in use.
X-Git-Tag: 20090517-FFI~3653
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=27e6b27e038ddeff87b1e45955c2f157c14558cd;p=mit-scheme.git

Removing files no longer in use.
---

diff --git a/v7/src/imail/imail-imap-url.scm b/v7/src/imail/imail-imap-url.scm
deleted file mode 100644
index 5c356682b..000000000
--- a/v7/src/imail/imail-imap-url.scm
+++ /dev/null
@@ -1,471 +0,0 @@
-;;; -*-Scheme-*-
-;;;
-;;; $Id: imail-imap-url.scm,v 1.10 2000/04/18 18:54:50 cph Exp $
-;;;
-;;; Copyright (c) 2000 Massachusetts Institute of Technology
-;;;
-;;; This program is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License as
-;;; published by the Free Software Foundation; either version 2 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;;; IMAIL mail reader: IMAP URLs
-
-(declare (usual-integrations))
-
-(define-class (<imap-url>
-	       (constructor (user-id auth-type host port mailbox uid)))
-    (<url>)
-  (user-id define accessor)
-  (auth-type define accessor)
-  (host define accessor)
-  (port define accessor)
-  (mailbox define accessor)
-  (uid define accessor))
-
-(define-url-protocol "imap" <imap-url>
-  (lambda (string)
-    (let ((lose (lambda () (error:bad-range-argument string #f))))
-      (if (not (string-prefix? "//" string))
-	  (lose))
-      (let ((end (string-length string)))
-	(let ((slash (substring-find-next-char string 2 end)))
-	  (if (not slash)
-	      (lose))
-	  (let ((pv1 (imap:parse:server string 0 slash)))
-	    (if (not (and pv1 (fix:= (car pv1) slash)))
-		(lose))
-	    (let ((pv2 (imap:parse:simple-message string (fix:+ slash 1) end)))
-	      (if (not (and pv2 (fix:= (car pv2) end)))
-		  (lose))
-	      (make-imap-url (parser-token pv1 'USER-ID)
-			     (parser-token pv1 'AUTH-TYPE)
-			     (parser-token pv1 'HOST)
-			     (parser-token pv1 'PORT)
-			     (parser-token pv2 'MAILBOX)
-			     (parser-token pv2 'UID)))))))))
-
-;;;; Parser language
-
-;;; A parser is a procedure that accepts a substring as three
-;;; arguments and returns one of two values.  If the parser
-;;; successfully parses the substring, it returns a pair whose car is
-;;; an index into the substring indicating how much of the substring
-;;; was parsed, and whose cdr is an alist of keyword/token pairs.  If
-;;; the parser fails, it returns #F.
-
-(define (parser-token parser-value keyword)
-  (let ((entry (assq keyword (cdr parser-value))))
-    (and entry
-	 (cdr entry))))
-
-(define (parse-never string start end)
-  string start end
-  #f)
-
-(define (parse-always string start end)
-  string end
-  (list start))
-
-(define (noise-parser match)
-  (lambda (string start end)
-    (let ((i (match string start end)))
-      (and i
-	   (list i)))))
-
-(define (simple-parser match keyword)
-  (lambda (string start end)
-    (let ((i (match string start end)))
-      (and i
-	   (list i (cons keyword (substring string start i)))))))
-
-(define (decoding-parser match-encoded decode match-decoded keyword)
-  (lambda (string start end)
-    (let ((i (match-encoded string start end)))
-      (and i
-	   (let ((string (decode string start i)))
-	     (let ((end (string-length string)))
-	       (let ((j (match-decoded string 0 end)))
-		 (and j
-		      (fix:= j end)
-		      (list i (cons keyword (substring string 0 j)))))))))))
-
-(define (optional-parser . parsers)
-  (let ((parse (apply sequence-parser parsers)))
-    (lambda (string start end)
-      (or (parse string start end)
-	  (list start)))))
-
-(define (sequence-parser . parsers)
-  (if (pair? parsers)
-      (if (pair? (cdr parsers))
-	  (lambda (string start end)
-	    (let loop ((parsers parsers) (start start))
-	      (let ((pv1 ((car parsers) string start end)))
-		(and pv1
-		     (if (pair? (cdr parsers))
-			 (let ((pv2 (loop (cdr parsers) (car pv1))))
-			   (and pv2
-				(cons (car pv2) (append (cdr pv1) (cdr pv2)))))
-			 pv1)))))
-	  (car parsers))
-      parse-always))
-
-(define (alternatives-parser . parsers)
-  (if (pair? parsers)
-      (if (pair? (cdr parsers))
-	  (lambda (string start end)
-	    (let loop ((parsers parsers))
-	      (or ((car parsers) string start end)
-		  (and (pair? (cdr parsers))
-		       (loop (cdr parsers))))))
-	  (car parsers))
-      parse-never))
-
-;;;; Matcher language
-
-;;; A matcher is a procedure that accepts a substring as three
-;;; arguments and returns one of two values.  If the matcher
-;;; successfully matches the substring, it returns an index into the
-;;; substring indicating how much of the substring was matched.  If
-;;; the matcher fails, it returns #F.
-
-(define (match-never string start end)
-  string start end
-  #f)
-
-(define (match-always string start end)
-  string end
-  start)
-
-(define (rexp-matcher pattern)
-  (let ((pattern (rexp-compile pattern)))
-    (lambda (string start end)
-      (let ((regs (re-substring-match pattern string start end)))
-	(and regs
-	     (re-match-end-index 0 regs))))))
-
-(define (string-matcher pattern)
-  (let ((pl (string-length pattern)))
-    (lambda (string start end)
-      (and (substring-prefix? pattern 0 pl string start end)
-	   (fix:+ start pl)))))
-
-(define (ci-string-matcher pattern)
-  (let ((pl (string-length pattern)))
-    (lambda (string start end)
-      (and (substring-prefix-ci? pattern 0 pl string start end)
-	   (fix:+ start pl)))))
-
-(define (optional-matcher . matchers)
-  (let ((matcher (apply sequence-matcher matchers)))
-    (lambda (string start end)
-      (or (matcher string start end)
-	  start))))
-
-(define (alternatives-matcher . matchers)
-  (if (pair? matchers)
-      (if (pair? (cdr matchers))
-	  (lambda (string start end)
-	    (let loop ((matchers matchers))
-	      (or ((car matchers) string start end)
-		  (and (pair? (cdr matchers))
-		       (loop (cdr matchers))))))
-	  (car matchers))
-      match-never))
-
-(define (sequence-matcher . matchers)
-  (if (pair? matchers)
-      (if (pair? (cdr matchers))
-	  (lambda (string start end)
-	    (let loop ((matchers matchers) (start start))
-	      (let ((i ((car matchers) string start end)))
-		(and i
-		     (if (pair? (cdr matchers))
-			 (loop (cdr matchers) i)
-			 i)))))
-	  (car matchers))
-      match-always))
-
-(define (*-matcher . matchers)
-  (let ((matcher (apply sequence-matcher matchers)))
-    (lambda (string start end)
-      (let loop ((start start))
-	(let ((i (matcher string start end)))
-	  (if i
-	      (loop i)
-	      start))))))
-
-(define (+-matcher . matchers)
-  (let ((matcher (apply sequence-matcher matchers)))
-    (sequence-matcher matcher (*-matcher matcher))))
-
-;;;; IMAP URL parser
-
-(define imap:char-set:achar
-  (char-set-union url:char-set:unreserved (string->char-set "&=~")))
-
-(define imap:match:achar+
-  (rexp-matcher
-   (rexp+ (rexp-alternatives imap:char-set:achar url:rexp:escape))))
-
-(define imap:match:bchar+
-  (rexp-matcher
-   (rexp+ (rexp-alternatives (char-set-union imap:char-set:achar
-					     (string->char-set ":@/"))
-			     url:rexp:escape))))
-
-(define imap:char-set:quoted-specials
-  (char-set #\" #\\))
-
-(define imap:char-set:list-wildcards
-  (char-set #\% #\*))
-
-(define imap:char-set:atom-char
-  (char-set-invert
-   (char-set-union (char-set #\( #\) #\{ #\space #\rubout)
-		   imap:char-set:quoted-specials
-		   imap:char-set:list-wildcards
-		   (ascii-range->char-set #x00 #x20))))
-
-(define imap:match:atom
-  (rexp-matcher (rexp+ imap:char-set:atom-char)))
-
-(define imap:match:quoted-string
-  (rexp-matcher
-   (rexp-sequence "\""
-		  (rexp* (rexp-alternatives
-			  (char-set-difference
-			   (char-set-difference
-			    (ascii-range->char-set #x01 #x80)
-			    (char-set #\return #\linefeed))
-			   imap:char-set:quoted-specials)
-			  (rexp-sequence "\\" imap:char-set:quoted-specials)))
-		  "\"")))
-
-(define (imap:match:literal string start end)
-  (let ((regs (re-substring-match "{\\([0-9]+\\)}\r\n" string start end)))
-    (and regs
-	 (let ((index
-		(fix:+ (re-match-end-index 0 regs)
-		       (substring->number string
-					  (re-match-start-index 1 regs)
-					  (re-match-end-index 1 regs)))))
-	   (and (fix:<= index end)
-		index)))))
-
-(define imap:match:string
-  (alternatives-matcher imap:match:quoted-string
-			imap:match:literal))
-
-(define imap:match:astring
-  (alternatives-matcher imap:match:atom
-			imap:match:string))
-
-(define imap:match:number
-  (rexp-matcher (rexp+ char-set:numeric)))
-
-(define imap:match:nz-number
-  (rexp-matcher
-   (rexp-sequence (char-set-difference char-set:numeric (char-set #\0))
-		  (rexp* char-set:numeric))))
-
-(define imap:match:date
-  (let ((date-text
-	 (rexp-matcher
-	  (rexp-sequence
-	   (rexp-sequence (rexp-optional (char-set #\1 #\2 #\3))
-			  char-set:numeric)
-	   "-"
-	   (apply rexp-alternatives
-		  (map rexp-case-fold
-		       '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul"
-			       "Aug" "Sep" "Oct" "Nov" "Dec")))
-	   "-"
-	   (rexp-sequence char-set:numeric
-			  char-set:numeric
-			  char-set:numeric
-			  char-set:numeric)))))
-    (alternatives-matcher date-text
-			  (sequence-matcher (string-matcher "\"")
-					    date-text
-					    (string-matcher "\"")))))
-
-(define imap:match:section-text
-  (alternatives-matcher
-   (ci-string-matcher "header")
-   (sequence-matcher (ci-string-matcher "header.fields")
-		     (optional-matcher (ci-string-matcher ".not"))
-		     (string-matcher " ")
-		     (string-matcher "(")
-		     (+-matcher imap:match:astring)
-		     (string-matcher ")"))
-   (ci-string-matcher "text")))
-
-(define imap:match:section
-  (alternatives-matcher
-   imap:match:section-text
-   (sequence-matcher imap:match:nz-number
-		     (*-matcher (string-matcher ".")
-				imap:match:nz-number)
-		     (optional-matcher (string-matcher ".")
-				       (alternatives-matcher
-					imap:match:section-text
-					(ci-string-matcher "mime"))))))
-
-(define (url:decoding-parser match-encoded match-decoded keyword)
-  (decoding-parser match-encoded url:decode-substring match-decoded keyword))
-
-(define imap:match:set
-  (let ((range
-	 (let ((number
-		(alternatives-matcher imap:match:nz-number
-				      (string-matcher "*"))))
-	   (alternatives-matcher number
-				 (sequence-matcher number ":" number)))))
-    (sequence-matcher range
-		      (*-matcher (string-matcher ",") range))))
-
-(define imap:match:search-key
-  (let ((m
-	 (lambda (keyword . arguments)
-	   (apply sequence-matcher
-		  (ci-string-matcher keyword)
-		  (map (lambda (argument)
-			 (sequence-matcher (string-matcher " ")
-					   argument))
-		       arguments))))
-	;; Kludge: self reference.
-	(imap:match:search-key
-	 (lambda (string start end)
-	   (imap:match:search-key string start end))))
-    (alternatives-matcher
-     (m "all")
-     (m "answered")
-     (m "bcc"		imap:match:astring)
-     (m "before"	imap:match:date)
-     (m "body"		imap:match:astring)
-     (m "cc"		imap:match:astring)
-     (m "deleted")
-     (m "draft")
-     (m "flagged")
-     (m "from"		imap:match:astring)
-     (m "header"	imap:match:astring imap:match:astring)
-     (m "keyword"	imap:match:atom)
-     (m "larger"	imap:match:number)
-     (m "new")
-     (m "not"		imap:match:search-key)
-     (m "old")
-     (m "on"		imap:match:date)
-     (m "or"		imap:match:search-key imap:match:search-key)
-     (m "recent")
-     (m "seen")
-     (m "sentbefore"	imap:match:date)
-     (m "senton"	imap:match:date)
-     (m "sentsince"	imap:match:date)
-     (m "since"		imap:match:date)
-     (m "smaller"	imap:match:number)
-     (m "subject"	imap:match:astring)
-     (m "text"		imap:match:astring)
-     (m "to"		imap:match:astring)
-     (m "uid"		imap:match:set)
-     (m "unanswered")
-     (m "undeleted")
-     (m "undraft")
-     (m "unflagged")
-     (m "unkeyword"	imap:match:atom)
-     (m "unseen")
-     imap:match:set
-     (sequence-matcher (string-matcher "(")
-		       imap:match:search-key
-		       (string-matcher ")")))))
-
-(define imap:match:search-program
-  (sequence-matcher
-   (optional-matcher (ci-string-matcher "charset ")
-		     imap:match:astring
-		     (string-matcher " "))
-   imap:match:search-key))
-
-(define imap:parse:server
-  (sequence-parser
-   (optional-parser
-    (let ((parse-user-id
-	   (url:decoding-parser imap:match:achar+
-				imap:match:astring
-				'USER-ID))
-	  (parse-auth
-	   (sequence-parser
-	    (noise-parser (ci-string-matcher ";auth="))
-	    (alternatives-parser
-	     (simple-parser (string-matcher "*") 'AUTH-TYPE)
-	     (url:decoding-parser imap:match:achar+
-				  imap:match:atom
-				  'AUTH-TYPE)))))
-      (sequence-parser
-       (alternatives-parser
-	(sequence-parser parse-user-id
-			 (optional-parser parse-auth))
-	(sequence-parser (optional-parser parse-user-id)
-			 parse-auth))
-       (noise-parser (string-matcher "@")))))
-   (simple-parser (rexp-matcher url:rexp:host) 'HOST)
-   (optional-parser
-    (noise-parser (string-matcher ":"))
-    (simple-parser (rexp-matcher (rexp+ char-set:numeric)) 'PORT))))
-
-(define imap:parse:mailboxlist
-  (sequence-parser
-   (optional-parser
-    (url:decoding-parser imap:match:bchar+
-			 (alternatives-matcher
-			  (rexp-matcher
-			   (rexp+
-			    (char-set-union imap:char-set:atom-char
-					    imap:char-set:list-wildcards)))
-			  imap:match:string)
-			 'MAILBOX-LIST))
-   (noise-parser (ci-string-matcher ";type="))
-   (simple-parser (alternatives-matcher (ci-string-matcher "list")
-					(ci-string-matcher "lsub"))
-		  'LIST-TYPE)))
-
-(define imap:parse:enc-mailbox
-  (url:decoding-parser imap:match:bchar+ imap:match:astring 'MAILBOX))
-
-(define imap:parse:uidvalidity
-  (sequence-parser (noise-parser (ci-string-matcher ";uidvalidity="))
-		   (simple-parser imap:match:nz-number 'UID-VALIDITY)))
-
-(define imap:parse:messagelist
-  (sequence-parser imap:parse:enc-mailbox
-		   (optional-parser
-		    (url:decoding-parser imap:match:bchar+
-					 imap:match:search-program
-					 'SEARCH-PROGRAM))
-		   (optional-parser imap:parse:uidvalidity)))
-
-(define imap:parse:messagepart
-  (sequence-parser imap:parse:enc-mailbox
-		   (optional-parser imap:parse:uidvalidity)
-		   (noise-parser (ci-string-matcher "/;uid="))
-		   (simple-parser imap:match:nz-number 'UID)
-		   (optional-parser
-		    (noise-parser (ci-string-matcher "/;section="))
-		    (url:decoding-parser imap:match:bchar+
-					 imap:match:section
-					 'SECTION))))
-
-(define imap:parse:simple-message
-  (sequence-parser imap:parse:enc-mailbox
-		   (noise-parser (ci-string-matcher "/;uid="))
-		   (simple-parser imap:match:nz-number 'UID)))
\ No newline at end of file
diff --git a/v7/src/imail/test-imap.scm b/v7/src/imail/test-imap.scm
deleted file mode 100644
index 6d23a067e..000000000
--- a/v7/src/imail/test-imap.scm
+++ /dev/null
@@ -1,80 +0,0 @@
-;;; -*-Scheme-*-
-;;;
-;;; $Id: test-imap.scm,v 1.1 2000/04/22 05:12:26 cph Exp $
-;;;
-;;; Copyright (c) 2000 Massachusetts Institute of Technology
-;;;
-;;; This program is free software; you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License as
-;;; published by the Free Software Foundation; either version 2 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;;; Manually interact with IMAP server
-
-(declare (usual-integrations))
-
-(define (open-imap-socket host user password)
-  (let ((port (open-tcp-stream-socket host "imap2")))
-    (let ((line (read-line port)))
-      (write-string line)
-      (newline)
-      (let ((conn (make-imap-connection port)))
-	(imap-command conn "LOGIN" user password)
-	conn))))
-
-(define (close-imap-socket conn)
-  (close-port (imap-connection-port conn)))
-
-(define (imap-command conn command . arguments)
-  (let ((tag (apply send-imap-command conn command arguments))
-	(port (imap-connection-port conn)))
-    (let loop ()
-      (let ((response (imap:read-server-response port)))
-	(if (not (eof-object? response))
-	    (begin
-	      (pp response)
-	      (if (not (and (memq (car response) '(OK NO BAD))
-			    (equal? tag (cadr response))))
-		  (loop))))))))
-
-(define (send-imap-command conn command . arguments)
-  (let ((tag (next-imap-command-tag conn))
-	(port (imap-connection-port conn)))
-    (let ((command
-	   (decorated-string-append "" " " "" (cons* tag command arguments))))
-      (write-string command port)
-      (newline port)
-      (write-string command)
-      (newline))
-    (flush-output port)
-    tag))
-
-(define (resynchronize-imap-socket conn tag)
-  (let ((prefix (string-append tag " "))
-	(port (imap-connection-port conn)))
-    (let loop ()
-      (let ((line (read-line port)))
-	(if (not (eof-object? line))
-	    (begin
-	      (write-string line)
-	      (newline)
-	      (if (not (string-prefix? prefix line))
-		  (loop))))))))
-
-(define (next-imap-command-tag conn)
-  (let ((n (imap-connection-sequence-number conn)))
-    (set-imap-connection-sequence-number! conn (+ n 1))
-    (string-append "A" (string-pad-left (number->string n) 4 #\0))))
-
-(define-structure (imap-connection (constructor make-imap-connection (port)))
-  (port #f read-only #t)
-  (sequence-number 0))
\ No newline at end of file