From f83ef56141675398acb1cf58873eb74e100df430 Mon Sep 17 00:00:00 2001 From: sterni Date: Mon, 24 Jan 2022 11:56:27 +0100 Subject: refactor(3p/lisp/mime4cl): use trivial-gray-streams This should be a net positive for portability and lets us drop some of the CMUCL cruft (which we don't test anyway, CMU support may have regressed regardless). Change-Id: I85664d82d211177da1db9eebea65c956295b09f7 Reviewed-on: https://cl.tvl.fyi/c/depot/+/5067 Tested-by: BuildkiteCI Reviewed-by: sterni --- third_party/lisp/mime4cl/default.nix | 1 + third_party/lisp/mime4cl/mime4cl.asd | 8 ++---- third_party/lisp/mime4cl/package.lisp | 5 ++-- third_party/lisp/mime4cl/streams.lisp | 53 ++++++++--------------------------- 4 files changed, 16 insertions(+), 51 deletions(-) (limited to 'third_party/lisp') diff --git a/third_party/lisp/mime4cl/default.nix b/third_party/lisp/mime4cl/default.nix index 5165774074c1..a14d695c298e 100644 --- a/third_party/lisp/mime4cl/default.nix +++ b/third_party/lisp/mime4cl/default.nix @@ -8,6 +8,7 @@ depot.nix.buildLisp.library { deps = [ depot.third_party.lisp.sclf depot.third_party.lisp.npg + depot.third_party.lisp.trivial-gray-streams ]; srcs = [ diff --git a/third_party/lisp/mime4cl/mime4cl.asd b/third_party/lisp/mime4cl/mime4cl.asd index 2761a00d5283..6528f115d47a 100644 --- a/third_party/lisp/mime4cl/mime4cl.asd +++ b/third_party/lisp/mime4cl/mime4cl.asd @@ -1,6 +1,7 @@ ;;; mime4cl.asd --- system definition ;;; Copyright (C) 2005-2007, 2010 by Walter C. Pelissero +;;; Copyright (C) 2022 by The TVL Authors ;;; Author: Walter C. Pelissero ;;; Project: mime4cl @@ -20,11 +21,6 @@ (in-package :cl-user) -#+(and cmu (not gray-streams)) -(eval-when (:compile-toplevel :load-toplevel :execute) - (ext:without-package-locks - (load "library:subsystems/gray-streams-library"))) - (defpackage :mime4cl-system (:use :common-lisp :asdf)) @@ -40,7 +36,7 @@ "A collection of Common Lisp primitives to forge and handle MIME mail contents." :licence "LGPL" - :depends-on (:npg :sclf) + :depends-on (:npg :sclf :trivial-gray-streams) :components ((:file "package") (:file "mime" :depends-on ("package" "endec" "streams")) diff --git a/third_party/lisp/mime4cl/package.lisp b/third_party/lisp/mime4cl/package.lisp index fc5d9627f9e5..b1217a0b6818 100644 --- a/third_party/lisp/mime4cl/package.lisp +++ b/third_party/lisp/mime4cl/package.lisp @@ -1,6 +1,7 @@ ;;; package.lisp --- package declaration ;;; Copyright (C) 2005-2007, 2010 by Walter C. Pelissero +;;; Copyright (C) 2022 The TVL Authors ;;; Author: Walter C. Pelissero ;;; Project: mime4cl @@ -22,9 +23,7 @@ (defpackage :mime4cl (:nicknames :mime) - (:use :common-lisp :npg :sclf - ;; for Gray streams - #+cmu :extensions #+sbcl :sb-gray) + (:use :common-lisp :npg :sclf :trivial-gray-streams) ;; this is stuff that comes from SCLF and clashes with CMUCL's EXT ;; package (:shadowing-import-from :sclf diff --git a/third_party/lisp/mime4cl/streams.lisp b/third_party/lisp/mime4cl/streams.lisp index 087207ce5341..4fce60d5aac3 100644 --- a/third_party/lisp/mime4cl/streams.lisp +++ b/third_party/lisp/mime4cl/streams.lisp @@ -1,12 +1,12 @@ - ;;; eds.lisp --- En/De-coding Streams +;;; streams.lisp --- En/De-coding Streams - ;;; Copyright (C) 2012 by Walter C. Pelissero - ;;; Copyright (C) 2021 by the TVL Authors +;;; Copyright (C) 2012 by Walter C. Pelissero +;;; Copyright (C) 2021-2022 by the TVL Authors - ;;; Author: Walter C. Pelissero - ;;; Project: mime4cl +;;; Author: Walter C. Pelissero +;;; Project: mime4cl -#+cmu (ext:file-comment "$Module: eds.lisp") +#+cmu (ext:file-comment "$Module: streams.lisp") ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public License @@ -23,39 +23,6 @@ (in-package :mime4cl) -#+cmu -(eval-when (:load-toplevel :compile-toplevel :execute) - ;; CMUCL doesn't provide the STREAM-FILE-POSITION method in its - ;; implementation of Gray streams. We patch it in ourselves. - (defgeneric stream-file-position (stream &optional position)) - (defun my-file-position (stream &optional position) - (stream-file-position stream position)) - (defvar *original-file-position-function* - (prog1 - (symbol-function 'file-position) - (setf (symbol-function 'file-position) (symbol-function 'my-file-position)))) - (defmethod stream-file-position (stream &optional position) - (if position - (funcall *original-file-position-function* stream position) - (funcall *original-file-position-function* stream))) - - ;; oddly CMUCL doesn't seem to provide a default for STREAM-READ-SEQUENCE - (defmacro make-read-sequence (stream-type element-reader) - `(defmethod stream-read-sequence ((stream ,stream-type) seq &optional start end) - (unless start - (setf start 0)) - (unless end - (setf end (length seq))) - (loop - for i from start below end - for b = (,element-reader stream) - until (eq b :eof) - do (setf (elt seq i) b) - finally (return i)))) - - (make-read-sequence fundamental-binary-input-stream stream-read-byte) - (make-read-sequence fundamental-character-input-stream stream-read-char)) - (defclass coder-stream-mixin () ((real-stream :type stream :initarg :stream @@ -63,9 +30,11 @@ (dont-close :initform nil :initarg :dont-close))) -(defmethod stream-file-position ((stream coder-stream-mixin) &optional position) - (apply #'file-position (remove nil (list (slot-value stream 'real-stream) - position)))) +(defmethod stream-file-position ((stream coder-stream-mixin)) + (file-position (slot-value stream 'real-stream))) + +(defmethod (setf stream-file-position) (newval (stream coder-stream-mixin)) + (file-position (slot-value stream 'real-stream) newval)) (defclass coder-input-stream-mixin (fundamental-binary-input-stream coder-stream-mixin) ()) -- cgit 1.4.1