1;;; navi2ch-board-misc.el --- Miscellaneous Functions for Navi2ch Board Mode -*- coding: iso-2022-7bit; -*- 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) 35 (defvar navi2ch-board-last-seen-alist) 36 (defvar navi2ch-board-subject-alist) 37 (defvar navi2ch-board-current-board)) 38 39;; Avoid byte-compile warnings (contrib/izonmoji-mode.el). 40(eval-when-compile (defvar izonmoji-mode nil)) 41 42(require 'navi2ch) 43 44(defvar navi2ch-bm-mode-map nil) 45(unless navi2ch-bm-mode-map 46 (let ((map (make-sparse-keymap))) 47 (set-keymap-parent map navi2ch-global-view-map) 48 (define-key map "\r" 'navi2ch-bm-select-article) 49 (unless (featurep 'xemacs) 50 (define-key map [follow-link] 'mouse-face)) 51 (navi2ch-define-mouse-key map 2 'navi2ch-bm-mouse-select) 52 (define-key map " " 'navi2ch-bm-select-article-or-scroll-up) 53 (define-key map "." 'navi2ch-bm-display-article) 54 (define-key map "i" 'navi2ch-bm-fetch-article) 55 (define-key map "e" 'navi2ch-bm-textize-article) 56 (navi2ch-define-delete-keys map 'navi2ch-bm-select-article-or-scroll-down) 57 (define-key map "n" 'navi2ch-bm-next-line) 58 (define-key map "p" 'navi2ch-bm-previous-line) 59 (define-key map "U" 'navi2ch-bm-show-url) 60 (define-key map "l" 'navi2ch-bm-view-logo) 61 (define-key map "A" 'navi2ch-bm-add-global-bookmark) 62 (define-key map "g" 'navi2ch-bm-goto-board) 63 (define-key map "q" 'navi2ch-bm-exit) 64 (define-key map "S" 'navi2ch-bm-sort) 65 (define-key map "?" 'navi2ch-bm-search) 66 (define-key map "\C-c\C-m" 'navi2ch-message-pop-message-buffer) 67 (define-key map "R" 'navi2ch-bm-remove-article) 68 (define-key map "\C-c\C-r" 'navi2ch-bm-remove-article) 69 (define-key map "\C-o" 'navi2ch-bm-save-dat-file) 70 (define-key map "I" 'navi2ch-bm-fetch-maybe-new-articles) 71 72 ;; mark command 73 (define-key map "*" 'navi2ch-bm-mark) 74 (define-key map "u" 'navi2ch-bm-unmark) 75 (define-key map "m" nil) 76 (define-key map "mr" 'navi2ch-bm-mark-region) 77 (define-key map "ma" 'navi2ch-bm-mark-all) 78 (define-key map "mA" 'navi2ch-bm-add-global-bookmark-mark-article) 79 (define-key map "m." 'navi2ch-bm-display-mark-article) 80 (define-key map "mi" 'navi2ch-bm-fetch-mark-article) 81 (define-key map "me" 'navi2ch-bm-textize-mark-article) 82 (define-key map "mm" 'navi2ch-bm-mark-marks) 83 (define-key map "m?" 'navi2ch-bm-mark-by-query) 84 (define-key map "mb" 'navi2ch-bm-add-bookmark-mark-article) 85 (define-key map "mR" 'navi2ch-bm-remove-mark-article) 86 (setq navi2ch-bm-mode-map map))) 87 88(defvar navi2ch-bm-mode-menu-spec 89 '(["Toggle offline" navi2ch-toggle-offline] 90 ["Exit" navi2ch-bm-exit] 91 ["Sort" navi2ch-bm-sort] 92 ["Search" navi2ch-bm-search]) 93 "Menu $B$N85(B") 94 95(defvar navi2ch-board-buffer-name "*navi2ch board*") 96 97;; set by navi2ch-bm-setup 98(defvar navi2ch-bm-get-property-function nil 99 "$B$=$N0LCV$N(B text-property $B$rF@$k4X?t!#0z?t$O(B POINT") 100(defvar navi2ch-bm-set-property-function nil 101 "text-property $B$r@_Dj$9$k4X?t!#0z?t$O(B BEGIN END ITEM") 102(defvar navi2ch-bm-get-board-function nil 103 "$BHD$rF@$k4X?t!#0z?t$O(B ITEM") 104(defvar navi2ch-bm-get-article-function nil 105 "$B%9%l$rF@$k4X?t!#0z?t$O(B ITEM") 106(defvar navi2ch-bm-exit-function nil) 107 108;; stub functions 109;; set by navi2ch-bm-setup 110(defun navi2ch-bm-get-property-internal (point)) 111(defun navi2ch-bm-set-property-internal (begin end item)) 112(defun navi2ch-bm-get-board-internal (item)) 113(defun navi2ch-bm-get-article-internal (item)) 114(defun navi2ch-bm-exit-internal ()) 115 116(defvar navi2ch-bm-fetched-article-list nil) 117(defvar navi2ch-bm-board-type-alist nil) 118 119(defvar navi2ch-bm-state-char-table 120 (navi2ch-alist-to-hash 121 '((view . ?V) 122 (cache . ?C) 123 (update . ?U) 124 (down . ?D) 125 (nil . ? )) 126 :test 'eq)) 127 128 129(eval-and-compile 130 (let ((state-list '(view cache update down nil)) 131 (update-list '(nil new updated seen))) 132 (let ((func (lambda (f) 133 (navi2ch-alist-to-hash 134 (mapcar (lambda (state) 135 (cons state 136 (navi2ch-alist-to-hash 137 (mapcar (lambda (update) 138 (cons update 139 (funcall f state update))) 140 update-list) 141 :test 'eq))) 142 state-list) 143 :test 'eq)))) 144 (defconst navi2ch-bm-state-face-table 145 (funcall func 146 (lambda (state update) 147 (intern (format "navi2ch-bm%s-%s-face" 148 (if update 149 (format "-%s" update) 150 "") 151 (or state 'unread)))))) 152 (defconst navi2ch-bm-state-mark-face-table 153 (funcall func 154 (lambda (state update) 155 (intern (format "navi2ch-bm%s-mark-face" 156 (if update 157 (format "-%s" update) 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 "$B%?%$%H%k$,(B TITLE $B$G(B $BFbMF$,(B `navi2ch-bm-mode-menu-spec' $B$H(B MENU-SPEC 194$B$r7R$2$?%a%K%e!<$r:n$k!#(B" 195 (append (list title) 196 navi2ch-bm-mode-menu-spec 197 '("----") 198 menu-spec)) 199 200;; (defvar navi2ch-list-navi2ch-category-alist nil) ; $B%3%s%Q%$%k$rDL$90Y(B 201 202(defun navi2ch-bm-regist-board (type open-func &optional board) 203 "TYPE $B$JHD$r3+$/4X?t(B OPEN-FUNC $B$r(B `navi2ch-bm-board-type-alist' $B$KEP(B 204$BO?$9$k!#$^$?!"F1;~$K(B BOARD $B$r(B `navi2ch-list-navi2ch-category-alist' $B$K(B 205$BEPO?$9$k!#(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 "$B$=$N0LCV$N(B state $B$rD4$Y$k!#(B" 356 (get-text-property (or point (point)) 'navi2ch-bm-state)) 357 358(defsubst navi2ch-bm-get-updated-mark (&optional point) 359 "$B$=$N0LCV$N(B updated-mark $B$rD4$Y$k!#(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 "$BHD$N(B url $B$rI=<($7$F!"$=$N(B url $B$r8+$k$+(B kill ring $B$K%3%T!<$9$k!#(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 "$B%a%K%e!<$rI=<($7$F!"(Burl $B$rF@$k!#(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 "$B%a%K%e!<$rI=<($7$F!"%?%$%H%k$rF@$k!#(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 "$B$=$NHD$N%m%4$r8+$k!#(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 $B$9$k!#(B 655INTERACTIVE $B$,(B non-nil $B$J$i(B mark $B$7$?$"$H0\F0$9$k!#(B 656ARG $B$,(B non-nil $B$J$i0\F0J}8~$r5U$K$9$k!#(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 "$B99?7$5$l$F$$$k2DG=@-$N$"$k%9%l$r(B fetch $B$9$k!#(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 ;; $BL$CN$N>uBV!#(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 $B$r8F$P$;$k$K$O(B nil $B$,M_$7$$$i$7$$!#$O$^$C$?(B($B5c(B)$B!#(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 "$BHD%P%C%U%!$N$&$A!"(BBOARD $B$H(B ARTICLE $B$K%^%C%A$9$k9T$r99?7$9$k!#(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 $B$H(B ARTICLES $B$G;XDj$5$l$k%9%l$N>pJs$r>C$9!#(B 951ARTILCES $B$,(B alist $B$N>l9g$O$=$N%9%l$N$_$r!"(Balist $B$N(B list $B$N>l9g$O;XDj$5(B 952$B$l$k$9$Y$F$N%9%l$rBP>]$K$9$k!#(B" 953 (let ((summary (navi2ch-article-load-article-summary board))) 954 (setq articles 955 (cond ((cdr (assq 'artid articles)) ; $B%9%l(B alist 956 (list articles)) 957 ((cdr (assq 'artid (car articles))) ; $B%9%l(B alist $B$N(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 $B$N2<$N%j%s%/$r;X$9(B URL $B$rF@$k!#(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 1015