navi2ch-list.el

   1 ;;; navi2ch-list.el --- board list module for navi2ch -*- coding: iso-2022-7bit; lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2008, 2009 by
   4 ;; Navi2ch Project
   5
   6 ;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
   7 ;; Keywords: network, 2ch
   8
   9 ;; This file is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This file is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; http://salad.2ch.net/bbstable.html \e$B$+$i!":n$C$?J}$,$$$$$s$+$J!#\e(B
  27
  28 ;;; Code:
  29 (provide 'navi2ch-list)
  30 (defconst navi2ch-list-ident
  31   "$Id$")
  32
  33 (eval-when-compile
  34   (require 'cl-lib)
  35   (require 'navi2ch-decls)
  36   (require 'navi2ch-inline))
  37 (require 'navi2ch-vars)
  38
  39 (defvar navi2ch-list-mode-map nil)
  40 (unless navi2ch-list-mode-map
  41   (let ((map (make-sparse-keymap)))
  42     (set-keymap-parent map navi2ch-global-view-map)
  43     (define-key map "\r" 'navi2ch-list-select-current-board)
  44     (define-key map "q" 'navi2ch-exit)
  45     (define-key map "z" 'navi2ch-suspend)
  46     (define-key map "s" 'navi2ch-list-sync)
  47     (define-key map " " 'navi2ch-list-select-current-board)
  48     (navi2ch-define-delete-keys map 'scroll-down)
  49     (define-key map "a" 'navi2ch-list-add-bookmark)
  50     (define-key map "b" 'navi2ch-list-toggle-bookmark)
  51     (unless (featurep 'xemacs)
  52       (define-key map [follow-link] 'mouse-face))
  53     (navi2ch-define-mouse-key map 2 'navi2ch-list-mouse-select)
  54     (define-key map "/" 'navi2ch-list-toggle-open)
  55     (define-key map "[" 'navi2ch-list-open-all-category)
  56     (define-key map "]" 'navi2ch-list-close-all-category)
  57     (define-key map "D" 'navi2ch-list-delete-global-bookmark)
  58     (define-key map "C" 'navi2ch-list-change-global-bookmark)
  59     (define-key map "?" 'navi2ch-list-search)
  60     (define-key map "e" 'navi2ch-list-expire)
  61     (define-key map "U" 'navi2ch-list-show-url)
  62     (setq navi2ch-list-mode-map map)))
  63
  64 (defvar navi2ch-list-mode-menu-spec
  65   '("List"
  66     ["Sync board list" navi2ch-list-sync]
  67     ["Toggle offline" navi2ch-toggle-offline]
  68     ["Open all category" navi2ch-list-open-all-category]
  69     ["Close all category" navi2ch-list-close-all-category]
  70     ["Toggle current category" navi2ch-list-toggle-open]
  71     ["Toggle bookmark" navi2ch-list-toggle-bookmark]
  72     ["Select current board" navi2ch-list-select-current-board])
  73   "Menu definition for navi2ch-list.")
  74
  75 (defvar navi2ch-list-ignore-category-list
  76   '("\e$B%A%c%C%H\e(B" "\e$B$*3($+$-\e(B" "\e$B1?1D0FFb\e(B" "\e$B%D!<%kN`\e(B" "\e$BB>$N7G<(HD\e(B" "\e$BB>$N%5%$%H\e(B" "\e$BFCJL4k2h\e(B"))
  77 (defvar navi2ch-list-buffer-name "*navi2ch list*")
  78 (defvar navi2ch-list-current-list nil)
  79 (defvar navi2ch-list-category-list nil)
  80 (defvar navi2ch-list-board-name-list nil)
  81
  82 (defvar navi2ch-list-navi2ch-category-name "Navi2ch")
  83 (defvar navi2ch-list-changed-category-name "\e$BJQ$o$C$?HD\e(B")
  84
  85 (defvar navi2ch-list-navi2ch-category-alist nil)
  86
  87 (defvar navi2ch-list-state-table
  88   (navi2ch-alist-to-hash
  89    '((add "A" navi2ch-list-add-board-name-face)
  90      (change "C" navi2ch-list-change-board-name-face)
  91      (nil " " navi2ch-list-board-name-face))))
  92
  93 (defconst navi2ch-list-bbstable-default-url
  94   (if (fboundp 'json-parse-string)
  95       "https://menu.5ch.net/bbsmenu.json"
  96       "https://menu.5ch.net/bbsmenu.html"))
  97
  98 ;; add hook
  99 (add-hook 'navi2ch-save-status-hook 'navi2ch-list-save-info)
 100
 101 (defun navi2ch-list-get-file-name (&optional name)
 102   (navi2ch-expand-file-name
 103    (or name "board.txt")))
 104
 105 (defun navi2ch-list-get-category-list-subr ()
 106   (let (list)
 107     (while (re-search-forward "\\(.+\\)\n\\(.+\\)\n\\(.+\\)" nil t)
 108       (setq list (cons
 109                   (list (cons 'name (match-string 1))
 110                         (cons 'uri (match-string 2))
 111                         (cons 'id (match-string 3))
 112                         (cons 'type 'board)
 113                         (cons 'seen nil))
 114                   list)))
 115     (nreverse list)))
 116
 117 (defun navi2ch-list-get-category (name list)
 118   (list name
 119         (cons 'open
 120               (or navi2ch-list-init-open-category
 121                   (cdr (assq 'open
 122                              (cdr (assoc name navi2ch-list-category-list))))))
 123         (cons 'child list)))
 124
 125 (defun navi2ch-list-set-category (name list)
 126   (let ((category (assoc name navi2ch-list-category-list)))
 127     (setcdr category
 128             (list
 129              (cadr category)
 130              (cons 'child list))))
 131   (setq navi2ch-list-board-name-list (navi2ch-list-get-board-name-list
 132                                       navi2ch-list-category-list)))
 133
 134 (defun navi2ch-list-get-global-bookmark-board-list ()
 135   (mapcar (lambda (x)
 136             (list (cons 'name (cadr x))
 137                   (cons 'type 'bookmark)
 138                   (cons 'id (car x))))
 139           navi2ch-bookmark-list))
 140
 141 (defun navi2ch-list-get-global-bookmark-category ()
 142   (navi2ch-list-get-category
 143    navi2ch-list-global-bookmark-category-name
 144    (navi2ch-list-get-global-bookmark-board-list)))
 145
 146 (defun navi2ch-list-set-global-bookmark-category ()
 147   (navi2ch-list-set-category
 148    navi2ch-list-global-bookmark-category-name
 149    (navi2ch-list-get-global-bookmark-board-list)))
 150
 151 (defun navi2ch-list-sync-global-bookmark-category ()
 152   (navi2ch-list-set-global-bookmark-category)
 153   (let ((buffer-read-only nil)
 154         (p (point)))
 155     (erase-buffer)
 156     (navi2ch-list-insert-board-names
 157      navi2ch-list-category-list)
 158     (goto-char p)))
 159
 160 (defun navi2ch-list-delete-global-bookmark ()
 161   (interactive)
 162   (let ((board (get-text-property (point) 'board)))
 163     (if (eq (cdr (assq 'type board)) 'bookmark)
 164         (navi2ch-bookmark-delete-bookmark (cdr (assq 'id board)))
 165       (message "This line is not bookmark!"))))
 166
 167 (defun navi2ch-list-change-global-bookmark ()
 168   (interactive)
 169   (let ((board (get-text-property (point) 'board)))
 170     (if (eq (cdr (assq 'type board)) 'bookmark)
 171         (navi2ch-bookmark-change-bookmark (cdr (assq 'id board)))
 172       (message "This line is not bookmark!"))))
 173
 174 (defun navi2ch-list-get-category-list (file)
 175   (when (file-exists-p file)
 176     (with-temp-buffer
 177       (navi2ch-insert-file-contents file)
 178       (run-hooks 'navi2ch-list-get-category-list-hook)
 179       (navi2ch-apply-filters navi2ch-list-current-list navi2ch-list-filter-list)
 180       (goto-char (point-min))
 181       (let (list)
 182         (while (re-search-forward "\\(.+\\)\n\n\n" nil t)
 183           (setq list (cons (list (match-string 1)
 184                                  (match-beginning 0) (match-end 0))
 185                            list)))
 186         (goto-char (point-min))
 187         (setq list (nreverse list))
 188         (let (list2)
 189           (while list
 190             (save-restriction
 191               (narrow-to-region (nth 2 (car list))
 192                                 (or (nth 1 (cadr list))
 193                                     (point-max)))
 194               (setq list2 (cons
 195                            (navi2ch-list-get-category
 196                             (caar list)
 197                             (navi2ch-list-get-category-list-subr))
 198                            list2)))
 199             (setq list (cdr list)))
 200           (nreverse list2))))))
 201
 202 (defun navi2ch-list-get-etc-category ()
 203   (let ((file (expand-file-name navi2ch-list-etc-file-name
 204                                 navi2ch-directory)))
 205     (when (file-exists-p file)
 206       (with-temp-buffer
 207         (insert-file-contents file)
 208         (goto-char (point-min))
 209         (navi2ch-list-get-category
 210          navi2ch-list-etc-category-name
 211          (navi2ch-list-get-category-list-subr))))))
 212
 213 (defun navi2ch-list-insert-board-names-subr (list)
 214   (let ((prev (point))
 215         (indent (make-string (1- navi2ch-list-indent-width) ?\ ))
 216         (change (cdr (assq 'change navi2ch-list-current-list))))
 217     (dolist (board list)
 218       (let* ((board-id (cdr (assq 'id board)))
 219              (state (gethash (cdr (assoc board-id change))
 220                              navi2ch-list-state-table)))
 221         (insert (car state)
 222                 indent
 223                 (cdr (assq 'name board)))
 224         (when navi2ch-list-display-board-id-p
 225           (insert " ")
 226           (indent-to-column navi2ch-list-board-id-column)
 227           (insert "(" board-id ")"))
 228         (insert "\n")
 229         (set-text-properties prev (point) nil)
 230         (set-text-properties
 231          (+ prev
 232             (length (car state))
 233             (length indent))
 234          (1- (point))
 235          (list 'mouse-face navi2ch-list-mouse-face
 236                'face (cadr state))))
 237       (put-text-property prev (point) 'board board)
 238       (setq prev (point)))))
 239
 240 (defun navi2ch-list-insert-board-names (list)
 241   "LIST \e$B$NFbMF$r%P%C%U%!$KA^F~!#\e(B"
 242   (if navi2ch-list-bookmark-mode
 243       (navi2ch-list-insert-bookmarks list)
 244     (let ((prev (point)))
 245       (dolist (pair list)
 246         (let* ((alist (cdr pair))
 247                (open (cdr (assq 'open alist))))
 248           (insert "[" (if open "-" "+") "]"
 249                   (car pair) "\n")
 250           (set-text-properties prev (1- (point))
 251                                (list 'mouse-face navi2ch-list-mouse-face
 252                                      'face 'navi2ch-list-category-face))
 253           (put-text-property prev (point) 'genre (car pair))
 254           (when open
 255             (navi2ch-list-insert-board-names-subr (cdr (assq 'child alist))))
 256           (setq prev (point)))))))
 257
 258 (defun navi2ch-list-bookmark-node (board)
 259   "BOARD \e$B$+$i\e(B bookmark \e$B$K3JG<$9$k\e(B node \e$B$r<hF@$9$k!#\e(B"
 260   (let ((uri (cdr (assq 'uri board)))
 261         (type (cdr (assq 'type board)))
 262         (id (cdr (assq 'id board))))
 263     (cond ((eq type 'board)
 264            uri)
 265           ((and type id)
 266            (cons type id)))))
 267
 268 (defun navi2ch-list-insert-bookmarks (list)
 269   (let ((bookmark (cdr (assq 'bookmark navi2ch-list-current-list)))
 270         alist)
 271     (dolist (x (navi2ch-list-get-board-name-list list))
 272       (let ((node (navi2ch-list-bookmark-node x)))
 273         (when (member node bookmark)
 274           ;; \e$B%j%9%H$N8e$K$"$k%N!<%I$rM%@h\e(B
 275           (setq alist (delq (assoc node alist) alist))
 276           (push (cons node x) alist))))
 277     (navi2ch-list-insert-board-names-subr (mapcar #'cdr
 278                                                   (nreverse alist)))))
 279
 280 (defun navi2ch-list-toggle-open ()
 281   "\e$B%+%F%4%j$r3+$$$?$jJD$8$?$j$9$k!#\e(B"
 282   (interactive)
 283   (when (save-excursion
 284           (end-of-line)
 285           (re-search-backward "^\\[[+-]\\]" nil t))
 286     (goto-char (match-beginning 0))
 287     (let* ((category (get-text-property (point) 'genre))
 288            (props (text-properties-at (point)))
 289            (pair (assoc category navi2ch-list-category-list))
 290            (alist (cdr pair))
 291            (open (cdr (assq 'open alist)))
 292            (buffer-read-only nil))
 293       (delete-region (point) (+ 3 (point)))
 294       (insert "[" (if open "+" "-") "]")
 295       (set-text-properties (- (point) 3) (point) props)
 296       (save-excursion
 297         (forward-line 1)
 298         (if open
 299             (delete-region (point)
 300                            (if (re-search-forward "^\\[[+-]\\]" nil t)
 301                                (match-beginning 0)
 302                              (point-max)))
 303           (navi2ch-list-insert-board-names-subr (cdr (assq 'child alist)))))
 304       (setcdr pair (navi2ch-put-alist 'open (not open) alist)))))
 305
 306 (defun navi2ch-list-select-current-board (&optional force)
 307   "\e$BHD$rA*$V!#$^$?$O%+%F%4%j$N3+JD$r$9$k!#\e(B"
 308   (interactive "P")
 309   (let (prop)
 310     (cond ((setq prop (get-text-property (point) 'board))
 311            (navi2ch-list-select-board prop force))
 312           ((get-text-property (point) 'genre)
 313            (navi2ch-list-toggle-open))
 314           (t
 315            (message "Can't select this line!")))))
 316
 317 (defun navi2ch-list-open-all-category ()
 318   (interactive)
 319   (when (save-excursion
 320           (end-of-line)
 321           (re-search-backward "^\\[[+-]\\]" nil t))
 322     (let ((str (buffer-substring-no-properties
 323                 (save-excursion (beginning-of-line) (point))
 324                 (save-excursion (end-of-line) (point)))))
 325       (setq navi2ch-list-category-list
 326             (mapcar (lambda (x)
 327                       (navi2ch-put-alist 'open t x))
 328                     navi2ch-list-category-list))
 329       (let ((buffer-read-only nil))
 330         (erase-buffer)
 331         (navi2ch-list-insert-board-names
 332          navi2ch-list-category-list))
 333       (goto-char (point-min))
 334       (re-search-forward (concat "^"
 335                                  (regexp-quote
 336                                   (navi2ch-replace-string "^\\[\\+\\]" "[-]"
 337                                                           str t))
 338                                  "$")
 339                          nil t)
 340       (beginning-of-line)
 341       (if (looking-at "\\[-\\]")
 342           (goto-char (match-end 0))
 343         (forward-char navi2ch-list-indent-width)))))
 344
 345 (defun navi2ch-list-close-all-category ()
 346   (interactive)
 347   (when (save-excursion
 348           (end-of-line)
 349           (re-search-backward "^\\[[+-]\\]" nil t))
 350     (goto-char (match-end 0))
 351     (let ((str (buffer-substring-no-properties
 352                 (point)
 353                 (save-excursion (end-of-line) (point)))))
 354       (setq navi2ch-list-category-list
 355             (mapcar (lambda (x)
 356                       (navi2ch-put-alist 'open nil x))
 357                     navi2ch-list-category-list))
 358       (let ((buffer-read-only nil))
 359         (erase-buffer)
 360         (navi2ch-list-insert-board-names
 361          navi2ch-list-category-list))
 362       (goto-char (point-min))
 363       (re-search-forward (concat "^\\(\\[[+-]\\]\\)"
 364                                  (regexp-quote str)
 365                                  "$")
 366                          nil t)
 367       (goto-char (match-end 1)))))
 368
 369 (defun navi2ch-list-select-board (board &optional force)
 370   (let ((flag (eq (current-buffer)
 371                   (get-buffer navi2ch-list-buffer-name))))
 372     (when (and (get-buffer navi2ch-board-buffer-name)
 373                flag)
 374       (delete-windows-on navi2ch-board-buffer-name))
 375     (dolist (x (navi2ch-article-buffer-list))
 376       (when x
 377         (delete-windows-on x)))
 378     (navi2ch-split-window 'board)
 379     (navi2ch-bm-select-board board force)))
 380
 381 (easy-menu-define navi2ch-list-mode-menu
 382   navi2ch-list-mode-map
 383   "Menu used in navi2ch-list"
 384   navi2ch-list-mode-menu-spec)
 385
 386 (defun navi2ch-list-setup-menu ()
 387   (easy-menu-add navi2ch-list-mode-menu))
 388
 389 (defun navi2ch-list-mode ()
 390   "\\{navi2ch-list-mode-map}"
 391   (interactive)
 392   (kill-all-local-variables)
 393   (setq major-mode 'navi2ch-list-mode)
 394   (setq mode-name "Navi2ch List")
 395   (setq buffer-read-only t)
 396   (buffer-disable-undo)
 397   (use-local-map navi2ch-list-mode-map)
 398   (navi2ch-list-setup-menu)
 399   (run-hooks 'navi2ch-list-mode-hook)
 400   (force-mode-line-update))
 401
 402 (defun navi2ch-list ()
 403   (interactive)
 404   (if (get-buffer navi2ch-list-buffer-name)
 405       (switch-to-buffer navi2ch-list-buffer-name)
 406     (switch-to-buffer (get-buffer-create navi2ch-list-buffer-name))
 407     (navi2ch-list-mode)
 408     (save-excursion
 409       (navi2ch-list-sync nil t))))
 410
 411 (defun navi2ch-list-get-changed-status (old-category-list category-list)
 412   "\e$B0JA0$NHD$N0lMw\e(B OLD-CATEGORY-LIST \e$B$H8=:_$NHD$N0lMw\e(B CATEGORY-LIST \e$B$r\e(B
 413 \e$BHf$Y$F!"DI2C!"JQ99$N$"$C$?HD$r\e(B
 414 '((add . added-list)
 415   (change . changed-list))
 416 \e$B$N\e(B alist \e$B$K$7$FJV$9!#\e(B
 417 added-list \e$B$O\e(B '(board-id ...) \e$B$J\e(B list\e$B!#\e(B
 418 changed-list \e$B$O\e(B '((board-id old-board new-board) ...) \e$B$J\e(B alist\e$B!#\e(B"
 419   (let ( ;; \e$B8=:_$NHD0lMw$N\e(B uri \e$B$N\e(B alist
 420         (list (navi2ch-alist-list-to-alist
 421                (navi2ch-list-get-board-name-list category-list)
 422                'uri))
 423         ;; \e$B0JA0$NHD0lMw$N\e(B uri \e$B$N\e(B alist
 424         (old-list (navi2ch-alist-list-to-alist
 425                    (navi2ch-list-get-board-name-list old-category-list)
 426                    'uri))
 427         added-list changed-list)
 428     (dolist (new list)
 429       (when (car new)                   ; uri \e$B$,$"$k$H$-$N$_=hM}$9$k!#\e(B
 430         (let ((old (assoc (car new) old-list)))
 431           ;; \e$B8=:_$NHD0lMw$N\e(B uri \e$B$,0JA0$NHD0lMw$+$i8+$D$+$i$J$+$C$?$i\e(B
 432           (unless old
 433             (let ((new-name (cdr (assq 'name (cdr new))))
 434                   (new-pure-id (navi2ch-replace-string
 435                                 ":.*" "" (cdr (assq 'id (cdr new)))))
 436                   old-name old-pure-id)
 437               (catch 'break
 438                 (dolist (x old-list)
 439                   (setq old-name (cdr (assq 'name (cdr x)))
 440                         old-pure-id (navi2ch-replace-string
 441                                      ":.*" "" (cdr (assq 'id (cdr new)))))
 442                   ;; \e$BL>A0$H\e(B id \e$B$N\e(B : \e$B0JA0$,F1$8$@$C$?$iJQ$o$C$?HD$KDI2C$9$k\e(B
 443                   (when (and (string= new-name old-name)
 444                              (string= new-pure-id old-pure-id))
 445                     (push (list (cdr (assq 'id (cdr new)))
 446                                 (cdr x) (cdr new))
 447                           changed-list)
 448                     (throw 'break nil)))
 449                 ;; \e$B8=:_$NHD0lMw$N\e(B id \e$B$,0JA0$NHD0lMw$+$i8+$D$+$i$J$+$C$?$i\e(B
 450                 ;; \e$BDI2C$5$l$?;v$K$9$k\e(B
 451                 (push (cdr (assq 'id (cdr new))) added-list)))))))
 452     (list (cons 'add added-list)
 453           (cons 'change changed-list))))
 454
 455 (defun navi2ch-list-change (changed-list)
 456   "CHANGED-LIST \e$B$r$b$H$KHD%V%C%/%^!<%/$r99?7!#\e(B"
 457   (let ((changed-alist (mapcar
 458                         (lambda (elt)
 459                           (cons (navi2ch-list-bookmark-node (nth 1 elt))
 460                                 (navi2ch-list-bookmark-node (nth 2 elt))))
 461                         changed-list)))
 462     (setq navi2ch-list-current-list
 463           (navi2ch-put-alist 'bookmark
 464                              (mapcar (lambda (node)
 465                                        (or (cdr (assoc node changed-alist))
 466                                            node))
 467                                      (cdr (assq 'bookmark
 468                                                 navi2ch-list-current-list)))
 469                              navi2ch-list-current-list))))
 470
 471 (defun navi2ch-list-apply-changed-status (changed-status)
 472   "CHANGED-STATUS \e$B$r$b$H$KHD$NJQ99$r$$$m$s$J=j$KH?1G$9$k!#\e(B"
 473   (message "Applying board changes...")
 474   (let ((added-list (cdr (assq 'add changed-status)))
 475         (changed-list (cdr (assq 'change changed-status))))
 476     (when changed-status
 477       (setq navi2ch-list-current-list
 478             (navi2ch-put-alist 'change
 479                                (append (mapcar (lambda (id)
 480                                                  (cons id 'add))
 481                                                added-list)
 482                                        (mapcar (lambda (pair)
 483                                                  (cons (car pair) 'change))
 484                                                changed-list))
 485                                navi2ch-list-current-list))
 486       (navi2ch-change-log-directory changed-list)
 487       (navi2ch-bookmark-change changed-list)
 488       (navi2ch-history-change changed-list)
 489       (navi2ch-list-change changed-list)
 490       (message "Applying board changes...done"))))
 491
 492 (defun navi2ch-list-get-changed-category (category-list)
 493   (let ((alist (navi2ch-alist-list-to-alist
 494                 (navi2ch-list-get-board-name-list category-list)
 495                 'id)))
 496     (navi2ch-list-get-category
 497      navi2ch-list-changed-category-name
 498      (mapcar (lambda (pair)
 499                (cdr (assoc (car pair) alist)))
 500              (cdr (assq 'change navi2ch-list-current-list))))))
 501
 502 (defun navi2ch-list-sync (&optional force first)
 503   (interactive "P")
 504   (save-excursion
 505     (let ((buffer-read-only nil)
 506           (navi2ch-net-force-update (or navi2ch-net-force-update
 507                                         force))
 508           (file (navi2ch-list-get-file-name))
 509           (bbstable (or navi2ch-list-bbstable-url
 510                         navi2ch-list-bbstable-default-url))
 511           (change (cdr (assq 'change navi2ch-list-current-list)))
 512           updated header time old-category-list)
 513       (when first
 514         (navi2ch-list-load-info))
 515       (navi2ch-set-mode-line-identification)
 516       (setq old-category-list (navi2ch-list-get-normal-category-list
 517                                navi2ch-list-category-list))
 518       (unless (or navi2ch-offline
 519                   (and first
 520                        (not navi2ch-list-sync-update-on-boot)
 521                        (file-exists-p file)))
 522         (setq time (and (equal (cdr (assq 'bbstable navi2ch-list-current-list))
 523                                bbstable)
 524                         (cdr (assq 'time navi2ch-list-current-list))))
 525         (setq header (navi2ch-net-update-file bbstable file time
 526                                               'navi2ch-list-make-board-txt))
 527         (setq updated (and header
 528                            (not (navi2ch-net-get-state 'not-updated header))
 529                            (not (navi2ch-net-get-state 'error header)))))
 530       (when updated
 531         (setq navi2ch-list-current-list
 532               (navi2ch-put-alist 'time
 533                                  (or (cdr (assq 'last-modified header))
 534                                      (cdr (assq 'date header)))
 535                                  navi2ch-list-current-list))
 536         (setq navi2ch-list-current-list
 537               (navi2ch-put-alist 'bbstable bbstable
 538                                  navi2ch-list-current-list)))
 539       ;; bbstable, etc.txt, navi2ch-list-navi2ch-category-alist
 540       ;; \e$B$N$$$:$l$+$,99?7$5$l$F$$$l$P\e(B \e$B0J2<$N=hM}$,I,MW!#\e(B
 541       ;; \e$B$H$j$"$($:!">o$K<B9T$7$F$*$/!#\e(B
 542       (let ((category-list (navi2ch-list-get-category-list file)))
 543         (when (or updated change)
 544           (navi2ch-list-apply-changed-status
 545            (navi2ch-list-get-changed-status old-category-list category-list)))
 546         (setq navi2ch-list-category-list
 547               (append
 548                (delq nil
 549                      (list (navi2ch-list-get-category
 550                             navi2ch-list-navi2ch-category-name
 551                             navi2ch-list-navi2ch-category-alist)
 552                            (navi2ch-list-get-global-bookmark-category)
 553                            (navi2ch-list-get-etc-category)
 554                            (navi2ch-list-get-changed-category
 555                             category-list)))
 556                category-list))
 557         (setq navi2ch-list-board-name-list
 558               (navi2ch-list-get-board-name-list
 559                navi2ch-list-category-list)))
 560       (erase-buffer)
 561       (navi2ch-list-insert-board-names navi2ch-list-category-list)))
 562   (run-hooks 'navi2ch-list-after-sync-hook))
 563
 564 (defun navi2ch-list-board-id-from-url (url)
 565   "URL \e$B$+$i\e(B board-id \e$B$rF@$k!#\e(B"
 566   (let ((board-id (cdr (assoc url navi2ch-list-board-id-alist))))
 567     (or board-id
 568         (save-match-data
 569           (if (string-match "\\`https?://.+/\\([^/]+\\)/\\'" url)
 570               (match-string 1 url))))))
 571
 572
 573 (defun navi2ch-list-make-board-txt ()
 574   (if (and navi2ch-list-media-type
 575            (string-equal (cdr navi2ch-list-media-type) "application/json"))
 576       (navi2ch-list-make-board-txt-from-json)
 577     (navi2ch-list-make-board-txt-from-html)))
 578
 579 (defun navi2ch-list-make-board-txt-from-json ()
 580   "bbstable.json \e$B$+$i\e(B (navi2ch \e$BMQ$N\e(B) board.txt \e$B$r:n$k!#\e(B
 581 `navi2ch-net-update-file' \e$B$N%O%s%I%i!#\e(B"
 582   (let ((coding-system-for-read 'binary)
 583         (coding-system-for-write 'binary)
 584         (case-fold-search t)
 585         (beg (point))
 586         (id-to-url-table (make-hash-table :test 'eq))
 587         (bbstable (json-parse-string (decode-coding-string (buffer-string) 'utf-8))))
 588     (erase-buffer)
 589     (seq-doseq (category (gethash "menu_list" bbstable))
 590       (let ((category-name (gethash "category_name" category)))
 591         (unless
 592             ;; ignore category?
 593             (member category-name navi2ch-list-ignore-category-list)
 594           (insert (encode-coding-string category-name navi2ch-coding-system) "\n\n\n")
 595           (seq-doseq (board (gethash "category_content" category))
 596             (let ((url (gethash "url" board))
 597                   (board-name (gethash "board_name" board))
 598                   board-id id u)
 599               (setq url (or (cdr (assoc url navi2ch-list-moved-board-alist))
 600                             url))
 601               (when (and (navi2ch-list-valid-board url)
 602                          (setq board-id (navi2ch-list-board-id-from-url url)))
 603                 (setq id (intern board-id))
 604                 (when (and (setq u (gethash id id-to-url-table))
 605                            (not (string= u url)))
 606                   ;; \e$BF1$8\e(B ID \e$B$G\e(B URL \e$B$,0c$&HD$,$"$k>l9g\e(B
 607                   (let ((i 2)
 608                         newid)
 609                     (while (and (setq newid (intern (format "%s:%d" id i)))
 610                                 (setq u (gethash newid id-to-url-table))
 611                                 (not (string= u url)))
 612                       (setq i (1+ i)))
 613                     (setq id newid)))
 614                 (insert (encode-coding-string board-name  navi2ch-coding-system) "\n"
 615                         url "\n" (symbol-name id) "\n")))))))))
 616
 617
 618 (defun navi2ch-list-make-board-txt-from-html ()
 619   "bbstable.html \e$B$+$i\e(B (navi2ch \e$BMQ$N\e(B) board.txt \e$B$r:n$k!#\e(B
 620 `navi2ch-net-update-file' \e$B$N%O%s%I%i!#\e(B"
 621   (let ((coding-system-for-read 'binary)
 622         (coding-system-for-write 'binary)
 623         (case-fold-search t)
 624         (beg (point))
 625         (id-to-url-table (make-hash-table :test 'eq))
 626         ignore)
 627     (when (re-search-forward "<b>[^>]+</b>" nil t)
 628       (goto-char (match-beginning 0))
 629       (while (re-search-forward
 630               "<\\([ab]\\)\\([^>]*\\)>\\([^<]+\\)</\\1>" nil t)
 631         (let ((tag (match-string 1))
 632               (attr (match-string 2))
 633               (cont (match-string 3)))
 634           (delete-region beg (point))
 635           (if (string-match "a" tag)
 636               (let (url board-id id u)
 637                 (when (and (not ignore)
 638                            (string-match "href=\"?\\(.+/\\([^/]+\\)/\\)" attr))
 639                   (setq url (match-string 1 attr))
 640                   (setq url (or (cdr (assoc
 641                                       url
 642                                       navi2ch-list-moved-board-alist))
 643                                 url))
 644                   (when (and (navi2ch-list-valid-board url)
 645                              (setq board-id (navi2ch-list-board-id-from-url url)))
 646                     (setq id (intern board-id))
 647                     (when (and (setq u (gethash id id-to-url-table))
 648                                (not (string= u url)))
 649                       ;; \e$BF1$8\e(B ID \e$B$G\e(B URL \e$B$,0c$&HD$,$"$k>l9g\e(B
 650                       (let ((i 2)
 651                             newid)
 652                         (while (and (setq newid (intern (format "%s:%d" id i)))
 653                                     (setq u (gethash newid id-to-url-table))
 654                                     (not (string= u url)))
 655                           (setq i (1+ i)))
 656                         (setq id newid)))
 657                     (puthash id url id-to-url-table)
 658                     (insert cont "\n"
 659                             url "\n"
 660                             (symbol-name id) "\n"))))
 661             (setq ignore
 662                   (member (decode-coding-string
 663                            cont navi2ch-coding-system)
 664                           navi2ch-list-ignore-category-list))
 665             (when (not ignore)
 666               (insert cont "\n\n\n"))))
 667         (setq beg (point))))
 668     (delete-region beg (point-max))))
 669
 670 (defun navi2ch-list-valid-board (uri)
 671   (save-match-data
 672     (when (string-match "https?://\\([^/]+\\)/\\([^/]+\\)/" uri)
 673       (let ((host (match-string 1 uri)))
 674         (and (not (string-match navi2ch-list-invalid-host-regexp host))
 675              (string-match navi2ch-list-valid-host-regexp host))))))
 676
 677 (defun navi2ch-list-mouse-select (e)
 678   (interactive "e")
 679   (beginning-of-line)
 680   (mouse-set-point e)
 681   (save-excursion
 682     (navi2ch-list-select-current-board)))
 683
 684 (defun navi2ch-list-goto-board (&optional default)
 685   (interactive)
 686   (let (alist board)
 687     (setq alist (mapcar (lambda (x) (cons (cdr (assq 'id x)) x))
 688                         navi2ch-list-board-name-list))
 689     (save-window-excursion
 690       (setq board (cdr (assoc
 691                         (completing-read
 692                          (concat "Board name"
 693                                  (when default
 694                                    (format " (%s)" (cdr (assq 'id default))))
 695                                  ": ")
 696                          alist nil t)
 697                         alist))))
 698     (setq board (or board
 699                     (assoc (cdr (assq 'id default)) alist)))
 700     (when board
 701       (when (eq (navi2ch-get-major-mode navi2ch-board-buffer-name)
 702                 'navi2ch-board-mode)
 703         (navi2ch-board-save-info))
 704       (navi2ch-list-select-board board))))
 705
 706 (defun navi2ch-list-get-normal-category-list (list)
 707   (setq list (copy-sequence list))      ; delq \e$B$9$k$+$i\e(B
 708   (when (assoc navi2ch-list-navi2ch-category-name list)
 709     (setq list (delq (assoc navi2ch-list-navi2ch-category-name list) list)))
 710   (when (assoc navi2ch-list-global-bookmark-category-name list)
 711     (setq list (delq (assoc navi2ch-list-global-bookmark-category-name list) list))))
 712
 713 (defun navi2ch-list-get-board-name-list (list)
 714   (let (alist id)
 715     (dolist (x list)
 716       (unless (string= (car x) navi2ch-list-changed-category-name)
 717         (dolist (y (cdr (assq 'child x)))
 718           (setq id (cdr (assq 'id y)))
 719           ;; \e$BF1$8\e(B id \e$B$KBP$7$F$O0l$D$N$_JV$9!#\e(B
 720           (setq alist (cons (cons id y)
 721                             (delq (assoc id alist) alist))))))
 722     (mapcar #'cdr (nreverse alist))))
 723
 724 (defun navi2ch-list-normalize-bookmark (list)
 725   (let ((bookmark (cdr (assq 'bookmark list)))
 726         ret)
 727     (dolist (x (navi2ch-list-get-board-name-list navi2ch-list-category-list))
 728       (let ((node (navi2ch-list-bookmark-node x)))
 729         (when (member node bookmark)
 730           (setq ret (cons node (delq node ret))))))
 731     (nreverse ret)))
 732
 733 (defun navi2ch-list-save-info ()
 734   (when navi2ch-list-category-list
 735     (let ((list (mapcar (lambda (elt)
 736                           (list (car elt)
 737                                 (assq 'open (cdr elt))))
 738                         navi2ch-list-category-list)))
 739       (setq navi2ch-list-current-list
 740             (navi2ch-put-alist 'category list
 741                                navi2ch-list-current-list))))
 742   (when navi2ch-list-current-list
 743     (navi2ch-save-info
 744      (navi2ch-list-get-file-name "list.info")
 745      (list (cons 'bookmark (navi2ch-list-normalize-bookmark
 746                             navi2ch-list-current-list))
 747            (assq 'category navi2ch-list-current-list)
 748            (assq 'change navi2ch-list-current-list)
 749            (assq 'bbstable navi2ch-list-current-list)
 750            (assq 'time navi2ch-list-current-list))
 751      t)))
 752
 753 (defun navi2ch-list-load-info ()
 754   (setq navi2ch-list-current-list
 755         (navi2ch-load-info (navi2ch-list-get-file-name "list.info")))
 756   (if navi2ch-list-load-category-list
 757       (setq navi2ch-list-category-list
 758             (cdr (assq 'category navi2ch-list-current-list))))
 759   (let* ((file (navi2ch-list-get-file-name))
 760          (category-list (navi2ch-list-get-category-list file)))
 761     (setq navi2ch-list-category-list
 762           (append
 763            (delq nil
 764                  (list (navi2ch-list-get-category
 765                         navi2ch-list-navi2ch-category-name
 766                         navi2ch-list-navi2ch-category-alist)
 767                        (navi2ch-list-get-global-bookmark-category)
 768                        (navi2ch-list-get-etc-category)
 769                        (navi2ch-list-get-changed-category category-list)))
 770            category-list))
 771     (setq navi2ch-list-board-name-list
 772           (navi2ch-list-get-board-name-list navi2ch-list-category-list))))
 773
 774 (defun navi2ch-list-get-current-category-list ()
 775   (save-excursion
 776     (end-of-line)
 777     (when (re-search-backward "^\\[[+-]\\]" nil t)
 778       (let ((category (get-text-property (point) 'genre)))
 779         (cdr (assq 'child (cdr
 780                            (assoc category
 781                                   navi2ch-list-category-list))))))))
 782
 783 ;;; bookmark mode
 784 (defvar navi2ch-list-bookmark-mode nil)
 785 (defvar navi2ch-list-bookmark-mode-map nil)
 786 (unless navi2ch-list-bookmark-mode-map
 787   (setq navi2ch-list-bookmark-mode-map (make-sparse-keymap))
 788   (define-key navi2ch-list-bookmark-mode-map "d"
 789     'navi2ch-list-delete-bookmark)
 790   (define-key navi2ch-list-bookmark-mode-map "a" 'undefined))
 791
 792 (navi2ch-set-minor-mode 'navi2ch-list-bookmark-mode
 793                         " Bookmark"
 794                         navi2ch-list-bookmark-mode-map)
 795
 796 (defun navi2ch-list-add-bookmark ()
 797   (interactive)
 798   (let ((node (navi2ch-list-bookmark-node (get-text-property (point)
 799                                                              'board)))
 800         (list (cdr (assq 'bookmark navi2ch-list-current-list))))
 801     (if node
 802         (unless (member node list)
 803           (setq list (cons node list))
 804           (setq navi2ch-list-current-list
 805                 (navi2ch-put-alist 'bookmark list
 806                                    navi2ch-list-current-list))
 807           (message "Add bookmark"))
 808       (message "Can't select this line!"))))
 809
 810 (defun navi2ch-list-delete-bookmark ()
 811   (interactive)
 812   (let ((node (navi2ch-list-bookmark-node (get-text-property (point)
 813                                                              'board)))
 814         (list (cdr (assq 'bookmark navi2ch-list-current-list))))
 815     (if node
 816         (progn
 817           (setq list (delete node list))
 818           (setq navi2ch-list-current-list
 819                 (navi2ch-put-alist 'bookmark list
 820                                    navi2ch-board-current-board))
 821           (let ((buffer-read-only nil))
 822             (delete-region (save-excursion (beginning-of-line) (point))
 823                            (save-excursion (forward-line) (point))))
 824           (message "Delete bookmark"))
 825       (message "Can't select this line!"))))
 826
 827 (defun navi2ch-list-toggle-bookmark ()
 828   (interactive)
 829   (setq navi2ch-list-bookmark-mode (not navi2ch-list-bookmark-mode))
 830   (let ((buffer-read-only nil))
 831     (save-excursion
 832       (erase-buffer)
 833       (navi2ch-list-insert-board-names navi2ch-list-category-list))))
 834
 835 ;;; search
 836 (defun navi2ch-list-search-current-board-subject ()
 837   (interactive)
 838   (navi2ch-search-subject-subr (list (get-text-property (point) 'board))))
 839
 840 (defun navi2ch-list-search-current-category-subject ()
 841   (interactive)
 842   (navi2ch-search-subject-subr
 843    (navi2ch-list-get-current-category-list)))
 844
 845 (defun navi2ch-list-search-current-board-article ()
 846   (interactive)
 847   (navi2ch-search-article-subr (list (get-text-property (point) 'board))))
 848
 849 (defun navi2ch-list-search-current-category-article ()
 850   (interactive)
 851   (navi2ch-search-article-subr
 852    (navi2ch-list-get-current-category-list)))
 853
 854 (defun navi2ch-list-search-current-board-cache ()
 855   (interactive)
 856   (navi2ch-search-cache-subr (list (get-text-property (point) 'board))))
 857
 858 (defun navi2ch-list-search-current-category-cache ()
 859   (interactive)
 860   (navi2ch-search-cache-subr
 861    (navi2ch-list-get-current-category-list)))
 862
 863 (defun navi2ch-list-search-current-board-orphan ()
 864   (interactive)
 865   (navi2ch-search-orphan-subr (list (get-text-property (point) 'board))))
 866
 867 (defun navi2ch-list-search-current-category-orphan ()
 868   (interactive)
 869   (navi2ch-search-orphan-subr
 870    (navi2ch-list-get-current-category-list)))
 871
 872 (defun navi2ch-list-search ()
 873   (interactive)
 874   (let* ((ch (navi2ch-read-char-with-retry
 875               "Search for: s)ubject a)rticle c)ache o)rphan: "
 876               nil '(?s ?a ?c ?o)))
 877          (board (get-text-property (point) 'board))
 878          (ch2 (if (eq ch ?s)
 879                   (if (and board
 880                            (navi2ch-board-get-file-name board))
 881                       (navi2ch-read-char-with-retry
 882                        "Search from: b)oard c)ategory l)ocal w)eb: "
 883                        nil '(?b ?c ?l ?w))
 884                     (navi2ch-read-char-with-retry
 885                      "Search from: c)ategory l)ocal w)eb: " nil '(?c ?l ?w)))
 886                   (if (and board
 887                            (navi2ch-board-get-file-name board))
 888                       (navi2ch-read-char-with-retry
 889                        "Search from: b)oard c)ategory l)ocal: " nil '(?b ?c ?l))
 890                     (navi2ch-read-char-with-retry
 891                      "Search from: c)ategory l)ocal: " nil '(?c ?l))))))
 892     (cond ((eq ch ?s)
 893            (cond ((eq ch2 ?b) (navi2ch-list-search-current-board-subject))
 894                  ((eq ch2 ?c) (navi2ch-list-search-current-category-subject))
 895                  ((eq ch2 ?l) (navi2ch-search-all-subject))
 896                  ((eq ch2 ?w) (navi2ch-search-web))))
 897           ((eq ch ?a)
 898            (cond ((eq ch2 ?b) (navi2ch-list-search-current-board-article))
 899                  ((eq ch2 ?c) (navi2ch-list-search-current-category-article))
 900                  ((eq ch2 ?l) (navi2ch-search-all-article))))
 901           ((eq ch ?c)
 902            (cond ((eq ch2 ?b) (navi2ch-list-search-current-board-cache))
 903                  ((eq ch2 ?c) (navi2ch-list-search-current-category-cache))
 904                  ((eq ch2 ?l) (navi2ch-search-all-cache))))
 905           ((eq ch ?o)
 906            (cond ((eq ch2 ?b) (navi2ch-list-search-current-board-orphan))
 907                  ((eq ch2 ?c) (navi2ch-list-search-current-category-orphan))
 908                  ((eq ch2 ?l) (navi2ch-search-all-orphan)))))))
 909
 910 ;;; expire
 911 (defun navi2ch-list-expire-current-board (&optional ask)
 912   (interactive)
 913   (navi2ch-board-expire
 914    (get-text-property (point) 'board) ask))
 915
 916 (defun navi2ch-list-expire-current-category (&optional ask)
 917   (interactive)
 918   (and (interactive-p) (setq ask t))
 919   (when (or (not ask)
 920             (y-or-n-p "Expire current category boards? "))
 921     (dolist (board (navi2ch-list-get-current-category-list))
 922       (navi2ch-board-expire board))
 923     (message "Expiring current category is done")))
 924
 925 (defun navi2ch-list-expire-all (&optional ask)
 926   (interactive)
 927   (and (interactive-p) (setq ask t))
 928   (when (or (not ask)
 929             (y-or-n-p "Expire all boards? "))
 930     (dolist (board navi2ch-list-board-name-list)
 931       (when (eq (cdr (assq 'type board)) 'board)
 932         (navi2ch-board-expire board)))
 933     (message "Expiring all board is done")))
 934
 935 (defun navi2ch-list-expire ()
 936   (interactive)
 937   (let ((ch (navi2ch-read-char-with-retry "Expire b)oard c)ategory a)ll? "
 938                                           nil '(?b ?c ?a))))
 939     (cond ((eq ch ?b) (navi2ch-list-expire-current-board 'ask))
 940           ((eq ch ?c) (navi2ch-list-expire-current-category 'ask))
 941           ((eq ch ?a) (navi2ch-list-expire-all 'ask)))))
 942
 943 (defun navi2ch-list-show-url ()
 944   (interactive)
 945   (let* ((board (get-text-property (point) 'board))
 946          (uri (cdr (assq 'uri board)))
 947          (name (cdr (assq 'name board))))
 948     (if (not uri)
 949         (message "Can't select this line!")
 950       (let ((char (navi2ch-read-char-with-retry
 951                    (format "c)opy v)iew t)itle u)rl&title? URL: %s: " uri)
 952                    nil '(?c ?v ?t ?u))))
 953         (if (eq char ?v)
 954             (navi2ch-browse-url-internal uri)
 955           (let ((str (cond ((eq char ?c)
 956                             uri)
 957                            ((eq char ?t)
 958                             name)
 959                            ((eq char ?u)
 960                             (format "%s\n%s" name uri)))))
 961             (if (not str)
 962                 (ding)
 963               (kill-new str)
 964               (message "Copy: %s" str))))))))
 965
 966 (defun navi2ch-list-url-at-point (point)
 967   (let ((board (get-text-property point 'board)))
 968     (cdr (assq 'uri board))))
 969
 970 (run-hooks 'navi2ch-list-load-hook)
 971 ;;; navi2ch-list.el ends here