API tools faq
paste
Guest User

Untitled

a guest
Jul 30th, 2023
136
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 27.48 KB | Source Code | 0 0
raw download clone embed print report
  1. diff --git a/Makefile.am b/Makefile.am
  2. index 799bef7..6f7f26e 100644
  3. --- a/Makefile.am
  4. +++ b/Makefile.am
  5. @@ -6,6 +6,7 @@ lisp_LISP = navi2ch-version.el \
  6. navi2ch-board.el navi2ch-articles.el navi2ch-bookmark.el \
  7. navi2ch-history.el navi2ch-search.el navi2ch-message.el \
  8. navi2ch.el \
  9. + navi2ch-inline.el \
  10. navi2ch-head.el navi2ch-mona.el navi2ch-e21.el navi2ch-xmas.el \
  11. navi2ch-splash.el navi2ch-directory.el \
  12. navi2ch-be2ch.el navi2ch-multibbs.el \
  13. diff --git a/Makefile.in b/Makefile.in
  14. index cb43249..9d57377 100644
  15. --- a/Makefile.in
  16. +++ b/Makefile.in
  17. @@ -175,6 +175,7 @@ lisp_LISP = navi2ch-version.el \
  18. navi2ch-board.el navi2ch-articles.el navi2ch-bookmark.el \
  19. navi2ch-history.el navi2ch-search.el navi2ch-message.el \
  20. navi2ch.el \
  21. + navi2ch-inline.el \
  22. navi2ch-head.el navi2ch-mona.el navi2ch-e21.el navi2ch-xmas.el \
  23. navi2ch-splash.el navi2ch-directory.el \
  24. navi2ch-be2ch.el navi2ch-multibbs.el \
  25. diff --git a/bcomp.el b/bcomp.el
  26. index 0c4017d..0090f5b 100644
  27. --- a/bcomp.el
  28. +++ b/bcomp.el
  29. @@ -7,7 +7,7 @@
  30.  
  31. (setq bcomp-files
  32. '(
  33. - "navi2ch-version.el" "navi2ch-vars.el" "navi2ch-face.el" "navi2ch-util.el" "navi2ch-net.el" "navi2ch-list.el" "navi2ch-article.el" "navi2ch-popup-article.el" "navi2ch-board-misc.el" "navi2ch-board.el" "navi2ch-articles.el" "navi2ch-bookmark.el" "navi2ch-history.el" "navi2ch-search.el" "navi2ch-message.el" "navi2ch.el" "navi2ch-head.el" "navi2ch-mona.el" "navi2ch-e21.el" "navi2ch-xmas.el" "navi2ch-splash.el" "navi2ch-directory.el" "navi2ch-be2ch.el" "navi2ch-multibbs.el" "navi2ch-jbbs-net.el" "navi2ch-jbbs-shitaraba.el" "navi2ch-machibbs.el" "navi2ch-futaba.el" "navi2ch-megabbs.el" "navi2ch-http-date.el" "navi2ch-localfile.el" "navi2ch-oyster.el" "navi2ch-auto-modify.el" "navi2ch-p2.el" "navi2ch-thumbnail.el"
  34. + "navi2ch-version.el" "navi2ch-vars.el" "navi2ch-face.el" "navi2ch-util.el" "navi2ch-net.el" "navi2ch-list.el" "navi2ch-article.el" "navi2ch-popup-article.el" "navi2ch-board-misc.el" "navi2ch-board.el" "navi2ch-articles.el" "navi2ch-bookmark.el" "navi2ch-history.el" "navi2ch-search.el" "navi2ch-message.el" "navi2ch.el" "navi2ch-inline.el" "navi2ch-head.el" "navi2ch-mona.el" "navi2ch-e21.el" "navi2ch-xmas.el" "navi2ch-splash.el" "navi2ch-directory.el" "navi2ch-be2ch.el" "navi2ch-multibbs.el" "navi2ch-jbbs-net.el" "navi2ch-jbbs-shitaraba.el" "navi2ch-machibbs.el" "navi2ch-futaba.el" "navi2ch-megabbs.el" "navi2ch-http-date.el" "navi2ch-localfile.el" "navi2ch-oyster.el" "navi2ch-auto-modify.el" "navi2ch-p2.el" "navi2ch-thumbnail.el"
  35. ))
  36.  
  37. (let* ((dir (expand-file-name default-directory))
  38. diff --git a/navi2ch-article.el b/navi2ch-article.el
  39. index cf5be30..c2b9923 100644
  40. --- a/navi2ch-article.el
  41. +++ b/navi2ch-article.el
  42. @@ -38,6 +38,7 @@
  43. (defvar navi2ch-board-last-seen-alist)
  44. (defvar navi2ch-popup-article-current-board)
  45. (defvar navi2ch-popup-article-current-article)
  46. + (require 'navi2ch-inline)
  47. (require 'wid-edit))
  48.  
  49. (require 'base64)
  50. diff --git a/navi2ch-be2ch.el b/navi2ch-be2ch.el
  51. index 848e510..0cb9796 100644
  52. --- a/navi2ch-be2ch.el
  53. +++ b/navi2ch-be2ch.el
  54. @@ -27,9 +27,9 @@
  55. ;;; Code:
  56. (provide 'navi2ch-be2ch)
  57.  
  58. -(eval-when-compile (require 'cl))
  59. +(eval-when-compile
  60. + (require 'cl))
  61. (require 'navi2ch-net)
  62. -(require 'navi2ch-util)
  63.  
  64. (defconst navi2ch-be2ch-ident
  65. "$Id$")
  66. diff --git a/navi2ch-board-misc.el b/navi2ch-board-misc.el
  67. index 5247768..4f53439 100644
  68. --- a/navi2ch-board-misc.el
  69. +++ b/navi2ch-board-misc.el
  70. @@ -32,6 +32,7 @@
  71.  
  72. (eval-when-compile
  73. (require 'cl)
  74. + (require 'navi2ch-inline)
  75. (defvar navi2ch-board-last-seen-alist)
  76. (defvar navi2ch-board-subject-alist)
  77. (defvar navi2ch-board-current-board))
  78. diff --git a/navi2ch-e21.el b/navi2ch-e21.el
  79. index 423bbd0..a3d8011 100644
  80. --- a/navi2ch-e21.el
  81. +++ b/navi2ch-e21.el
  82. @@ -30,7 +30,10 @@
  83. (provide 'navi2ch-e21)
  84. (defconst navi2ch-e21-ident
  85. "$Id$")
  86. -(require 'navi2ch)
  87. +
  88. +(eval-when-compile
  89. + (require 'navi2ch-vars)
  90. + (require 'navi2ch-inline))
  91.  
  92. ;;; 以下、Wanderlust (wl-e21.el) からほとんどコピペ。これ最強。
  93. (add-hook 'navi2ch-hook 'navi2ch-offline-init-icons)
  94. diff --git a/navi2ch-inline.el b/navi2ch-inline.el
  95. new file mode 100644
  96. index 0000000..e810625
  97. --- /dev/null
  98. +++ b/navi2ch-inline.el
  99. @@ -0,0 +1,89 @@
  100. +;;; navi2ch-inline.el --- User variables for navi2ch. -*- coding: iso-2022-7bit; -*-
  101. +
  102. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2023
  103. +;; by Navi2ch Project
  104. +
  105. +;; Author: Taiki SUGAWARA <[email protected]>
  106. +;; Keywords: www 2ch
  107. +
  108. +;; This file is free software; you can redistribute it and/or modify
  109. +;; it under the terms of the GNU General Public License as published by
  110. +;; the Free Software Foundation; either version 2, or (at your option)
  111. +;; any later version.
  112. +
  113. +;; This file is distributed in the hope that it will be useful,
  114. +;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  115. +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  116. +;; GNU General Public License for more details.
  117. +
  118. +;; You should have received a copy of the GNU General Public License
  119. +;; along with GNU Emacs; see the file COPYING. If not, write to
  120. +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  121. +;; Boston, MA 02111-1307, USA.
  122. +
  123. +;;; Commentary:
  124. +
  125. +;;
  126. +
  127. +;;; Code:
  128. +(provide 'navi2ch-inline)
  129. +
  130. +;;;; macros
  131. +;;; navi2ch-util
  132. +(defmacro navi2ch-with-default-file-modes (mode &rest body)
  133. + "default-file-modes を MODE にして BODY を実行する。"
  134. + (let ((temp (make-symbol "--file-modes-temp--")))
  135. + `(let ((,temp (default-file-modes)))
  136. + (unwind-protect
  137. + (progn
  138. + (set-default-file-modes
  139. + (navi2ch-ifxemacs
  140. + (if (integerp ,mode)
  141. + ,mode
  142. + (char-to-int ,mode))
  143. + ,mode))
  144. + ,@body)
  145. + (set-default-file-modes ,temp)))))
  146. +
  147. +(put 'navi2ch-with-default-file-modes 'lisp-indent-function 1)
  148. +
  149. +(defmacro navi2ch-cache-get (key value cache)
  150. + `(or (gethash ,key (navi2ch-cache-hash-table ,cache))
  151. + (navi2ch-cache-put ,key ,value ,cache)))
  152. +
  153. +(defmacro navi2ch-region-active-p ()
  154. + "Say whether the region is active."
  155. + (if (fboundp 'region-active-p)
  156. + (list 'region-active-p)
  157. + (list 'and 'transient-mark-mode 'mark-active)))
  158. +
  159. +(defmacro navi2ch-defalias-maybe (symbol definition)
  160. + "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
  161. +See also the function `defalias'."
  162. + (setq symbol (eval symbol))
  163. + (or (and (fboundp symbol)
  164. + (not (get symbol 'defalias-maybe)))
  165. + `(or (fboundp (quote ,symbol))
  166. + (prog1
  167. + (defalias (quote ,symbol) ,definition)
  168. + ;; `defalias' updates `load-history' internally.
  169. + (put (quote ,symbol) 'defalias-maybe t)))))
  170. +
  171. +(defmacro navi2ch-ifxemacs (then &rest else)
  172. + "If on XEmacs, do THEN, else do ELSE.
  173. +Like \"(if (featurep 'xemacs) THEN ELSE)\", but expanded at
  174. +compilation time. Because byte-code of XEmacs is not compatible with
  175. +GNU Emacs's one, this macro is very useful."
  176. + (if (featurep 'xemacs)
  177. + then
  178. + (cons 'progn else)))
  179. +;; Navi2chのコードをハクする人は↓を~/.emacsにも入れときましょう。
  180. +(put 'navi2ch-ifxemacs 'lisp-indent-function 1)
  181. +
  182. +(defmacro navi2ch-ifemacsce (then &rest else)
  183. + "If on EmacsCE, do THEN, else do ELSE.
  184. +Expanded at compilation time."
  185. + `(if (string-match "windowsce" system-configuration)
  186. + ,then
  187. + (progn ,@else)))
  188. +(put 'navi2ch-ifemacsce 'lisp-indent-function 1)
  189. diff --git a/navi2ch-jbbs-net.el b/navi2ch-jbbs-net.el
  190. index 9db69ea..3232ac4 100644
  191. --- a/navi2ch-jbbs-net.el
  192. +++ b/navi2ch-jbbs-net.el
  193. @@ -32,6 +32,8 @@
  194. (defconst navi2ch-jbbs-net-ident
  195. "$Id$")
  196.  
  197. +(eval-when-compile
  198. + (require 'navi2ch-inline))
  199. (require 'navi2ch-multibbs)
  200.  
  201. (defvar navi2ch-jbbs-func-alist
  202. diff --git a/navi2ch-jbbs-shitaraba.el b/navi2ch-jbbs-shitaraba.el
  203. index 1b05a25..1f7964c 100644
  204. --- a/navi2ch-jbbs-shitaraba.el
  205. +++ b/navi2ch-jbbs-shitaraba.el
  206. @@ -34,7 +34,8 @@
  207. "$Id$")
  208.  
  209. (eval-when-compile
  210. - (require 'cl))
  211. + (require 'cl)
  212. + (require 'navi2ch-inline))
  213.  
  214. (require 'navi2ch-util)
  215. (require 'navi2ch-multibbs)
  216. diff --git a/navi2ch-list.el b/navi2ch-list.el
  217. index 4188735..3860665 100644
  218. --- a/navi2ch-list.el
  219. +++ b/navi2ch-list.el
  220. @@ -37,7 +37,6 @@
  221. (defvar navi2ch-board-buffer-name)
  222. (defvar navi2ch-board-current-board))
  223.  
  224. -(require 'navi2ch)
  225.  
  226. (defvar navi2ch-list-mode-map nil)
  227. (unless navi2ch-list-mode-map
  228. @@ -94,7 +93,9 @@
  229. (nil " " navi2ch-list-board-name-face))))
  230.  
  231. (defconst navi2ch-list-bbstable-default-url
  232. - "http://menu.2ch.net/bbsmenu.html")
  233. + (if (fboundp 'json-parse-string)
  234. + "https://menu.5ch.net/bbsmenu.json"
  235. + "https://menu.5ch.net/bbsmenu.html"))
  236.  
  237. ;; add hook
  238. (add-hook 'navi2ch-save-status-hook 'navi2ch-list-save-info)
  239. @@ -567,10 +568,56 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  240. (let ((board-id (cdr (assoc url navi2ch-list-board-id-alist))))
  241. (or board-id
  242. (save-match-data
  243. - (if (string-match "\\`http://.+/\\([^/]+\\)/\\'" url)
  244. + (if (string-match "\\`https?://.+/\\([^/]+\\)/\\'" url)
  245. (match-string 1 url))))))
  246.  
  247. +
  248. (defun navi2ch-list-make-board-txt ()
  249. + (if (and navi2ch-list-media-type
  250. + (string-equal (cdr navi2ch-list-media-type) "application/json"))
  251. + (navi2ch-list-make-board-txt-from-json)
  252. + (navi2ch-list-make-board-txt-from-html)))
  253. +
  254. +(defun navi2ch-list-make-board-txt-from-json ()
  255. + "bbstable.json から (navi2ch 用の) board.txt を作る。
  256. +`navi2ch-net-update-file' のハンドラ。"
  257. + (let ((coding-system-for-read 'binary)
  258. + (coding-system-for-write 'binary)
  259. + (case-fold-search t)
  260. + (beg (point))
  261. + (id-to-url-table (make-hash-table :test 'eq))
  262. + (bbstable (json-parse-string (decode-coding-string (buffer-string) 'utf-8))))
  263. + (erase-buffer)
  264. + (seq-doseq (category (gethash "menu_list" bbstable))
  265. + (let ((category-name (gethash "category_name" category)))
  266. + (unless
  267. + ;; ignore category?
  268. + (member category-name navi2ch-list-ignore-category-list)
  269. + (insert (encode-coding-string category-name navi2ch-coding-system) "\n\n\n")
  270. + (seq-doseq (board (gethash "category_content" category))
  271. + (let ((url (gethash "url" board))
  272. + (board-name (gethash "board_name" board))
  273. + board-id id u)
  274. + (setq url (or (cdr (assoc url navi2ch-list-moved-board-alist))
  275. + url))
  276. + (when (and (navi2ch-list-valid-board url)
  277. + (setq board-id (navi2ch-list-board-id-from-url url)))
  278. + (setq id (intern board-id))
  279. + (when (and (setq u (gethash id id-to-url-table))
  280. + (not (string= u url)))
  281. + ;; 同じ ID で URL が違う板がある場合
  282. + (let ((i 2)
  283. + newid)
  284. + (while (and (setq newid (intern (format "%s:%d" id i)))
  285. + (setq u (gethash newid id-to-url-table))
  286. + (not (string= u url)))
  287. + (setq i (1+ i)))
  288. + (setq id newid)))
  289. + (insert (encode-coding-string board-name navi2ch-coding-system) "\n"
  290. + url "\n" (symbol-name id) "\n")))))))))
  291. +
  292. +
  293. +(defun navi2ch-list-make-board-txt-from-html ()
  294. "bbstable.html から (navi2ch 用の) board.txt を作る。
  295. `navi2ch-net-update-file' のハンドラ。"
  296. (let ((coding-system-for-read 'binary)
  297. @@ -590,7 +637,7 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  298. (if (string-match "a" tag)
  299. (let (url board-id id u)
  300. (when (and (not ignore)
  301. - (string-match "href=\\(.+/\\([^/]+\\)/\\)" attr))
  302. + (string-match "href=\"?\\(.+/\\([^/]+\\)/\\)" attr))
  303. (setq url (match-string 1 attr))
  304. (setq url (or (cdr (assoc
  305. url
  306. @@ -624,7 +671,7 @@ changed-list は '((board-id old-board new-board) ...) な alist。
  307.  
  308. (defun navi2ch-list-valid-board (uri)
  309. (save-match-data
  310. - (when (string-match "http://\\([^/]+\\)/\\([^/]+\\)/" uri)
  311. + (when (string-match "https?://\\([^/]+\\)/\\([^/]+\\)/" uri)
  312. (let ((host (match-string 1 uri)))
  313. (and (not (string-match navi2ch-list-invalid-host-regexp host))
  314. (string-match navi2ch-list-valid-host-regexp host))))))
  315. diff --git a/navi2ch-machibbs.el b/navi2ch-machibbs.el
  316. index 8159575..5b0a623 100644
  317. --- a/navi2ch-machibbs.el
  318. +++ b/navi2ch-machibbs.el
  319. @@ -32,7 +32,9 @@
  320. (defconst navi2ch-machibbs-ident
  321. "$Id$")
  322.  
  323. -(eval-when-compile (require 'cl))
  324. +(eval-when-compile
  325. + (require 'cl)
  326. + (require 'navi2ch-inline))
  327. (require 'navi2ch-multibbs)
  328.  
  329. (defvar navi2ch-machibbs-func-alist
  330. diff --git a/navi2ch-mona.el b/navi2ch-mona.el
  331. index a76735b..d23894a 100644
  332. --- a/navi2ch-mona.el
  333. +++ b/navi2ch-mona.el
  334. @@ -43,7 +43,9 @@
  335. (provide 'navi2ch-mona)
  336. (defconst navi2ch-mona-ident
  337. "$Id$")
  338. -(eval-when-compile (require 'cl))
  339. +(eval-when-compile
  340. + (require 'cl)
  341. + (require 'navi2ch-inline))
  342. (require 'base64)
  343. (require 'navi2ch-util)
  344.  
  345. diff --git a/navi2ch-multibbs.el b/navi2ch-multibbs.el
  346. index 8e49f28..e3d7b99 100644
  347. --- a/navi2ch-multibbs.el
  348. +++ b/navi2ch-multibbs.el
  349. @@ -34,10 +34,9 @@
  350. (defconst navi2ch-multibbs-ident
  351. "$Id$")
  352.  
  353. -(eval-when-compile (require 'cl))
  354. -(require 'navi2ch-http-date)
  355. -(require 'navi2ch)
  356. -(require 'navi2ch-be2ch)
  357. +(eval-when-compile
  358. + (require 'cl)
  359. + (require 'navi2ch-inline))
  360.  
  361. (defvar navi2ch-multibbs-func-table nil
  362. "BBS の種類と関数群の hash。
  363. @@ -345,7 +344,7 @@ START, END, NOFIRST で範囲を指定する"
  364.  
  365. ;;;-----------------------------------------------
  366.  
  367. -(defsubst navi2ch-2ch-subject-callback ()
  368. +(defsubst navi2ch-2ch-subject-callback (&optional args)
  369. (when navi2ch-board-use-subback-html
  370. (navi2ch-board-make-subject-txt)))
  371.  
  372. @@ -525,7 +524,7 @@ START, END, NOFIRST で範囲を指定する"
  373. 'equal)))
  374. (navi2ch-cache-get
  375. (cons uri file-name)
  376. - (cond ((string-match "http://\\(?:[^@/]+@\\)?\\(.+\\)" uri)
  377. + (cond ((string-match "https?://\\(?:[^@/]+@\\)?\\(.+\\)" uri)
  378. (navi2ch-expand-file-name
  379. (concat (match-string 1 uri)
  380. file-name)))
  381. diff --git a/navi2ch-net.el b/navi2ch-net.el
  382. index dc11ec5..6fedaa6 100644
  383. --- a/navi2ch-net.el
  384. +++ b/navi2ch-net.el
  385. @@ -31,12 +31,12 @@
  386. "$Id$")
  387.  
  388. (eval-when-compile
  389. - (require 'cl))
  390. + (require 'cl)
  391. + (require 'navi2ch-inline))
  392. +(require 'navi2ch-util)
  393. (require 'timezone)
  394. (require 'base64)
  395.  
  396. -(require 'navi2ch)
  397. -
  398. (defvar navi2ch-net-connection-name "navi2ch connection")
  399. (defvar navi2ch-net-user-agent "Monazilla/1.00 Navi2ch")
  400. (defvar navi2ch-net-setting-file-name "SETTING.TXT")
  401. @@ -121,13 +121,13 @@ BODY の評価中にエラーが起こると nil を返す。"
  402. (signal (car err) (cdr err)))))))
  403. proc))
  404.  
  405. -(defun navi2ch-open-network-stream-via-command (name buffer host service)
  406. +(defun navi2ch-open-network-stream-via-command (name buffer host service &rest rest)
  407. (let ((command (cond ((stringp navi2ch-open-network-stream-command)
  408. (format navi2ch-open-network-stream-command
  409. - host service))
  410. + host service (member (plist-get rest :type) '(tls ssl))))
  411. ((functionp navi2ch-open-network-stream-command)
  412. (funcall navi2ch-open-network-stream-command
  413. - host service)))))
  414. + host service (member (plist-get rest :type) '(tls ssl)))))))
  415. (apply #'start-process name buffer
  416. (if (stringp command)
  417. (list shell-file-name shell-command-switch command)
  418. @@ -220,7 +220,7 @@ nil なら常に再接続する。")
  419. (process-connection-type nil)
  420. (inherit-process-coding-system
  421. navi2ch-net-inherit-process-coding-system)
  422. - user pass host file port host2ch credentials auth)
  423. + user pass host file port host2ch credentials auth rest)
  424. (let ((list (navi2ch-net-split-url url navi2ch-net-http-proxy)))
  425. (setq list (navi2ch-net-connect-check list))
  426. (setq user (cdr (assq 'user list))
  427. @@ -228,7 +228,8 @@ nil なら常に再接続する。")
  428. host (cdr (assq 'host list))
  429. file (cdr (assq 'file list))
  430. port (cdr (assq 'port list))
  431. - host2ch (cdr (assq 'host2ch list))))
  432. + host2ch (cdr (assq 'host2ch list))
  433. + rest (cdr (assq 'rest list))))
  434. (when navi2ch-net-http-proxy
  435. (setq credentials (navi2ch-net-http-basic-credentials
  436. navi2ch-net-http-proxy-userid
  437. @@ -257,11 +258,8 @@ nil なら常に再接続する。")
  438. (setq proc nil)
  439. (unless (navi2ch-net-down-p host)
  440. (condition-case nil
  441. - (if (string-match "^https://" url)
  442. - (setq proc (funcall 'open-tls-stream
  443. - navi2ch-net-connection-name buf host "443"))
  444. - (setq proc (funcall navi2ch-open-network-stream-function
  445. - navi2ch-net-connection-name buf host port)))
  446. + (setq proc (apply navi2ch-open-network-stream-function
  447. + navi2ch-net-connection-name buf host port rest))
  448. (error (navi2ch-net-add-down-host host)))))
  449. (when proc
  450. (with-current-buffer buf
  451. @@ -275,7 +273,7 @@ nil なら常に再接続する。")
  452. (process-send-string
  453. proc
  454. (format (concat
  455. - "%s %s %s\r\n"
  456. + "%s %s HTTP/1.1\r\n"
  457. "MIME-Version: 1.0\r\n"
  458. "Host: %s\r\n"
  459. "%s" ;connection
  460. @@ -283,9 +281,6 @@ nil なら常に再接続する。")
  461. "%s" ;content
  462. "\r\n")
  463. method file
  464. - (if navi2ch-net-enable-http11
  465. - "HTTP/1.1"
  466. - "HTTP/1.0")
  467. host2ch
  468. (if navi2ch-net-enable-http11
  469. ""
  470. @@ -300,10 +295,15 @@ nil なら常に再接続する。")
  471. (format "Content-length: %d\r\n\r\n%s"
  472. (length content) content)
  473. "")))
  474. + (process-put proc 'method method)
  475. (message "%sdone" (current-message)))
  476. (navi2ch-net-cleanup-vars)
  477. (setq navi2ch-net-process proc))))
  478.  
  479. +(defun navi2ch-net-split-url-scheme-to-rest (scheme)
  480. + (if (string-prefix-p "https:" scheme)
  481. + '(:type tls)))
  482. +
  483. (defun navi2ch-net-split-url (url &optional proxy)
  484. (let (host2ch authinfo user pass)
  485. (string-match "https?://\\([^@/]+@\\)?\\([^/]+\\)" url)
  486. @@ -324,16 +324,21 @@ nil なら常に再接続する。")
  487. (cons 'host (match-string 2 proxy))
  488. (cons 'file url)
  489. (cons 'port (string-to-number (match-string 3 proxy)))
  490. - (cons 'host2ch host2ch)))
  491. - (string-match "https?://\\(?:[^@/]+@\\)?\\([^/:]+\\)\\(?::\\([0-9]+\\)\\)?\\(.*\\)" url)
  492. + (cons 'host2ch host2ch)
  493. + (cons 'rest (navi2ch-net-split-url-scheme-to-rest (match-string 1 proxy)))))
  494. + (string-match "\\(https?://\\)\\(?:[^@/]+@\\)?\\([^/:]+\\)\\(?::\\([0-9]+\\)\\)?\\(.*\\)" url)
  495. (list
  496. (cons 'user user)
  497. (cons 'pass pass)
  498. - (cons 'host (match-string 1 url))
  499. - (cons 'port (string-to-number (or (match-string 2 url)
  500. - "80")))
  501. - (cons 'file (match-string 3 url))
  502. - (cons 'host2ch host2ch)))))
  503. + (cons 'host (match-string 2 url))
  504. + (cons 'port
  505. + (if (match-string 3 url)
  506. + (string-to-number (match-string 3 url))
  507. + (if (string-prefix-p "https:" (match-string 1 url))
  508. + 443 80)))
  509. + (cons 'file (match-string 4 url))
  510. + (cons 'host2ch host2ch)
  511. + (cons 'rest (navi2ch-net-split-url-scheme-to-rest (match-string 1 url)))))))
  512.  
  513. (defun navi2ch-net-http-basic-credentials (user pass)
  514. "USER と PASS から Basic 認証の証明書 (?) 部分を返す。"
  515. @@ -473,7 +478,9 @@ chunk のサイズを返す。point は chunk の直後に移動。"
  516.  
  517. (defun navi2ch-net-get-content (proc)
  518. "PROC の接続の本文を返す。"
  519. - (when (and (navi2ch-net-get-status proc) (navi2ch-net-get-header proc))
  520. + (when (and (navi2ch-net-get-status proc)
  521. + (navi2ch-net-get-header proc)
  522. + (not (string= (process-get proc 'method) "HEAD")))
  523. (navi2ch-net-ignore-errors
  524. (or navi2ch-net-content
  525. (let* ((header (navi2ch-net-get-header proc))
  526. @@ -642,6 +649,9 @@ OTHER-HEADER は `navi2ch-net-download-file' に渡される。
  527. (navi2ch-set-buffer-multibyte nil)
  528. (insert cont)
  529. (goto-char (point-min))
  530. + (set (make-local-variable 'navi2ch-list-media-type)
  531. + (if (assq 'content-type header)
  532. + (assq 'content-type header)))
  533. (funcall func)
  534. (buffer-string))))
  535. (when (navi2ch-net-is-tanpan-thread-p cont)
  536. @@ -999,7 +1009,7 @@ This is taken from RFC 2396.")
  537. "BBS_\\(TITLE_PICTURE\\|FIGUREHEAD\\)=\\(.+\\)" content))
  538. (setq src (match-string 2 content))
  539. (let (url file)
  540. - (setq url (if (string-match "http://" src)
  541. + (setq url (if (string-match "https?://" src)
  542. src
  543. (navi2ch-board-get-url board src)))
  544. (string-match "/\\([^/]+\\)$" url)
  545. diff --git a/navi2ch-splash.el b/navi2ch-splash.el
  546. index bcda292..3c60bc4 100644
  547. --- a/navi2ch-splash.el
  548. +++ b/navi2ch-splash.el
  549. @@ -39,7 +39,8 @@
  550. "$Id$")
  551.  
  552. (eval-when-compile
  553. - (require 'cl))
  554. + (require 'cl)
  555. + (require 'navi2ch-inline))
  556. (require 'navi2ch-vars)
  557. (require 'navi2ch-face)
  558. (require 'navi2ch-util)
  559. @@ -61,15 +62,15 @@ Navi2ch comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ful
  560.  
  561. ;; これはさすがに差しかえないと……
  562. (defvar navi2ch-splash-logo-ascii "\
  563. -　　■　　　　■■　　　　　　　　　　　　　■■　　　　■　　
  564. -　■　　　　■　　　　　　　■■■■　　　　　　■　　　　■　
  565. +　　■　　　　■■　　　　　　　　　　　　　■■　　　　■
  566. +　■　　　　■　　　　　　　■■■■　　　　　　■　　　　■
  567. ■　　　　　　　　　　　　　■　　■　　　　　　　　　　　　■
  568. ■　　　　　　　　　　　　　■　　■　　　　　　　　　　　　■
  569. ■　　　　　　　　　　　　　■　　■　　　　　　　　　　　　■
  570. ■　　　　　　　　　　　　　■　　■　　　　　　　　　　　　■
  571. ■　　　　　　　　　　　　■　　　■　　　　　　　　　　　　■
  572. -　■　　　　　　　　　　■■■■■■■　　　　　　　　　　■　
  573. -　　■　　　　　　　　　■　　　　　■　　　　　　　　　■　　
  574. +　■　　　　　　　　　　■■■■■■■　　　　　　　　　　■
  575. +　　■　　　　　　　　　■　　　　　■　　　　　　　　　■
  576.  
  577. Navi2ch"
  578. "Ascii picture used to splash the startup screen.")
  579. diff --git a/navi2ch-thumbnail.el b/navi2ch-thumbnail.el
  580. index 94aea37..48cbc6b 100644
  581. --- a/navi2ch-thumbnail.el
  582. +++ b/navi2ch-thumbnail.el
  583. @@ -141,7 +141,8 @@
  584.  
  585. (defun navi2ch-thumbnail-image-pre (url &optional force)
  586. "forceはスレ再描画ではnil"
  587. - (let ((rtn nil) (real-image-url url) (target-list nil) (cache-url url))
  588. + (let ((rtn nil) (real-image-url url) (target-list nil) (cache-url url)
  589. + url-regex ext)
  590.  
  591. ;;imepic等のURLが画像っぽくない場合の処理
  592. (dolist (l navi2ch-thumbnail-url-coversion-table)
  593. diff --git a/navi2ch-util.el b/navi2ch-util.el
  594. index 84e60b3..f819f8b 100644
  595. --- a/navi2ch-util.el
  596. +++ b/navi2ch-util.el
  597. @@ -33,7 +33,9 @@
  598. (defconst navi2ch-util-ident
  599. "$Id$")
  600.  
  601. -(eval-when-compile (require 'cl))
  602. +(eval-when-compile
  603. + (require 'cl)
  604. + (require 'navi2ch-inline))
  605. (require 'timezone)
  606. (require 'browse-url)
  607. (require 'base64)
  608. @@ -209,56 +211,7 @@
  609. (eval-when-compile
  610. (defvar minibuffer-allow-text-properties))
  612. -;;;; macros
  613. -(defmacro navi2ch-ifxemacs (then &rest else)
  614. - "If on XEmacs, do THEN, else do ELSE.
  615. -Like \"(if (featurep 'xemacs) THEN ELSE)\", but expanded at
  616. -compilation time. Because byte-code of XEmacs is not compatible with
  617. -GNU Emacs's one, this macro is very useful."
  618. - (if (featurep 'xemacs)
  619. - then
  620. - (cons 'progn else)))
  621. -;; Navi2chのコードをハクする人は↓を~/.emacsにも入れときましょう。
  622. -(put 'navi2ch-ifxemacs 'lisp-indent-function 1)
  623. -
  624. -(defmacro navi2ch-ifemacsce (then &rest else)
  625. - "If on EmacsCE, do THEN, else do ELSE.
  626. -Expanded at compilation time."
  627. - `(if (string-match "windowsce" system-configuration)
  628. - ,then
  629. - (progn ,@else)))
  630. -(put 'navi2ch-ifemacsce 'lisp-indent-function 1)
  631. -
  632. ;; from apel
  633. -(eval-and-compile
  634. - (defmacro navi2ch-defalias-maybe (symbol definition)
  635. - "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
  636. -See also the function `defalias'."
  637. - (setq symbol (eval symbol))
  638. - (or (and (fboundp symbol)
  639. - (not (get symbol 'defalias-maybe)))
  640. - `(or (fboundp (quote ,symbol))
  641. - (prog1
  642. - (defalias (quote ,symbol) ,definition)
  643. - ;; `defalias' updates `load-history' internally.
  644. - (put (quote ,symbol) 'defalias-maybe t))))))
  645. -
  646. -(defmacro navi2ch-with-default-file-modes (mode &rest body)
  647. - "default-file-modes を MODE にして BODY を実行する。"
  648. - (let ((temp (make-symbol "--file-modes-temp--")))
  649. - `(let ((,temp (default-file-modes)))
  650. - (unwind-protect
  651. - (progn
  652. - (set-default-file-modes
  653. - (navi2ch-ifxemacs
  654. - (if (integerp ,mode)
  655. - ,mode
  656. - (char-to-int ,mode))
  657. - ,mode))
  658. - ,@body)
  659. - (set-default-file-modes ,temp)))))
  660. -
  661. -(put 'navi2ch-with-default-file-modes 'lisp-indent-function 1)
  662.  
  663. (defsubst navi2ch-cache-limit (cache)
  664. (elt cache 0))
  665. @@ -266,10 +219,6 @@ See also the function `defalias'."
  666. (defsubst navi2ch-cache-hash-table (cache)
  667. (elt cache 1))
  668.  
  669. -(defmacro navi2ch-cache-get (key value cache)
  670. - `(or (gethash ,key (navi2ch-cache-hash-table ,cache))
  671. - (navi2ch-cache-put ,key ,value ,cache)))
  672. -
  674. ;;;; other misc stuff
  675. (defun navi2ch-mouse-key (num)
  676. @@ -1513,12 +1462,6 @@ properties to add to the result."
  677. (memq item maybe-list)
  678. (eq item maybe-list)))
  679.  
  680. -(defmacro navi2ch-region-active-p ()
  681. - "Say whether the region is active."
  682. - (if (fboundp 'region-active-p)
  683. - (list 'region-active-p)
  684. - (list 'and 'transient-mark-mode 'mark-active)))
  685. -
  686. (navi2ch-update-html-tag-regexp)
  687.  
  688. (run-hooks 'navi2ch-util-load-hook)
  689. diff --git a/navi2ch-vars.el b/navi2ch-vars.el
  690. index 7bb307c..f3170af 100644
  691. --- a/navi2ch-vars.el
  692. +++ b/navi2ch-vars.el
  693. @@ -255,7 +255,7 @@ nil ならば手動で更新しないかぎり取りにいかない。"
  694.  
  695. (defcustom navi2ch-list-valid-host-regexp
  696. (concat "\\("
  697. - (regexp-opt '(".2ch.net" ".bbspink.com" ".machibbs.com" ".machi.to"))
  698. + (regexp-opt '(".5ch.net" ".2ch.net" ".bbspink.com" ".machibbs.com" ".machi.to"))
  699. "\\)\\'")
  700. "*２ちゃんねるの板とみなすホストの正規表現。"
  701. :type 'regexp
  702. @@ -263,7 +263,7 @@ nil ならば手動で更新しないかぎり取りにいかない。"
  703.  
  704. (defcustom navi2ch-list-invalid-host-regexp
  705. (concat "\\`\\("
  706. - (regexp-opt '("find.2ch.net" "info.2ch.net"))
  707. + (regexp-opt '("find.5ch.net" "find.2ch.net" "info.5ch.net" "info.2ch.net" ))
  708. "\\)\\'")
  709. "*２ちゃんねるの板とみなさないホストの正規表現。
  710. `navi2ch-list-valid-host-regexp' より優先される。"
  711. diff --git a/navi2ch-xmas.el b/navi2ch-xmas.el
  712. index 9f0626e..6aec258 100644
  713. --- a/navi2ch-xmas.el
  714. +++ b/navi2ch-xmas.el
  715. @@ -33,6 +33,7 @@
  716. (add-hook 'navi2ch-hook 'navi2ch-offline-init-icons)
  717.  
  718. (eval-when-compile
  719. + (require 'navi2ch-inline)
  720. (navi2ch-defalias-maybe 'make-extent 'ignore)
  721. (navi2ch-defalias-maybe 'make-glyph 'ignore)
  722. (navi2ch-defalias-maybe 'make-modeline-command-wrapper 'ignore)
  723. diff --git a/navi2ch.el b/navi2ch.el
  724. index 5c31661..992e0f8 100644
  725. --- a/navi2ch.el
  726. +++ b/navi2ch.el
  727. @@ -30,7 +30,9 @@
  728. (defconst navi2ch-ident
  729. "$Id$")
  730.  
  731. -(eval-when-compile (require 'cl))
  732. +(eval-when-compile
  733. + (require 'cl)
  734. + (require 'navi2ch-inline))
  735.  
  736. ;; BEWARE: order is important.
  737. (require 'navi2ch-vars)
  738.  
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!