[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: automatically filling out WordPress comment fields
- From: Naohiro Aota <naota@xxxxxxxxx>
- Date: Sun, 24 May 2009 05:31:15 +0900
- X-ml-name: emacs-w3m
- X-mail-count: 10902
- References: <871vueoqjc.fsf@xxxxxxxxxxx> <87eiychfgv.fsf@xxxxxxxxxxx> <b4meiycbha7.fsf@xxxxxxx> <87zlh0mnsf.fsf@xxxxxxxxxxxxxxxx> <87tz78tnoz.fsf@xxxxxxxxxxxxxxxxxxxxxxx> <b4mmyd0wepl.fsf@xxxxxxx>
青田です。
Katsumi Yamaoka <yamaoka@xxxxxxx> writes:
>>>>>> In [emacs-w3m : No.10679] 青田さん wrote:
>>>基本的に山岡さんの実装に賛成です。 ただ、以下のようにして柔軟にしておく
>>>のはどうでしょうか? 特に url での切り分けは "id" なんかのよくあるフォー
>>>ム名で便利になると思います。
>
> いいですね。ただ、高度な設定例と初心者向けの簡単な設定例が Info
> と doc に必要でしょうね。
>
>> 設定するのではなくて，自動的に収集してくれるともっと嬉しい．
>
>> (1) form のフィールド名に基づいて初期値候補を検索．
>> (2) 初期値をユーザが修正した場合は，その URL に対応する初期値として新
>> たに記憶．
>> (3) 初期値候補を探すときは，URL をパーツ(ホスト部分・ディレクトリ部分)
>> に分解して，最も類似した URL に対する初期値を適用．
>
>> みたいなロジックではどうでしょう?
>
> うーん、すごい。まかせたっ!
>
>> ;; 実装しなくてすみません．
>
> ;; Mee too.
ちょっと時間がとれたので書いてみました。まだ、コードがちょっと怪しいので
すが…とりあえずバグ出しと査読をできるようにパッチを出してみます。
フォームをうめる部分は [emacs-w3m:10679] でのぼくのパッチをバグ修正しただ
けです。
そこで使われる w3m-form-values のデフォルトを '(w3m-form-auto-fill) とし
て w3m-form-auto-fill に自動収集の結果を検索させており、自動収集は
w3m-form-input() で行なわれます。
収集結果は、たとえば http://example.com/foo/bar/baz というページでhoge と
いうフォームに fuga を入力した後にはこのようなっています。
(("example.com"
(("foo"
(("bar"
(("baz" nil
(("hoge" . "fuga"))))
nil))
nil))
nil))
ようするに `auto-fill-item' が
(<キー> <auto-fill-item のリスト(このキーの下部ツリー)> <このキーの form データ>)
となっていて、全体で木構造を作っている感じになります。また、木構造のキー
には url の ホスト名・ディレクトリ名・ファイル名が使われています。
この収集結果から
- 完全に一致する木が見つかり、該当する form データがあれば、それを返しま
す
- それ以外でホスト名が一致していれば、最も一致している位置から木を一つず
つ戻りながら、下部ツリーの form データを検索し、もっとも使われているも
のを返します。
- ホスト名も一致していなければ、 nil を返します。
;; うまく説明できてないなぁ…。説明するのが下手なようですみません…。
;; w3m-form-input あたりで cl パッケージの macro で簡単に書けそうなのをわ
;; ざわざ書いてあったりしそうです… ^^;
--
青田Index: w3m-form.el
===================================================================
RCS file: /storage/cvsroot/emacs-w3m/w3m-form.el,v
retrieving revision 1.178
diff -u -r1.178 w3m-form.el
--- w3m-form.el 20 May 2009 23:13:29 -0000 1.178
+++ w3m-form.el 23 May 2009 20:17:40 -0000
@@ -173,6 +173,15 @@
"Specify non-nil value to download contents after sending form.
It is useful to bind this variable with `let', but do not set it globally.")
+(defvar w3m-form-values '(w3m-form-auto-fill)
+ "")
+(defvar w3m-form-auto-fill-data nil)
+(defcustom w3m-form-auto-fill-file
+ (expand-file-name ".form-data" w3m-profile-directory)
+ "*File name to keep form data."
+ :group 'w3m
+ :type '(file :size 0))
+
;;; w3m-form structure:
(defun w3m-form-normalize-action (action url)
@@ -702,8 +711,35 @@
no_effect ; map
name value)
(incf id)
- (when value
- (setq value (w3m-decode-entities-string value)))
+ (setq value
+ (catch 'loop
+ (dolist (x w3m-form-values)
+ (if (listp x)
+ (cond
+ ((and (stringp (car x))
+ (string= (car x) name))
+ (throw 'loop (cdr x)))
+ ((listp (car x))
+ (let* ((plist (car x))
+ (name-reg (plist-get plist :name))
+ (url-reg (plist-get plist :url))
+ (value-reg (plist-get plist :value)))
+ (when (and (or (null name-reg)
+ (string-match name-reg name))
+ (or (null url-reg)
+ (string-match url-reg w3m-current-url))
+ (or (null value-reg)
+ (string-match value-reg value)))
+ (throw 'loop (cdr x)))))
+ ((functionp (car x))
+ (when (funcall (car x) w3m-current-url name value)
+ (throw 'loop (cdr x)))))
+ (when (functionp x)
+ (let ((item (funcall x w3m-current-url name value)))
+ (when item
+ (throw 'loop item))))))
+ (when value
+ (throw 'loop (w3m-decode-entities-string value)))))
(save-excursion
(search-forward "</input_alt>")
(setq end (match-beginning 0)))
@@ -972,8 +1008,31 @@
(insert input)
(w3m-form-coding-system-accept-region-p nil nil coding))
(w3m-form-put form id name input)
- (w3m-form-replace input)))))))
-
+ (w3m-form-replace input))
+ (w3m-string-match-url-components w3m-current-url)
+ (let* ((host (match-string 4 w3m-current-url))
+ (path (match-string 5 w3m-current-url))
+ (tree (assoc host w3m-form-auto-fill-data)))
+ (unless tree
+ (setq tree `(,host () ()))
+ (setq w3m-form-auto-fill-data
+ (cons tree
+ w3m-form-auto-fill-data)))
+ (while (string-match "^/\\([^/]*\\)" path)
+ (let* ((dir (match-string 1 path))
+ (next-tree (assoc dir (cadr tree))))
+ (unless next-tree
+ (setq next-tree `(,dir () ()))
+ (setf (cadr tree) (cons next-tree (cadr tree))))
+ (setq path (substring path (match-end 0))
+ tree next-tree)))
+ (let ((elem (assoc name (caddr tree))))
+ (if elem
+ (setcdr elem input)
+ (setf (caddr tree)
+ (cons (cons name input)
+ (caddr tree)))))))))))
+
(defun w3m-form-input-password (form id name)
(if (get-text-property (point) 'w3m-form-readonly)
(message "This input box is read-only.")
@@ -1892,6 +1951,56 @@
(goto-char (or (w3m-form-real-reset form (w3m-action pos))
(next-single-property-change pos 'w3m-action)))))))
+(defun w3m-form-search-for-auto-fill-value (tree name)
+ (let (result elem)
+ (dolist (x tree)
+ (dolist (item (let ((child (w3m-form-search-for-auto-fill-value (cadr x) name))
+ (myval (cdr (assoc name (caddr x)))))
+ (if (setq elem (assoc myval child))
+ (progn (setcdr elem (1+ (cdr elem)))
+ child)
+ (if myval
+ (cons (cons myval 1)
+ child)
+ child))))
+ (if (setq elem (assoc (car item) result))
+ (setcdr elem (1+ (cdr elem)))
+ (setq result (cons item result)))))
+ result))
+
+(defun w3m-form-auto-fill (url name value)
+ (unless w3m-form-auto-fill-data
+ (setq w3m-form-auto-fill-data
+ (or (w3m-load-list w3m-form-auto-fill-file)
+ '(("" () ())))))
+ (w3m-string-match-url-components url)
+ (let* ((host (match-string 4 url))
+ (path (match-string 5 url))
+ (tree (assoc host w3m-form-auto-fill-data))
+ (traveled (list tree))
+ (parsed nil))
+ (when tree
+ (setq tree
+ (catch 'loop
+ (while (string-match "^/\\([^/]*\\)" path)
+ (let* ((dir (match-string 1 path))
+ (next-tree (assoc dir (cadr tree))))
+ (unless next-tree (throw 'loop tree))
+ (setq tree next-tree
+ traveled (cons next-tree traveled)
+ path (substring path (match-end 0)))))
+ (setq parsed t)
+ (throw 'loop tree)))
+ (or (and parsed (cdr (assoc name (caddr tree))))
+ (catch 'loop
+ (dolist (tree traveled)
+ (let ((val-list (w3m-form-search-for-auto-fill-value (cadr tree) name))
+ (max 0) val)
+ (dolist (l val-list)
+ (when (< max (cdr l))
+ (setq max (cdr l)
+ val (car l))))
+ (when val (throw 'loop val)))))))))
(provide 'w3m-form)