+(defun ps-line-lengths-internal ()
+ "Display the correspondance between a line length and a font size,
+using the current ps-print setup.
+Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
+ (let ((buf (get-buffer-create "*Line-lengths*"))
+ (ifs ps-font-size) ; initial font size
+ (icw ps-avg-char-width) ; initial character width
+ (print-width (progn (ps-get-page-dimensions)
+ ps-print-width))
+ (ps-setup (ps-setup)) ; setup for the current buffer
+ (fs-min 5) ; minimum font size
+ cw-min ; minimum character width
+ nb-cpl-max ; maximum nb of characters per line
+ (fs-max 14) ; maximum font size
+ cw-max ; maximum character width
+ nb-cpl-min ; minimum nb of characters per line
+ fs ; current font size
+ cw ; current character width
+ nb-cpl ; current nb of characters per line
+ )
+ (setq cw-min (/ (* icw fs-min) ifs)
+ nb-cpl-max (floor (/ print-width cw-min))
+ cw-max (/ (* icw fs-max) ifs)
+ nb-cpl-min (floor (/ print-width cw-max)))
+ (setq nb-cpl nb-cpl-min)
+ (set-buffer buf)
+ (goto-char (point-max))
+ (if (not (bolp)) (insert "\n"))
+ (insert ps-setup)
+ (insert "nb char per line / font size\n")
+ (while (<= nb-cpl nb-cpl-max)
+ (setq cw (/ print-width (float nb-cpl))
+ fs (/ (* ifs cw) icw))
+ (insert (format "%3s %s\n" nb-cpl fs))
+ (setq nb-cpl (1+ nb-cpl)))
+ (insert "\n")
+ (display-buffer buf 'not-this-window)))
+
+(defun ps-nb-pages (nb-lines)
+ "Display an approximate correspondance between a font size and the number
+of pages the number of lines would require to print
+using the current ps-print setup."
+ (let ((buf (get-buffer-create "*Nb-Pages*"))
+ (ifs ps-font-size) ; initial font size
+ (ilh ps-line-height) ; initial line height
+ (page-height (progn (ps-get-page-dimensions)
+ ps-print-height))
+ (ps-setup (ps-setup)) ; setup for the current buffer
+ (fs-min 4) ; minimum font size
+ lh-min ; minimum line height
+ nb-lpp-max ; maximum nb of lines per page
+ nb-page-min ; minimum nb of pages
+ (fs-max 14) ; maximum font size
+ lh-max ; maximum line height
+ nb-lpp-min ; minimum nb of lines per page
+ nb-page-max ; maximum nb of pages
+ fs ; current font size
+ lh ; current line height
+ nb-lpp ; current nb of lines per page
+ nb-page ; current nb of pages
+ )
+ (setq lh-min (/ (* ilh fs-min) ifs)
+ nb-lpp-max (floor (/ page-height lh-min))
+ nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
+ lh-max (/ (* ilh fs-max) ifs)
+ nb-lpp-min (floor (/ page-height lh-max))
+ nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)))
+ (setq nb-page nb-page-min)
+ (set-buffer buf)
+ (goto-char (point-max))
+ (if (not (bolp)) (insert "\n"))
+ (insert ps-setup)
+ (insert (format "%d lines\n" nb-lines))
+ (insert "nb page / font size\n")
+ (while (<= nb-page nb-page-max)
+ (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
+ lh (/ page-height nb-lpp)
+ fs (/ (* ifs lh) ilh))
+ (insert (format "%s %s\n" nb-page fs))
+ (setq nb-page (1+ nb-page)))
+ (insert "\n")
+ (display-buffer buf 'not-this-window)))
+
+(defun ps-select-font ()
+ "Choose the font name and size (scaling data)."
+ (let ((assoc (assq ps-font-family ps-font-info-database))
+ l fn fb fi bi sz lh sw aw)
+ (if (null assoc)
+ (error "Don't have data to scale font %s. Known fonts families are %s"
+ ps-font-family
+ (mapcar 'car ps-font-info-database)))
+ (setq l (cdr assoc)
+ fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
+ fb (prog1 (car l) (setq l (cdr l)))
+ fi (prog1 (car l) (setq l (cdr l)))
+ bi (prog1 (car l) (setq l (cdr l)))
+ sz (prog1 (car l) (setq l (cdr l)))
+ lh (prog1 (car l) (setq l (cdr l)))
+ sw (prog1 (car l) (setq l (cdr l)))
+ aw (prog1 (car l) (setq l (cdr l))))
+
+ (setq ps-font fn)
+ (setq ps-font-bold fb)
+ (setq ps-font-italic fi)
+ (setq ps-font-bold-italic bi)
+ ;; These data just need to be rescaled:
+ (setq ps-line-height (/ (* lh ps-font-size) sz))
+ (setq ps-space-width (/ (* sw ps-font-size) sz))
+ (setq ps-avg-char-width (/ (* aw ps-font-size) sz))
+ ps-font-family))
+
+(defun ps-select-header-font ()
+ "Choose the font name and size (scaling data) for the header."
+ (let ((assoc (assq ps-header-font-family ps-font-info-database))
+ l fn fb fi bi sz lh sw aw)
+ (if (null assoc)
+ (error "Don't have data to scale font %s. Known fonts families are %s"
+ ps-font-family
+ (mapcar 'car ps-font-info-database)))
+ (setq l (cdr assoc)
+ fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
+ fb (prog1 (car l) (setq l (cdr l)))
+ fi (prog1 (car l) (setq l (cdr l)))
+ bi (prog1 (car l) (setq l (cdr l)))
+ sz (prog1 (car l) (setq l (cdr l)))
+ lh (prog1 (car l) (setq l (cdr l)))
+ sw (prog1 (car l) (setq l (cdr l)))
+ aw (prog1 (car l) (setq l (cdr l))))
+
+ ;; Font name
+ (setq ps-header-font fn)
+ (setq ps-header-title-font fb)
+ ;; Line height: These data just need to be rescaled:
+ (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz))
+ (setq ps-header-line-height (/ (* lh ps-header-font-size) sz))
+ ps-header-font-family))
+