# HG changeset patch # User Kenichi Handa # Date 1109053241 0 # Node ID 0d38d6148c13fc862456bbc282ec7422d32ab7f7 # Parent 9afc1e30ea84d5f06c7918eb97a377a76fd91921 (ps-mule-header-string-charsets): Delete it. (ps-mule-show-warning): New function. (ps-mule-begin-job): Use ps-mule-show-warning if unprintable characters are found. diff -r 9afc1e30ea84 -r 0d38d6148c13 lisp/ps-mule.el --- a/lisp/ps-mule.el Tue Feb 22 06:18:38 2005 +0000 +++ b/lisp/ps-mule.el Tue Feb 22 06:20:41 2005 +0000 @@ -1390,20 +1390,60 @@ (setq string (ps-mule-string-encoding font-spec string nil t)))))) string) -;;;###autoload -(defun ps-mule-header-string-charsets () - "Return a list of character sets that appears in header strings." - (let* ((str (ps-header-footer-string)) - (len (length str)) - (i 0) - charset-list) - (while (< i len) - (let ((charset (char-charset (aref str i)))) - (setq i (1+ i)) - (or (eq charset 'ascii) - (memq charset charset-list) - (setq charset-list (cons charset charset-list))))) - charset-list)) +(defun ps-mule-show-warning (charsets from to header-footer-list) + (let ((table (make-category-table)) + (buf (current-buffer)) + char-pos-list) + (define-category ?u "Unprintable charset" table) + (dolist (cs charsets) + (modify-category-entry (make-char cs) ?u table)) + (with-category-table table + (save-excursion + (goto-char from) + (while (and (< (length char-pos-list) 20) + (re-search-forward "\\cu" to t)) + (push (cons (preceding-char) (1- (point))) char-pos-list)) + (setq char-pos-list (nreverse char-pos-list)))) + (with-output-to-temp-buffer "*Warning*" + (with-current-buffer standard-output + (when char-pos-list + (let ((func #'(lambda (buf pos) + (when (buffer-live-p buf) + (pop-to-buffer buf) + (goto-char pos))))) + (insert "These characters in the buffer can't be printed:\n") + (dolist (elt char-pos-list) + (insert " ") + (insert-text-button (string (car elt)) + :type 'help-xref + 'help-echo + "mouse-2, RET: jump to this character" + 'help-function func + 'help-args (list buf (cdr elt))) + (insert ",")) + ;; Delete the last comma. + (delete-char -1) + (insert "\nClick them to jump to the buffer position,\n" + (substitute-command-keys "\ +or \\[universal-argument] \\[what-cursor-position] will give information about them.\n")))) + + (with-category-table table + (let (string-list idx) + (dolist (elt header-footer-list) + (when (stringp elt) + (when (string-match "\\cu+" elt) + (setq elt (copy-sequence elt)) + (put-text-property (match-beginning 0) (match-end 0) + 'face 'highlight elt) + (while (string-match "\\cu+" elt (match-end 0)) + (put-text-property (match-beginning 0) (match-end 0) + 'face 'highlight elt)) + (push elt string-list)))) + (when string-list + (insert + "These highlighted characters in header/footer can't be printed:\n") + (dolist (elt string-list) + (insert " " elt "\n"))))))))) ;;;###autoload (defun ps-mule-begin-job (from to) @@ -1424,58 +1464,55 @@ enable-multibyte-characters ;; Initialize `ps-mule-charset-list'. If some characters aren't ;; printable, warn it. - (let ((charsets (find-charset-region from to))) - (setq charsets (delq 'ascii (delq 'unknown (delq nil charsets))) - ps-mule-charset-list charsets) - (save-excursion - (goto-char from) - (and (search-forward "\200" to t) - (setq ps-mule-charset-list - (cons 'composition ps-mule-charset-list)))) - ;; We also have to check non-ASCII charsets in the header strings. - (let ((tail (ps-mule-header-string-charsets))) - (while tail - (unless (eq (car tail) 'ascii) - (setq ps-mule-header-charsets - (cons (car tail) ps-mule-header-charsets)) - (or (memq (car tail) charsets) - (setq charsets (cons (car tail) charsets)))) - (setq tail (cdr tail)))) - (while charsets - (setq charsets - (cond - ((or (eq (car charsets) 'composition) - (ps-mule-printable-p (car charsets))) - (cdr charsets)) - ((y-or-n-p - "Font for some characters not found, continue anyway? ") - nil) - (t - (error "Printing cancelled"))))))) + (let ((header-footer-list (ps-header-footer-string)) + unprintable-charsets) + (setq ps-mule-charset-list + (delq 'ascii (delq 'eight-bit-control + (delq 'eight-bit-graphic + (find-charset-region from to)))) + ps-mule-header-charsets + (delq 'ascii (delq 'eight-bit-control + (delq 'eight-bit-graphic + (find-charset-string + (mapconcat + 'identity header-footer-list "")))))) + (dolist (cs ps-mule-charset-list) + (or (ps-mule-printable-p cs) + (push cs unprintable-charsets))) + (dolist (cs ps-mule-header-charsets) + (or (ps-mule-printable-p cs) + (memq cs unprintable-charsets) + (push cs unprintable-charsets))) + (when unprintable-charsets + (ps-mule-show-warning unprintable-charsets from to + header-footer-list) + (or + (y-or-n-p "Font for some characters not found, continue anyway? ") + (error "Printing cancelled"))) + + (or ps-mule-composition-prologue-generated + (let ((use-composition (nth 2 (find-composition from to)))) + (or use-composition + (let (str) + (while header-footer-list + (setq str (car header-footer-list)) + (if (and (stringp str) + (nth 2 (find-composition 0 (length str) str))) + (setq use-composition t + header-footer-list nil) + (setq header-footer-list (cdr header-footer-list)))))) + (when use-composition + (progn + (ps-mule-prologue-generated) + (ps-output-prologue ps-mule-composition-prologue) + (setq ps-mule-composition-prologue-generated t))))))) (setq ps-mule-current-charset 'ascii) - (if (and (nth 2 (find-composition from to)) - (not ps-mule-composition-prologue-generated)) - (progn - (ps-mule-prologue-generated) - (ps-output-prologue ps-mule-composition-prologue) - (setq ps-mule-composition-prologue-generated t))) - (if (or ps-mule-charset-list ps-mule-header-charsets) - (let ((the-list (append ps-mule-header-charsets ps-mule-charset-list)) - font-spec elt) + (dolist (elt (append ps-mule-header-charsets ps-mule-charset-list)) (ps-mule-prologue-generated) - ;; If external functions are necessary, generate prologues for them. - (while the-list - (setq elt (car the-list) - the-list (cdr the-list)) - (cond ((and (eq elt 'composition) - (not ps-mule-composition-prologue-generated)) - (ps-output-prologue ps-mule-composition-prologue) - (setq ps-mule-composition-prologue-generated t)) - ((setq font-spec (ps-mule-get-font-spec elt 'normal)) - (ps-mule-init-external-library font-spec)))))) + (ps-mule-init-external-library (ps-mule-get-font-spec elt 'normal)))) ;; If ASCII font is also specified in ps-mule-font-info-database, ;; use it instead of what specified in ps-font-info-database. @@ -1496,7 +1533,8 @@ ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font ;; and glyphs for the first occurrence of such characters. (if (and ps-mule-header-charsets - (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1))) + (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1)) + (= (charset-dimension (car ps-mule-header-charsets)) 1)) (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets) 'normal))) (if font-spec