+1999-11-10 05:22:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnultimate.el (nnultimate-open-server): Do address.
+ (nnultimate-forum-table-p): New function.
+
+ * nnweb.el (nnweb-insert-html): Renamed.
+ (nnweb-insert): New function.
+
+ * nnultimate.el (nnultimate-insert-html): New function.
+
+ * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything
+ if nov is evil.
+ (nnslashdot-retrieve-headers): use the sane version instead.
+
1999-11-09 00:13:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnslashdot.el (nnslashdot-request-article): Fold case.
(defvoo nnslashdot-active-url "http://slashdot.org/search.pl?section=&min=%d"
"Where nnslashdot will fetch the active file from.")
-(defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=0&mode=flat&startat=%d"
+(defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=4&mode=flat&startat=%d"
"Where nnslashdot will fetch comments from.")
(defvoo nnslashdot-article-url
(nnoo-define-basics nnslashdot)
-(deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnslashdot-thread-retrieve-headers (articles &optional group server fetch-old)
(nnslashdot-possibly-change-server group server)
(let ((last (car (last articles)))
(did nil)
(sid (caddr (assoc group nnslashdot-groups)))
headers article subject score from date lines parent point
startats s)
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (let ((case-fold-search t))
+ (unless gnus-nov-is-evil
+ (save-excursion
+ (set-buffer nnslashdot-buffer)
+ (let ((case-fold-search t))
+ (erase-buffer)
+ (when (= start 1)
+ (nnweb-insert (format nnslashdot-article-url sid))
+ (goto-char (point-min))
+ (search-forward "Posted by ")
+ (when (looking-at "<a[^>]+>\\([^<]+\\)")
+ (setq from (match-string 1)))
+ (search-forward " on ")
+ (setq date (nnslashdot-date-to-date
+ (buffer-substring (point) (1- (search-forward "<")))))
+ (forward-line 2)
+ (setq lines (count-lines
+ (point)
+ (search-forward
+ "A href=http://slashdot.org/article.pl")))
+ (push
+ (cons
+ 1
+ (make-full-mail-header
+ 1 group from date (concat "<" sid "%1@slashdot>")
+ "" 0 lines nil nil))
+ headers)
+ (goto-char (point-max))
+ (while (re-search-backward "startat=\\([0-9]+\\)" nil t)
+ (setq s (match-string 1))
+ (unless (memq s startats)
+ (push s startats)))
+ (unless startats
+ (push 1 startats)))
+ (setq startats (sort startats '<))
+ (while (and (setq start (pop startats))
+ (< start last))
+ (setq point (goto-char (point-max)))
+ (nnweb-insert
+ (format nnslashdot-comments-url sid nnslashdot-threshold start))
+ (goto-char point)
+ (while (re-search-forward
+ "<a name=\"\\([0-9]+\\)\"><b>\\([^<]+\\)</b>.*score:\\([^)]+\\))"
+ nil t)
+ (setq article (string-to-number (match-string 1))
+ subject (match-string 2)
+ score (match-string 3))
+ (when (string-match "^Re: *" subject)
+ (setq subject (concat "Re: " (substring subject (match-end 0)))))
+ (forward-line 1)
+ (if (looking-at
+ "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
+ (setq from (concat (match-string 1)
+ " <" (match-string 2) ">"))
+ (looking-at "by \\(.+\\) on ")
+ (setq from (match-string 1)))
+ (goto-char (- (match-end 0) 5))
+ (search-forward " on ")
+ (setq date
+ (nnslashdot-date-to-date
+ (buffer-substring (point) (progn (end-of-line) (point)))))
+ (setq lines (/ (abs (- (search-forward "<td ")
+ (search-forward "</td>")))
+ 70))
+ (forward-line 2)
+ (setq parent
+ (if (looking-at ".*cid=\\([0-9]+\\)")
+ (match-string 1)
+ nil))
+ (setq did t)
+ (push
+ (cons
+ (1+ article)
+ (make-full-mail-header
+ (1+ article) subject
+ from date
+ (concat "<" sid "%"
+ (number-to-string (1+ article))
+ "@slashdot>")
+ (if parent
+ (concat "<" sid "%"
+ (number-to-string (1+ (string-to-number parent)))
+ "@slashdot>")
+ "")
+ 0 (string-to-number score) nil nil))
+ headers)))))
+ (setq nnslashdot-headers
+ (sort headers (lambda (s1 s2) (< (car s1) (car s2)))))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (dolist (header nnslashdot-headers)
+ (nnheader-insert-nov (cdr header))))
+ 'nov)))
+
+(deffoo nnslashdot-retrieve-headers (articles &optional group
+ server fetch-old)
+ (unless gnus-nov-is-evil
+ (nnslashdot-possibly-change-server group server)
+ (let ((last (car (last articles)))
+ (did nil)
+ (start (max (1- (car articles)) 1))
+ (sid (caddr (assoc group nnslashdot-groups)))
+ headers article subject score from date lines parent point)
+ (save-excursion
+ (set-buffer nnslashdot-buffer)
(erase-buffer)
(when (= start 1)
- (url-insert-file-contents (format nnslashdot-article-url sid))
- (setq buffer-file-name nil)
+ (nnweb-insert (format nnslashdot-article-url sid))
(goto-char (point-min))
(search-forward "Posted by ")
(when (looking-at "<a[^>]+>\\([^<]+\\)")
(make-full-mail-header
1 group from date (concat "<" sid "%1@slashdot>")
"" 0 lines nil nil))
- headers)
- (goto-char (point-max))
- (while (re-search-backward "startat=\\([0-9]+\\)" nil t)
- (setq s (match-string 1))
- (unless (memq s startats)
- (push s startats)))
- (unless startats
- (push 1 startats)))
- (setq startats (sort startats '<))
- (while (and (setq start (pop startats))
- (< start last))
+ headers))
+ (while (or (not article)
+ (and did
+ (< article last)))
+ (when article
+ (setq start (1+ article)))
(setq point (goto-char (point-max)))
- (url-insert-file-contents
+ (nnweb-insert
(format nnslashdot-comments-url sid nnslashdot-threshold start))
- (setq buffer-file-name nil)
(goto-char point)
(while (re-search-forward
- "<a name=\"\\([0-9]+\\)\"><b>\\([^<]+\\)</b>.*score:\\([^)]+\\))"
+ "<a name=\"\\([0-9]+\\)\"><b>\\([^<]+\\)</b>.*score\\([^)]+\\))"
nil t)
(setq article (string-to-number (match-string 1))
subject (match-string 2)
score (match-string 3))
- (when (string-match "^Re: *" subject)
- (setq subject (concat "Re: " (substring subject (match-end 0)))))
(forward-line 1)
- (if (looking-at "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
+ (if (looking-at
+ "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
(setq from (concat (match-string 1) " <" (match-string 2) ">"))
(looking-at "by \\(.+\\) on ")
(setq from (match-string 1)))
(cons
(1+ article)
(make-full-mail-header
- (1+ article) subject
+ (1+ article) (concat subject " (" score ")")
from date
(concat "<" sid "%"
(number-to-string (1+ article))
(number-to-string (1+ (string-to-number parent)))
"@slashdot>")
"")
- 0 (string-to-number score) nil nil))
- headers)))))
- (setq nnslashdot-headers
- (sort headers (lambda (s1 s2) (< (car s1) (car s2)))))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (header nnslashdot-headers)
- (nnheader-insert-nov (cdr header))))
- 'nov))
-
-(deffoo nnslashdot-sane-retrieve-headers (articles &optional group
- server fetch-old)
- (nnslashdot-possibly-change-server group server)
- (let ((last (car (last articles)))
- (did nil)
- (start (car articles))
- (sid (caddr (assoc group nnslashdot-groups)))
- headers article subject score from date lines parent point)
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (erase-buffer)
- (when (= start 1)
- (url-insert-file-contents (format nnslashdot-article-url sid))
- (setq buffer-file-name nil)
- (goto-char (point-min))
- (search-forward "Posted by ")
- (when (looking-at "<a[^>]+>\\([^<]+\\)")
- (setq from (match-string 1)))
- (search-forward " on ")
- (setq date (nnslashdot-date-to-date
- (buffer-substring (point) (1- (search-forward "<")))))
- (forward-line 2)
- (setq lines (count-lines (point)
- (search-forward
- "A href=http://slashdot.org/article.pl")))
- (push
- (cons
- 1
- (make-full-mail-header
- 1 group from date (concat "<" sid "%1@slashdot>")
- "" 0 lines nil nil))
- headers))
- (while (or (not article)
- (and did
- (< article last)))
- (when article
- (setq start (1+ article)))
- (setq point (goto-char (point-max)))
- (url-insert-file-contents
- (format nnslashdot-comments-url sid nnslashdot-threshold start))
- (setq buffer-file-name nil)
- (goto-char point)
- (while (re-search-forward
- "<a name=\"\\([0-9]+\\)\"><b>\\([^<]+\\)</b>.*score\\([^)]+\\))"
- nil t)
- (setq article (string-to-number (match-string 1))
- subject (match-string 2)
- score (match-string 3))
- (forward-line 1)
- (if (looking-at "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))")
- (setq from (concat (match-string 1) " <" (match-string 2) ">"))
- (looking-at "by \\(.+\\) on ")
- (setq from (match-string 1)))
- (goto-char (- (match-end 0) 5))
- (search-forward " on ")
- (setq date
- (nnslashdot-date-to-date
- (buffer-substring (point) (progn (end-of-line) (point)))))
- (setq lines (/ (abs (- (search-forward "<td ")
- (search-forward "</td>")))
- 70))
- (forward-line 2)
- (setq parent
- (if (looking-at ".*cid=\\([0-9]+\\)")
- (match-string 1)
- nil))
- (setq did t)
- (push
- (cons
- (1+ article)
- (make-full-mail-header
- (1+ article) (concat subject " (" score ")")
- from date
- (concat "<" sid "%"
- (number-to-string (1+ article))
- "@slashdot>")
- (if parent
- (concat "<" sid "%"
- (number-to-string (1+ (string-to-number parent)))
- "@slashdot>")
- "")
- 0 lines nil nil))
- headers))))
- (setq nnslashdot-headers
- (sort headers (lambda (s1 s2) (< (car s1) (car s2)))))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (header nnslashdot-headers)
- (nnheader-insert-nov (cdr header))))
- 'nov))
+ 0 lines nil nil))
+ headers))))
+ (setq nnslashdot-headers
+ (sort headers (lambda (s1 s2) (< (car s1) (car s2)))))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (dolist (header nnslashdot-headers)
+ (nnheader-insert-nov (cdr header))))
+ 'nov)))
(deffoo nnslashdot-request-group (group &optional server dont-check)
(nnslashdot-possibly-change-server nil server)
(while (> (- nnslashdot-group-number number) 0)
(with-temp-buffer
(let ((case-fold-search t))
- (url-insert-file-contents (format nnslashdot-active-url number))
- (setq buffer-file-name nil)
+ (nnweb-insert (format nnslashdot-active-url number))
(goto-char (point-min))
(while (re-search-forward
"article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>" nil t)
(nnslashdot-generate-active)
t)
-(deffoo nnslashdot-asynchronous-p ()
- nil)
-
(nnoo-define-skeleton nnslashdot)
;;; Internal functions
(nnheader-set-temp-buffer
(format " *nnslashdot %s*" server))))))
-(defun nnslashdot-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (function
- (lambda (data)
- (concat (w3-form-encode-xwfu (car data)) "="
- (w3-form-encode-xwfu (cdr data)))))
- pairs "&"))
-
-(defun nnslashdot-fetch-form (url pairs)
- (let ((url-request-data (nnslashdot-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun nnslashdot-decode-entities ()
- (goto-char (point-min))
- (while (re-search-forward "&\\([a-z]+\\);" nil t)
- (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
- w3-html-entities))
- ?#))
- t t)))
-
-(defun nnslashdot-remove-markup ()
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
- (goto-char (point-min))
- (while (re-search-forward "<[^>]+>" nil t)
- (replace-match "" t t)))
-
(defun nnslashdot-date-to-date (sdate)
(let ((elem (split-string sdate)))
(concat (substring (nth 0 elem) 0 3) " "
-;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board
+;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
;; Copyright (C) 1999 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
"Where nnultimate will save its files.")
-(defvoo nnultimate-address-1 "http://debet.solbors.no/cgi-bin/billboard/"
+(defvoo nnultimate-address ""
"The address of the Ultimate bulletin board.")
;;; Internal variables
-(defvar nnultimate-groups nil)
-(defvar nnultimate-buffer nil)
-(defvar nnultimate-headers nil)
-(defvar nnultimate-articles nil)
+(defvar nnultimate-groups-alist nil)
+(defvoo nnultimate-groups nil)
+(defvoo nnultimate-headers nil)
+(defvoo nnultimate-articles nil)
;;; Interface functions
(mapping (nth 5 entry))
(old-total (or (nth 6 entry) 0))
(furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000")
- (turl "http://debet.solbors.no/billboard/Forum%d/HTML/%06d.html")
headers article subject score from date lines parent point
- contents tinfo fetchers map elem)
- (save-excursion
- (set-buffer nnultimate-buffer)
- (erase-buffer)
- (url-insert-file-contents
- (concat nnultimate-address-1 (format furl sid)))
- (setq buffer-file-name nil)
+ contents tinfo fetchers map elem a href garticles topic old-max
+ inc datel)
+ (with-temp-buffer
+ (nnweb-insert (concat nnultimate-address (format furl sid)))
(goto-char (point-min))
(setq contents (nth 2 (car (nth 2
(nnultimate-find-forum-table
;; topic one and 10 will be the 2 in topic three.
(dolist (row (cdr contents))
(setq row (nth 2 row))
- (when (setq a (nnultimate-descend 'a (nth 2 row)))
- (setq subject (car (last (nnultimate-text a)))
+ (when (setq a (nnweb-parse-find 'a row))
+ (setq subject (car (last (nnweb-text a)))
href (cdr (assq 'href (nth 1 a))))
- (setq garticles (1+ (string-to-number (car (last (nnultimate-text
- (nth 4 row)))))))
+ (let ((artlist (nreverse (nnweb-text row)))
+ art)
+ (while (and (not art)
+ artlist)
+ (when (string-match "^[0-9]+$" (car artlist))
+ (setq art (1+ (string-to-number (car artlist)))))
+ (pop artlist))
+ (setq garticles art))
(string-match "/\\([0-9]+\\).html" href)
(setq topic (string-to-number (match-string 1 href)))
(if (setq tinfo (assq topic topics))
(setq old-max (cadr tinfo))
(setcar (cdr tinfo) garticles))
(setq old-max 0)
- (push (list topic garticles subject) topics)
+ (push (list topic garticles subject href) topics)
(setcar (nthcdr 4 entry) topics))
(when (not (= old-max garticles))
(setq inc (- garticles old-max))
(dolist (elem fetchers)
(erase-buffer)
(setq subject (nth 2 (assq (car elem) topics)))
- (url-insert-file-contents (format turl sid (car elem)))
- (setq buffer-file-name nil)
+ (nnweb-insert (nth 3 (assq (car elem) topics)))
(goto-char (point-min))
+ (setq a (w3-parse-buffer (current-buffer)))
(setq contents
(cdr
(nth 2 (car (nth 2
contents (nth 1 articlef)
subject (nth 2 articlef))
(setq from (mapconcat 'identity
- (nnultimate-text (car (nth 2 contents)))
+ (nnweb-text (car (nth 2 contents)))
" ")
- datel (nnultimate-text (nth 2 (car (cdr (nth 2 contents))))))
+ datel (nnweb-text (nth 2 (car (cdr (nth 2 contents))))))
(while datel
(when (string-match "Posted" (car datel))
(setq date (substring (car datel) (match-end 0))
(concat "<" (number-to-string sid) "%"
(number-to-string article)
"@ultimate>")
- "" 0 0 nil nil))
+ "" 0
+ (/ (length (mapconcat
+ 'identity
+ (nnweb-text
+ (cdr (nth 2 (nth 1 (nth 2 contents)))))
+ ""))
+ 70)
+ nil nil))
headers))
(setq nnultimate-headers (sort headers 'car-less-than-car))
(save-excursion
(deffoo nnultimate-request-group (group &optional server dont-check)
(nnultimate-possibly-change-server nil server)
+ (when (or (not dont-check)
+ (not nnultimate-groups))
+ (nnultimate-request-list))
(let ((elem (assoc group nnultimate-groups)))
(cond
((not elem)
"211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
(prin1-to-string group))))))
-(deffoo nnultimate-close-group (group &optional server)
- (nnultimate-possibly-change-server group server)
- (when (gnus-buffer-live-p nnultimate-buffer)
- (save-excursion
- (set-buffer nnultimate-buffer)
- (kill-buffer nnultimate-buffer)))
- t)
-
(deffoo nnultimate-request-article (article &optional group server buffer)
(nnultimate-possibly-change-server group server)
(let ((contents (cdr (assq article nnultimate-articles))))
- (setq contents (cdr (nth 2 (nth 1 (nth 2 (car contents))))))
+ (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents))))))
(when contents
(save-excursion
(set-buffer (or buffer nntp-server-buffer))
(erase-buffer)
- (apply 'insert (nnultimate-text contents))
+ (nnweb-insert-html (cons 'p (cons nil (list contents))))
(goto-char (point-min))
(insert "Content-Type: text/html\nMIME-Version: 1.0\n")
(let ((header (cdr (assq article nnultimate-headers))))
(nnheader-report 'nnultimate "Fetched article %s" article)
(cons group article)))))
-(deffoo nnultimate-close-server (&optional server)
- (when (and (nnultimate-server-opened server)
- (gnus-buffer-live-p nnultimate-buffer))
- (save-excursion
- (set-buffer nnultimate-buffer)
- (kill-buffer nnultimate-buffer)))
- (nnoo-close-server 'nnultimate server))
-
(deffoo nnultimate-request-list (&optional server)
(nnultimate-possibly-change-server nil server)
(with-temp-buffer
- (url-insert-file-contents (concat nnultimate-address-1 "Ultimate.cgi"))
- (setq buffer-file-name nil)
+ (nnweb-insert (concat nnultimate-address "Ultimate.cgi"))
(let ((contents (nth 2 (car (nth 2
(nnultimate-find-forum-table
(w3-parse-buffer (current-buffer)))))))
- sid elem description articles a href group)
+ sid elem description articles a href group forum
+ a1 a2)
(dolist (row contents)
(setq row (nth 2 row))
- (when (setq a (nnultimate-descend 'a row))
- (setq group (car (last (nnultimate-text a)))
+ (when (setq a (nnweb-parse-find 'a row))
+ (setq group (car (last (nnweb-text a)))
href (cdr (assq 'href (nth 1 a))))
- (setq description (car (last (nnultimate-text (nth 1 row)))))
- (setq articles (string-to-number (car (last (nnultimate-text
- (nth 2 row))))))
+ (setq description (car (last (nnweb-text (nth 1 row)))))
+ (setq a1 (car (last (nnweb-text (nth 2 row)))))
+ (setq a2 (car (last (nnweb-text (nth 3 row)))))
+ (when (string-match "^[0-9]+$" a1)
+ (setq articles (string-to-number a1)))
+ (when (and a2 (string-match "^[0-9]+$" a2))
+ (setq articles (max articles (string-to-number a2))))
(when href
(string-match "number=\\([0-9]+\\)" href)
(setq forum (string-to-number (match-string 1 href)))
(nnultimate-generate-active)
t)
-(deffoo nnultimate-asynchronous-p ()
- nil)
-
(nnoo-define-skeleton nnultimate)
;;; Internal functions
(when (and server
(not (nnultimate-server-opened server)))
(nnultimate-open-server server))
- (unless nnultimate-groups
- (nnultimate-read-groups)))
+ (unless nnultimate-groups-alist
+ (nnultimate-read-groups))
+ (setq nnultimate-groups (cdr (assoc nnultimate-address
+ nnultimate-groups-alist))))
+
+(deffoo nnultimate-open-server (server &optional defs connectionless)
+ (nnheader-init-server-buffer)
+ (if (nnultimate-server-opened server)
+ t
+ (unless (assq 'nnultimate-address defs)
+ (setq defs (append defs (list (list 'nnultimate-address server)))))
+ (nnoo-change-server 'nnultimate server defs)))
(defun nnultimate-read-groups ()
(let ((file (expand-file-name "groups" nnultimate-directory)))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
- (setq nnultimate-groups (read (current-buffer)))))))
+ (setq nnultimate-groups-alist (read (current-buffer)))))))
(defun nnultimate-write-groups ()
+ (setq nnultimate-groups-alist
+ (delq (assoc nnultimate-address nnultimate-groups-alist)
+ nnultimate-groups-alist))
+ (push (cons nnultimate-address nnultimate-groups)
+ nnultimate-groups-alist)
(with-temp-file (expand-file-name "groups" nnultimate-directory)
- (prin1 nnultimate-groups (current-buffer))))
+ (prin1 nnultimate-groups-alist (current-buffer))))
(defun nnultimate-init (server)
"Initialize buffers and such."
(unless (file-exists-p nnultimate-directory)
- (gnus-make-directory nnultimate-directory))
- (unless (gnus-buffer-live-p nnultimate-buffer)
- (setq nnultimate-buffer
- (save-excursion
- (nnheader-set-temp-buffer
- (format " *nnultimate %s*" server))))))
-
-(defun nnultimate-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (function
- (lambda (data)
- (concat (w3-form-encode-xwfu (car data)) "="
- (w3-form-encode-xwfu (cdr data)))))
- pairs "&"))
-
-(defun nnultimate-fetch-form (url pairs)
- (let ((url-request-data (nnultimate-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun nnultimate-decode-entities ()
- (goto-char (point-min))
- (while (re-search-forward "&\\([a-z]+\\);" nil t)
- (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
- w3-html-entities))
- ?#))
- t t)))
-
-(defun nnultimate-remove-markup ()
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
- (goto-char (point-min))
- (while (re-search-forward "<[^>]+>" nil t)
- (replace-match "" t t)))
+ (gnus-make-directory nnultimate-directory)))
(defun nnultimate-date-to-date (sdate)
(let ((elem (split-string sdate)))
(dolist (element contents)
(unless (stringp element)
(when (and (eq (car element) 'table)
- (equalp (cdr (assq 'width (cadr element))) "100%"))
+ (nnultimate-forum-table-p element))
(throw 'found element))
(when (nth 2 element)
(nnultimate-find-forum-table-1 (nth 2 element))))))
-(defun nnultimate-descend (type contents)
- (catch 'found
- (nnultimate-descend-1 type contents)))
-
-(defun nnultimate-descend-1 (type contents)
- (when (consp contents)
- (when (eq (car contents) type)
- (throw 'found contents))
- (when (listp (cdr contents))
- (dolist (element contents)
- (when (consp element)
- (nnultimate-descend-1 type element))))))
-
-(defvar nnultimate-text)
-(defun nnultimate-text (contents)
- (let ((nnultimate-text nil))
- (nnultimate-text-1 contents)
- (nreverse nnultimate-text)))
-
-(defun nnultimate-text-1 (contents)
- (when (consp (car contents))
- (dolist (element contents)
- (if (stringp element)
- (push element nnultimate-text)
- (when (consp element)
- (nnultimate-text-1 (nth 2 element)))))))
-
-
-(defun nnultimate-text-1 (contents)
- (dolist (element contents)
- (if (stringp element)
- (push element nnultimate-text)
- (when (and (consp element)
- (listp (cdr element)))
- (nnultimate-text-1 element)))))
+(defun nnultimate-forum-table-p (parse)
+ (when (not (apply 'gnus-or
+ (mapcar
+ (lambda (p)
+ (nnweb-parse-find 'table p))
+ (nth 2 parse))))
+ (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
+ case-fold-search)
+ (when (and href (string-match "forumdisplay\\|Forum[0-9]+/HTML\\|getbio"
+ href))
+ t))))
(provide 'nnultimate)
(url-retrieve url))
(setq-default url-be-asynchronous old-asynch)))
-(defun nnweb-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (function
- (lambda (data)
- (concat (w3-form-encode-xwfu (car data)) "="
- (w3-form-encode-xwfu (cdr data)))))
- pairs "&"))
-
-(defun nnweb-fetch-form (url pairs)
- (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun nnweb-decode-entities ()
- (goto-char (point-min))
- (while (re-search-forward "&\\([a-z]+\\);" nil t)
- (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
- w3-html-entities))
- ?#))
- t t)))
-
-(defun nnweb-remove-markup ()
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
- (goto-char (point-min))
- (while (re-search-forward "<[^>]+>" nil t)
- (replace-match "" t t)))
-
;;;
;;; DejaNews functions.
;;;
(setq buffer-file-name nil)
t)
+;;;
+;;; General web/w3 interface utility functions
+;;;
+
+(defun nnweb-insert-html (parse)
+ "Insert HTML based on a w3 parse tree."
+ (if (stringp parse)
+ (insert parse)
+ (insert "<" (symbol-name (car parse)) " ")
+ (insert (mapconcat
+ (lambda (param)
+ (concat (symbol-name (car param)) "="
+ (prin1-to-string
+ (if (consp (cdr param))
+ (cadr param)
+ (cdr param)))))
+ (nth 1 parse)
+ " "))
+ (insert ">\n")
+ (mapcar 'nnweb-insert-html (nth 2 parse))
+ (insert "</" (symbol-name (car parse)) ">\n")))
+
+(defun nnweb-encode-www-form-urlencoded (pairs)
+ "Return PAIRS encoded for forms."
+ (mapconcat
+ (function
+ (lambda (data)
+ (concat (w3-form-encode-xwfu (car data)) "="
+ (w3-form-encode-xwfu (cdr data)))))
+ pairs "&"))
+
+(defun nnweb-fetch-form (url pairs)
+ "Fetch a form from URL with PAIRS as the data."
+ (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
+ (url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-type" . "application/x-www-form-urlencoded"))))
+ (url-insert-file-contents url)
+ (setq buffer-file-name nil))
+ t)
+
+(defun nnweb-decode-entities ()
+ "Decode all HTML entities."
+ (goto-char (point-min))
+ (while (re-search-forward "&\\([a-z]+\\);" nil t)
+ (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
+ w3-html-entities))
+ ?#))
+ t t)))
+
+(defun nnweb-remove-markup ()
+ "Remove all HTML markup, leaving just plain text."
+ (goto-char (point-min))
+ (while (search-forward "<!--" nil t)
+ (delete-region (match-beginning 0)
+ (or (search-forward "-->" nil t)
+ (point-max))))
+ (goto-char (point-min))
+ (while (re-search-forward "<[^>]+>" nil t)
+ (replace-match "" t t)))
+
+(defun nnweb-insert (url)
+ "Insert the contents from an URL in the current buffer."
+ (let ((name buffer-file-name))
+ (url-insert-file-contents url)
+ (setq buffer-file-name name)))
+
+(defun nnweb-parse-find (type parse &optional maxdepth)
+ "Find the element of TYPE in PARSE."
+ (catch 'found
+ (nnweb-parse-find-1 type parse maxdepth)))
+
+(defun nnweb-parse-find-1 (type contents maxdepth)
+ (when (or (null maxdepth)
+ (not (zerop maxdepth)))
+ (when (consp contents)
+ (when (eq (car contents) type)
+ (throw 'found contents))
+ (when (listp (cdr contents))
+ (dolist (element contents)
+ (when (consp element)
+ (nnweb-parse-find-1 type element
+ (and maxdepth (1- maxdepth)))))))))
+
+(defvar nnweb-text)
+(defun nnweb-text (parse)
+ "Return a list of text contents in PARSE."
+ (let ((nnweb-text nil))
+ (nnweb-text-1 parse)
+ (nreverse nnweb-text)))
+
+(defun nnweb-text-1 (contents)
+ (dolist (element contents)
+ (if (stringp element)
+ (push element nnweb-text)
+ (when (and (consp element)
+ (listp (cdr element)))
+ (nnweb-text-1 element)))))
+
(provide 'nnweb)
;;; nnweb.el ends here
projects / gnus / commitdiff