(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 --git a/lisp/ChangeLog b/lisp/ChangeLog
index dd1bc36f284aa7d1316a44b0b29128708da32f8e..d906c3d8efe200435cb8aae55547bc3502bcf075 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2005-02-22  Kenichi Handa  <handa@m17n.org>
+
+       * ps-mule.el (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.
+
+       * ps-print.el (ps-header-footer-string): Return a list of header
+       and footer strings.
+
 2005-02-21  Wolfgang Jenkner  <wjenkner@inode.at>  (tiny change)
 
        * pcvs.el (cvs-retrieve-revision): Fix thinko.

diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index ec7b3b22fcad83f850dc22a75c7c2568800f76ff..6f14538ff4d6e54a75076368e46b7c05125ebc3a 100644 (file)
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1390,20 +1390,60 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
          (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 @@ This checks if all multi-byte characters in the region are printable or not."
        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 @@ This checks if all multi-byte characters in the region are printable or not."
   ;; 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