;;=============================================================================
;;AUTOLOAD: print-margin
;;=============================================================================
;;AUTODOC: print-margin "print-format but with lines truncated"
;;used exactly in the same way as print-format, but the output is truncated to
;;a max limit of print-margin:width, which defaults to 79
;;If print-margin:width is set to (), no truncating is done

(defvar print-margin:width 79)

(defun print-margin (&rest args &aux
    (out (getn args 0))
    result s
    line
    need-to-newline
  )
  (if print-margin:width (progn
      (if args (progn
	  (if
	    (= (type-of out) String) (progn
	      (insert args 0 String)
	      (setq out *standard-output*)
	    )

	    (progn (put args 0 String) out)
	    (if (or (= out String) (= out 'String)) (setq out ()))

	    (setq out *standard-output*)
      )))
      (if out (progn
	  (setq result (open (setq s (apply print-format args)) :type :string))
	  (while (setq line (read-line result ()))
	    (if need-to-newline (write-line "" out) (setq need-to-newline t))
	    (write-string (if (> (length line) print-margin:width)
		(subseq line 0 print-margin:width)
		line
	      )
	      out
	  ))
	  (if (= #\newline (get s -1 0)) (write-line "" out))
	)
    ;; String
	(progn
	  (if (> (length (setq line (apply print-format args)))
	      print-margin:width)
	    (subseq line 0 print-margin:width)
	    line
      )))
  ))
  (apply print-format args)		; no margin, raw call
)
  
;;=============================================================================
;;AUTOLOAD: print-margin-line
;;=============================================================================
;;AUTODOC: print-margin-line "print-format but only first line and truncated"
;;used exactly in the same way as print-format, but the output is limited to 
;;the first line, truncated to
;;a max limit of print-margin:width, which defaults to 79
;;If print-margin:width is set to (), no truncating is done

(defun print-margin-line (&rest args &aux
    (out (getn args 0))
    result s
    line
    need-to-newline
  )
  (if args 
    (progn
      (if
	(= (type-of out) String) (progn
	  (insert args 0 String)
	  (setq out *standard-output*)
	)
	(progn (put args 0 String) out)
	(if (or (= out String) (= out 'String)) (setq out ()))

	(setq out *standard-output*)
      )
      (setq result (open (setq s (apply print-format args)) :type :string))
      (while (= "" (setq line (read-line result " "))))
      (write-line (if (> (length line) print-margin:width)
	  (subseq line 0 print-margin:width)
	  line
	)
	out
))))
  
;;=============================================================================
;;AUTOLOAD: print-margin-item
;;=============================================================================
;;AUTODOC: print-margin-item "print items with word-wrapping"
;;usage:
;;(print-margin-item args...)
;;args can be:
;;    :begin    - starts a new "paragraph" (set of items)
;;    :end      - ends a "paragraph"
;;    :break    - forces a line break
;;    string    - the string is taken as an unbreakable word, and is outputted
;;
;;Not alls strings of a paragraph need to be in the same call, you can write:
;;    (print-margin-item :begin)
;;    (dolist (item item-list) (print-margin-item item))
;;    (print-margin-item :end)
;;The behavior can be customized by the global variables:
;;    print-margin:width (defaults to 79) sets the right margin
;;    print-margin-item:prompts a list of the different separators (strings)
;;        0: prefix printed at the start of the paragraph
;;        1: prefix printed at the start of continuation lines
;;        2: postfix printed at the end of the paragraph
;;        3: wrapped lines continuation sign added before adding a newline
;;        4: item separator
;;        5: sign added to end of line to indicate item was cut
;;        6: prefix for continuation lines if preceding item was cut
;;        defaults to: ("(" " " ")" "" " " "\\" "   ")    (for printing lists)
;;        Output is: P0xxxP4xxxP4xxxP3
;;                   P3xxxP4xxxP4yyyP5
;;                   P6yyyyyP2
;;    print-margin-item:nowrap  If set, when an item is too large to fit alone
;;        on a line, it is not cut nor wrapped but printed past the right margin
;;        defaults to ()
;;    print-margin-item:truncate  If set, when an item is too large to fit alone
;;        on a line, it is cut to fit in margin and the rest is discarded
;;        defaults to ()
;;
;;If print-margin-item:nowrap and print-margin-item:truncate are both nil, 
;;when an item is too large to fit alone on a line, it is cut to fit in the 
;;margin, prompt 5 is added to the end of line, and the rest is printed on the 
;;following lines prefixed by prompt 6.
;;
;;Returns the current position on line
;;SEE ALSO: print-margin-words


(setq print-margin-item:prompts-defaults '("(" " " ")" "" " " "\\" "   "))
(defvar print-margin-item:prompts ())
(setq print-margin-item:curpos 0)
(defun print-margin-item:prompt (n)
  (get print-margin-item:prompts n '(get print-margin-item:prompts-defaults
      n "")))

(defvar print-margin-item:nowrap ())
(defvar print-margin-item:truncate ())
(defvar print-margin-item:state :begin)

(defun print-margin-item (&rest args &aux
    (width (if print-margin:width print-margin:width *maxint*))
    (pmip print-margin-item:prompt)
    (goto {lambda (state) (setq print-margin-item:state state)})
    arg 
    (i 0)
  )
  (while (< i (length args))		;so that args can be dynamically modified
    (setq arg (getn args i))
    (if 
      (or (eq :begin print-margin-item:state)	;### :start state
	(eq :break print-margin-item:state)	; or :break state
      )
      (if
	(= :begin arg) ()		; :begin => nothing
	(= :end arg) (progn		; :end => close prompt, and => :start
	  (print-format "%n0\n" (pmip 2))
	  (setq print-margin-item:curpos 0)
	  (goto :begin)
	)
	(= :break arg) ()		; :break => nothing
	;; printable argument
	(with (string (print-format String "%n0%n1" 
	      (if (eq :begin print-margin-item:state) (pmip 0) (pmip 1))
	      arg))
	  (if (<= (length string) width) ;fits in line?
	    (progn
	      (write string)
	      (setq print-margin-item:curpos (length string))
	      (goto :middle)
	    )
	    ;; does not fit, cut but discard rest
	    print-margin-item:truncate (progn
	      (setq string (subseq string 0 width))
	      (write string)
	      (setq print-margin-item:curpos (length string))
	      (goto :middle)
	    )
	    ;; jagged: does not fit, dont cut, let go past margin
	    print-margin-item:nowrap (progn
	      (write string)
	      (setq print-margin-item:curpos (length string))
	      (goto :middle)
	    )
	    ;; does not fit, cut & wrap
	    (with (pieces (list (subseq string 0 (- width (length (pmip 5))))))
	      (setq string (+ (pmip 6)
		  (subseq string (- width (length (pmip 5)))))
	      )
	      (while (> (length string) width)
		(lappend pieces (subseq string 0 (- width (length (pmip 5)))))
		(setq string (+ (pmip 6)
		    (subseq string (- width (length (pmip 5)))))
		)
	      )
	      (dolist (piece pieces)
		(print-format "%0%1\n" piece (pmip 5))
	      )
	      (print-format "%0" string)
	      (setq print-margin-item:curpos (length string))
	      (goto :middle)
	    )
      )))
      
      (eq :middle print-margin-item:state)	;### in the middle of a line
      (if 
	(or (= :begin arg) (= :end arg)) (progn	; :begin means :end too
	  (print-format "%n0\n" (pmip 2))
	  (setq print-margin-item:curpos 0)
	  (goto :begin)
	)
	(= :break arg) (progn
	  (print-format "\n")
	  (setq print-margin-item:curpos 0)
	  (goto :break)
	)
	;; printable argument
	(with (string (+ (pmip 4) arg))
	  (if (<= (+ print-margin-item:curpos (length string)) width) ;fits?
	    (progn
	      (write string)
	      (incf print-margin-item:curpos (length string))
	      (goto :middle)
	    )
	    ;; does not fit, break.
	    (progn
	      (incf i -1)		;will re-process this argument
	      (print-format "\n")	;break
	      (setq print-margin-item:curpos 0)
	      (goto :break)
    )))))
    (incf i)
  )
  print-margin-item:curpos
)

;;=============================================================================
;;AUTOLOAD: print-margin-words
;;=============================================================================
;;AUTODOC: print-margin-words "print words with word-wrapping"
;;(print-margin-words string &optional prompts)
;;
;;Prints, word-wrapping at print-margin:width the string by cutting at blank
;;spaces (blank, tab or newline)
;;Optionally a second argument specify how to format the results:
;;    prompts must be a list of the different separators (strings)
;;        0: prefix printed at the start of the paragraph
;;        1: prefix printed at the start of continuation lines
;;        2: postfix printed at the end of the paragraph
;;        3: wrapped lines continuation sign added before adding a newline
;;        4: item separator
;;        5: sign added to end of line to indicate item was cut
;;        6: prefix for continuation lines if preceding item was cut
;;        defaults to: ("" "" "" "" " " "-" "    ")
;;        Output is: P0xxxP4xxxP4xxxP3
;;                   P3xxxP4xxxP4yyyP5
;;                   P6yyyyyP2
;;The behavior is set by the global variables:
;;    print-margin:width (defaults to 79) sets the right margin
;;    print-margin-words:prompts The list of prompts to be used if not passed
;;        as an optional parameter.
;;    print-margin-item:nowrap  If set, when an item is too large to fit alone
;;        on a line, it is not cut nor wrapped but printed past the right margin
;;        defaults to ()
;;    print-margin-item:truncate  If set, when an item is too large to fit alone
;;        on a line, it is cut to fit in margin and the rest is discarded
;;        defaults to ()
;;If print-margin-item:nowrap and print-margin-item:truncate are both nil, 
;;when an item is too large to fit alone on a line, it is cut to fit in the 
;;margin, prompt 5 is added to the end of line, and the rest is printed on the 
;;following lines prefixed by prompt 6.
;;
;;Returns nil.
;;SEE ALSO: print-margin-item

(defvar print-margin-word:re (regcomp "^([^ \t\n]+)([ \t\n]*)"))
(defvar print-margin-word:re-blank (regcomp "^[ \t\n]+"))
(defvar print-margin-words:prompts '("" "" "" "" " " "-" "    "))

(defun print-margin-words (buffer
    &optional (print-margin-item:prompts print-margin-words:prompts)
    &aux
    (offset 0)
  )
  (if (regexec  print-margin-word:re-blank buffer) ;skip starting blanks
    (setq offset (get (get print-margin-word:re-blank 0) 1))
  )
  (print-margin-item :begin)
  (while (regexec  print-margin-word:re buffer offset)
    (print-margin-item (regsub print-margin-word:re 1))
    (setq offset (get (get print-margin-word:re 2) 1))
  )
  (print-margin-item :end)
  ()
)
