猫熊は燃えつきた？！日記

○ tDiary 高速化

大家さんがtDiary を高速化した、とのこと。立派立派。

ついでにアクセスカウンタも動くようになったということで、一番下に復活させておいた。

○ が、しかし。。。

tdiary-mode から commit(?) しようとすると、
http-fetch: HTTP fetch: Connection timeout!
ですって。

HTTP/1.0 500 Internal Server Error
Date: Thu, 10 May 2007 01:48:09 GMT
Content-Type: text/html
Server: Apache/2.0.59 (FreeBSD) mod_ssl/2.0.59 OpenSSL/0.9.7e-p1 DAV/2 省略
MS-Author-Via: DAV
Via: 1.1 mnc08 (NetCache NetApp/6.0.4P1D4), Version 1.1-Build_SOL_1074 省略
<h1>500 Internal Server Error</h1>
<pre>
Permission denied - tdiary.conf (Errno::EACCES)
  
/usr/local/tdiary/tdiary.rb:497:in `initialize'
/usr/local/tdiary/tdiary.rb:497:in `open'
/usr/local/tdiary/tdiary.rb:497:in `load'
/usr/local/tdiary/tdiary.rb:425:in `initialize'
/home/shirai/public_html/diary/update.rb:21:in `new'
/home/shirai/public_html/diary/update.rb:21
/usr/local/lib/ruby/site_ruby/1.8/apache/ruby-run.rb:53:in `load'
/usr/local/lib/ruby/site_ruby/1.8/apache/ruby-run.rb:53:in `handler'
/usr/local/lib/ruby/site_ruby/1.8/apache/ruby-run.rb:53
</pre>
<div>スペースたくさん</div>
  
Process *request to ko.meadowy.net* connection broken by remote peer

○ というわけで、

ko.meadowy.net で

% ls -la /home/shirai/public_html/diary/tdiary.conf
 -rw-r---- shirai shirai ...... tdiary.conf

だったので、

% chmod 644 /home/shirai/public_html/diary/tdiary.conf

で直るかと思ったら、やっぱり直らなかった。まかせた。

○ 直った

(setq tdiary-update-rb "update.cgi")

で、OK。サンキュー。

○ my-aaview 前フリ

2ch を navi2ch とかで読んでいるとき、AA をちゃんと見たいときは 'v' を押して、aadisplay や popup を使うが、個人的には

• aadisplay にしろ popup にしろマウス触らないと終了できないから嫌
• 一番 navi2ch を使う Zaurus じゃだめ

のであまり好きではない。当然、(setq navi2ch-mona-enable t) で全部モナーフォントで表示しても良いのだけど、

• 等幅フォントじゃないので、普通の文章は読みにくい
• このフォントは線が細すぎてあまり好みではない

のだ。と、結構以前からず〜〜〜と思っていた。

○ my-aaview 実体

そこで、いつものように(？)Emacs だけで動く AA Viewer を作ってみた。当然だがモナーフォントが必須。
調整が必要な変数は my-aaview-font-path(Meadow のみ), my-aaview-font-width ぐらいかな？
また、ipaモナーフォントは、ぼくが使っていないのでやり方がわからないので対応しているのは元祖 BDF なモナーフォントだけね ^^;;;
面倒なので、複数のフォントセットの切り替えは対応していないが、そのかわりに久しぶりに XEmacs に対応したつもり。

;;; Emacs だけで動く AA Viewer
;;
;; Meadow3 と Emacs 22 ぐらいで動く。XEmacs もとりあえず対応したつもり。
;;
;; navi2ch 以外でも region を指定して M-x my-aaview でも OK
;;                  region がなかったら buffer 全部表示
;; そうすると、今のフレームより一回り小さいフレームで AA 表示。
;; そのフレームは、'q', 'スペース', 'mouse-1', 'mouse-2' で閉じる。
  
;; window-system => t のときだけね
(when window-system
  (setq navi2ch-article-view-aa-function 'my-aaview))
  
(defvar my-aaview-font-path "c:/usr/fonts/mona-font"
  "*mona font path (for Meadow).")
  
(defvar my-aaview-font-width 8
  "*mona font width")
  
(defvar my-aaview-font-type "medium" ;; または "bold" も OK
  "*mona font type.")
  
(defvar my-aaview-mode-hook nil
  "*Hook of my-aaview-mode.")
  
(defvar my-aaview-fontset-name "aaview"
  "*Fontset name for my-aaview.")
  
(defvar my-aaview-font-height (* my-aaview-font-width 2)
  "*mona font height")
  
(defun my-aaview-create-face ()
  (unless (or (and (fboundp 'find-face)
		   (find-face 'my-aaview-face))
	      (and (fboundp 'facep)
		   (facep 'my-aaview-face)))
    (make-face 'my-aaview-face)
    (cond
     ((featurep 'meadow)
      (unless (member my-aaview-fontset-name (w32-font-list))
	(let ((dir my-aaview-font-path)
	      (w my-aaview-font-width)
	      (h my-aaview-font-height)
	      (b (if (string= my-aaview-font-type "medium")
		     "" "B")))
	  (w32-add-font
	   my-aaview-fontset-name
	   `((spec
	      ((:char-spec ascii :height any :weight any :slant any)
	       strict
	       (bdf-font ,(expand-file-name
			   (format "mona%dx%da%s.bdf" w h b)
			   dir)))
	      ((:char-spec katakana-jisx0201 :height any :weight any :slant any)
	       strict
	       (bdf-font ,(expand-file-name
			   (format "mona%dx%dr%s.bdf" w h b)
			   dir))
	       ((encoding . 1-byte-set-msb)))
	      ((:char-spec latin-jisx0201 :height any :weight any :slant any)
	       strict
	       (bdf-font ,(expand-file-name
			   (format "mona%dx%dr%s.bdf" w h b)
			   dir)))
	      ((:char-spec japanese-jisx0208 :height any :weight any :slant any)
	       strict
	       (bdf-font ,(expand-file-name
			   (format "monak%d%s.bdf" (* w 2) b)
			   dir))))))))
      (set-face-font 'my-aaview-face my-aaview-fontset-name))
     ((featurep 'xemacs)
      (set-face-font 'my-aaview-face
		     (format "-mona-gothic-%s-r-*--%d-*-*-*-p-*-*-*"
			     my-aaview-font-type
			     my-aaview-font-height)))
     (t
      (unless (query-fontset (format "-*-%s" my-aaview-fontset-name))
	(let* ((prefix (format "-mona-gothic-%s-r-*--%d-*-*-*-p-*-"
			       my-aaview-font-type
			       my-aaview-font-height))
	       (fontset (concat prefix "fontset-" my-aaview-fontset-name))
	       (font (concat prefix "%s")))
	  (new-fontset fontset
		       (list (cons 'ascii
				   (format font "iso8859-1"))
			     (cons 'latin-iso8859-1
				   (format font "iso8859-1"))
			     (cons 'katakana-jisx0201
				   (format font "jisx0201.1976-0"))
			     (cons 'latin-jisx0201
				   (format font "jisx0201.1976-0"))
			     (cons 'japanese-jisx0208
				   (format font "jisx0208.1990-0"))))))
      (set-face-font 'my-aaview-face
		     (query-fontset (format "-*-%s" my-aaview-fontset-name)))))))
  
(if (fboundp 'frame-parameter)
    (defalias 'my-aaview-fpram 'frame-parameter)
  (defun my-aaview-fpram (frame param)
    (cdr (assq param (frame-parameters frame)))))
  
(defun my-aaview (&optional str)
  (interactive)
  (setq str (or str
		(if (or (and (fboundp 'region-active-p)
			     (region-active-p))
			(and (boundp 'mark-active)
			     transient-mark-mode mark-active))
		    (buffer-substring (region-beginning) (region-end))
		  (buffer-substring (point-min) (point-max)))))
  (my-aaview-create-face)
  (let* ((header (condition-case nil
		     (navi2ch-article-default-header-format-function
		      (navi2ch-article-get-current-number)
		      (navi2ch-article-get-current-name)
		      (navi2ch-article-get-current-mail)
		      (navi2ch-article-get-current-date))
		   (error nil)))
	 (oframe (selected-frame))
	 (top (my-aaview-fpram oframe 'top))
	 (left (my-aaview-fpram oframe 'left))
	 (fore (my-aaview-fpram oframe 'foreground-color))
	 (back (my-aaview-fpram oframe 'background-color))
	 (height (- (my-aaview-fpram oframe 'height) 2))
	 (width (- (my-aaview-fpram oframe 'width) 3))
	 (frame (or (catch 'detect
		      (let ((frames (frame-list)))
			(while frames
			  (when (my-aaview-fpram (car frames) 'my-aaview)
			    (throw 'detect (car frames)))
			  (setq frames (cdr frames)))))
		    (make-frame `((my-aaview . t)
				  (name . "my-aaview")
				  (height . ,height)
				  (width . ,width)
				  (line-spacing . 0)
				  (minibuffer             . nil)
				  (vertical-scroll-bars   . nil)
				  (horizontal-scroll-bars . nil)
				  (menu-bar-lines         . nil)
				  (visibility             . nil)))))
	 buf)
    (if (numberp top)
	(setq top (+ top 16))
      (setq top 16))
    (if (numberp left)
	(setq left (+ left 16))
      (setq left 16))
    (modify-frame-parameters frame
			     `((foreground-color . ,fore)
			       (background-color . ,back)
			       (top   . ,top)
			       (left  . ,left)))
    (when (eq (frame-visible-p frame) 'icon)
      (make-frame-visible))
    (select-frame frame)
    (raise-frame frame)
    (setq buf (get-buffer-create "*my-aaview*"))
    (let ((buffer-read-only nil)
	  (inhibit-read-only t)
	  pos)
      (set-buffer buf)
      (erase-buffer)
      (when header (insert header))
      (setq pos (point))
      (insert str "\n")
      (goto-char pos)
      (put-text-property (point) (point-max) 'face 'my-aaview-face))
    (my-aaview-mode)
    (set-window-buffer (frame-selected-window frame) buf)))
  
(defun my-aaview-close (&optional args)
  (interactive)
  (kill-buffer (current-buffer))
  (delete-frame))
  
(defvar my-aaview-mode-map nil)
(unless my-aaview-mode-map
  (setq my-aaview-mode-map (make-keymap))
  (define-key my-aaview-mode-map [mouse-1] 'my-aaview-close)
  (define-key my-aaview-mode-map [mouse-2] 'my-aaview-close)
  (define-key my-aaview-mode-map " " 'my-aaview-close)
  (define-key my-aaview-mode-map "q" 'my-aaview-close))
  
(defun my-aaview-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'my-aaview-mode)
  (setq mode-name "my-aaview")
  (use-local-map my-aaview-mode-map)
  (setq buffer-read-only t)
  (setq truncate-lines t)
  (cond
   ((boundp 'auto-hscroll-mode)
    (set (make-local-variable 'auto-hscroll-mode) t))
   ((boundp 'automatic-hscrolling)
    (set (make-local-variable 'automatic-hscrolling) t))
   ((fboundp 'auto-show-mode)
    (auto-show-mode 1)))
  (buffer-disable-undo (current-buffer))
  (setq mode-line-format "Type `q' to close.")
  (run-hooks 'my-aaview-mode-hook))
;;;;

navi2ch 以外でも動くので、emacs-w3m なんかで『あ、これ AA で見たい』とかいうときは便利かもしれない。

○ うぅ。。

LangScan の書き方がわからなくて、<pre>〜</pre> にしちまったい。