Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

* navi2ch-search.el

Add navi2ch-search-web-*; Rewrite navi2ch-search-find-2ch-* to follow the above change;
Add navi2ch-search-hula-*.
Add navi2ch-search-union-*.
(navi2ch-search-find-2ch-thread-regexp): Make it const.
(navi2ch-search-find-2ch-next): Call navi2ch-search-find-2ch with the smaller number
of navi2ch-search-find-2ch-search-num and 50.
(navi2ch-search-web-make-list): Rename from navi2ch-search-find-2ch-make-list.
Use navi2ch-board-url-to-board() to get board.

* navi2ch-vars.el (navi2ch-global-view-map): Bind C-c C-s to
navi2ch-search-web().
  • Loading branch information...
commit 3e6ee5f755a88d25da40ba4b93141339bf958c13 1 parent 9de6a8c
nawota authored
15 ChangeLog
View
@@ -1,3 +1,18 @@
+2009-01-19 Naohiro Aota <naota@elisp.net>
+
+ * navi2ch-search.el
+ navi2ch-search-web-* を追加。 navi2ch-search-find-2ch-* を上記変更
+ にあわせて変更。navi2ch-search-hula-* を追加。
+ navi2ch-search-union-* を追加。
+ (navi2ch-search-find-2ch-thread-regexp): 定数に。
+ (navi2ch-search-find-2ch-next): navi2ch-search-find-2ch-search-num
+ と 50 との小さいほうを navi2ch-search-find-2ch に渡すように。
+ (navi2ch-search-web-make-list): navi2ch-search-find-2ch-make-list
+ から改名。 board を navi2ch-board-url-to-board() で取得するように。
+
+ * navi2ch-vars.el (navi2ch-global-view-map): C-c C-s を
+ navi2ch-search-web に割り当て。
+
2009-01-15 Naohiro Aota <naota@elisp.net>
* navi2ch-article.el (navi2ch-article-mode-map):
4 navi2ch-article.el
View
@@ -1,7 +1,7 @@
;;; navi2ch-article.el --- article view module for navi2ch -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;; by Navi2ch Project
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009 by Navi2ch Project
;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: network, 2ch
4 navi2ch-board-misc.el
View
@@ -1,7 +1,7 @@
;;; navi2ch-board-misc.el --- Miscellaneous Functions for Navi2ch Board Mode -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2008 by Navi2ch
-;; Project
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2008, 2009 by
+;; Navi2ch Project
;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: 2ch, network
12 navi2ch-list.el
View
@@ -1,7 +1,7 @@
;;; navi2ch-list.el --- board list module for navi2ch -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2008 by Navi2ch
-;; Project
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2008, 2009 by
+;; Navi2ch Project
;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: network, 2ch
@@ -834,10 +834,10 @@ changed-list $B$O(B '((board-id old-board new-board) ...) $B$J(B alist$B!#
(if (and board
(navi2ch-board-get-file-name board))
(navi2ch-read-char-with-retry
- "Search from: b)oard c)ategory l)ocal f)ind.2ch.net: "
- nil '(?b ?c ?l ?f))
+ "Search from: b)oard c)ategory l)ocal w)eb: "
+ nil '(?b ?c ?l ?w))
(navi2ch-read-char-with-retry
- "Search from: c)ategory l)ocal f)ind.2ch.net: " nil '(?c ?l ?f)))
+ "Search from: c)ategory l)ocal w)eb: " nil '(?c ?l ?w)))
(if (and board
(navi2ch-board-get-file-name board))
(navi2ch-read-char-with-retry
@@ -848,7 +848,7 @@ changed-list $B$O(B '((board-id old-board new-board) ...) $B$J(B alist$B!#
(cond ((eq ch2 ?b) (navi2ch-list-search-current-board-subject))
((eq ch2 ?c) (navi2ch-list-search-current-category-subject))
((eq ch2 ?l) (navi2ch-search-all-subject))
- ((eq ch2 ?f) (navi2ch-search-find-2ch))))
+ ((eq ch2 ?w) (navi2ch-search-web))))
((eq ch ?a)
(cond ((eq ch2 ?b) (navi2ch-list-search-current-board-article))
((eq ch2 ?c) (navi2ch-list-search-current-category-article))
4 navi2ch-message.el
View
@@ -1,7 +1,7 @@
;;; navi2ch-message.el --- write message module for navi2ch -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008 by
-;; Navi2ch Project
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008, 2009
+;; by Navi2ch Project
;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: network, 2ch
3  navi2ch-popup-article.el
View
@@ -1,6 +1,7 @@
;;; navi2ch-popup-article.el --- popup article module for navi2ch -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 by Navi2ch Project
+;; Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008, 2009 by Navi2ch
+;; Project
;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: network, 2ch
245 navi2ch-search.el
View
@@ -1,6 +1,7 @@
;;; navi2ch-search.el --- Search Module for Navi2ch -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2008 by Navi2ch Project
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2008, 2009 by Navi2ch
+;; Project
;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: 2ch, network
@@ -321,55 +322,97 @@
(setq navi2ch-mode-line-identification str)
(navi2ch-set-mode-line-identification))
-;;; navi2ch find.2ch.net
-(defvar navi2ch-search-find-2ch-last-search-word nil
+;;; navi2ch web subject search
+(defvar navi2ch-search-web-last-search-word nil
"$B:G8e$K8!:w$7$?J8;zNs(B")
-(defvar navi2ch-search-find-2ch-last-search-num nil)
-(defvar navi2ch-search-find-2ch-total-hit nil
+(defvar navi2ch-search-web-current-start 0
+ "$B8=:_!"I=<($7$F$$$k%9%l$N%*%U%;%C%H(B")
+(defvar navi2ch-search-web-current-end 0)
+(defvar navi2ch-search-web-total-hit 0
"$B8!:wAm%R%C%H?t(B")
+(defvar navi2ch-search-web-search-method 'navi2ch-search-find-2ch-method)
+(defsubst navi2ch-search-web-method ()
+ (if (symbolp navi2ch-search-web-search-method)
+ (symbol-value navi2ch-search-web-search-method)
+ navi2ch-search-web-search-method))
+(defsubst navi2ch-search-web-subject-list (keyword arg)
+ (funcall (nth 0 (navi2ch-search-web-method)) keyword arg))
+(defun navi2ch-search-web-next (&optional args)
+ (interactive "P")
+ (let ((item (nth 1 (navi2ch-search-web-method))))
+ (navi2ch-search-web
+ (if (functionp item)
+ (apply item args)
+ item))))
+(defun navi2ch-search-web-previous (&optional args)
+ (interactive "P")
+ (let ((item (nth 2 (navi2ch-search-web-method))))
+ (navi2ch-search-web
+ (if (functionp item)
+ (apply item args)
+ item))))
+
+(defun navi2ch-search-web (&optional arg)
+ "web $B$N8!:w%7%9%F%`$r;H$C$F(B 2ch $B$r%9%l%?%$$G8!:w$9$k!#(B
+`arg' $B$O(B backend $B$K$h$j2r<a$,0[$J$k$,!"(B `arg' $B$,(B `nil' $B$N>l9g$OI,(B
+$B$:?7$7$$8!:w$r3+;O$9$k!#(B"
+ (interactive "P")
+ (let (keyword)
+ (if (and navi2ch-search-web-last-search-word arg)
+ (setq keyword navi2ch-search-web-last-search-word)
+ (setq keyword (navi2ch-read-string "Subject search from web: "
+ nil
+ 'navi2ch-search-history)))
+ (setq navi2ch-search-web-last-search-word keyword
+ navi2ch-search-web-current-start 0
+ navi2ch-search-web-current-end 0
+ navi2ch-search-web-total-hit 0)
+ ;; board mode $B$KEO$9%9%l%?%$$N%j%9%H:n@.(B
+ (setq navi2ch-search-searched-subject-list
+ (navi2ch-search-web-subject-list keyword arg))
+ (navi2ch-bm-select-board navi2ch-search-board)
+ (setq navi2ch-search-mode-line-info
+ (format "Search: %s [%d-%d/%d]"
+ navi2ch-search-web-last-search-word
+ navi2ch-search-web-current-start
+ navi2ch-search-web-current-end
+ navi2ch-search-web-total-hit))))
+(defun navi2ch-search-web-make-list (url title num)
+ "((board) (subject)) $B$N$h$&$J(B navi2ch $BFbIt$N%9%l>pJs$r5<;wE*$K:n@.!#(B"
+ (when (string-match
+ "\\(http://[-a-zA-Z0-9_.!~*';/?:@&=+$,%#]+/\\)test/read.cgi/\\(.+\\)/\\([0-9]+\\)/.*"
+ url)
+ (let ((subject (cons 'subject title))
+ (response (cons 'response num))
+ (artid (cons 'artid (match-string 3 url))))
+ (list (navi2ch-board-url-to-board url) subject artid response))))
+
+;;; navi2ch find.2ch.net
+(defvar navi2ch-search-find-2ch-method
+ '(navi2ch-search-find-2ch-subject-list
+ navi2ch-search-find-2ch-next
+ navi2ch-search-find-2ch-previous))
+(defvar navi2ch-search-find-2ch-last-search-num nil)
(defvar navi2ch-search-find-2ch-search-num 30
"$B0lEY$KI=<($9$k8!:w7k2L(B
find.2ch.net $B$N;EMM>e!":GBg$O(B50$B7o(B")
(defvar navi2ch-search-find-2ch-coding 'euc-japan-dos
"find.2ch.net $B$G;H$o$l$k%3!<%G%#%s%0(B")
-(defvar navi2ch-search-find-2ch-thread-regexp
+(defconst navi2ch-search-find-2ch-thread-regexp
"<dt><a href=\"\\(http://[-a-zA-Z0-9_.!~*';/?:@&=+$,%#]+\\)\">\\(.*\\)</a> (\\([0-9]+\\)) - <font size=[-0-9]+><a href=.+/>\\(.+\\)$BHD(B</a>.+</font></dt><dd>"
"find.2ch.net $B$G8!:w$9$k(B regexp")
-(defun navi2ch-search-find-2ch (&optional offset)
- "2$B$A$c$s$M$k8!:w(B(http://find.2ch.net)$B$G%9%l%C%I%?%$%H%k8!:w!#(B
-`offset' $B$O!V<!$N(B10$B7o!WEy$NAjBP0LCV;XDj$K;H$&(B($B%G%U%)%k%H$O(B0)
-$BI=<($K$O(B navi2ch-search- $B$N%U%l!<%`%o!<%/$r;HMQ(B"
- (interactive "P")
- (let (keyword)
- (if (and navi2ch-search-find-2ch-last-search-word offset)
- (setq keyword navi2ch-search-find-2ch-last-search-word)
- (setq keyword (navi2ch-read-string "Subject search at find.2ch.net: "
- nil
- 'navi2ch-search-history))
- (setq navi2ch-search-find-2ch-last-search-word keyword
- navi2ch-search-find-2ch-last-search-num 0))
- (setq navi2ch-search-find-2ch-last-search-num
- (+ navi2ch-search-find-2ch-last-search-num
- (or offset 0)))
- ;; board mode $B$KEO$9%9%l%?%$$N%j%9%H:n@.(B
- (setq navi2ch-search-searched-subject-list
- (navi2ch-search-find-2ch-subr keyword navi2ch-search-find-2ch-last-search-num))
- (navi2ch-bm-select-board navi2ch-search-board)
- (setq navi2ch-search-mode-line-info
- (format "Search: %s [%s/%s]"
- navi2ch-search-find-2ch-last-search-word
- navi2ch-search-find-2ch-last-search-num
- navi2ch-search-find-2ch-total-hit))))
-
-(defun navi2ch-search-find-2ch-subr (query offset)
- "find.2ch.net$B$KJ8;zNs(Bquery$B$G%j%/%(%9%H!#(B
+(defun navi2ch-search-find-2ch-subject-list (query offset)
+ "find.2ch.net $B$KJ8;zNs(B `query' $B$G%j%/%(%9%H!#(B
`offset' $B$O!V<!$N(B10$B7o!W$H$+I=<($5$;$?$$$H$-$K;H$&!#(B"
- (let* ((query (navi2ch-replace-string
- " "
- "\+"
- (encode-coding-string query navi2ch-search-find-2ch-coding)))
+ (setq offset
+ (if offset
+ (+ (or navi2ch-search-find-2ch-last-search-num 0) offset)
+ 0))
+ (setq navi2ch-search-find-2ch-last-search-num offset)
+ (let* ((query (navi2ch-url-encode-string query
+ navi2ch-search-find-2ch-coding t))
;; $B0UL#$bJ,$+$i$:;H$C$F$k%Q%i%a!<%?B?$7!#FbIt;EMM$,J,$+$j<!Bh2~A1M=Dj(B
(url (format
"http://find.2ch.net/?STR=%s&SCEND=A&SORT=MODIFIED&COUNT=%s&TYPE=TITLE&BBS=ALL&OFFSET=%s"
@@ -384,44 +427,120 @@ find.2ch.net $B$N;EMM>e!":GBg$O(B50$B7o(B")
;; $B$^$:Am%R%C%H7o?t$rC5$9(B
(if (re-search-forward "<font color=white size=-1>\\([0-9]+\\)$B%9%lCf(B.*$BIC(B</font>" nil t)
(progn
- (setq navi2ch-search-find-2ch-total-hit (match-string 1))
+ (setq navi2ch-search-web-total-hit (string-to-number (match-string 1)))
(while (re-search-forward
navi2ch-search-find-2ch-thread-regexp
nil t)
(let ((url (match-string 1))
(title (navi2ch-replace-html-tag (match-string 2)))
- (num (match-string 3))
- (ita (match-string 4)))
- (push (navi2ch-search-find-2ch-make-list url title num ita) subject-list))))
- (setq navi2ch-search-find-2ch-total-hit "0")
+ (num (match-string 3)))
+ (push (navi2ch-search-web-make-list url title num)
+ subject-list))))
+ (setq navi2ch-search-web-total-hit 0)
(message "No match")))
+ (setq navi2ch-search-web-current-start
+ (min (1+ navi2ch-search-find-2ch-last-search-num)
+ navi2ch-search-web-total-hit)
+ navi2ch-search-web-current-end
+ (min (+ navi2ch-search-find-2ch-last-search-num
+ (min navi2ch-search-find-2ch-search-num 50))
+ navi2ch-search-web-total-hit))
(nreverse subject-list)))
;; $B<!$N%Z!<%8(B
(defun navi2ch-search-find-2ch-next ()
- (interactive)
- (navi2ch-search-find-2ch
- navi2ch-search-find-2ch-search-num))
+ (min navi2ch-search-find-2ch-search-num 50))
;; $BA0$N%Z!<%8(B
-(defun navi2ch-search-find-2ch-prev ()
- (interactive)
- (navi2ch-search-find-2ch
- (- navi2ch-search-find-2ch-search-num)))
+(defun navi2ch-search-find-2ch-previous ()
+ (- (min navi2ch-search-find-2ch-search-num 50)))
+
+;;; navi2ch h.ula.cc
+(defvar navi2ch-search-hula-method
+ '(navi2ch-search-hula-subject-list 1 -1))
+(defvar navi2ch-search-hula-current-page nil)
+(defvar navi2ch-search-hula-coding 'shift_jis)
+(defconst navi2ch-search-hula-thread-regexp
+ "<nobr>[^<]+<a href=\"http://same.ula.cc/test/r.so/\\([^/]+\\)/\\([^/]+\\)/\\([0-9]+\\)/\\?guid=ON\" target=\"_blank\">\\([^<]*\\) (\\([0-9]+\\))</a></nobr>")
+
+(defun navi2ch-search-hula-subject-list (query arg)
+ "h.ula.cc $B$KJ8;zNs(B `query' $B$G%j%/%(%9%H!#(B"
+ (setq navi2ch-search-hula-current-page
+ (if arg
+ (+ navi2ch-search-hula-current-page
+ (if (< arg 0) -1 1))
+ 1))
+ (let* ((query (navi2ch-url-encode-string query
+ navi2ch-search-hula-coding t))
+ (url (format
+ "http://h.ula.cc/dance/?P=%d&kenken=%s"
+ navi2ch-search-hula-current-page query))
+ (proc (navi2ch-net-download-file url))
+ (cont (decode-coding-string (navi2ch-net-get-content proc)
+ navi2ch-search-hula-coding))
+ subject-list)
+ (with-temp-buffer
+ (insert cont)
+ (goto-char (point-min))
+ (if (re-search-forward "<font color=red face=\"Arial\"><b>\\([0-9,]+\\)</b></font>"
+ nil t)
+ (progn
+ (setq navi2ch-search-web-total-hit
+ (string-to-number (navi2ch-replace-string "," ""
+ (match-string 1))))
+ (while (re-search-forward
+ navi2ch-search-hula-thread-regexp
+ nil t)
+ (let ((url (format "http://%s/test/read.cgi/%s/%s/"
+ (match-string 1)
+ (match-string 2)
+ (match-string 3)))
+ (title (navi2ch-replace-html-tag (match-string 4)))
+ (num (match-string 5)))
+ (push (navi2ch-search-web-make-list url title num)
+ subject-list))))
+ (setq navi2ch-search-web-total-hit 0)
+ (message "No match")))
+ (setq navi2ch-search-web-current-start
+ (min (1+ (* (1- navi2ch-search-hula-current-page) 50))
+ navi2ch-search-web-total-hit)
+ navi2ch-search-web-current-end
+ (min (* navi2ch-search-hula-current-page 50)
+ navi2ch-search-web-total-hit))
+ (nreverse subject-list)))
-(defun navi2ch-search-find-2ch-make-list (url title num ita)
- "((board) (subject)) $B$N$h$&$J(B navi2ch $BFbIt$N%9%l>pJs$r5<;wE*$K:n@.!#(B"
- (when (string-match
- "\\(http://[-a-zA-Z0-9_.!~*';/?:@&=+$,%#]+/\\)test/read.cgi/\\(.+\\)/\\([0-9]+\\)/.+"
- url)
- (let* ((uri (cons 'uri (concat (match-string 1 url) (match-string 2 url) "/")))
- (id (cons 'id (match-string 2 url)))
- (name (cons 'name ita))
- (board (list name uri id '(type . board)))
- (subject (cons 'subject title))
- (response (cons 'response num))
- (artid (cons 'artid (match-string 3 url))))
- (list board subject artid response))))
+;; navi2ch union
+(defvar navi2ch-search-union-method
+ '(navi2ch-search-union-subject-list 1 -1))
+(defvar navi2ch-search-union-method-list
+ '(navi2ch-search-find-2ch-method
+ navi2ch-search-hula-method))
+(defvar navi2ch-search-union-last-search-num 0)
+
+(defun navi2ch-search-union-subject-list (keyword arg)
+ (unless arg (setq navi2ch-search-union-last-search-num 0))
+ (let ((all 0) (current 0) method-list url-list result)
+ (dolist (m navi2ch-search-union-method-list)
+ (let ((navi2ch-search-web-search-method m))
+ (setq method-list (navi2ch-search-web-subject-list keyword arg)))
+ (setq all (+ all navi2ch-search-web-total-hit)
+ current (+ current
+ (- navi2ch-search-web-current-end
+ navi2ch-search-web-current-start)
+ 1))
+ (dolist (l method-list)
+ (let ((url (navi2ch-article-to-url (car l) (cdr l))))
+ (unless (member url url-list)
+ (push url url-list)
+ (push l result)))))
+ (setq navi2ch-search-web-total-hit all
+ navi2ch-search-web-current-start
+ (1+ navi2ch-search-union-last-search-num)
+ navi2ch-search-web-current-end
+ (+ current navi2ch-search-union-last-search-num)
+ navi2ch-search-union-last-search-num
+ (+ current navi2ch-search-union-last-search-num))
+ (nreverse result)))
(run-hooks 'navi2ch-search-load-hook)
;;; navi2ch-search.el ends here
22 navi2ch-util.el
View
@@ -1450,6 +1450,28 @@ properties to add to the result."
(defsubst navi2ch-cache-remove (key cache)
(remhash key (navi2ch-cache-hash-table cache)))
+
+;; from emacs-w3m
+(defun navi2ch-url-encode-string (str &optional coding encode-space)
+ (apply (function concat)
+ (mapcar
+ (lambda (ch)
+ (cond
+ ((eq ch ?\n) ; newline
+ "%0D%0A")
+ ((string-match "[-a-zA-Z0-9_:/.]" (char-to-string ch)) ; xxx?
+ (char-to-string ch)) ; printable
+ ((and (char-equal ch ?\x20); space
+ encode-space)
+ "+")
+ (t
+ (format "%%%02X" ch)))) ; escape
+ ;; Coerce a string into a list of chars.
+ (append (encode-coding-string (or str "")
+ (or coding
+ navi2ch-coding-system
+ 'shift_jis))
+ nil))))
(navi2ch-update-html-tag-regexp)
5 navi2ch-vars.el
View
@@ -1,7 +1,7 @@
;;; navi2ch-vars.el --- User variables for navi2ch. -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by
-;; Navi2ch Project
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; by Navi2ch Project
;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
;; Keywords: www 2ch
@@ -2405,6 +2405,7 @@ to force the image format."
(define-key map "t" 'navi2ch-toggle-offline)
(define-key map "V" 'navi2ch-version)
(define-key map "\C-x\C-s" 'navi2ch-save-status)
+ (define-key map "\C-c\C-s" 'navi2ch-search-web)
(setq navi2ch-global-view-map map)))
(run-hooks 'navi2ch-vars-load-hook)
Please sign in to comment.
Something went wrong with that request. Please try again.