• R/O
  • SSH
  • HTTPS

macemacsjp:


File Info

Rev. 395
Size 18,582 bytes
Time 2005-10-21 00:03:21
Author zenitani
Log Message

Document fix.

Content

  1. ;; -*- mode: lisp-interaction; syntax: elisp; coding: iso-2022-7bit -*-
  2. ;; pdf-preview.el : preview text from the buffer as pdf files through PostScript
  3. ;; Version 1.0.4
  4. ;;
  5. ;; Copyright (C) 2004-2005 by T. Hiromatsu <matsuan@users.sourceforge.jp>
  6. ;;; Commentary:
  7. ;; Comments, questions and feedback will be sent to an english list
  8. ;; <http://lists.sourceforge.jp/mailman/listinfo/macemacsjp-english>
  9. ;; of MacEmacs JP project <http://macemacsjp.sourceforge.jp/en/>.
  10. ;;----------------------------------------------------------------------
  11. ;; This program is free software; you can redistribute it and/or
  12. ;; modify it under the terms of the GNU General Public License
  13. ;; as published by the Free Software Foundation; either version 2
  14. ;; of the License, or (at your option) any later version.
  15. ;;
  16. ;; This program is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;; GNU General Public License for more details.
  20. ;;
  21. ;; The GNU General Public License can be gotten from
  22. ;; the Free Software Foundation, Inc.,
  23. ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  24. ;; http://www.gnu.org/licenses/gpl.html
  25. ;;
  26. ;;----------------------------------------------------------------------
  27. ;; 本プログラムはフリー・ソフトウェアです。
  28. ;; あなたは、Free Software Foundationが公表したGNU 一般公有使用許諾の
  29. ;; 「バージョン2」或いはそれ以降の各バージョンの中からいずれかを選択し、
  30. ;; そのバージョンが定める条項に従って本プログラムを
  31. ;; 再頒布または変更することができます。
  32. ;;
  33. ;; 本プログラムは有用とは思いますが、頒布にあたっては、
  34. ;; 市場性及び特定目的適合性についての暗黙の保証を含めて、
  35. ;; いかなる保証も行ないません。
  36. ;; 詳細についてはGNU 一般公有使用許諾書をお読みください。
  37. ;;
  38. ;; GNU一般公有使用許諾は、 
  39. ;; Free Software Foundation,
  40. ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  41. ;; http://www.gnu.org/licenses/gpl.html
  42. ;; から入手可能です。
  43. ;;
  44. ;;----------------------------------------------------------------------
  45. ;; 1. Features
  46. ;;
  47. ;; This package requires Multilingual Ghostscript. I suggest to
  48. ;; use the package provided by Dr. Ogawa (Kumamoto Gakuen
  49. ;; University).
  50. ;; http://www2.kumagaku.ac.jp/teacher/herogw/index.html
  51. ;; http://www2.kumagaku.ac.jp/teacher/herogw/archive/gplgs041101.dmg
  52. ;;
  53. ;; 1) Print texts in Emacs buffer through PostScript format as
  54. ;; pdf(portable document format) file, then show it by
  55. ;; adequate viewer. By default, GhostScript (ps2pdf13) will
  56. ;; be used for transform from PostScript to pdf.
  57. ;; 2) Make cjk font width 2 times as ascii font.
  58. ;; 3) enable to input some parameters interactively.
  59. ;;
  60. ;; 2. Functions
  61. ;; Totally 10 interactive functions are defined. Main 8 functions
  62. ;; has names similar like as ps-print-* functions.
  63. ;;
  64. ;; pdf-preview-spool-buffer
  65. ;; pdf-preview-spool-buffer-with-faces
  66. ;; pdf-preview-spool-region
  67. ;; pdf-preview-spool-region-with-faces
  68. ;;
  69. ;; These 4 functions make PostScript buffer "*PostScript*" by
  70. ;; calling ps-spool-* functions after getting parameters
  71. ;; interactively.
  72. ;;
  73. ;; pdf-preview-buffer
  74. ;; pdf-preview-buffer-with-faces
  75. ;; pdf-preview-region
  76. ;; pdf-preview-region-with-faces
  77. ;;
  78. ;; These 4 functions compensate font width of CJK fonts (multipe
  79. ;; by 1.2) to have 2 times width of ascii by calling
  80. ;; pdf-preview-rescale-mule-font, then make pdf files through
  81. ;; temporal PostScript file by pdf-preview-do-despool.
  82. ;;
  83. ;; pdf-preview-rescale-mule-font
  84. ;;
  85. ;; Compensate font width of CJK fonts (multipe by 1.2) to have 2
  86. ;; times width of ascii on "*PostScript*" buffer.
  87. ;;
  88. ;; pdf-preview-do-despool
  89. ;;
  90. ;; Make and preview pdf files through temporal PostScript file.
  91. ;;
  92. ;; 3. Usage
  93. ;; usage1: call interactively
  94. ;; M-x pdf-preview-(buffer|region)(-with-faces)
  95. ;;
  96. ;; usage2: call interactively with prefix argument
  97. ;; C-u M-x pdf-preview-(buffer|region)(-with-faces)
  98. ;; You can set some factors interactively shown as follows.
  99. ;; ps-paper-type (Paper Size)
  100. ;; ps-landscape-mode (Paper Direction)
  101. ;; ps-print-header (Title on/off)
  102. ;; pdf-preview-font-rescale-factor (Font Rescale Factor)
  103. ;; ps-line-spacing (Linse Spacing)
  104. ;;
  105. ;; usage3:
  106. ;; (pdf-preview-buffer arg-list)
  107. ;; arg-list contains
  108. ;; (ps-paper-type ps-landscape-mode
  109. ;; ps-print-header pdf-preview-font-rescale-factor ps-line-spacing).
  110. ;;
  111. ;; example ; (pdf-preview-buffer '(a3 t nil 8 6))
  112. ;;
  113. ;; 4. variables
  114. ;; 1) pdf-preview-ps2pdf-command
  115. ;; command for ps2pdf (transform Postscript to Portable Document Format)
  116. ;; default : "ps2pdf13"
  117. ;;
  118. ;; 2) pdf-preview-ps2pdf-paper-size-option
  119. ;; option for paper size of pdf-preview-ps2pdf-command
  120. ;; default : "-sPAPERSIZE="
  121. ;;
  122. ;; 3) pdf-preview-preview-command
  123. ;; command for launching pdf viewer
  124. ;; default :
  125. ;; windows + CMD.EXE --- "start"
  126. ;; windows + cygwin --- "cygstart"
  127. ;; carbon-emacs --- "open"
  128. ;; others --- "xpdf"
  129. ;;
  130. ;; 4) pdf-preview-font-rescale-factor
  131. ;; rescale factor of font size defined in ps-print package
  132. ;; default : 1.0
  133. ;;
  134. ;;----------------------------------------------------------------------
  135. ;;
  136. ;; 1. 機能
  137. ;;
  138. ;; このパッケージを使う為には、多言語化された、Ghostscript が必要です。
  139. ;; 熊本学園大学の、小川先生が提供されている、パッケージなどがお勧めです。
  140. ;; http://www2.kumagaku.ac.jp/teacher/herogw/index.html
  141. ;;
  142. ;; 1) Emacs の バッファーのテキストを、PostScript format を経由して、
  143. ;; pdf に変換し、適当なビュワーを使って表示します。
  144. ;; Default では、GhostScript (ps2pdf13) を使っています。
  145. ;; 2) 日本語フォントとアスキーフォントの幅を 2:1 に設定します。
  146. ;; 3) プレフィックス付きで呼び出すと、幾つかの項目を対話的に設定できます。
  147. ;;
  148. ;; 2. 関数
  149. ;; 主な関数は、以下の8個。各々の差は、ps-print(spool系の関数と同じ
  150. ;;
  151. ;; pdf-preview-spool-buffer
  152. ;; pdf-preview-spool-buffer-with-faces
  153. ;; pdf-preview-spool-region
  154. ;; pdf-preview-spool-region-with-faces
  155. ;; 上記4関数は、interactiveに変数を取得した上、ps-spool-* でPostScript
  156. ;; フォーマットのbuffer(*PostScript)を作成します。
  157. ;;
  158. ;; pdf-preview-buffer
  159. ;; pdf-preview-buffer-with-faces
  160. ;; pdf-preview-region
  161. ;; pdf-preview-region-with-faces
  162. ;; 上記4関数は、ps-preview-spool-* でspoolした、PostScriptフォーマットに対し、
  163. ;; 関数 pdf-preview-rescale-mule-font
  164. ;; を使って、Mule Font のみ 1.2 倍(所謂当幅にする為)した後、
  165. ;; 関数 pdf-preview-do-despool
  166. ;; で、pdfファイルを作成します。
  167. ;;
  168. ;; 3. 使い方
  169. ;;
  170. ;; 1) M-x pdf-preview-(buffer|region)(-with-faces)
  171. ;; 初期設定値で、ps、pdf ファイルが作られます。
  172. ;;
  173. ;; 2) C-u M-x pdf-preview-(buffer|region)(-with-faces)
  174. ;; 下記項目を、対話的に設定できます。
  175. ;; 紙サイズ (ps-paper-type)
  176. ;; 'b5, 'b4, 'a4small, 'ledger, 'lettersmall, 'legal,
  177. ;; 'letter, 'a3, 'a4,
  178. ;; 紙の向き (ps-landscape-mode)
  179. ;; 'Landscape, 'Portrait,
  180. ;; ヘッダーの有無 (ps-preint-header)
  181. ;; 't, 'nil,
  182. ;; フォントサイズの拡大比率 (pdf-preview-font-rexcale-factor)
  183. ;;    任意の正の数
  184. ;; 行間隔 (ps-line-spacing)
  185. ;; 任意の正の数
  186. ;;
  187. ;; 3) (pdf-preview-buffer arg-list)
  188. ;; 引数付きで関数呼び出し。引数は、上記の5項目を含んだリストである事。
  189. ;; 例 ; (pdf-preview-buffer '(a3 t nil 8 10))
  190. ;; a3、横置きで、ヘッダー無し、フォントサイズは標準の8倍
  191. ;; 行間隔は 10/72 inch
  192. ;;
  193. ;; 4. 設定可能な変数
  194. ;; 1) pdf-preview-ps2pdf-command
  195. ;; ps2pdf に使うコマンド
  196. ;; デフォルト : "ps2pdf13"
  197. ;;
  198. ;; * 私は、cjkps2pdf.pl を使ったりしているので、
  199. ;; "perl ~/bin/cjkps2pdf.pl --keepmetrics"
  200. ;; にしています。
  201. ;;
  202. ;; 2) pdf-preview-ps2pdf-paper-size-option
  203. ;; pdf-preview-ps2pdf-command で、紙サイズの指定に使うオプション
  204. ;; デフォルト : "-sPAPERSIZE="
  205. ;;
  206. ;; * 私は、cjkps2pdf.pl を使ったりしているので、
  207. ;; "--papersize "
  208. ;; にしています。
  209. ;;
  210. ;; 3) pdf-preview-preview-command
  211. ;; プレビュワーを起動するコマンド
  212. ;; デフォルト :
  213. ;; windows + CMD.EXE --- "start"
  214. ;; windows + cygwin --- "cygstart"
  215. ;; carbon-emacs --- "open"
  216. ;; others --- "xpdf"
  217. ;;
  218. ;; 4) pdf-preview-font-rescale-factor
  219. ;; フォントの拡大率
  220. ;; デフォルト : 1.0
  221. ;;
  222. ;; * 私は、1.1 にしてます。
  223. ;;
  224. ;; 5. 履歴
  225. ;; 1.0.4 2005-10-17 bug fix
  226. ;; 1.0.3 2005-05-30 bug fix
  227. ;; 1.0.2 2005-05-24 bug fix
  228. ;; プレビュワーコマンドのデフォルト値をOS毎に設定
  229. ;; 1.0.1 2005-05-23 .emacs の設定がなくても動くように変更
  230. ;; 紙サイズA4, 行間隔6をデフォルトに
  231. ;; 行間隔も対話的に設定できるように
  232. ;; 1.0.0 2005-05-20 リリース
  233. ;;; code
  234. ;;;
  235. ;;; initialize section
  236. ;;;
  237. (if (not (boundp 'ps-paper-type)) (setq ps-paper-type 'a4))
  238. (if (not (boundp 'ps-line-spacing)) (setq ps-line-spacing 6))
  239. (require 'ps-print)
  240. (require 'ps-mule)
  241. (defalias 'ps-mule-header-string-charsets 'ignore)
  242. (defvar pdf-preview-ps2pdf-command "ps2pdf13")
  243. (defvar pdf-preview-ps2pdf-paper-size-option "-sPAPERSIZE=")
  244. (defvar pdf-preview-preview-command
  245. (cond
  246. ((featurep 'dos-w32)
  247. (if (string-match "\\(cmdproxy\.exe$\\|cmd\.exe$\\)" shell-file-name) "start"
  248. "cygstart"))
  249. ((featurep 'mac-carbon) "open")
  250. ("xpdf")))
  251. (defvar pdf-preview-ignored-papersize-list '("tabloid" "statement" "executive"))
  252. (defvar pdf-preview-font-rescale-factor 1.0)
  253. (defvar pdf-preview-ps-mule-search-word
  254. (concat "/f[89][29]-[0-2] \\([0-9]+\.[0-9][0-9][0-9][0-9][0-9][0-9]\\) /"
  255. "\\(Ryumin-Light\\|GothicBBB-Medium\\)"
  256. "\\(-H\\|\\.Katakana\\|\\.Hankaku\\) "
  257. "\\(DefFontMule\\)"))
  258. (defun pdf-preview-get-paper-size (paper-type)
  259. (downcase (nth 3 (or (assoc paper-type ps-page-dimensions-database)
  260. (assoc ps-paper-type ps-page-dimensions-database)))))
  261. (defvar pdf-preview-papersize-list
  262. (let ((lst
  263. (mapcar
  264. (function (lambda (s) (cons (car s) (pdf-preview-get-paper-size (car s)))))
  265. ps-page-dimensions-database)))
  266. (dolist (elt pdf-preview-ignored-papersize-list) (delete (rassoc elt lst) lst))
  267. lst))
  268. ;;;
  269. ;;; Function section
  270. ;;;
  271. (defun pdf-preview-do-despool (&optional papersize)
  272. "Preview PostScript spool via PDF"
  273. (interactive (list (pdf-preview-papersize current-prefix-arg)))
  274. (let* ((ps-temp-file
  275. (concat (make-temp-name (concat temporary-file-directory "pdf")) ".ps"))
  276. (pdf-temp-file
  277. (concat (file-name-sans-extension ps-temp-file) ".pdf"))
  278. (paper
  279. (cdr (assoc (or papersize ps-paper-type) pdf-preview-papersize-list)))
  280. (ps2pdf-command
  281. (format "%s %s%s %s %s" pdf-preview-ps2pdf-command
  282. pdf-preview-ps2pdf-paper-size-option paper
  283. ps-temp-file pdf-temp-file))
  284. (preview-command
  285. (format "%s %s" pdf-preview-preview-command pdf-temp-file)))
  286. (ps-do-despool ps-temp-file)
  287. (shell-command (concat ps2pdf-command " && " preview-command))))
  288. (defun pdf-preview-rescale-mule-font (&optional arg)
  289. "Rescale mule fonts for keeping in line with ascii"
  290. (interactive)
  291. (save-excursion
  292. (set-buffer "*PostScript*")
  293. (goto-char (point-min))
  294. (while (re-search-forward pdf-preview-ps-mule-search-word nil t)
  295. (let* ((end (match-end 4))
  296. (num (buffer-substring (match-beginning 1) (match-end 1)))
  297. (str (format "%.6f" (* (string-to-number num) 1.2))))
  298. (goto-char (match-beginning 1))
  299. (delete-region (match-beginning 1) (match-end 1))
  300. (insert str)
  301. (goto-char end)))))
  302. (defun pdf-preview-spool-buffer (&optional arg-list)
  303. "Generate and spool a PostScript image of the buffer for pdf preview."
  304. (interactive (pdf-preview-factor current-prefix-arg))
  305. (pdf-preview-spool 'ps-spool-buffer arg-list))
  306. (defun pdf-preview-buffer (&optional arg-list)
  307. "Generate and preview a pdf file of the buffer via PostScript."
  308. (interactive (pdf-preview-factor current-prefix-arg))
  309. (pdf-preview-spool-buffer arg-list)
  310. (save-excursion (pdf-preview-rescale-mule-font))
  311. (pdf-preview-do-despool (car arg-list)))
  312. (defun pdf-preview-spool-buffer-with-faces (&optional arg-list)
  313. "Generate and spool a PostScript image of the buffer with faces for pdf preview."
  314. (interactive (pdf-preview-factor current-prefix-arg))
  315. (pdf-preview-spool 'ps-spool-buffer-with-faces arg-list))
  316. (defun pdf-preview-buffer-with-faces (&optional arg-list)
  317. "Generate and preview a pdf file of the buffer with faces via PostScript."
  318. (interactive (pdf-preview-factor current-prefix-arg))
  319. (pdf-preview-spool-buffer-with-faces arg-list)
  320. (save-excursion (pdf-preview-rescale-mule-font))
  321. (pdf-preview-do-despool (car arg-list)))
  322. (defun pdf-preview-spool-region (from to &optional arg-list)
  323. "Generate and spool a PostScript image of the region for pdf preview."
  324. (interactive (pdf-preview-region-factor current-prefix-arg))
  325. (pdf-preview-spool 'ps-spool-region arg-list from to))
  326. (defun pdf-preview-region (from to &optional arg-list)
  327. "Generate and preview a pdf file of the region via PostScript."
  328. (interactive (pdf-preview-region-factor current-prefix-arg))
  329. (pdf-preview-spool-region from to arg-list)
  330. (save-excursion (pdf-preview-rescale-mule-font))
  331. (pdf-preview-do-despool (car arg-list)))
  332. (defun pdf-preview-spool-region-with-faces (from to &optional arg-list)
  333. "Generate and spool a PostScript image of the region with faces for pdf preview."
  334. (interactive (pdf-preview-region-factor current-prefix-arg))
  335. (pdf-preview-spool 'ps-spool-region-with-faces arg-list from to))
  336. (defun pdf-preview-region-with-faces (from to &optional arg-list)
  337. "Generate and preview a pdf file of the region with faces via PostScript."
  338. (interactive (pdf-preview-region-factor current-prefix-arg))
  339. (pdf-preview-spool-region-with-faces from to arg-list)
  340. (save-excursion (pdf-preview-rescale-mule-font))
  341. (pdf-preview-do-despool (car arg-list)))
  342. (defun pdf-preview-region-factor (prefix-arg)
  343. (let ((lst (car (pdf-preview-factor prefix-arg))))
  344. (list (region-beginning) (region-end) lst)))
  345. (defun pdf-preview-papersize (prefix-arg)
  346. (and prefix-arg
  347. (or (numberp prefix-arg) (listp prefix-arg))
  348. (let* ((prompt "Papersize : ")
  349. (completion-ignore-case t)
  350. (default (cdr (assoc ps-paper-type pdf-preview-papersize-list)))
  351. (lst (mapcar (lambda (ls) (cdr ls)) pdf-preview-papersize-list))
  352. (str (completing-read prompt lst nil t default)))
  353. (car (rassoc str pdf-preview-papersize-list)))))
  354. (defun pdf-preview-factor (prefix-arg)
  355. (and prefix-arg
  356. (or (numberp prefix-arg) (listp prefix-arg))
  357. (list
  358. (list
  359. (pdf-preview-papersize prefix-arg)
  360. (let* ((prompt (format "Direction : "))
  361. (completion-ignore-case t)
  362. (default (if ps-landscape-mode "Landscape" "Portrait"))
  363. (lst '("Landscape" "Portrait"))
  364. (str (completing-read prompt lst nil t default)))
  365. (if (string-match str "Landscape") t nil))
  366. (let* ((prompt (format "Print Title : "))
  367. (completion-ignore-case t)
  368. (default (if ps-print-header "t" "nil"))
  369. (str (completing-read prompt '("t" "nil") nil t default)))
  370. (if (string-match str "t") t nil))
  371. (let ((prompt (format "Font Rescale Factor : "))
  372. (factor)
  373. (default (number-to-string pdf-preview-font-rescale-factor)))
  374. (while (not (numberp (setq factor (read-minibuffer prompt default)))))
  375. factor)
  376. (let ((prompt (format "Line Spacing : "))
  377. (spacing)
  378. (default (number-to-string ps-line-spacing)))
  379. (while (not (numberp (setq spacing (read-minibuffer prompt default)))))
  380. spacing)))))
  381. (defun pdf-preview-mult (cons_cell factor)
  382. (if (numberp cons_cell) (* cons_cell factor)
  383. (cons (* factor (car cons_cell)) (* factor (cdr cons_cell)))))
  384. (defun pdf-preview-spool (pdf-preview-spool-function arg-list &optional from to)
  385. (save-excursion
  386. (let* ((ps-paper-type (if arg-list (nth 0 arg-list) ps-paper-type))
  387. (ps-landscape-mode (if arg-list (nth 1 arg-list) ps-landscape-mode))
  388. (ps-print-header (if arg-list (nth 2 arg-list) ps-print-header))
  389. (factor (if arg-list (nth 3 arg-list) pdf-preview-font-rescale-factor))
  390. (ps-line-spacing (if arg-list (nth 4 arg-list) ps-line-spacing))
  391. (ps-font-size (pdf-preview-mult ps-font-size factor))
  392. (ps-header-font-size (pdf-preview-mult ps-header-font-size factor))
  393. (ps-footer-font-size (pdf-preview-mult ps-footer-font-size factor))
  394. (ps-header-title-font-size
  395. (pdf-preview-mult ps-header-title-font-size factor))
  396. (ps-line-number-font-size
  397. (pdf-preview-mult ps-line-number-font-size factor))
  398. (ps-multibyte-buffer 'non-latin-printer))
  399. (if from (funcall pdf-preview-spool-function from to)
  400. (funcall pdf-preview-spool-function)))))
  401. (provide 'pdf-preview)
  402. ;;; pdf-preview.el ends here
Show on old repository browser