;;; 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, 2006, 2007 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
+;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
+;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript, multibyte, mule
-;; Time-stamp: <2003/05/14 22:19:41 vinicius>
;; This file is part of GNU Emacs.
;; 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:
(defsubst ps-mule-printable-p (charset)
"Non-nil if characters in CHARSET is printable."
- (ps-mule-get-font-spec charset 'normal))
+ ;; ASCII and Latin-1 are always printable.
+ (or (eq charset 'ascii)
+ (eq charset 'latin-iso8859-1)
+ (ps-mule-get-font-spec charset 'normal)))
(defconst ps-mule-external-libraries
'((builtin nil nil
Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence."
- (setq ps-mule-current-charset (charset-after from))
+ (let ((ch (char-after from)))
+ (setq ps-mule-current-charset
+ (char-charset (or (aref ps-print-translation-table ch) ch))))
(let* ((wrappoint (ps-mule-find-wrappoint
from to (ps-avg-char-width 'ps-font-for-text)))
(to (car wrappoint))
(ps-font-alist 'ps-font-for-text))))
(font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
(string (buffer-substring-no-properties from to)))
+ (dotimes (i (length string))
+ (let ((ch (aref ps-print-translation-table (aref string i))))
+ (if ch
+ (aset string i ch))))
(cond
((= from to)
;; We can't print any more characters in the current line.
/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 ]
} 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 {
(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)
(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))))
+ (or (aref ps-print-translation-table (preceding-char))
+ (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
'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"))))
(setq ps-mule-charset-list
(delq 'ascii (delq 'eight-bit-control
(delq 'eight-bit-graphic
- (find-charset-region from to))))
+ (find-charset-region
+ from to ps-print-translation-table))))
ps-mule-header-charsets
(delq 'ascii (delq 'eight-bit-control
(delq 'eight-bit-graphic
(find-charset-string
(mapconcat
- 'identity header-footer-list ""))))))
+ 'identity header-footer-list "")
+ ps-print-translation-table)))))
(dolist (cs ps-mule-charset-list)
(or (ps-mule-printable-p cs)
(push cs unprintable-charsets)))
(provide 'ps-mule)
-;;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe
+;; Local Variables:
+;; generated-autoload-file: "ps-print.el"
+;; End:
+
+;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe
;;; ps-mule.el ends here