X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/51bb954e7ad81cc91cdac77e82a3e73f264ec769..1b74c4346e92c9ac1ae0575c2ad69f8d81126d7e:/lisp/ps-mule.el

diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index e0e9268c3d..748cfd560b 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,7 +1,7 @@
 ;;; ps-mule.el --- provide multi-byte character facility to ps-print
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;;	Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
@@ -24,8 +24,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -1039,9 +1039,12 @@ the sequence."
 	    /BOTTOM LLY def
 	    currentfont /RelativeCompose known {
 		/relative currentfont /RelativeCompose get def
+		relative false eq {
+		    %% Disable relative composition by setting sufficiently low
+		    %% and high positions.
+		    /relative [ -100000 100000 ] def
+		} if
 	    } {
-		%% Disable relative composition by setting sufficiently low
-		%% and high positions.
 		/relative [ -100000 100000 ] def
 	    } ifelse
 	    [ elt 0 0 ]
@@ -1236,7 +1239,7 @@ NewBitmapDict
 	} ifelse
 	/FirstCode -1 store
 
-	bmp 0 get SpaceWidthRatio ratio div mul size div 0	% wx wy
+	bmp 0 get size div 0		% wx wy
 	setcharwidth			% We can't use setcachedevice here.
 
 	bmp 1 get 0 gt bmp 2 get 0 gt and {
@@ -1402,6 +1405,7 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
 (defun ps-mule-show-warning (charsets from to header-footer-list)
   (let ((table (make-category-table))
 	(buf (current-buffer))
+	(max-unprintable-chars 15)
 	char-pos-list)
     (define-category ?u "Unprintable charset" table)
     (dolist (cs charsets)
@@ -1409,19 +1413,22 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
     (with-category-table table
       (save-excursion
 	(goto-char from)
-	(while (and (< (length char-pos-list) 20)
+	(while (and (<= (length char-pos-list) max-unprintable-chars)
 		    (re-search-forward "\\cu" to t))
-	  (push (cons (preceding-char) (1- (point))) char-pos-list))
-	(setq char-pos-list (nreverse char-pos-list))))
+	  (push (cons (preceding-char) (1- (point))) 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)))))
+			    (goto-char pos))))
+		(more nil))
+	    (if (>= (length char-pos-list) max-unprintable-chars)
+		(setq char-pos-list (cdr char-pos-list)
+		      more t))
 	    (insert "These characters in the buffer can't be printed:\n")
-	    (dolist (elt char-pos-list)
+	    (dolist (elt (nreverse char-pos-list))
 	      (insert " ")
 	      (insert-text-button (string (car elt))
 				  :type 'help-xref
@@ -1430,8 +1437,10 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
 				  'help-function func
 				  'help-args (list buf (cdr elt)))
 	      (insert ","))
-	    ;; Delete the last comma.
-	    (delete-char -1)
+	    (if more
+		(insert " and more...")
+	      ;; 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"))))