From 65e0e3154e02040921a2d0f69c6650d85c187757 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?=
 <dominik.pantucek@trustica.cz>
Date: Tue, 11 Apr 2023 14:17:37 +0200
Subject: [PATCH] Implement quoted-printable conversion.

---
 src/util-mail.scm   | 11 +++++++++--
 src/util-string.scm | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/src/util-mail.scm b/src/util-mail.scm
index 13be163..5eddd50 100644
--- a/src/util-mail.scm
+++ b/src/util-mail.scm
@@ -35,6 +35,7 @@
  (import scheme
 	 (chicken base)
 	 (chicken keyword)
+	 (chicken string)
 	 util-io
 	 util-string)
 
@@ -43,8 +44,14 @@
 
  ;; Encodes given UTF-8 string as quoted-printable
  (define (string->qp str)
-   (let ((lst (string->list/utf8 str)))
-     str))
+   (let loop ((lst (string->list/utf8 str))
+	      (res '()))
+     (if (null? lst)
+	 (string-intersperse (reverse res) "")
+	 (loop (cdr lst)
+	       (cons (let ((chs (car lst)))
+		       chs)
+		     res)))))
 
  ;; Ensures the subject has proper encoding
  (define (encode-subject subj)
diff --git a/src/util-string.scm b/src/util-string.scm
index 1d0788c..04d0cf6 100644
--- a/src/util-string.scm
+++ b/src/util-string.scm
@@ -33,6 +33,7 @@
   string-utf8?
   string-tests!
   string->list/utf8
+  string->qp
   )
 
  (import scheme
@@ -71,6 +72,32 @@
  (define (string->list/utf8 str)
    (irregex-extract (irregex "." 'u) str))
 	 
+ ;; Encodes given UTF-8 string as quoted-printable
+ (define (string->qp str)
+   (let loop ((lst (string->list/utf8 str))
+	      (res '()))
+     (if (null? lst)
+	 (string-intersperse (reverse res) "")
+	 (loop (cdr lst)
+	       (cons (let* ((chs (car lst))
+			    (ch1 (if (= (string-length chs) 1)
+				     (string-ref chs 0)
+				     (integer->char 31))))
+		       (if (and (char>=? ch1 #\space)
+				(char<=? ch1 #\~))
+			   chs
+			   (string-intersperse
+			    (map (lambda (ch)
+				   (string-append "="
+						  (substring
+						   (number->string
+						    (+ 256 (char->integer ch))
+						    16)
+						   1)))
+				 (string->list chs))
+			    "")))
+		     res)))))
+
  ;; Performs utils module self-tests.
  (define (string-tests!)
    (run-tests
@@ -92,6 +119,12 @@
 		 '("asdf" . ""))
     (test-true string-utf8? (string-utf8? "ěščř"))
     (test-false string-utf8? (string-utf8? "Hello World!"))
+    (test-equal? string->qp
+		 (string->qp "asdf")
+		 "asdf")
+    (test-equal? string->qp
+		 (string->qp "asdfásdf")
+		 "asdf=c3=a1sdf")
     ))
 
  )