🚀 go-pugleaf

池田です。

satoru@isoternet.org (Satoru Takabayashi) writes:

> hiroki-t@is.aist-nara.ac.jp wrote:
> 
> >  　 　か ボ す い 間 機 化 使 化 な 来  　 　か う 作 に  　 　大 こ
> > 御  　？ ｜  ゜ま の を す う に い な こ  　っ な っ は 当  　学 ん
> > 意  　 　ド 人 す こ と る 人 関 氣 い れ  　た も て な 分  　で に
> > 見  　 　が 間  ゜と り な が す が と を  　の の み ら  　 　す ち
> > 御  　 　ど 工 キ を ま り 人 る し 真 作  　で で ま な E　 　 ゜は
> > 感  　 　う 学 ｜ 考 く し 間 こ て に り  　少 す し そ m　 　 　 ゜
> > 想  　 　し に ボ え 環 て で と き 日 始  　な が た う a　 　 　玉
> > な  　 　て 則 ｜ て 境 欲 あ は ま 本 め  　か  ｀ ゜な c　 　 　越
> > ど  　 　標 っ ド い が し る 単 し 語 て  　ら ち 絶 の s　 　 　＠
> >  ｀ 　 　準 た や な 使 い と に た 処 か  　ず ょ 対 で  　 　 　奈
> > お  　 　に  ｀マ い い も い 技  ゜理 ら  　驚 っ 誰  ｀は  　 　良
> > 気  　 　な も ウ か に の う 術 縦 を  ｀ 　い と か 遊 縦  　 　先
> > 軽  　 　ら っ ス ら く で こ 的 書 し や  　て 探 が び 書  　 　端
> > に  　 　な と な で い す と な き て は  　い し 既 で き  　 　科
> > ど  　 　い 使 ど は の  ゜を こ に い り  　ま た に こ が  　 　学
> > う  　 　の い は な は 現 考 と 限 る 縦  　す 限 作 ん 出  　 　技
> > ぞ  　 　で 易 そ い  ｀在 え で ら と 書  　 ゜り っ な 来  　 　術
> >  ゜ 　 　し い の か 使 の て は ず は き  　 　で て も る  　 　大
> >  　 　 　ょ キ 例 と う 計 規 な  ｀言 が  　 　は い の よ  　 　学
> >  　 　 　う ｜ で 思 人 算 格 く 文 え 出  　 　な そ を う  　 　院
> 
> tategaki.el のコメントによると
> 
> | * emacs-version が 20.x 以上でないと動きません。

19系でも動くものを作ってみました。ひょっとすると18も…
パッチするほどのものでもないので直接送ります。
ただ、このelはバグっていて、region内だけを対象にする訳ではなく、region
以降にも影響を与えてしまいます。役所などに提出する際には注意が必要でしょ
うね。

ぜんぜんコメントを触ってませんが、よしなに…

# あと、バグってたら直すなりぼくに報告するなりrmするなり読み飛ばすなり
適当に処理して下さい。


;;; tategaki.el --- a simple 縦
;;                           書
;;                           き typesetter

;;; Copyright (C) 1999 Tamakoshi Hiroki <hiroki-t@is.aist-nara.ac.jp>

;;; Last modified on Mon Mar 15 03:34:17 1999

;; Author: Tamakoshi Hiroki <hiroki-t@is.aist-nara.ac.jp>
;; Maintainer: Tamakoshi Hiroki <hiroki-t@is.aist-nara.ac.jp>
;; Created: 10 Mar 1999
;; Version: 1.0
;; Keywords: wp

;;; Commentary:
;; 1. Set region, and invoke the program by typing M-x tategaki-region.
;; 2. Then it asks the number of letters in one line, please answer.
;; 3. The result is what you will see.
;;
;; 1. 範囲を指定して、M-x tategaki-region して下さい。
;; 2. 一行の字数を聞いてくるので入力します。
;; 3. 縦書きに整形されます。

;;; Features:
;; * ー を ｜ に、↑ を → にするなど 90 度回転したときに正しくなるように
;;   変換します。句読点なども同様です。
;; * 禁則処理もします。
;; * 空行(正確には二つ連続した \n)がある場合、それを段落の区切りとして
;;   前の文の最後で強制的に改行します。

;;; Tips:
;; * HTML の中では <pre> </pre> で囲めば大体うまく見られるようです。
;; * TeX では素直に pTeX を使いましょう。
;; * 縦書きのメールも乙なものです。

;;; Bugs:
;; * 組版の方法はいい加減です。
;; * 多くの変換不能な記号があります。例えば ( ) に対応する、
;;   縦書きに使える記号が存在しません(あれば教えて下さい)。
;; * 12月 は 12
;;           月 とすべきでしょうが、やっていません。
;; * emacs-version が 20.x 以上でないと動きません。

;;; A simple sample                          せ の す な ？ き 日  　こ
;;                                           で 強 よ ん 縦 だ 本  　ん
;; こんにちは。                              す い  ゜て 書 と 語  　に
;;                                            ゜文 あ  ｀き 思 は  　ち
;; 日本語はやはり縦書きだと                   　化 る 病 が い や  　は
;; 思いませんか？                  →         　の い ん 出 ま は  　 ゜
;; 縦書きが出来ないなんて、                   　お は で 来 せ り  　 　
;; 病んでいますよ。あるいは                   　仕 西 い な ん 縦  　 　
;; 西欧の強い文化のお仕着せです。             　着 欧 ま い か 書  　 　

;;; Feature Work:
;; 12月、(1) などに対応する。
;; *, ○, ・ などでインデントを揃える。
;; 縦書きにしたものを横書きに戻す機構を考える。

;;; History:
;; 1999年03月15日: なんとなく公開してみる。
;;                 http://mimi.aist-nara.ac.jp/~hiroki-t/Distribution/Tategaki/

;;; Code:

(defvar tategaki-tmp-buffer " *Tategaki tmp*")

(defun tategaki-emu-substring (string start &optional end)
  (let ((buffer (get-buffer-create " *tategaki-emu-substring*")))
    (save-excursion
      (set-buffer buffer)
      (erase-buffer)
      (insert string)
      (goto-char (point-min))
      (forward-char start)
      (format "%s"
	      (prog1
		  (if (not end)
		      (buffer-substring (point) (point-max))
		    (let ((point (point)))
		      (goto-char (point-min))
		      (forward-char end)
		      (buffer-substring point (point)))
		    )
		(kill-buffer buffer))))))

(defun tategaki-emu-length (string)
  (and (listp string) (setq string (nth 1 string)))
  (let ((buffer (get-buffer-create " *tategaki-emu-length*")))
    (save-excursion
      (set-buffer buffer)
      (erase-buffer)
      (insert string)
      (let ((n 0))
	(goto-char (point-min))
	(while (not (eobp))
	  (forward-char)
	  (setq n (1+ n)))
	(kill-buffer buffer)
	n
	))))

(defun tategaki-get-string (number start end)
  (let ((string (buffer-substring start end)))
    (kill-buffer (get-buffer-create tategaki-tmp-buffer))
    (get-buffer-create tategaki-tmp-buffer)
    (save-excursion
      (set-buffer tategaki-tmp-buffer)
      (insert string)
      (goto-char (point-min))
      (let* ((str (let ((tmp '())
			(start-point (point-min)))
		    (while (search-forward "\n\n" nil t 1)
		      (setq tmp (cons (tategaki-emu-buffer-substring start-point
							(- (point) 2))
				      tmp))
		      (save-excursion (insert (make-string number ? )))
		      (setq start-point (point)))
		    (setq tmp (cons (buffer-substring (point) (point-max))
				    tmp))
		    tmp))
	     (purged (let ((tmp '()))
		       (while str
			 (erase-buffer)
			 (insert (car str))
			 (goto-char (point-min))
			 (replace-string "\n" "")
			 (setq tmp (cons (buffer-substring (point-min)
							   (point-max))
					 tmp))
			 (setq str (cdr str)))
		       tmp)))
	(kill-buffer tategaki-tmp-buffer)
	purged))))

(defvar tategaki-tobe-converted-letters
  '(("。" " ゜" t) ("、" " ｀" t) ("ー" "｜") ("｜" "―")
    ("→" "↓") ("←" "↑") ("↑" "→") ("↓" "←")
    ("「" " ┐" t) ("」" (if (bolp)
			   (insert "└")
			 (backward-delete-char 1)
			 (insert "└ ")) )
    ("＜" "∧") ("＞" "∨") (":" "‥") ("：" "‥") ("‥" "：")
    )
  )

(defun tategaki-convert-letter (letter)
  (let ((hit (assoc letter tategaki-tobe-converted-letters)))
    (if hit
	(progn
	  (if (stringp (nth 1 hit))
	      (insert (nth 1 hit))
	    (eval (nth 1 hit)))
	  (if (= 3 (tategaki-emu-length hit))
	      (cons t (nth 2 hit))
	    (cons t nil)))
      nil)))

(defun tategaki-insert-car-of-divided-sentence (divided)
  (let ((tmp divided)
	(half-slipp nil))
    (while tmp
      (let ((substr (car tmp)))
	(if (string= "" substr)
	    (insert " 　")
	  (if half-slipp
	      ()
	    (insert " "))
	  (setq half-slipp nil)
;;	  (let ((result (tategaki-convert-letter (aref substr 0))))
	  (let ((result (tategaki-convert-letter (tategaki-emu-substring substr 0 1))))
	    (if result
		(setq half-slipp (cdr result))
	      (insert (tategaki-emu-substring substr 0 1))
	      (if (= 1 (string-width (tategaki-emu-substring substr 0 1)))
		  (progn (insert "　") (setq half-slipp t)))
	      ))
	  ))
      (setq tmp (cdr tmp)))))

(defun tategaki-all-null-string (list)
  (or (null list)
      (and (string= "" (car list))
	   (tategaki-all-null-string (cdr list)))))

(defun tategaki-divide-string-to-pieces (number string)
  (let ((divided (if (string= "" string)
		     (list (make-string (1+ number) ? ))
		   '())))
    (while (not (string= "" string))
      (let* ((limit (min number (tategaki-emu-length string)))
	     (substr (tategaki-emu-substring string 0 limit))
	     (kinsokup
	      (if (< limit (tategaki-emu-length string))
		  (let ((nextletter (tategaki-emu-substring string limit (1+ limit))))
		    (or (string="。" nextletter)
			(string="、" nextletter)
			(string="」" nextletter)
			))
		nil)))
	(setq divided (cons (if kinsokup
				(concat substr (tategaki-emu-substring string limit
							  (1+ limit)))
			      (concat substr
				      (make-string (- (+ number 1)
						      (tategaki-emu-length substr))
						   ? )))
			    divided)
	      string (tategaki-emu-substring string (if kinsokup (1+ limit) limit)))))
    divided))

(defun tategaki-region-aux (number string newlinep)
  (let ((divided (tategaki-divide-string-to-pieces number string)))
    (while (not (tategaki-all-null-string divided))
      (tategaki-insert-car-of-divided-sentence divided)
      (let ((tmp '()))
	(while divided
	  (setq tmp (cons (if (string= "" (car divided))
			      ""
			    (tategaki-emu-substring (car divided) 1))
			  tmp))
	  (setq divided (cdr divided)))
	(setq divided (reverse tmp)))
      ; the next sentence doesn't work. very curious.
;       (setq divided (mapcar (function (lambda (s)
; 					(if (string= "" s)
; 					    ()
; 					  (setq s (substring s 1)))))
; 			    divided))
      (if newlinep (insert "\n")
;      (if (not newlinep) (insert "\n")
	(let ((before (format "%s" (buffer-substring 
		       (if (bobp)
			   ""
			 (save-excursion (backward-char) (point)) (point))))))
;; ん…
;;	  (if (or (string= "゜" before)
;;		  (string= "｀" before)
;;		  (string= "┐" before)
;;		  (string= "　" before)
;;		  )
;;	      (delete-char 1))
	  (forward-line)))
      )))

(defun tategaki-finalize (start)
  (let* ((zure-regexp "゜\\|｀\\|┐"))
    (save-excursion
      (goto-char start)
      (while (search-forward-regexp zure-regexp nil t)
	(if (eolp) () (delete-char 1))))
  ))

(defun tategaki-region (number start end)
  (interactive "nLine width: \nr")
  (let ((strings (tategaki-get-string number start end))
	(newlinep t))
    (delete-region start end)
    (while strings
      (tategaki-region-aux number (car strings) newlinep)
      (setq newlinep nil)
      (goto-char start)
      (setq strings (cdr strings)))
    (tategaki-finalize start)
    ))

(provide 'tategaki)

;;; tategaki.el ends here


> とのことで、手元の環境では動かせません。くやしいので perl で
> 似たようなフィルタを作ってみました。

普及をかねて、Rubyでも作ってみました。やはり、EUCでしか動きません。そ
れと禁則処理もしません。半角カナなどはもってのほかでしょう…

  % nkf -e foobar.txt | ruby tategaki.rb

とかで使って下さい。

こっちも無保証です。どうぞ適当に。

#!/usr/local/bin/ruby -Ke

$column   = 20
$tateyoko = {
    "-" => "| ",
    "ー" => "｜",
    "｜" => "―",
    "→" => "↓",
    "←" => "↑",
    "↑" => "→",
    "↓" => "←",
    "」" => "└",
    "＜" => "∧",
    "＞" => "∨",
    ": " => "‥",
    "：" => "‥",
    "‥" => "："
		}
$zure_chars = {
    "。" => "゜",
    "、" => "｀",
    "「" => "┐"
}

w = readlines.join.gsub!("\n", "")
w.gsub!("^[ \t]+", "")
w.gsub!("\s", "")
chars = w.split("")
lines = []
s = 0
i = 0
while s < chars.length
  if s + $column > chars.length then
    lines[i] = chars[s,chars.length] + (" "*(s + $column - chars.length)).split("")      
  else
    lines[i] = chars[s,$column]
  end
  i += 1
  s += $column
end
count = i
lines.reverse!
for i in 0..($column-1)
  for j in 0..(count-1)
    c = lines[j][0]
    if c =~ /^[\x20-\x7e]/ then
      if $tateyoko[c] then 
	print $tateyoko[c], " "
      else
	print c, "  "
      end
    elsif c =~ /^[\xa1-\xfe]/ then
      if $tateyoko[c] then
	print $tateyoko[c], " "
      elsif $zure_chars[c] then
	print " ", $zure_chars[c]
      else
	print c, " "
      end
    end
    lines[j] = lines[j][1,(lines[j].length-1)]
  end
  print "\n"
end


takashi ikeda cercine@kcn.ne.jp
                                chemicals