1;;; sb-tigris.el --- shimbun backend for tigris.org ML 2 3;; Copyright (C) 2005, 2007, 2009, 2017, 2019 4;; Tsuyoshi CHO <Tsuyoshi.CHO@Gmail.com> 5 6;; Author: Tsuyoshi CHO <Tsuyoshi.CHO@Gmail.com> 7;; Keywords: news 8 9;; This file is a part of shimbun. 10 11;; This program is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; This program is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with this program; see the file COPYING. If not, write to 23;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Code: 27 28(eval-when-compile (require 'cl-lib)) ;; cl-incf 29(require 'shimbun) 30 31(luna-define-class shimbun-tigris (shimbun) ()) 32 33(defvar shimbun-tigris-server-name "tigris.org") 34(defvar shimbun-tigris-url-regexp "http://%s.tigris.org/servlets/SummarizeList?listName=%s") 35(defcustom shimbun-tigris-group-alist 36 '(("subversion" . ("announce" "dev" "issues" "svn" "svn-breakage" "users" 37 "l10n-es" "l10n-fr")) 38 ("rapidsvn" . ("users" "issues" "announce" "dev" "cvs")) 39 ("tortoisesvn" . ("dev" "announce" "patches")) 40 ("scarab" . ("announce" "dev" "users" "cvs" "issues")) 41 ("xmlbasedsrs" . ("dev" "cvs" "announce" "users")) 42 ("argouml" . ("announce" "issues" "cvs" "users" "dev" "modules-dev" 43 "mda" "user-group-sweden" "users-espanol")) 44 ("eyebrowse" . ("announce" "dev" "users" "cvs" "issues")) 45 ("binarycloud" . ("users" "issues" "cvs" "dev")) 46 ("phpcreate" . ("dev" "announce" "issues" "users")) 47 ("lptools" . ("dev" "cvs" "announce" "issues" "users")) 48 ("maxq" . ("users" "dev" "issues")) 49 ("aut" . ("dev" "cvs" "announce" "issues" "users")) 50 ("current" . ("dev" "cvs" "announce" "issues" "users")) 51 ("readyset" . ("dev" "cvs" "issues" "announce")) 52 ("gef" . ("issues" "dev" "users" "cvs" "announce")) 53 ("axion" . ("dev" "cvs" "announce" "issues" "users")) 54 ("style" . ("dev" "cvs" "announce" "issues" "users")) 55 ("sstree" . ("issues" "dev" "cvs")) 56 ("readings" . ("discuss" "issues" "announce" "cvs" "suggest")) 57 ("spin" . ("dev" "cvs" "announce" "issues" "users")) 58 ("elmuth" . ("users" "dev" "cvs" "announce" "issues")) 59 ("ankhsvn" . ("issues" "users" "announce" "cvs" "svn-commit" 60 "Draco-build")) 61 ) 62 "List of mailing lists serverd by Tigris.org." 63 :group 'shimbun 64 :type '(repeat 65 (cons 66 :format "%v" :indent 0 67 (string :format "Project Name: %v") 68 (repeat 69 :format "%v%i\n" :indent 12 70 (string :format "ML: %v")))) 71 ) 72 73(defmacro shimbun-tigris-get-project (shimbun) 74 `(nth 0 (split-string 75 (shimbun-current-group-internal ,shimbun) 76 "\\."))) 77 78(defmacro shimbun-tigris-get-ml-name (shimbun) 79 `(nth 1 (split-string 80 (shimbun-current-group-internal ,shimbun) 81 "\\."))) 82 83(luna-define-method shimbun-groups ((shimbun shimbun-tigris)) 84 "return groups : project.ml-name" 85 (let (groups) 86 (dolist (project shimbun-tigris-group-alist) 87 (let ((mls (cdr project))) 88 (dolist (ml-name mls) 89 (push (concat (car project) "." ml-name) groups)))) 90 groups)) 91 92(luna-define-method shimbun-index-url ((shimbun shimbun-tigris)) 93 (shimbun-expand-url 94 (format shimbun-tigris-url-regexp 95 (shimbun-tigris-get-project shimbun) 96 (shimbun-tigris-get-ml-name shimbun) 97 ))) 98 99(defun shimbun-tigris-remove-amp (url) 100 "Remove URL & -> &" 101 (save-match-data 102 (while (string-match "&" url) 103 (setq url (replace-match "&" nil nil url)))) 104 url) 105 106(luna-define-method shimbun-get-headers ((shimbun shimbun-tigris) 107 &optional range) 108 (save-excursion 109 (let ((case-fold-search t) 110 (pages (shimbun-header-index-pages range)) 111 (link-regexp 112 (format "http://%s.tigris.org/servlets/BrowseList\\?listName=%s&\\(amp;\\)?by=date&\\(amp;\\)?.*" 113 (shimbun-tigris-get-project shimbun) 114 (shimbun-tigris-get-ml-name shimbun))) 115 indexes headers) 116 (goto-char (point-min)) 117 (search-forward "inclsummarizeby") ;; top of links 118 (while (re-search-forward "<a +href=\"\\([^\"]+\\)\"" nil t) 119 (let ((url (match-string 1))) 120 (when (and url 121 (string-match link-regexp url)) 122 (push (concat (shimbun-tigris-remove-amp url) "&paged=false") indexes)))) 123 (setq indexes (nreverse indexes)) 124 (catch 'stop 125 (let ((count 0) url) 126 (while (and indexes 127 (if pages (<= (cl-incf count) pages) t)) 128 (erase-buffer) 129 (setq url (pop indexes)) 130 (shimbun-retrieve-url url) 131 (goto-char (point-min)) 132 (while (re-search-forward "<tr[^>]*>\\s *\ 133<td[^>]*>\\([^<]+\\)</td>\\s *\ 134<td[^>]*>\\s *<a *href=\"\\([^\"]+\\)\"[^>]*>\\([^<]+\\)</a>\\s *</td>\\s *\ 135<td[^>]*>\\([^<]+\\)</td>\\s *\ 136</tr>" nil t) 137 (let* ((from (match-string-no-properties 1)) 138 (url (shimbun-tigris-remove-amp (match-string-no-properties 2))) 139 (title (match-string-no-properties 3)) 140 (date (match-string-no-properties 4)) 141 (count 0) 142 id) 143 (when (string-match ".*msgNo=\\([0-9]+\\).*" url) 144 (setq count (string-to-number (match-string 1 url)))) 145 (setq id (format "<%d%%%s.%s.%s>" 146 count 147 (shimbun-tigris-get-ml-name shimbun) 148 (shimbun-tigris-get-project shimbun) 149 shimbun-tigris-server-name 150 )) 151 (if (and (stringp date) 152 (string-match "\\([0-9]*\\)-\\([0-9]*\\)-\\([0-9]*\\)" date)) 153 (setq date (shimbun-make-date-string 154 (string-to-number (match-string 1 date)) 155 (string-to-number (match-string 2 date)) 156 (string-to-number (match-string 3 date)))) 157 (setq date nil)) 158 ;; change to raw page 159 (setq url (shimbun-expand-url 160 (concat url "&raw=true"))) 161 (when (shimbun-search-id shimbun id) 162 (throw 'stop nil)) 163 (push (shimbun-create-header 164 count title 165 from 166 date 167 id "" 0 0 url) 168 headers)))))) 169 headers))) 170 171(luna-define-method shimbun-make-contents ((shimbun shimbun-tigris) 172 header) 173 (let ((case-fold-search t) 174 (beg nil) 175 (end nil)) 176 (when (search-forward "<PRE>") 177 (forward-line 1) 178 (beginning-of-line) 179 (setq beg (point)) 180 (delete-region (point-min) beg)) 181 (when (search-forward "</PRE>") 182 (forward-line -1) 183 (end-of-line) 184 (setq end (point)) 185 (delete-region end (point-max))) 186 ;; replace "<" -> "<" 187 (goto-char (point-min)) 188 (while (search-forward "<" nil t) 189 (replace-match "<")) 190 ;; header edit if deleted 191 (goto-char (point-min)) 192 (when (and beg end) 193 (when (re-search-forward "^$" nil t) ;; end of header 194 (goto-char (match-end 0)) 195 (when (re-search-backward "^Message-ID" nil t) 196 (replace-match "X-Original-Message-ID"))) ;; replace msg-id to x-ori-msg-id 197 (goto-char (point-min)) 198 (insert (concat "Message-ID: " (shimbun-header-id header) "\n")) ;; add msg-id 199 (insert (concat "Xref: " (shimbun-header-xref header) "\n")) ;; add Xref 200 )) 201 (buffer-string)) 202 203(provide 'sb-tigris) 204 205;;; sb-tigris.el ends here 206