[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Fix for stylized mail



Doubtless most of you have had trouble with certain messages containing
odd character styles in the headers today.  Since the resulting Zmail
bug reports are all I have been able to work on this morning, I'm
sending out a patch for this problem so that I can get some other work
done.

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10; Patch-File: T -*-
;;; Patch file for Private version 0.0
;;; Reason: DEFINE-CHARACTER-STYLE-FAMILIES SI:*B&W-SCREEN*:  Add a
;;;  translation for FIX.CONDENSED.TINY and related.
;;; Function ZWEI:FOLD-MULTI-LINE-SUBJECT:  Fix for multi-line stylized
;;;  subject fields. 
;;; Written by Chucko, 2/22/89 09:07:47
;;; while running on Barnabas Collins from FEP0:>configured-7-2-with-ECO.load.1
;;; with Genera 7.2, System 376.158,
;;; Experimental Logical Pathnames Translation Files NEWEST, Utilities 27.29,
;;; Server Utilities 28.5, Hardcopy 118.17, Zmail 165.20, LMFS 102.7, Tape 82.18,
;;; Nsage 27.245, Extended Help 18.4, Documentation Database 62.1, IP-TCP 67.5,
;;; Experimental Ivory Architecture Doc 3.0, Obsolete Ivory Documentation 3.2,
;;; microcode 3645-FPA-MIC 420, FEP 127, fep0:>v127-lisp.flod(64),
;;; fep0:>v127-loaders.flod(64), fep0:>v127-tests.flod(64),
;;; fep0:>v127-debug.flod(34), fep0:>v127-info.flod(64), Machine serial number 10167,
;;; Default Dired spec to *.*.newest (from VTX:>Chucko>hacks>zmacs-hacks-7-2).


(SYSTEM-INTERNALS:FILES-PATCHED-IN-THIS-PATCH-FILE 
  "SYS:ZMAIL;WINDOW.LISP.1530"
  "SYS:SYS2;CHARACTER-STYLES.LISP.197")


(NOTE-PRIVATE-PATCH "Better handling for stylized mail")


;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:SYS2;CHARACTER-STYLES.LISP.197")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
  "-*- Package:SYSTEM-INTERNALS; Mode:LISP; Base: 10; Lowercase: Yes -*-")

(define-character-style-families *b&w-screen* *standard-character-set*
  '(:family :fix
	    (:size :normal (:face :roman fonts:cptfont
				  :italic fonts:cptfonti
				  :bold fonts:cptfontcb
				  :bold-italic fonts:cptfontbi
				  :bold-extended fonts:cptfontb
				  :condensed fonts:cptfontc
				  :extra-condensed fonts:cptfontcc)
		   :small (:face :roman fonts:tvfont
				 :italic fonts:tvfonti
				 :bold fonts:tvfontb
				 :bold-italic fonts:tvfontbi
				 ;; needed for presentation-inspector
				 :bold-extended fonts:tvfontb
				 :condensed fonts:tvfont
				 :extra-condensed fonts:tvfont
				 )
		   :very-small (:face :roman fonts:einy7
				      :italic fonts:einy7	;can't do much better, 
				      :bold fonts:einy7		;  when it gets this small.
				      :bold-italic fonts:einy7
				      :uppercase fonts:5x5)
		   :tiny (:face :roman fonts:tiny
				:italic fonts:tiny
				:bold fonts:tiny
				:bold-italic fonts:tiny
				;; Added entries below -- Chucko 21 Feb 89
				:bold-extended fonts:tiny
				:condensed fonts:tiny
				:extra-condensed fonts:tiny
				)
		   :large (:face :roman fonts:medfnt
				 :italic fonts:medfnti
				 :bold fonts:medfntb
				 :bold-italic fonts:medfntbi)
		   :very-large (:face :roman fonts:bigfnt
				      :italic fonts:bigfnti
				      :bold fonts:bigfntb
				      :bold-italic fonts:bigfntbi))))


;=====================================
(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION)
(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "SYS:ZMAIL;WINDOW.LISP.1530")
(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
  "-*- Base: 8; Mode: LISP; Package: ZWEI -*-")

(DEFUN FOLD-MULTI-LINE-SUBJECT (SUBJECT)
  (IF (OR (NOT *SUMMARY-SUBJECT-TRIM-SPACES*)
	  (NOT (STRING-SEARCH-CHAR #\RETURN SUBJECT)))
      SUBJECT
      (LET ((STRING (MAKE-ARRAY (STRING-LENGTH SUBJECT)
				:TYPE (array-type subject)	;was 'ART-STRING
				:FILL-POINTER 0)))
	(LOOP AS START = 0 THEN END
	      AS END = (STRING-SEARCH-CHAR #\RETURN SUBJECT START)
	      DO (APPEND-TO-ARRAY STRING SUBJECT START
				  (LET ((TEM (STRING-REVERSE-SEARCH-NOT-SET *BLANKS* SUBJECT
									    END START)))
				    (IF TEM (1+ TEM) START)))
	      UNTIL (NULL END)
	      WHILE (SETQ END (STRING-SEARCH-NOT-SET *BLANKS* SUBJECT (1+ END)))
	      DO (ARRAY-PUSH-EXTEND STRING #\SP))
	STRING)))