Meadow 掲示板への post

[Hideyuki SHIRAI ( 白井秀行 ) <shirai@xxxxxxxxxxxxxxxxxxx>]

冗談半分 ＋ 100% 力づくで emacs-w3m から Meadow 掲示板
<http://www66.tcup.com/6629/yutopia.html> に post するときのサポー
トツールを作りました。

他の人の文章の上で M-x w3m-meadow-post とすると引用します。

-- 
白井秀行＠で、夏休み突入 :-)

;; emacs-w3m で Meadow 掲示板に投稿する。
(defvar w3m-meadow-handle "あなたのハンドル" "*Your handle name")
(defvar w3m-meadow-mailaddr "メールアドレス" "*Your mail address")

(defvar w3m-meadow-reply-subject "Re: " "*返信の subject につける")

(defvar w3m-meadow-cite-format "『%s』 さん曰く\n\n" "*Cite format")
(defvar w3m-meadow-cite-myformat "『%s』 曰く\n\n" "*自分用の Cite format")

(defvar w3m-meadow-cite-string "> " "*引用記号")

(defconst w3m-meadow-reply-subject-regex "^re: *")
(defconst w3m-meadow-zenkaku-spc (char-to-string 53409))
(defconst w3m-meadow-original-message-regex
  (concat "^\\(.+\\)" w3m-meadow-zenkaku-spc "+投稿者：\\(.+\\)"
	  w3m-meadow-zenkaku-spc "+投稿日："))
(defconst w3m-meadow-left-magin "\n    ?")
(defconst w3m-meadow-bound-regex "^[━-]+\n")

(defun w3m-meadow-post ()
  "Meadow 掲示板で動かしてね。"
  (interactive)
  (if (not (string= w3m-current-url "http://www66.tcup.com/6629/yutopia.html"))
      (Message "だめだめ。")
    (let (osubj ohandle obody beg)
      (save-excursion
	(when (re-search-backward w3m-meadow-bound-regex nil t)
	  (forward-line)
	  (when (looking-at w3m-meadow-original-message-regex)
	    (setq osubj (match-string-no-properties 1))
	    (setq ohandle (match-string-no-properties 2))
	    (when (string-match " +$" osubj)
	      (setq osubj (substring osubj 0 (match-beginning 0))))
	    (when (string-match " +$" ohandle)
	      (setq ohandle (substring ohandle 0 (match-beginning 0))))
	    (forward-line 2)
	    (setq beg (point))
	    (when (re-search-forward w3m-meadow-bound-regex nil t)
	      (forward-line -2)
	      (setq obody (buffer-substring-no-properties beg (point)))
	      (setq obody (concat w3m-meadow-cite-string
				  (substring obody 4)))
	      (while (string-match w3m-meadow-left-magin obody)
		(setq obody (replace-match
			     (concat "\n" w3m-meadow-cite-string)
			     nil nil obody)))
	      (while (string-match w3m-meadow-zenkaku-spc obody)
		(setq obody (replace-match "  " nil nil obody)))
	      (if (string= ohandle w3m-meadow-handle)
		  (setq obody (concat (format w3m-meadow-cite-myformat ohandle)
				      obody))
		(setq obody (concat (format w3m-meadow-cite-format ohandle)
				    obody))))))
	(w3m-meadow-post-insert "fid=0/type=text/name=name" w3m-meadow-handle)
	(w3m-meadow-post-insert "fid=0/type=text/name=email" w3m-meadow-mailaddr)
	(if (null osubj)
	    (setq osubj (read-from-minibuffer "Subject: "))
	  (when (string-match w3m-meadow-reply-subject-regex osubj)
	    (setq osubj (replace-match "" nil nil osubj)))
	  (setq osubj (concat w3m-meadow-reply-subject osubj)))
	(w3m-meadow-post-insert "fid=0/type=text/name=subject" osubj))
      (goto-char (or (w3m-meadow-tp-any (point-min) (point-max)
					'w3m-form-field-id
					"fid=0/type=textarea/name=value")
		     (point-min)))
      (when (equal (get-text-property (point) 'w3m-form-field-id)
		   "fid=0/type=textarea/name=value")
	(w3m-view-this-url)
	(when obody
	  (insert obody)
	  (goto-char (point-min)))))))

(defun w3m-meadow-post-insert (fid str)
  (let (pos act)
    (when (setq pos (w3m-meadow-tp-any (point-min) (point-max)
				       'w3m-form-field-id fid))
      (goto-char pos)
      (when (setq act (w3m-action))
	(w3m-form-put (nth 1 act) (nth 2 act) str)
	(w3m-form-replace str)))))

(defun w3m-meadow-tp-any (beg end prop value)
  (while (and beg (< beg end)
	      (not (equal value (get-text-property beg prop))))
    (setq beg (next-single-property-change beg prop nil end)))
  (if (eq beg end) nil beg))