]> code.delx.au - gnu-emacs/blobdiff - lisp/ps-mule.el
(fortran-comment-line-start): Renamed from comment-line-start.
[gnu-emacs] / lisp / ps-mule.el
index 727c76ba02c37ddcbddfcd8ff8fd4efd33ca9421..13eeb9909bef55a780a90cbd35e622f1f348c140 100644 (file)
@@ -1,13 +1,13 @@
 ;;; ps-mule.el --- Provide multi-byte character facility to ps-print.
 
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999 Free Software Foundation, Inc.
 
 ;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
 ;; Author:     Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Keywords:   print, PostScript, multibyte, mule
-;; Time-stamp: <99/02/19 13:15:52 vinicius>
+;; Keywords:   wp, print, PostScript, multibyte, mule
+;; Time-stamp: <99/06/24 23:07:11 vinicius>
 
 ;; This file is part of GNU Emacs.
 
@@ -28,7 +28,7 @@
 
 ;;; Commentary:
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; About ps-mule
 ;; -------------
 ;;
 ;; Valid values for `ps-multibyte-buffer' are:
 ;;
-;;  nil                     This is the value to use when you are printing
-;;                         buffer with only ASCII and Latin characters.
+;;  nil                     This is the value to use the default settings which
+;;                         is by default for printing buffer with only ASCII
+;;                         and Latin characters.   The default setting can be
+;;                         changed by setting the variable
+;;                         `ps-mule-font-info-database-default' differently.
+;;                         The initial value of this variable is
+;;                         `ps-mule-font-info-database-latin' (see
+;;                         documentation).
 ;;
 ;;  `non-latin-printer'     This is the value to use when you have a japanese
 ;;                         or korean PostScript printer and want to print
 ;;
 ;; The default is nil.
 ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;; Code:
 
 (eval-and-compile (require 'ps-print))
 
-;;;###autoload
-(defcustom ps-multibyte-buffer nil
-  "*Specifies the multi-byte buffer handling.
-
-Valid values are:
-
-  nil                     This is the value to use the default settings which
-                         is by default for printing buffer with only ASCII
-                         and Latin characters.   The default setting can be
-                         changed by setting the variable
-                         `ps-mule-font-info-database-default' differently.
-                         The initial value of this variable is
-                         `ps-mule-font-info-database-latin' (which see).
-
-  `non-latin-printer'     This is the value to use when you have a Japanese
-                         or Korean PostScript printer and want to print
-                         buffer with ASCII, Latin-1, Japanese (JISX0208 and
-                         JISX0201-Kana) and Korean characters.  At present,
-                         it was not tested the Korean characters printing.
-                         If you have a korean PostScript printer, please,
-                         test it.
-
-  `bdf-font'              This is the value to use when you want to print
-                         buffer with BDF fonts.  BDF fonts include both latin
-                         and non-latin fonts.  BDF (Bitmap Distribution
-                         Format) is a format used for distributing X's font
-                         source file.  BDF fonts are included in
-                         `intlfonts-1.1' which is a collection of X11 fonts
-                         for all characters supported by Emacs.  In order to
-                         use this value, be sure to have installed
-                         `intlfonts-1.1' and set the variable
-                         `bdf-directory-list' appropriately (see ps-bdf.el for
-                         documentation of this variable).
-
-  `bdf-font-except-latin' This is like `bdf-font' except that it is used
-                         PostScript default fonts to print ASCII and Latin-1
-                         characters.  This is convenient when you want or
-                         need to use both latin and non-latin characters on
-                         the same buffer.  See `ps-font-family',
-                         `ps-header-font-family' and `ps-font-info-database'.
-
-Any other value is treated as nil."
-  :type '(choice (const non-latin-printer) (const bdf-font)
-                (const bdf-font-except-latin) (other :tag "nil" nil))
-  :group 'ps-print-font)
+
+(require 'ps-vars)                     ; Common definitions
+
+
+;;;; `ps-multibyte-buffer' definition should be placed in `ps-mule' but due to
+;;;; compilation and customization gripes it was moved to `ps-print-def'.
+;;
+;;(defcustom ps-multibyte-buffer nil
+;;  "*Specifies the multi-byte buffer handling.
+;;
+;;Valid values are:
+;;
+;;  nil                     This is the value to use the default settings which
+;;                         is by default for printing buffer with only ASCII
+;;                         and Latin characters.   The default setting can be
+;;                         changed by setting the variable
+;;                         `ps-mule-font-info-database-default' differently.
+;;                         The initial value of this variable is
+;;                         `ps-mule-font-info-database-latin' (see
+;;                         documentation).
+;;
+;;  `non-latin-printer'     This is the value to use when you have a Japanese
+;;                         or Korean PostScript printer and want to print
+;;                         buffer with ASCII, Latin-1, Japanese (JISX0208 and
+;;                         JISX0201-Kana) and Korean characters.  At present,
+;;                         it was not tested the Korean characters printing.
+;;                         If you have a korean PostScript printer, please,
+;;                         test it.
+;;
+;;  `bdf-font'              This is the value to use when you want to print
+;;                         buffer with BDF fonts.  BDF fonts include both latin
+;;                         and non-latin fonts.  BDF (Bitmap Distribution
+;;                         Format) is a format used for distributing X's font
+;;                         source file.  BDF fonts are included in
+;;                         `intlfonts-1.1' which is a collection of X11 fonts
+;;                         for all characters supported by Emacs.  In order to
+;;                         use this value, be sure to have installed
+;;                         `intlfonts-1.1' and set the variable
+;;                         `bdf-directory-list' appropriately (see ps-bdf.el for
+;;                         documentation of this variable).
+;;
+;;  `bdf-font-except-latin' This is like `bdf-font' except that it is used
+;;                         PostScript default fonts to print ASCII and Latin-1
+;;                         characters.  This is convenient when you want or
+;;                         need to use both latin and non-latin characters on
+;;                         the same buffer.  See `ps-font-family',
+;;                         `ps-header-font-family' and `ps-font-info-database'.
+;;
+;;Any other value is treated as nil."
+;;  :type '(choice (const non-latin-printer) (const bdf-font)
+;;                (const bdf-font-except-latin) (other :tag "nil" nil))
+;;  :group 'ps-print-font)
+
 
 ;; For Emacs 20.2 and the earlier version.
 (eval-and-compile
-  (if (not (string< mule-version "4.0"))
+  (if (and (boundp 'mule-version)      ; only if mule package is loaded
+          (not (string< mule-version "4.0")))
       (progn
        (defalias 'ps-mule-next-point '1+)
        (defalias 'ps-mule-chars-in-string 'length)
@@ -148,8 +163,7 @@ Any other value is treated as nil."
     (defun ps-mule-string-char (string idx)
       (string-to-char (substring string idx)))
     (defun ps-mule-next-index (string i)
-      (+ i (charset-bytes (char-charset (string-to-char string))))))
-  )
+      (+ i (charset-bytes (char-charset (string-to-char string)))))))
 
 (defvar ps-mule-font-info-database
   nil
@@ -198,9 +212,23 @@ See also the variable `ps-font-info-database'.")
      (normal nil nil iso-latin-1)))
   "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
 
-(defvar ps-mule-font-info-database-default
+(defcustom ps-mule-font-info-database-default
   ps-mule-font-info-database-latin
-  "The default setting to use if `ps-multibyte-buffer' (which see) is nil.")
+  "*The default setting to use if `ps-multibyte-buffer' is nil."
+  :type '(repeat :tag "Multi-Byte Buffer Database Font Default"
+                (list (symbol :tag "Charset")
+                      (repeat :inline t
+                              (list (choice :tag "Font Type"
+                                            (const normal) (const bold)
+                                            (const italic) (const bold-italic))
+                                    (choice :tag "Font Source"
+                                            (const builtin) (const ps-bdf)
+                                            (const vflib)
+                                            (other :tag "nil" nil))
+                                    (list (string :tag "Font Name"))
+                                    (function :tag "Encoding")
+                                    (integer :tag "Bytes")))))
+  :group 'ps-print-font)
 
 (defconst ps-mule-font-info-database-ps
   '((katakana-jisx0201
@@ -208,14 +236,14 @@ See also the variable `ps-font-info-database'.")
      (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
      (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
     (latin-jisx0201
-     (normat builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
+     (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
      (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
     (japanese-jisx0208
      (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
      (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
     (korean-ksc5601
-     (normal builtin "Batang-Medium-KSC-H" ps-mule-encode-7bit 2)
-     (bold builtin " Gulim-Medium-KSC-H" ps-mule-encode-7bit 2))
+     (normal builtin "Munhwa-Regular-KSC-EUC-H" ps-mule-encode-7bit 2)
+     (bold builtin "Munhwa-Bold-KSC-EUC-H" ps-mule-encode-7bit 2))
     )
   "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
 
@@ -272,7 +300,7 @@ Currently, data for Japanese and Korean PostScript printers are listed.")
     (chinese-big5-2
      (normal bdf "taipei24.bdf" chinese-big5 2))
     (chinese-sisheng
-     (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-8bit 1))
+     (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1))
     (ipa
      (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
     (vietnamese-viscii-lower
@@ -366,26 +394,34 @@ See also `ps-mule-font-info-database-bdf'.")
     str))
 
 ;; Special encoding function for Ethiopic.
-(define-ccl-program ccl-encode-ethio-unicode
-  `(1
-    ((read r2)
-     (loop
-      (if (r2 == ,leading-code-private-22)
-         ((read r0)
-          (if (r0 == ,(charset-id 'ethiopic))
-              ((read r1 r2)
-               (r1 &= 127) (r2 &= 127)
-               (call ccl-encode-ethio-font)
-               (write r1)
-               (write-read-repeat r2))
-            ((write r2 r0)
-             (repeat))))
-       (write-read-repeat r2))))))
-
-(defun ps-mule-encode-ethiopic (string)
-  (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
-                        (make-vector 9 nil)
-                        string))
+(if (boundp 'mule-version)             ; only if mule package is loaded
+    (define-ccl-program ccl-encode-ethio-unicode
+      `(1
+       ((read r2)
+        (loop
+         (if (r2 == ,leading-code-private-22)
+             ((read r0)
+              (if (r0 == ,(charset-id 'ethiopic))
+                  ((read r1 r2)
+                   (r1 &= 127) (r2 &= 127)
+                   (call ccl-encode-ethio-font)
+                   (write r1)
+                   (write-read-repeat r2))
+                ((write r2 r0)
+                 (repeat))))
+           (write-read-repeat r2))))))
+  ;; to avoid compilation gripes
+  (defvar ccl-encode-ethio-unicode nil))
+
+(if (boundp 'mule-version)
+    ;; bound mule-version
+    (defun ps-mule-encode-ethiopic (string)
+      (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
+                            (make-vector 9 nil)
+                            string))
+  ;; unbound mule-version
+  (defun ps-mule-encode-ethiopic (string)
+    string))
 
 ;; A charset which we are now processing.
 (defvar ps-mule-current-charset nil)
@@ -574,16 +610,38 @@ STRING should contain only ASCII characters."
 %% Working dictionary for general use.
 /MuleDict 10 dict def
 
+%% Adjust /RelativeCompose properly by checking /BaselineOffset.
+/AdjustRelativeCompose {       % fontdict  |-  fontdict
+  dup length 2 add dict begin
+    { 1 index /FID ne { def } { pop pop } ifelse } forall
+    currentdict /BaselineOffset known {
+       BaselineOffset false eq { /BaselinfOffset 0 def } if
+    } {
+      /BaselineOffset 0 def
+    } ifelse
+    currentdict /RelativeCompose known not {
+      /RelativeCompose [ 0 0.1 ] def
+    } {
+      RelativeCompose false ne {
+        [ BaselineOffset RelativeCompose BaselineOffset add
+          [ FontMatrix { FontSize div } forall ] transform ]
+        /RelativeCompose exch def
+      } if
+    } ifelse
+    currentdict
+  end
+} def
+
 %% Define already scaled font for non-ASCII character sets.
 /DefFontMule {                 % fontname size basefont  |-  --
-  findfont exch scalefont definefont pop
+  findfont exch scalefont AdjustRelativeCompose definefont pop
 } bind def
 
 %% Define already scaled font for ASCII character sets.
 /DefAsciiFontMule {            % fontname size basefont  |-
   MuleDict begin
   findfont dup /Encoding get /ISOLatin1Encoding exch def
-  exch scalefont reencodeFontISO
+  exch scalefont AdjustRelativeCompose reencodeFontISO
   end
 } def
 
@@ -727,10 +785,10 @@ the sequence."
     currentfont /FontType get 3 eq { %ifelse
        stringwidth pop pop
     } {
-       currentpoint /y exch def pop
+       currentpoint /y exch def /x exch def
        false charpath flattenpath pathbbox
-       y sub /URY exch def pop
-       y sub /LLY exch def pop
+       y sub /URY exch def x sub /URX exch def
+       y sub /LLY exch def x sub /LLX exch def
     } ifelse
     grestore
 } bind def
@@ -752,7 +810,10 @@ the sequence."
     grestore
     /Effect Effectsave 8 32 add and def        % enable only shadow and outline
     false BG
-    gsave SpaceWidth mul 0 rmoveto dup GetPathBox S grestore
+    gsave
+       SpaceWidth mul 0 rmoveto dup GetPathBox S
+       /RIGHT currentpoint pop def
+    grestore
     /y currentpoint exch pop def
     /HIGH URY y add def /LOW LLY y add def
 } bind def
@@ -762,7 +823,11 @@ the sequence."
     /bg bgsave def /bgcolor bgcolorsave def
     /Effect Effectsave def
     /Cmpchar false def
-    CmpcharWidth SpaceWidth mul 0 rmoveto
+    CmpcharRelativeCompose false eq {
+       CmpcharWidth SpaceWidth mul 0 rmoveto
+    } {
+       RIGHT currentpoint exch pop moveto
+    } ifelse
 } bind def
 
 %% Rule base composition
@@ -781,20 +846,26 @@ the sequence."
     currentpoint pop btm LLY sub moveto
     S
     grestore
+    /CmpcharRelativeCompose false def
 } bind def
 
 %% Relative composition
 /RLC {                         % str  |-  --
     gsave
     dup GetPathBox
-    CmpcharRelativeCompose type /integertype eq {
-       LLY CmpcharRelativeCompose gt { % compose on top
+    LLX 0 lt { RIGHT currentpoint exch pop moveto } if
+    CmpcharRelativeCompose type /arraytype eq {
+       LLY CmpcharRelativeCompose 1 get ge {   % compose on top
            currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto
            /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def
-       } { URY 0 le {                  % compose under bottom
-           currentpoint pop LOW LLY add CmpcharRelativeSkip sub moveto
+       } { URY CmpcharRelativeCompose 0 get le { % compose under bottom
+           currentpoint pop LOW URY sub CmpcharRelativeSkip sub moveto
            /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def
-    } if } ifelse } if
+       } {
+           /y currentpoint exch pop def
+           y URY add dup HIGH gt { /HIGH exch def } { pop } ifelse
+           y LLY add dup LOW lt { /LOW exch def } { pop } ifelse
+       } ifelse } ifelse } if
     S
     grestore
 } bind def
@@ -958,9 +1029,9 @@ NewBitmapDict
        Cmpchar { %ifelse
            /FontMatrix get [ exch { size div } forall ] /mtrx exch def
            bmp 3 get bmp 4 get mtrx transform
-           /LLY exch def pop
+           /LLY exch def /LLX exch def
            bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform
-           /URY exch def pop
+           /URY exch def /URX exch def
        } {
            pop
        } ifelse
@@ -1088,7 +1159,7 @@ This checks if all multi-byte characters in the region are printable or not."
              ((eq ps-multibyte-buffer 'bdf-font-except-latin)
               ps-mule-font-info-database-ps-bdf)
              (t
-              ps-mule-font-info-database-latin)))
+              ps-mule-font-info-database-default)))
   (and (boundp 'enable-multibyte-characters)
        enable-multibyte-characters
        ;; Initialize `ps-mule-charset-list'.  If some characters aren't
@@ -1155,7 +1226,7 @@ This checks if all multi-byte characters in the region are printable or not."
                   (string-as-multibyte "[^\040-\176\240-\377]"))
                  ((eq ps-print-control-characters 'control)
                   (string-as-multibyte "[^\040-\176\200-\377]"))
-                 (t (string-as-multibyte "[^\000-\011\013\015-\377"))))))
+                 (t (string-as-multibyte "[^\000-\011\013\015-\377]"))))))
 
 ;;;###autoload
 (defun ps-mule-begin-page ()