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 <sternenseemann@systemli.org>
This commit is contained in:
sterni 2022-01-24 11:56:27 +01:00
parent 25cb0ad32f
commit f83ef56141
4 changed files with 16 additions and 51 deletions

View file

@ -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 = [

View file

@ -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 <walter@pelissero.de>
;;; 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"))

View file

@ -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 <walter@pelissero.de>
;;; 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

View file

@ -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 <walter@pelissero.de>
;;; Project: mime4cl
;;; Author: Walter C. Pelissero <walter@pelissero.de>
;;; 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)
())