navi2ch-board-misc.el

   1 ;;; navi2ch-board-misc.el --- Miscellaneous Functions for Navi2ch Board Mode -*- coding: iso-2022-7bit; lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2008, 2009, 2010
   4 ;; by Navi2ch Project
   5
   6 ;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net>
   7 ;; Keywords: 2ch, network
   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 ;;
  27
  28 ;;; Code:
  29 (provide 'navi2ch-board-misc)
  30 (defconst navi2ch-board-misc-ident
  31   "$Id$")
  32
  33 (eval-when-compile
  34   (require 'cl-lib)
  35   (require 'navi2ch-decls)
  36   (require 'navi2ch-inline))
  37
  38 (require 'navi2ch-vars)
  39 (eval-when-compile (defvar izonmoji-mode nil))
  40
  41 (defvar navi2ch-bm-mode-map nil)
  42 (unless navi2ch-bm-mode-map
  43   (let ((map (make-sparse-keymap)))
  44     (set-keymap-parent map navi2ch-global-view-map)
  45     (define-key map "\r" 'navi2ch-bm-select-article)
  46     (unless (featurep 'xemacs)
  47       (define-key map [follow-link] 'mouse-face))
  48     (navi2ch-define-mouse-key map 2 'navi2ch-bm-mouse-select)
  49     (define-key map " " 'navi2ch-bm-select-article-or-scroll-up)
  50     (define-key map "." 'navi2ch-bm-display-article)
  51     (define-key map "i" 'navi2ch-bm-fetch-article)
  52     (define-key map "e" 'navi2ch-bm-textize-article)
  53     (navi2ch-define-delete-keys map 'navi2ch-bm-select-article-or-scroll-down)
  54     (define-key map "n" 'navi2ch-bm-next-line)
  55     (define-key map "p" 'navi2ch-bm-previous-line)
  56     (define-key map "U" 'navi2ch-bm-show-url)
  57     (define-key map "l" 'navi2ch-bm-view-logo)
  58     (define-key map "A" 'navi2ch-bm-add-global-bookmark)
  59     (define-key map "g" 'navi2ch-bm-goto-board)
  60     (define-key map "q" 'navi2ch-bm-exit)
  61     (define-key map "S" 'navi2ch-bm-sort)
  62     (define-key map "?" 'navi2ch-bm-search)
  63     (define-key map "\C-c\C-m" 'navi2ch-message-pop-message-buffer)
  64     (define-key map "R" 'navi2ch-bm-remove-article)
  65     (define-key map "\C-c\C-r" 'navi2ch-bm-remove-article)
  66     (define-key map "\C-o" 'navi2ch-bm-save-dat-file)
  67     (define-key map "I" 'navi2ch-bm-fetch-maybe-new-articles)
  68
  69     ;; mark command
  70     (define-key map "*" 'navi2ch-bm-mark)
  71     (define-key map "u" 'navi2ch-bm-unmark)
  72     (define-key map "m" nil)
  73     (define-key map "mr" 'navi2ch-bm-mark-region)
  74     (define-key map "ma" 'navi2ch-bm-mark-all)
  75     (define-key map "mA" 'navi2ch-bm-add-global-bookmark-mark-article)
  76     (define-key map "m." 'navi2ch-bm-display-mark-article)
  77     (define-key map "mi" 'navi2ch-bm-fetch-mark-article)
  78     (define-key map "me" 'navi2ch-bm-textize-mark-article)
  79     (define-key map "mm" 'navi2ch-bm-mark-marks)
  80     (define-key map "m?" 'navi2ch-bm-mark-by-query)
  81     (define-key map "mb" 'navi2ch-bm-add-bookmark-mark-article)
  82     (define-key map "mR" 'navi2ch-bm-remove-mark-article)
  83     (setq navi2ch-bm-mode-map map)))
  84
  85 (defvar navi2ch-bm-mode-menu-spec
  86   '(["Toggle offline" navi2ch-toggle-offline]
  87     ["Exit" navi2ch-bm-exit]
  88     ["Sort" navi2ch-bm-sort]
  89     ["Search" navi2ch-bm-search])
  90   "Menu \e$B$N85\e(B")
  91
  92 (defvar navi2ch-board-buffer-name "*navi2ch board*")
  93
  94 ;; set by navi2ch-bm-setup
  95 (defvar navi2ch-bm-get-property-function nil
  96   "\e$B$=$N0LCV$N\e(B text-property \e$B$rF@$k4X?t!#0z?t$O\e(B POINT")
  97 (defvar navi2ch-bm-set-property-function nil
  98   "text-property \e$B$r@_Dj$9$k4X?t!#0z?t$O\e(B BEGIN END ITEM")
  99 (defvar navi2ch-bm-get-board-function nil
 100   "\e$BHD$rF@$k4X?t!#0z?t$O\e(B ITEM")
 101 (defvar navi2ch-bm-get-article-function nil
 102   "\e$B%9%l$rF@$k4X?t!#0z?t$O\e(B ITEM")
 103 (defvar navi2ch-bm-exit-function nil)
 104
 105 ;; stub functions
 106 ;; set by navi2ch-bm-setup
 107 ;; (declare-function navi2ch-bm-get-property-internal "navi2ch-board-misc" (point))
 108 ;; (declare-function navi2ch-bm-set-property-internal "navi2ch-board-misc" (begin end item))
 109 ;; (declare-function navi2ch-bm-get-board-internal "navi2ch-board-misc" (item))
 110 ;; (declare-function navi2ch-bm-get-article-internal "navi2ch-board-misc" (item))
 111 ;; (declare-function navi2ch-bm-exit-internal "navi2ch-board-misc" ())
 112 ;; (declare-function navi2ch-bm-setup "navi2ch-board-misc" (prefix))
 113
 114 (defvar navi2ch-bm-fetched-article-list nil)
 115 (defvar navi2ch-bm-board-type-alist nil)
 116
 117 (defvar navi2ch-bm-state-char-table
 118   (navi2ch-alist-to-hash
 119    '((view   . ?V)
 120      (cache  . ?C)
 121      (update . ?U)
 122      (down   . ?D)
 123      (nil    . ? ))
 124    :test 'eq))
 125
 126
 127 (eval-and-compile
 128   (require 'navi2ch-util)
 129   (let ((state-list '(view cache update down nil))
 130         (update-list '(nil new updated seen)))
 131     (let ((func (lambda (f)
 132                   (navi2ch-alist-to-hash
 133                    (mapcar (lambda (state)
 134                              (cons state
 135                                    (navi2ch-alist-to-hash
 136                                     (mapcar (lambda (update)
 137                                               (cons update
 138                                                     (funcall f state update)))
 139                                             update-list)
 140                                     :test 'eq)))
 141                            state-list)
 142                    :test 'eq))))
 143       (defconst navi2ch-bm-state-face-table
 144         (funcall func
 145                  (lambda (state update)
 146                    (intern (format "navi2ch-bm%s-%s-face"
 147                                    (if update
 148                                        (format "-%s" update)
 149                                      "")
 150                                    (or state 'unread))))))
 151       (defconst navi2ch-bm-state-mark-face-table
 152         (funcall func
 153                  (lambda (state update)
 154                    (intern (format "navi2ch-bm%s-mark-face"
 155                                    (if update
 156                                        (format "-%s" update)
 157                                      "")))))))))
 158
 159
 160 (defconst navi2ch-bm-updated-mark-table
 161   (navi2ch-alist-to-hash '((new     . ?%)
 162                            (updated . ?+)
 163                            (seen    . ?=)
 164                            (nil     . ? ))
 165                          :test 'eq))
 166
 167 (defvar navi2ch-bm-move-downward t)
 168
 169 ;; add hook
 170 (add-hook 'navi2ch-save-status-hook 'navi2ch-bm-save-info)
 171 (add-hook 'navi2ch-load-status-hook 'navi2ch-bm-load-info)
 172
 173 (defmacro navi2ch-bm-set-func (sym val)
 174   `(let ((val-str (symbol-name ',val))
 175          (sym-str (symbol-name ,sym))
 176          func-str)
 177      (when (string-match "navi2ch-bm-\\(.+\\)" val-str)
 178        (setq func-str (format "%s-%s"
 179                               sym-str (match-string 1 val-str)))
 180        (set (intern (concat val-str "-function")) (intern func-str))
 181        (fset (intern (concat val-str "-internal")) (intern func-str)))))
 182
 183 (defun navi2ch-bm-setup (prefix)
 184   (navi2ch-bm-set-func prefix navi2ch-bm-get-property)
 185   (navi2ch-bm-set-func prefix navi2ch-bm-set-property)
 186   (navi2ch-bm-set-func prefix navi2ch-bm-get-board)
 187   (navi2ch-bm-set-func prefix navi2ch-bm-get-article)
 188   ;; (navi2ch-bm-set-func prefix navi2ch-bm-get-subject)
 189   (navi2ch-bm-set-func prefix navi2ch-bm-exit)
 190   (setq navi2ch-bm-move-downward t))
 191
 192 (defun navi2ch-bm-make-menu-spec (title menu-spec)
 193   "\e$B%?%$%H%k$,\e(B TITLE \e$B$G\e(B \e$BFbMF$,\e(B `navi2ch-bm-mode-menu-spec' \e$B$H\e(B MENU-SPEC
 194 \e$B$r7R$2$?%a%K%e!<$r:n$k!#\e(B"
 195   (append (list title)
 196           navi2ch-bm-mode-menu-spec
 197           '("----")
 198           menu-spec))
 199
 200 ;; (defvar navi2ch-list-navi2ch-category-alist nil) ; \e$B%3%s%Q%$%k$rDL$90Y\e(B
 201
 202 (defun navi2ch-bm-regist-board (type open-func &optional board)
 203   "TYPE \e$B$JHD$r3+$/4X?t\e(B OPEN-FUNC \e$B$r\e(B `navi2ch-bm-board-type-alist' \e$B$KEP\e(B
 204 \e$BO?$9$k!#$^$?!"F1;~$K\e(B BOARD \e$B$r\e(B `navi2ch-list-navi2ch-category-alist' \e$B$K\e(B
 205 \e$BEPO?$9$k!#\e(B"
 206   (setq navi2ch-bm-board-type-alist
 207         (navi2ch-put-alist type open-func
 208                            navi2ch-bm-board-type-alist))
 209   (when board
 210     (add-to-list 'navi2ch-list-navi2ch-category-alist board)))
 211
 212 (defun navi2ch-bm-select-board (board &optional force)
 213   (let ((buf (get-buffer-create navi2ch-board-buffer-name))
 214         (type (cdr (assq 'type board))))
 215     (set-buffer buf)
 216     (funcall (cdr (assq type navi2ch-bm-board-type-alist))
 217              board force)
 218     (switch-to-buffer buf))
 219   (run-hooks 'navi2ch-bm-select-board-hook)
 220   (navi2ch-set-mode-line-identification))
 221
 222 (defun navi2ch-bm-set-property (begin end item state &optional updated mark)
 223   (navi2ch-bm-set-property-internal begin end item)
 224   (let ((updated (or updated
 225                      (get-text-property begin 'navi2ch-bm-updated)))
 226         (face-table (if mark
 227                         navi2ch-bm-state-mark-face-table
 228                       navi2ch-bm-state-face-table)))
 229     (add-text-properties begin end
 230                          (list 'navi2ch-bm-updated updated
 231                                'navi2ch-bm-state state
 232                                'navi2ch-bm-mark mark
 233                                'mouse-face navi2ch-bm-mouse-face
 234                                'face
 235                                (gethash updated
 236                                         (gethash state face-table))))))
 237
 238 (defun navi2ch-bm-down-article-p (board article)
 239   (cdr (or (assq 'down article)
 240            (assq 'down (navi2ch-article-load-info board article)))))
 241
 242 (defun navi2ch-bm-get-state-from-article (board article)
 243   (cond ((navi2ch-board-from-file-p board)
 244          (cond ((get-buffer (navi2ch-article-get-buffer-name
 245                              board article))
 246                 'view)
 247                ((file-exists-p (navi2ch-article-get-file-name board article))
 248                 'cache)
 249                (t nil)))
 250         ((navi2ch-bm-fetched-article-p board article)
 251          'update)
 252         ((navi2ch-bm-down-article-p board article)
 253          'down)
 254         (t
 255          (navi2ch-article-check-cached board article))))
 256
 257 (defun navi2ch-bm-format-subject
 258   (number updated-char state-char subject other)
 259   (format (concat "%" (number-to-string navi2ch-bm-number-width)
 260                   "d %c%c %s%s%s\n")
 261           number updated-char state-char subject
 262           (make-string (max (- navi2ch-bm-subject-width
 263                                (string-width subject))
 264                             1)
 265                        ? )
 266           other))
 267
 268 (defun navi2ch-bm-insert-subject (item number subject other
 269                                        &optional updated)
 270   (let* ((article (navi2ch-bm-get-article-internal item))
 271          (board (navi2ch-bm-get-board-internal item))
 272          (point (point))
 273          (state (navi2ch-bm-get-state-from-article board article))
 274          (string (navi2ch-bm-format-subject
 275                   number
 276                   (gethash updated navi2ch-bm-updated-mark-table)
 277                   (gethash state navi2ch-bm-state-char-table)
 278                   (or subject navi2ch-bm-empty-subject)
 279                   other)))
 280     ;; for contrib/izonmoji-mode.el
 281     (navi2ch-ifxemacs
 282         (insert string)
 283       (let ((buffer-display-table (if (and (boundp 'izonmoji-mode)
 284                                            izonmoji-mode)
 285                                       nil
 286                                     buffer-display-table)))
 287         (insert string)))
 288     (save-excursion
 289       (goto-char point)
 290       (set-text-properties (navi2ch-line-beginning-position)
 291                            (1+ (navi2ch-line-end-position))
 292                            nil)
 293       (navi2ch-bm-set-property (navi2ch-line-beginning-position)
 294                                (navi2ch-line-end-position)
 295                                item state updated))))
 296
 297 (defun navi2ch-bm-exit ()
 298   (interactive)
 299   (dolist (x (navi2ch-article-buffer-list))
 300     (when x
 301       (delete-windows-on x)))
 302   (navi2ch-bm-exit-internal)
 303   (run-hooks 'navi2ch-bm-exit-hook)
 304   (when (get-buffer navi2ch-board-buffer-name)
 305     (delete-windows-on navi2ch-board-buffer-name)
 306     (bury-buffer navi2ch-board-buffer-name))
 307   (when navi2ch-list-buffer-name
 308     (let ((win (get-buffer-window navi2ch-list-buffer-name)))
 309       (if win
 310           (select-window win)
 311         (navi2ch-list)))))
 312
 313 ;;; goto-*-column
 314 (defsubst navi2ch-bm-goto-updated-mark-column ()
 315   (beginning-of-line)
 316   (when (looking-at " *[0-9]+ ")
 317     (goto-char (match-end 0))))
 318
 319 (defsubst navi2ch-bm-goto-state-column ()
 320   (when (navi2ch-bm-goto-updated-mark-column)
 321     (forward-char 1)))
 322
 323 (defsubst navi2ch-bm-goto-mark-column ()
 324   (when (navi2ch-bm-goto-updated-mark-column)
 325     (forward-char 2)))
 326
 327 (defun navi2ch-bm-goto-other-column ()
 328   (let ((sbj (cdr
 329               (assq 'subject
 330                     (navi2ch-bm-get-article-internal
 331                      (navi2ch-bm-get-property-internal (point)))))))
 332     (navi2ch-bm-goto-mark-column)
 333     (forward-char 1)
 334     (unless sbj (setq sbj navi2ch-bm-empty-subject))
 335     (when (and (not (string= sbj ""))
 336                (search-forward sbj nil t))
 337       (goto-char (match-end 0)))
 338     (skip-chars-forward " ")))
 339
 340
 341 (defun navi2ch-bm-insert-state (item state &optional updated)
 342   ;; (setq article (navi2ch-put-alist 'cache 'view article))
 343   (let ((buffer-read-only nil))
 344     (save-excursion
 345       (navi2ch-bm-goto-state-column)
 346       (backward-char 1)
 347       (delete-char 2)
 348       (insert (gethash updated navi2ch-bm-updated-mark-table)
 349               (gethash state navi2ch-bm-state-char-table))
 350       (navi2ch-bm-set-property (navi2ch-line-beginning-position)
 351                                (navi2ch-line-end-position)
 352                                item state updated))))
 353
 354 (defsubst navi2ch-bm-get-state (&optional point)
 355   "\e$B$=$N0LCV$N\e(B state \e$B$rD4$Y$k!#\e(B"
 356   (get-text-property (or point (point)) 'navi2ch-bm-state))
 357
 358 (defsubst navi2ch-bm-get-updated-mark (&optional point)
 359   "\e$B$=$N0LCV$N\e(B updated-mark \e$B$rD4$Y$k!#\e(B"
 360   (get-text-property (or point (point)) 'navi2ch-bm-updated))
 361
 362 (defun navi2ch-bm-select-article (&optional max-line)
 363   (interactive "P")
 364   (let* ((item (navi2ch-bm-get-property-internal (point)))
 365          (board (navi2ch-bm-get-board-internal item))
 366          (article (navi2ch-article-load-info board (navi2ch-bm-get-article-internal item)))
 367          (buf (current-buffer))
 368          (window-configuration (current-window-configuration)))
 369     (unwind-protect
 370         (if article
 371             (progn
 372               (navi2ch-split-window 'article)
 373               (let (state)
 374                 (setq state
 375                       (if (navi2ch-board-from-file-p board)
 376                           (navi2ch-article-view-article-from-file
 377                            (navi2ch-article-get-file-name board article))
 378                         (navi2ch-article-view-article
 379                          board article nil nil max-line)))
 380                 (with-current-buffer buf
 381                   (when (or state
 382                             (navi2ch-bm-fetched-article-p board article)
 383                             (eq (navi2ch-bm-get-state) 'view))
 384                     (navi2ch-bm-remove-fetched-article board article)
 385                     (if (eq major-mode 'navi2ch-board-mode)
 386                         (navi2ch-bm-insert-state item 'view 'seen)
 387                       (navi2ch-bm-insert-state item 'view))))
 388                 (when (eq major-mode 'navi2ch-article-mode)
 389                   (setq window-configuration (current-window-configuration)))))
 390           (message "Can't select this line!"))
 391       (set-window-configuration window-configuration))))
 392
 393 (defun navi2ch-bm-show-url ()
 394   "\e$BHD$N\e(B url \e$B$rI=<($7$F!"$=$N\e(B url \e$B$r8+$k$+\e(B kill ring \e$B$K%3%T!<$9$k!#\e(B"
 395   (interactive)
 396   (let* ((board (navi2ch-bm-get-board-internal
 397                  (navi2ch-bm-get-property-internal (point))))
 398          (url (navi2ch-board-to-url board)))
 399     (if (not url)
 400         (message "Can't select this line!")
 401       (let ((char (navi2ch-read-char-with-retry
 402                    (format "c)opy v)iew t)itle? URL: %s: " url)
 403                    nil '(?c ?v ?t))))
 404         (if (eq char ?t)
 405             (navi2ch-bm-copy-title board)
 406           (setq url (navi2ch-bm-show-url-subr board))
 407           (cond ((not url)
 408                  (message "Can't select this line!"))
 409                 ((eq char ?c)
 410                  (kill-new url)
 411                  (message "Copy: %s" url))
 412                 ((eq char ?v)
 413                  (navi2ch-browse-url-internal url)
 414                  (message "View: %s" url))))))))
 415
 416 (defun navi2ch-bm-show-url-subr (board)
 417   "\e$B%a%K%e!<$rI=<($7$F!"\e(Burl \e$B$rF@$k!#\e(B"
 418   (let ((char (navi2ch-read-char-with-retry
 419                (format "b)oard a)rticle l)ast%d: "
 420                        navi2ch-article-show-url-number)
 421                nil '(?b ?a ?l)))
 422         (article (navi2ch-bm-get-article-internal
 423                   (navi2ch-bm-get-property-internal (point)))))
 424     (cond ((eq char ?b) (navi2ch-board-to-url board))
 425           ((eq char ?a) (when article
 426                           (navi2ch-article-to-url board article)))
 427           ((eq char ?l) (let ((l (format "l%d" navi2ch-article-show-url-number)))
 428                           (when article
 429                             (navi2ch-article-to-url board article l l)))))))
 430
 431 (defun navi2ch-bm-copy-title (board)
 432   "\e$B%a%K%e!<$rI=<($7$F!"%?%$%H%k$rF@$k!#\e(B"
 433   (navi2ch-article-copy-title board
 434                               (navi2ch-bm-get-article-internal
 435                                (navi2ch-bm-get-property-internal
 436                                 (point)))))
 437
 438 (defun navi2ch-bm-display-article (&optional max-line)
 439   (interactive "P")
 440   (let ((win (selected-window)))
 441     (navi2ch-bm-select-article max-line)
 442     (select-window win)))
 443
 444 (defun navi2ch-bm-remember-fetched-article (board article)
 445   (let* ((uri (navi2ch-board-get-uri board))
 446          (list (assoc uri navi2ch-bm-fetched-article-list))
 447          (artid (cdr (assq 'artid article))))
 448     (if list
 449         (unless (member artid (cdr list))
 450           (push artid (cdr list)))
 451       (push (list uri artid) navi2ch-bm-fetched-article-list))))
 452
 453 (defun navi2ch-bm-fetched-article-p (board article)
 454   (member (cdr (assq 'artid article))
 455           (cdr (assoc (navi2ch-board-get-uri board)
 456                       navi2ch-bm-fetched-article-list))))
 457
 458 (defun navi2ch-bm-remove-fetched-article (board article)
 459   (let* ((uri (navi2ch-board-get-uri board))
 460          (list (assoc uri navi2ch-bm-fetched-article-list))
 461          (artid (cdr (assq 'artid article))))
 462     (when (member artid list)
 463       (setcdr list (delete artid (cdr list)))
 464       (unless (cdr list)
 465         (setq navi2ch-bm-fetched-article-list
 466               (delq list navi2ch-bm-fetched-article-list))))))
 467
 468 (defun navi2ch-bm-fetch-article (&optional force)
 469   (interactive "P")
 470   (let* ((item (navi2ch-bm-get-property-internal (point)))
 471          (board (navi2ch-bm-get-board-internal item))
 472          (article (navi2ch-bm-get-article-internal item))
 473          state)
 474     (if (and article
 475              (not (navi2ch-board-from-file-p board)))
 476         (let (summary artid element seen)
 477           (when (and navi2ch-board-check-article-update-suppression-length
 478                      (not (navi2ch-bm-fetched-article-p board article)))
 479             (setq summary (navi2ch-article-load-article-summary board))
 480             (setq artid (cdr (assq 'artid article)))
 481             (setq element (cdr (assoc artid summary)))
 482             (setq seen (or (navi2ch-article-summary-element-seen element)
 483                            (cdr (assoc artid navi2ch-board-last-seen-alist))
 484                            0)))
 485           (setq state (navi2ch-article-fetch-article board article force))
 486           (when state
 487             (let ((state-mark 'update)
 488                   (updated-mark (navi2ch-bm-get-updated-mark)))
 489               (when seen
 490                 (setq seen
 491                       (and (catch 'break
 492                              (<= (string-to-number
 493                                   (or (cdr (assoc artid navi2ch-board-subject-alist))
 494                                       (throw 'break t)))
 495                                  (+ seen navi2ch-board-check-article-update-suppression-length)))
 496                            (navi2ch-article-check-message-suppression
 497                             board
 498                             article
 499                             (1+ seen)
 500                             (+ seen navi2ch-board-check-article-update-suppression-length)))))
 501               (if seen
 502                   (progn
 503                     (navi2ch-article-summary-element-set-seen element seen)
 504                     (navi2ch-article-save-article-summary board summary)
 505                     (setq state-mark (navi2ch-bm-get-state))
 506                     (when (memq updated-mark '(new updated))
 507                       (setq updated-mark 'seen))
 508                     (message "No updates need seeing"))
 509                 (navi2ch-bm-remember-fetched-article board article))
 510               (navi2ch-bm-insert-state item state-mark updated-mark))))
 511       (message "Can't select this line!"))
 512     state))
 513
 514 (defun navi2ch-bm-textize-article (&optional dir-or-file buffer)
 515   (interactive)
 516   (let* ((navi2ch-article-view-range nil)
 517          (navi2ch-article-auto-range nil)
 518          window)
 519     (setq window (selected-window))
 520     (navi2ch-bm-display-article)
 521     (select-window (get-buffer-window (navi2ch-article-current-buffer)))
 522     (when navi2ch-article-view-range
 523       (setq navi2ch-article-view-range nil)
 524       (navi2ch-article-redraw))
 525     (navi2ch-article-textize-article dir-or-file buffer)
 526     (select-window window)))
 527
 528 (defun navi2ch-bm-select-article-or-scroll (way &optional max-line)
 529   (let ((article (navi2ch-bm-get-article-internal
 530                   (navi2ch-bm-get-property-internal (point)))))
 531     (if (and (navi2ch-article-current-buffer)
 532              (string= (cdr (assq 'artid article))
 533                       (with-current-buffer (navi2ch-article-current-buffer)
 534                         (cdr (assq 'artid navi2ch-article-current-article))))
 535              (get-buffer-window (navi2ch-article-current-buffer)))
 536         (let ((win (selected-window)))
 537           (unwind-protect
 538               (progn
 539                 (select-window
 540                  (get-buffer-window (navi2ch-article-current-buffer)))
 541                 (cond
 542                  ((eq way 'up)
 543                   (navi2ch-article-scroll-up))
 544                  ((eq way 'down)
 545                   (navi2ch-article-scroll-down))))
 546             (select-window win)))
 547       (navi2ch-bm-select-article max-line))))
 548
 549 (defun navi2ch-bm-select-article-or-scroll-up (&optional max-line)
 550   (interactive "P")
 551   (navi2ch-bm-select-article-or-scroll 'up max-line))
 552
 553 (defun navi2ch-bm-select-article-or-scroll-down (&optional max-line)
 554   (interactive "P")
 555   (navi2ch-bm-select-article-or-scroll 'down max-line))
 556
 557 (defun navi2ch-bm-mouse-select (e)
 558   (interactive "e")
 559   (mouse-set-point e)
 560   (save-excursion
 561     (beginning-of-line)
 562     (navi2ch-bm-select-article)))
 563
 564 (defun navi2ch-bm-goto-board ()
 565   (interactive)
 566   (navi2ch-list-goto-board
 567    (navi2ch-bm-get-board-internal
 568     (navi2ch-bm-get-property-internal (point)))))
 569
 570 (defun navi2ch-bm-renumber ()
 571   (interactive)
 572   (save-excursion
 573     (goto-char (point-min))
 574     (let ((buffer-read-only nil)
 575           (i 1))
 576       (while (not (eobp))
 577         (let ((props (text-properties-at (point)))
 578               (num-string (format
 579                            (concat "%" (number-to-string navi2ch-bm-number-width) "d")
 580                            i)))
 581           (delete-region (point)
 582                          (save-excursion
 583                            (navi2ch-bm-goto-state-column)
 584                            (- (point) 2)))
 585           (insert num-string)
 586           (set-text-properties (- (point) (length num-string))
 587                                (point) props)
 588           (forward-line 1)
 589           (setq i (1+ i)))))))
 590
 591 (defun navi2ch-bm-view-logo ()
 592   "\e$B$=$NHD$N%m%4$r8+$k!#\e(B"
 593   (interactive)
 594   (let ((board (navi2ch-bm-get-board-internal
 595                 (navi2ch-bm-get-property-internal (point))))
 596         (board-mode-p (eq major-mode 'navi2ch-board-mode))
 597         file old-file)
 598     (unless board-mode-p
 599       (setq board (navi2ch-board-load-info board)))
 600     (setq old-file (cdr (assq 'logo board)))
 601     (if navi2ch-offline
 602         (setq file old-file)
 603       (setq file (navi2ch-net-download-logo board))
 604       (when file
 605         (setq file (file-name-nondirectory (navi2ch-net-download-logo board)))
 606         (when (and old-file navi2ch-board-delete-old-logo
 607                    (not (string-equal file old-file)))
 608           (delete-file (navi2ch-board-get-file-name board old-file)))
 609         (if board-mode-p
 610             (setq navi2ch-board-current-board board)
 611           (navi2ch-board-save-info board))))
 612     (if file
 613         (apply 'start-process "navi2ch view logo"
 614                nil navi2ch-board-view-logo-program
 615                (append navi2ch-board-view-logo-args
 616                        (list (navi2ch-board-get-file-name board file))))
 617       (message "Can't find logo file"))))
 618
 619 (defun navi2ch-bm-add-global-bookmark (&optional bookmark-id)
 620   (interactive (list (navi2ch-bookmark-read-id "Bookmark ID: ")))
 621   (let* ((item (navi2ch-bm-get-property-internal (point)))
 622          (board (navi2ch-bm-get-board-internal item))
 623          (article (navi2ch-bm-get-article-internal item)))
 624     (if item
 625         (navi2ch-bookmark-add
 626          bookmark-id
 627          board
 628          article)
 629       (message "Can't select this line!"))))
 630
 631 ;;; move
 632 (defun navi2ch-bm-forward-line (&optional n)
 633   (interactive "p")
 634   (let ((ret (forward-line n)))
 635     (when (eobp)
 636       (forward-line -1)
 637       (setq ret (1+ ret)))
 638     ret))
 639
 640 (defun navi2ch-bm-next-line (num)
 641   (interactive "p")
 642   (unless (zerop (navi2ch-bm-forward-line num))
 643     (message "No more articles"))
 644   (setq navi2ch-bm-move-downward t))
 645
 646 (defun navi2ch-bm-previous-line (num)
 647   (interactive "p")
 648   (unless (zerop (navi2ch-bm-forward-line (- num)))
 649     (message "No more articles"))
 650   (setq navi2ch-bm-move-downward nil))
 651
 652 ;;; mark
 653 (defun navi2ch-bm-mark-subr (mark &optional arg interactive)
 654   "mark \e$B$9$k!#\e(B
 655 INTERACTIVE \e$B$,\e(B non-nil \e$B$J$i\e(B mark \e$B$7$?$"$H0\F0$9$k!#\e(B
 656 ARG \e$B$,\e(B non-nil \e$B$J$i0\F0J}8~$r5U$K$9$k!#\e(B"
 657   (let ((item (navi2ch-bm-get-property-internal (point)))
 658         (state (navi2ch-bm-get-state (point)))
 659         (table (and mark navi2ch-bm-state-mark-face-table)))
 660     (when item
 661       (let ((buffer-read-only nil)
 662             (pos (point)))
 663         (navi2ch-bm-goto-mark-column)
 664         (delete-char 1)
 665         (insert (if mark ?* ? ))
 666         (navi2ch-bm-set-property (navi2ch-line-beginning-position)
 667                                  (navi2ch-line-end-position)
 668                                  item state nil table)
 669         (goto-char pos)))
 670     (when (and navi2ch-bm-mark-and-move interactive)
 671       (let (downward)
 672         (cond ((eq navi2ch-bm-mark-and-move 'follow)
 673                (setq downward
 674                      (if arg
 675                          (not navi2ch-bm-move-downward)
 676                        navi2ch-bm-move-downward)))
 677               ((eq navi2ch-bm-mark-and-move t)
 678                (setq downward (not arg))))
 679         (navi2ch-bm-forward-line (if downward 1 -1))))))
 680
 681 (defun navi2ch-bm-mark (&optional arg)
 682   (interactive "P")
 683   (navi2ch-bm-mark-subr t arg (interactive-p)))
 684
 685 (defun navi2ch-bm-unmark (&optional arg)
 686   (interactive "P")
 687   (navi2ch-bm-mark-subr nil arg (interactive-p)))
 688
 689 (defun navi2ch-bm-exec-subr (func &rest args)
 690   (save-excursion
 691     (goto-char (point-min))
 692     (while (not (eobp))
 693       (navi2ch-bm-goto-mark-column)
 694       (if (looking-at "\\*")
 695           (progn
 696             (condition-case nil
 697                 (save-excursion
 698                   (navi2ch-bm-unmark)
 699                   (apply func args))
 700               (navi2ch-update-failed nil))
 701             (sit-for 0)
 702             (discard-input))
 703         (forward-line)))))
 704
 705 (defsubst navi2ch-bm-display-mark-article ()
 706   (interactive)
 707   (navi2ch-bm-exec-subr 'navi2ch-bm-display-article))
 708
 709 (defun navi2ch-bm-fetch-mark-article (&optional force)
 710   (interactive "P")
 711   (unless navi2ch-offline
 712     (navi2ch-bm-exec-subr #'navi2ch-bm-fetch-article force)))
 713
 714 (defun navi2ch-bm-textize-mark-article (directory &optional file)
 715   (interactive "DDirectory: \nFList file: ")
 716   (let ((buffer (get-buffer-create (make-temp-name "*navi2ch "))))
 717     (navi2ch-bm-exec-subr 'navi2ch-bm-textize-article directory buffer)
 718     (with-current-buffer buffer
 719       (when file
 720         (navi2ch-write-region (point-min) (point-max) file)))
 721     (kill-buffer buffer)))
 722
 723 (defun navi2ch-bm-add-global-bookmark-mark-article (bookmark-id)
 724   (interactive (list (navi2ch-bookmark-read-id "Bookmark ID: ")))
 725   (navi2ch-bm-exec-subr 'navi2ch-bm-add-global-bookmark bookmark-id))
 726
 727
 728 ;; add marked ones to the board bookmark
 729 (defun navi2ch-bm-add-bookmark-mark-article ()
 730   (interactive)
 731   (navi2ch-bm-exec-subr 'navi2ch-board-add-bookmark))
 732
 733 (defun navi2ch-bm-mark-region-subr (begin end mark)
 734   (save-excursion
 735     (save-restriction
 736       (narrow-to-region begin end)
 737       (goto-char (point-min))
 738       (while (not (eobp))
 739         (navi2ch-bm-mark-subr mark)
 740         (forward-line)))))
 741
 742 (defun navi2ch-bm-mark-region (begin end &optional arg)
 743   (interactive "r\nP")
 744   (navi2ch-bm-mark-region-subr (save-excursion (goto-char begin)
 745                                                (beginning-of-line)
 746                                                (point))
 747                                (save-excursion (goto-char (max (1- end)
 748                                                                (point-min)))
 749                                                (end-of-line)
 750                                                (point))
 751                                (not arg)))
 752
 753 (defun navi2ch-bm-fetch-maybe-new-articles ()
 754   "\e$B99?7$5$l$F$$$k2DG=@-$N$"$k%9%l$r\e(B fetch \e$B$9$k!#\e(B"
 755   (interactive)
 756   (unless navi2ch-offline
 757     (navi2ch-bm-mark-states "[^=]")
 758     (sit-for 0)
 759     (navi2ch-bookmark-fetch-mark-article)))
 760
 761 (defun navi2ch-bm-mark-all (&optional arg)
 762   (interactive "P")
 763   (navi2ch-bm-mark-region (point-min) (point-max) arg))
 764
 765 (defun navi2ch-bm-mark-marks (mark &optional arg)
 766   (interactive "cInput mark: \nP")
 767   (navi2ch-bm-mark-states
 768    (format ".%c" (upcase mark))
 769    arg))
 770
 771 (defun navi2ch-bm-mark-states (regexp &optional arg)
 772   (save-excursion
 773     (goto-char (point-min))
 774     (while (not (eobp))
 775       (navi2ch-bm-goto-updated-mark-column)
 776       (when (looking-at regexp)
 777         (navi2ch-bm-mark-subr (not arg)))
 778       (forward-line))))
 779
 780 ;; mark by regexp query
 781 (defun navi2ch-bm-mark-by-query (query &optional arg)
 782   (interactive "MQuery (regexp): ")
 783   (save-excursion
 784     (goto-char (point-min))
 785     (while (re-search-forward query nil t)
 786       (navi2ch-bm-mark-subr (not arg)))))
 787
 788 ;;; sort
 789 (defun navi2ch-bm-sort-subr (rev start-key-fun end-key-fun)
 790   (let ((buffer-read-only nil))
 791     (save-excursion
 792       (goto-char (point-min))
 793       (sort-subr rev 'forward-line 'end-of-line
 794                  start-key-fun end-key-fun))))
 795
 796 (defun navi2ch-bm-sort-by-number (&optional rev)
 797   (interactive "P")
 798   (navi2ch-bm-sort-subr
 799    rev
 800    (lambda ()
 801      (beginning-of-line)
 802      (save-match-data
 803        (if (looking-at "^ *\\([0-9]+\\)")
 804            (string-to-number
 805             (buffer-substring (match-beginning 1) (match-end 1)))
 806          ;; not a number
 807          -1)))
 808    nil))
 809
 810 (defun navi2ch-bm-sort-by-state (&optional rev)
 811   (interactive "P")
 812   (navi2ch-bm-sort-subr
 813    rev
 814    (lambda ()
 815      (navi2ch-bm-goto-state-column)
 816      (backward-char)
 817      (or (cdr (assoc (buffer-substring (point) (+ (point) 2))
 818                      navi2ch-bm-sort-by-state-order))
 819          ;; \e$BL$CN$N>uBV!#\e(B
 820          1000))
 821    nil))
 822
 823 (defun navi2ch-bm-sort-by-subject (&optional rev)
 824   (interactive "P")
 825   (navi2ch-bm-sort-subr
 826    rev
 827    (lambda ()
 828      (navi2ch-bm-goto-mark-column)
 829      (forward-char 1))
 830    'navi2ch-bm-goto-other-column))
 831
 832 (defun navi2ch-bm-sort-by-other (&optional rev)
 833   (interactive "P")
 834   (navi2ch-bm-sort-subr
 835    rev
 836    (lambda ()
 837      (navi2ch-bm-goto-other-column)
 838      nil) ; end-key-fun \e$B$r8F$P$;$k$K$O\e(B nil \e$B$,M_$7$$$i$7$$!#$O$^$C$?\e(B(\e$B5c\e(B)\e$B!#\e(B
 839    'end-of-line))
 840
 841 (defun navi2ch-bm-sort-by-date (&optional rev)
 842   (interactive "P")
 843   (navi2ch-bm-sort-subr
 844    (not rev)
 845    (lambda ()
 846      (string-to-number
 847       (cdr (assq 'artid
 848                  (navi2ch-bm-get-article-internal
 849                   (navi2ch-bm-get-property-internal (point)))))))
 850    nil))
 851
 852 (defun navi2ch-bm-sort (&optional arg)
 853   (interactive "P")
 854   (let ((ch (navi2ch-read-char-with-retry
 855              "Sort by n)umber s)tate t)itle o)ther d)ate? "
 856              nil '(?n ?s ?t ?o ?d))))
 857     (message "Sorting...")
 858     (funcall
 859      (cond ((eq ch ?n) 'navi2ch-bm-sort-by-number)
 860            ((eq ch ?s) 'navi2ch-bm-sort-by-state)
 861            ((eq ch ?t) 'navi2ch-bm-sort-by-subject)
 862            ((eq ch ?o) 'navi2ch-bm-sort-by-other)
 863            ((eq ch ?d) 'navi2ch-bm-sort-by-date))
 864      arg)
 865     (message "Sorting...done")))
 866
 867 ;;; search
 868 (defun navi2ch-bm-search-current-board-subject ()
 869   (interactive)
 870   (navi2ch-search-subject-subr
 871    (list (navi2ch-bm-get-board-internal
 872           (navi2ch-bm-get-property-internal (point))))))
 873
 874 (defun navi2ch-bm-search-current-board-article ()
 875   (interactive)
 876   (navi2ch-search-article-subr
 877    (list (navi2ch-bm-get-board-internal
 878           (navi2ch-bm-get-property-internal (point))))))
 879
 880 (defun navi2ch-bm-search-current-board-cache ()
 881   (interactive)
 882   (navi2ch-search-cache-subr
 883    (list (navi2ch-bm-get-board-internal
 884           (navi2ch-bm-get-property-internal (point))))))
 885
 886 (defun navi2ch-bm-search-current-board-orphan ()
 887   (interactive)
 888   (navi2ch-search-orphan-subr
 889    (list (navi2ch-bm-get-board-internal
 890           (navi2ch-bm-get-property-internal (point))))))
 891
 892 (defun navi2ch-bm-search ()
 893   (interactive)
 894   (let ((ch (navi2ch-read-char-with-retry
 895              "Search for: s)ubject a)rticle c)ache o)rphan: "
 896              nil '(?s ?a ?c ?o)))
 897         (ch2 (navi2ch-read-char-with-retry
 898               "Search from: b)oard a)ll: " nil '(?b ?a))))
 899     (cond ((eq ch ?s)
 900            (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-subject))
 901                  ((eq ch2 ?a) (navi2ch-search-all-subject))))
 902           ((eq ch ?a)
 903            (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-article))
 904                  ((eq ch2 ?a) (navi2ch-search-all-article))))
 905           ((eq ch ?c)
 906            (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-cache))
 907                  ((eq ch2 ?a) (navi2ch-search-all-cache))))
 908           ((eq ch ?o)
 909            (cond ((eq ch2 ?b) (navi2ch-bm-search-current-board-orphan))
 910                  ((eq ch2 ?a) (navi2ch-search-all-orphan)))))))
 911
 912 ;;; save and load info
 913 (defun navi2ch-bm-save-info ()
 914   (navi2ch-save-info navi2ch-bm-fetched-info-file
 915                      navi2ch-bm-fetched-article-list
 916                      t))
 917
 918 (defun navi2ch-bm-load-info ()
 919   (setq navi2ch-bm-fetched-article-list
 920         (navi2ch-load-info navi2ch-bm-fetched-info-file)))
 921
 922 (defun navi2ch-bm-update-article (board article &optional state updated)
 923   "\e$BHD%P%C%U%!$N$&$A!"\e(BBOARD \e$B$H\e(B ARTICLE \e$B$K%^%C%A$9$k9T$r99?7$9$k!#\e(B"
 924   (let ((buffer (get-buffer navi2ch-board-buffer-name)))
 925     (when buffer
 926       (with-current-buffer buffer
 927         (let ((buffer-read-only nil))
 928           (save-excursion
 929             (goto-char (point-min))
 930             (while (not (eobp))
 931               (let* ((item (navi2ch-bm-get-property-internal (point)))
 932                      (item-article (navi2ch-bm-get-article-internal item))
 933                      (item-board (navi2ch-bm-get-board-internal item)))
 934                 (when (and (equal (cdr (assq 'id board))
 935                                   (cdr (assq 'id item-board)))
 936                            (equal (cdr (assq 'artid article))
 937                                   (cdr (assq 'artid item-article))))
 938                   (let ((state (or state
 939                                    (navi2ch-bm-get-state-from-article
 940                                     board article)))
 941                         (updated (or updated
 942                                      (navi2ch-bm-get-updated-mark))))
 943                     (navi2ch-bm-insert-state item state updated)
 944                     (navi2ch-bm-set-property (navi2ch-line-beginning-position)
 945                                              (navi2ch-line-end-position)
 946                                              item state updated))))
 947               (forward-line))))))))
 948
 949 (defun navi2ch-bm-remove-article-subr (board articles)
 950   "BOARD \e$B$H\e(B ARTICLES \e$B$G;XDj$5$l$k%9%l$N>pJs$r>C$9!#\e(B
 951 ARTILCES \e$B$,\e(B alist \e$B$N>l9g$O$=$N%9%l$N$_$r!"\e(Balist \e$B$N\e(B list \e$B$N>l9g$O;XDj$5\e(B
 952 \e$B$l$k$9$Y$F$N%9%l$rBP>]$K$9$k!#\e(B"
 953   (let ((summary (navi2ch-article-load-article-summary board)))
 954     (setq articles
 955           (cond ((cdr (assq 'artid articles)) ; \e$B%9%l\e(B alist
 956                  (list articles))
 957                 ((cdr (assq 'artid (car articles))) ; \e$B%9%l\e(B alist \e$B$N\e(B list
 958                  articles)))
 959     (dolist (article articles)
 960       (let ((artid (cdr (assq 'artid article)))
 961             (buffer (get-buffer (navi2ch-article-get-buffer-name board
 962                                                                  article)))
 963             (info-file (navi2ch-article-get-info-file-name board article))
 964             elt)
 965         (when buffer
 966           (delete-windows-on buffer)
 967           (kill-buffer buffer))
 968         (dolist (file (list info-file
 969                             (navi2ch-make-backup-file-name
 970                              info-file)
 971                             (navi2ch-article-get-file-name board article)
 972                             (navi2ch-article-get-message-filter-cache-file-name
 973                              board article)))
 974           (condition-case nil
 975               (if (file-exists-p file)
 976                   (delete-file file))
 977             (file-error nil))
 978           (navi2ch-cache-remove file navi2ch-info-cache))
 979         (navi2ch-bm-remove-fetched-article board article)
 980         (while (setq elt (assoc artid summary))
 981           (setq summary (delq elt summary))))
 982       (navi2ch-bm-update-article board article))
 983     (navi2ch-article-save-article-summary board summary)))
 984
 985 (defun navi2ch-bm-remove-article ()
 986   (interactive)
 987   (let* ((item (navi2ch-bm-get-property-internal (point)))
 988          (article (navi2ch-bm-get-article-internal item))
 989          (board (navi2ch-bm-get-board-internal item)))
 990     (when (and board article)
 991       (navi2ch-bm-remove-article-subr board article))))
 992
 993 (defun navi2ch-bm-remove-mark-article ()
 994   (interactive)
 995   (navi2ch-bm-exec-subr 'navi2ch-bm-remove-article))
 996
 997 (defun navi2ch-bm-save-dat-file ()
 998   (interactive)
 999   (let* ((item (navi2ch-bm-get-property-internal (point)))
1000          (article (navi2ch-bm-get-article-internal item))
1001          (board (navi2ch-bm-get-board-internal item)))
1002     (when (and board article)
1003       (navi2ch-article-save-dat-file board article))))
1004
1005 (defun navi2ch-bm-url-at-point (point)
1006   "POINT \e$B$N2<$N%j%s%/$r;X$9\e(B URL \e$B$rF@$k!#\e(B"
1007   (let ((board (navi2ch-bm-get-board-internal
1008                 (navi2ch-bm-get-property-internal point)))
1009         (article (navi2ch-bm-get-article-internal
1010                   (navi2ch-bm-get-property-internal point))))
1011     (navi2ch-article-to-url board article)))
1012
1013 (run-hooks 'navi2ch-board-misc-load-hook)
1014 ;;; navi2ch-board-misc.el ends here