;;;
;;; $Id$
;;;

(require 'tl-num)

;;; @ Quoted-Printable (Q-encode) encoder/decoder
;;;

(defun quoted-printable-quote-char (chr)
  (concat "="
	  (char-to-string (number-to-hex-char (ash chr -4)))
	  (char-to-string (number-to-hex-char (logand chr 15)))
	  ))

(defun quoted-printable-encode-string-for-body (str)
  (mapconcat (function
	      (lambda (chr)
		(cond ((or (< chr 32) (< 126 chr) (eq chr ?=))
		       (quoted-printable-quote-char chr)
		       )
		      (t (char-to-string chr))
		      )))
	     str ""))

(defun quoted-printable-encode-string-for-text (str)
  (mapconcat (function
	      (lambda (chr)
		(cond ((eq chr 32) "_")
		      ((or (< chr 32) (< 126 chr) (eq chr ?=))
		       (quoted-printable-quote-char chr)
		       )
		      (t (char-to-string chr))
		      )))
	     str ""))

(defun quoted-printable-encode-string-for-comment (str)
  (mapconcat (function
	      (lambda (chr)
		(cond ((eq chr 32) "_")
		      ((or (< chr 32) (< 126 chr)
			   (memq chr '(?= ?\( ?\) ?\\))
			   )
		       (quoted-printable-quote-char chr)
		       )
		      (t (char-to-string chr))
		      )))
	     str ""))

(defun quoted-printable-encode-string-for-phrase (str)
  (mapconcat (function
	      (lambda (chr)
		(cond ((or (and (<= ?A chr)(<= chr ?Z))
			   (and (<= ?a chr)(<= chr ?z))
			   (and (<= ?0 chr)(<= chr ?9))
			   (memq chr '(?! ?* ?+ ?- ?/))
			   )
		       (char-to-string chr)
		       )
		      (t (quoted-printable-quote-char chr))
		      )))
	     str ""))

(defun quoted-printable-encode-string (str &optional mode)
  (cond ((eq mode 'text)
	 (quoted-printable-encode-string-for-text str)
	 )
	((eq mode 'comment)
	 (quoted-printable-encode-string-for-comment str)
	 )
	((eq mode 'phrase)
	 (quoted-printable-encode-string-for-phrase str)
	 )
	(t (quoted-printable-encode-string-for-body str))
	))

(defun quoted-printable-decode-string-for-body (str)
  (let (q h l)
    (mapconcat (function
		(lambda (chr)
		  (cond ((eq chr ?=)
			 (setq q t)
			 "")
			(q (setq h (hex-char-to-number chr))
			   (setq q nil)
			   "")
			(h (setq l (hex-char-to-number chr))
			   (prog1
			       (char-to-string (logior (ash h 4) l))
			     (setq h nil)
			     )
			   )
			(t (char-to-string chr))
			)))
	       str "")))

(defun quoted-printable-decode-string-for-header (str)
  (let (q h l)
    (mapconcat (function
		(lambda (chr)
		  (cond ((eq chr ?_) " ")
			((eq chr ?=)
			 (setq q t)
			 "")
			(q (setq h (hex-char-to-number chr))
			   (setq q nil)
			   "")
			(h (setq l (hex-char-to-number chr))
			   (prog1
			       (char-to-string (logior (ash h 4) l))
			     (setq h nil)
			     )
			   )
			(t (char-to-string chr))
			)))
	       str "")))

(defun quoted-printable-decode-string (str &optional mode)
  (if (eq mode 'header)
      (quoted-printable-decode-string-for-header str)
    (quoted-printable-decode-string-for-body str)
    ))


;;; @ etc
;;;

(defun quoted-printable-encoded-length (string &optional mode)
  (let ((l 0)(i 0)(len (length string)) chr)
    (while (< i len)
      (setq chr (elt string i))
      (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
	  (setq l (+ l 1))
	(setq l (+ l 3))
	)
      (setq i (+ i 1)) )
    l))

(provide 'qprint)