From 693c9089d4368437b535f66173fa6c4e09527db3 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 18 Apr 2000 21:44:48 +0000 Subject: [PATCH] Add new files, rearrange package structure. --- v7/src/imail/compile.scm | 6 ++- v7/src/imail/ed-ffi.scm | 24 ++++++----- v7/src/imail/imail-imap.scm | 86 +++++++++++++++++++++++++++++++++++++ v7/src/imail/imail.pkg | 80 ++++++++++++++++++++++++++++++---- 4 files changed, 175 insertions(+), 21 deletions(-) create mode 100644 v7/src/imail/imail-imap.scm diff --git a/v7/src/imail/compile.scm b/v7/src/imail/compile.scm index 39bd80e39..c5a1f1c8c 100644 --- a/v7/src/imail/compile.scm +++ b/v7/src/imail/compile.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: compile.scm,v 1.4 2000/04/14 18:01:34 cph Exp $ +;;; $Id: compile.scm,v 1.5 2000/04/18 21:44:45 cph Exp $ ;;; ;;; Copyright (c) 2000 Massachusetts Institute of Technology ;;; @@ -27,10 +27,12 @@ (for-each compile-file '("imail-core" "imail-file" - "imail-imap-url" + "imail-imap" "imail-rmail" "imail-umail" "imail-util" + "imap-syntax" + "parser" "rexp" "rfc822" "url")) diff --git a/v7/src/imail/ed-ffi.scm b/v7/src/imail/ed-ffi.scm index eed1f44b8..3bb7a97b3 100644 --- a/v7/src/imail/ed-ffi.scm +++ b/v7/src/imail/ed-ffi.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: ed-ffi.scm,v 1.6 2000/04/14 18:01:35 cph Exp $ +;;; $Id: ed-ffi.scm,v 1.7 2000/04/18 21:44:46 cph Exp $ ;;; ;;; Copyright (c) 2000 Massachusetts Institute of Technology ;;; @@ -21,13 +21,15 @@ ;;;; IMAIL mail reader: Edwin buffer packaging info (standard-scheme-find-file-initialization - '#(("imail-core" (edwin imail) system-global-syntax-table) - ("imail-file" (edwin imail) system-global-syntax-table) - ("imail-imap-url" (edwin imail) system-global-syntax-table) - ("imail-rmail" (edwin imail) system-global-syntax-table) - ("imail-top" (edwin imail) edwin-syntax-table) - ("imail-umail" (edwin imail) system-global-syntax-table) - ("imail-util" (edwin imail) system-global-syntax-table) - ("rexp" (runtime rexp) system-global-syntax-table) - ("rfc822" (edwin imail) system-global-syntax-table) - ("url" (runtime url) system-global-syntax-table))) \ No newline at end of file + '#(("imail-core" (edwin imail) system-global-syntax-table) + ("imail-file" (edwin imail) system-global-syntax-table) + ("imail-imap" (edwin imail) system-global-syntax-table) + ("imail-rmail" (edwin imail) system-global-syntax-table) + ("imail-top" (edwin imail) edwin-syntax-table) + ("imail-umail" (edwin imail) system-global-syntax-table) + ("imail-util" (edwin imail) system-global-syntax-table) + ("imap-syntax" (edwin imail imap-syntax) system-global-syntax-table) + ("parser" (edwin imail parser) system-global-syntax-table) + ("rexp" (edwin imail rexp) system-global-syntax-table) + ("rfc822" (edwin imail rfc822) system-global-syntax-table) + ("url" (edwin imail url) system-global-syntax-table))) \ No newline at end of file diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm new file mode 100644 index 000000000..ccb997eca --- /dev/null +++ b/v7/src/imail/imail-imap.scm @@ -0,0 +1,86 @@ +;;; -*-Scheme-*- +;;; +;;; $Id: imail-imap.scm,v 1.1 2000/04/18 21:44:48 cph Exp $ +;;; +;;; Copyright (c) 1999-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 back end + +(declare (usual-integrations)) + +;;;; URL + +(define-class ( + (constructor (user-id auth-type host port mailbox uid))) + () + (user-id define accessor) + (auth-type define accessor) + (host define accessor) + (port define accessor) + (mailbox define accessor) + (uid define accessor)) + +(define-url-protocol "imap" + (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))))))))) + +;;;; Server operations + +(define-method %open-folder ((url )) + ) + +(define-method %new-folder ((url )) + ) + +(define-method %delete-folder ((url )) + ) + +(define-method %move-folder ((url ) (new-url )) + ) + +(define-method %copy-folder ((url ) (new-url )) + ) + +(define-method available-folder-names ((url )) + ) + +(define-method subscribed-folder-names ((url )) + ) + +;;;; Folder + +(define-class ( (constructor (url))) () + (url accessor folder-url) + ) \ No newline at end of file diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg index 19d76d05b..4c2c3d032 100644 --- a/v7/src/imail/imail.pkg +++ b/v7/src/imail/imail.pkg @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail.pkg,v 1.13 2000/04/14 18:01:36 cph Exp $ +;;; $Id: imail.pkg,v 1.14 2000/04/18 21:44:47 cph Exp $ ;;; ;;; Copyright (c) 2000 Massachusetts Institute of Technology ;;; @@ -24,10 +24,10 @@ (global-definitions "$bscm/sos/sos") (global-definitions "$bscm/edwin/edwinunx") -(define-package (runtime rexp) +(define-package (edwin imail rexp) (files "rexp") - (parent ()) - (export () + (parent (edwin imail)) + (export (edwin imail) rexp* rexp+ rexp->regexp @@ -52,10 +52,34 @@ rexp-word-start rexp?)) -(define-package (runtime url) +(define-package (edwin imail parser) + (files "parser") + (parent (edwin imail)) + (export (edwin imail) + *-matcher + +-matcher + alternatives-matcher + alternatives-parser + ci-string-matcher + decoding-parser + match-always + match-never + noise-parser + optional-matcher + optional-parser + parse-always + parse-never + parser-token + rexp-matcher + sequence-matcher + sequence-parser + simple-parser + string-matcher)) + +(define-package (edwin imail url) (files "url") - (parent ()) - (export () + (parent (edwin imail)) + (export (edwin imail) url:char-set:escaped url:char-set:extra url:char-set:national @@ -78,9 +102,49 @@ url:string-encoded? url:substring-encoded?)) +(define-package (edwin imail rfc822) + (files "rfc822") + (parent (edwin imail)) + (export (edwin imail) + rfc822-addresses->string + rfc822-first-address + rfc822-strip-quoted-names + string->rfc822-addresses + string->rfc822-tokens)) + +(define-package (edwin imail imap-syntax) + (files "imap-syntax") + (parent (edwin imail)) + (export (edwin imail) + imap:char-set:achar + imap:char-set:atom-char + imap:char-set:list-wildcards + imap:char-set:quoted-specials + imap:match:achar+ + imap:match:astring + imap:match:atom + imap:match:bchar+ + imap:match:date + imap:match:literal + imap:match:number + imap:match:nz-number + imap:match:quoted-string + imap:match:search-key + imap:match:search-program + imap:match:section + imap:match:section-text + imap:match:set + imap:match:string + imap:parse:enc-mailbox + imap:parse:mailboxlist + imap:parse:messagelist + imap:parse:messagepart + imap:parse:server + imap:parse:simple-message + imap:parse:uidvalidity)) + (define-package (edwin imail) (files "imail-util" - "rfc822" "imail-core" "imail-file" "imail-rmail" -- 2.25.1