Mercurial > emacs

changeset 60201:0d38d6148c13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Kenichi Handa <handa@m17n.org>
date Tue, 22 Feb 2005 06:20:41 +0000
parents 9afc1e30ea84
children 6cd07da67508
files lisp/ps-mule.el
diffstat 1 files changed, 100 insertions(+), 62 deletions(-) [+]
line wrap: on
line diff
--- 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