+(defvar ps-mule-header-charsets nil)
+
+;;;###autoload
+(defun ps-mule-encode-header-string (string fonttag)
+ "Generate PostScript code for ploting STRING by font FONTTAG.
+FONTTAG should be a string \"/h0\" or \"/h1\"."
+ (setq string (cond ((not (stringp string))
+ "")
+ ((multibyte-string-p string)
+ (copy-sequence string))
+ (t
+ (string-make-multibyte string))))
+ (when ps-mule-header-charsets
+ (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1)
+ ;; Latin1 characters can be printed by the standard PostScript
+ ;; font. Converts the other non-ASCII characters to `?'.
+ (let ((len (length string))
+ (i 0))
+ (while (< i len)
+ (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1))
+ (aset string i ??))
+ (setq i (1+ i)))
+ (setq string (encode-coding-string string 'iso-latin-1)))
+ ;; We must prepare a font for the first non-ASCII and non-Latin1
+ ;; character in STRING.
+ (let* ((ps-current-font (if (string= fonttag "/h0") 0 1))
+ (ps-mule-current-charset (car ps-mule-header-charsets))
+ (font-type (car (nth ps-current-font
+ (ps-font-alist 'ps-font-for-header))))
+ (font-spec (ps-mule-get-font-spec ps-mule-current-charset
+ font-type)))
+ (if (or (not font-spec)
+ (/= (charset-dimension ps-mule-current-charset) 1))
+ ;; We don't have a proper font, or we can't print them on
+ ;; header because this kind of charset is not ASCII
+ ;; compatible.
+ (let ((len (length string))
+ (i 0))
+ (while (< i len)
+ (or (memq (char-charset (aref string i))
+ '(ascii latin-iso8859-1))
+ (aset string i ??))
+ (setq i (1+ i)))
+ (setq string (encode-coding-string string 'iso-latin-1)))
+ (let ((charsets (list 'ascii (car ps-mule-header-charsets)))
+ (len (length string))
+ (i 0))
+ (while (< i len)
+ (or (memq (char-charset (aref string i)) charsets)
+ (aset string i ??))
+ (setq i (1+ i))))
+ (setq string (ps-mule-string-encoding font-spec string nil t))))))
+ string)
+
+(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)
+ (modify-category-entry (make-char cs) ?u table))
+ (with-category-table table
+ (save-excursion
+ (goto-char from)
+ (while (and (<= (length char-pos-list) max-unprintable-chars)
+ (re-search-forward "\\cu" to t))
+ (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))))
+ (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 (nreverse 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 ","))
+ (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"))))
+
+ (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")))))))))
+