navi2ch-popup-article.el

   1 ;;; navi2ch-popup-article.el --- popup article module for navi2ch -*- coding: iso-2022-7bit; -*-
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008, 2009 by Navi2ch
   4 ;; 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 ;;
  27
  28 ;;; Code:
  29 (provide 'navi2ch-popup-article)
  30 (defconst navi2ch-popup-article-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-popup-article-buffer-name "*navi2ch popup article*")
  40 (defvar navi2ch-popup-article-window-configuration nil)
  41 (defvar navi2ch-popup-article-mode-map nil)
  42 (unless navi2ch-popup-article-mode-map
  43   (let ((map (make-sparse-keymap)))
  44     (set-keymap-parent map navi2ch-global-view-map)
  45     (define-key map "j" 'navi2ch-article-few-scroll-up)
  46     (define-key map "k" 'navi2ch-article-few-scroll-down)
  47     (define-key map " " 'navi2ch-article-scroll-up)
  48     (navi2ch-define-delete-keys map 'navi2ch-article-scroll-down)
  49     (define-key map "\r" 'navi2ch-popup-article-select-current-link)
  50     (unless (featurep 'xemacs)
  51       (define-key map [follow-link] 'mouse-face))
  52     (navi2ch-define-mouse-key map 2 'navi2ch-popup-article-mouse-select)
  53     (define-key map "g" 'navi2ch-article-goto-number)
  54     (define-key map "q" 'navi2ch-popup-article-exit)
  55     (define-key map "Q" 'navi2ch-popup-article-exit-and-goto-number)
  56     (define-key map "l" 'navi2ch-popup-article-pop-point-or-exit)
  57     (define-key map "L" 'navi2ch-article-pop-poped-point)
  58     (define-key map "m" 'navi2ch-article-push-point)
  59     (define-key map "R" 'navi2ch-article-rotate-point)
  60     (define-key map "U" 'navi2ch-popup-article-show-url)
  61     (define-key map "." 'navi2ch-article-redisplay-current-message)
  62     (define-key map "p" 'navi2ch-article-previous-message)
  63     (define-key map "n" 'navi2ch-article-next-message)
  64     (define-key map [(shift tab)] 'navi2ch-article-previous-link)
  65     (define-key map [(shift iso-lefttab)] 'navi2ch-article-previous-link)
  66     (define-key map [(iso-lefttab)] 'navi2ch-article-previous-link)
  67     (define-key map "\e\C-i" 'navi2ch-article-previous-link)
  68     (define-key map "\C-\i" 'navi2ch-article-next-link)
  69     (define-key map ">" 'navi2ch-article-goto-last-message)
  70     (define-key map "<" 'navi2ch-article-goto-first-message)
  71     (define-key map "\ed" 'navi2ch-article-decode-message)
  72     (define-key map "\ei" 'navi2ch-article-auto-decode-toggle-text)
  73     (define-key map "v" 'navi2ch-article-view-aa)
  74     (define-key map "?" 'navi2ch-article-search)
  75     (define-key map "d" 'navi2ch-popup-article-exclude-message)
  76     (define-key map "D" 'navi2ch-popup-article-hide-messages)
  77     (define-key map "A" 'navi2ch-popup-article-add-important-messages)
  78     (define-key map "u" 'navi2ch-show-url-at-point)
  79     (define-key map "\e\r" 'navi2ch-article-select-current-link)
  80     (when (featurep 'navi2ch-thumbnail)
  81       (define-key map "," 'navi2ch-thumbnail-select-current-link)
  82       (define-key map "V" 'navi2ch-thumbnail-save-content)
  83       (define-key map "\C-c\C-d" 'navi2ch-thumbnail-image-delete-cache)
  84       (define-key map "T" 'navi2ch-thumbnail-all-show))
  85     (setq navi2ch-popup-article-mode-map map)))
  86
  87 (defvar navi2ch-popup-article-current-board nil)
  88 (defvar navi2ch-popup-article-current-article nil)
  89 (defvar navi2ch-popup-article-exclude-stack nil)
  90 (defvar navi2ch-popup-number-list nil)
  91
  92 (defun navi2ch-popup-article-exit ()
  93   "PopUp Article \e$B%b!<%I$rH4$1$k!#\e(B"
  94   (interactive)
  95   (run-hooks 'navi2ch-popup-article-exit-hook)
  96   (bury-buffer)
  97   (set-window-configuration navi2ch-popup-article-window-configuration)
  98   (delete-windows-on (get-buffer navi2ch-popup-article-buffer-name))
  99   (unless (eq navi2ch-article-current-article
 100               navi2ch-popup-article-current-article)
 101     (navi2ch-article-view-article
 102      navi2ch-popup-article-current-board
 103      navi2ch-popup-article-current-article)))
 104
 105 (defun navi2ch-popup-article-exit-and-goto-number (&optional num)
 106   "Article \e$B%b!<%I$KLa$C$F$+$i:#$N0LCV$N%l%9$NHV9f$K0\F0!#\e(B
 107 NUM \e$B$,;XDj$5$l$l$P!"\e(B NUM \e$BHVL\$N%l%9$K0\F0!#\e(B"
 108   (interactive)
 109   (setq num (or num (navi2ch-article-get-current-number)))
 110   (navi2ch-popup-article-exit)
 111   (if (integerp num)
 112       (navi2ch-article-goto-number num t t)
 113     (navi2ch-popup-article num)))
 114
 115 (defun navi2ch-popup-article-pop-point-or-exit ()
 116   "stack \e$B$+$i\e(B pop \e$B$7$?0LCV$K0\F0$9$k!#\e(B
 117 stack \e$B$,6u$J$i!"\e(BPopUp Article \e$B%b!<%I$rH4$1$k!#\e(B"
 118   (interactive)
 119   (if navi2ch-article-point-stack
 120       (navi2ch-article-pop-point)
 121     (navi2ch-popup-article-exit)))
 122
 123 (defun navi2ch-popup-article-mode ()
 124   "\\{navi2ch-popup-article-mode-map}"
 125   (interactive)
 126   (kill-all-local-variables)
 127   (setq major-mode 'navi2ch-popup-article-mode)
 128   (setq mode-name "Navi2ch PopUp Article")
 129   (setq buffer-read-only t)
 130   (buffer-disable-undo)
 131   (make-local-variable 'truncate-partial-width-windows)
 132   (setq truncate-partial-width-windows nil)
 133   (use-local-map navi2ch-popup-article-mode-map)
 134   (setq navi2ch-article-point-stack nil)
 135   (setq navi2ch-popup-article-exclude-stack nil)
 136   (navi2ch-make-local-hook 'post-command-hook)
 137   (add-hook 'post-command-hook 'navi2ch-article-display-link-minibuffer nil t)
 138   (run-hooks 'navi2ch-popup-article-mode-hook))
 139
 140 (defun navi2ch-popup-article (num-list)
 141   (let ((mlist navi2ch-article-message-list)
 142         (sep navi2ch-article-separator)
 143         (buf (get-buffer-create navi2ch-popup-article-buffer-name))
 144         (popup-message-list navi2ch-article-message-list))
 145     (setq navi2ch-popup-article-window-configuration
 146           (current-window-configuration))
 147     (when (eq major-mode 'navi2ch-article-mode)
 148       (setq navi2ch-popup-article-current-board
 149             navi2ch-article-current-board
 150             navi2ch-popup-article-current-article
 151             navi2ch-article-current-article))
 152     (pop-to-buffer buf)
 153     (navi2ch-popup-article-mode) ; \e$B$3$3$G\e(B local-variable \e$B$,A4$F>C$5$l$k\e(B
 154     (setq navi2ch-popup-number-list num-list)
 155     (setq navi2ch-article-message-list
 156           (mapcar (lambda (x)
 157                     (let ((item (cdr x)))
 158                       (cons (car x)
 159                             (cond ((stringp item)
 160                                    item)
 161                                   ((consp item)
 162                                    (copy-alist item))
 163                                   (t item)))))
 164                   mlist))
 165     (setq popup-message-list
 166           (mapcar (lambda (x)
 167                     (let ((msg (navi2ch-article-get-message x)))
 168                       (cond
 169                        ((stringp msg) (cons x msg))
 170                        (msg (cons x (delq 'point (copy-alist msg))))
 171                        (t nil))))
 172                   num-list))
 173     (setq popup-message-list
 174           (delq nil popup-message-list))
 175     (if (null popup-message-list)
 176         (progn
 177           (navi2ch-popup-article-exit)
 178           (message "No responses found"))
 179       (setq navi2ch-article-separator sep)
 180       (setq navi2ch-article-point-stack nil)
 181       (setq navi2ch-article-poped-point-stack nil)
 182       (setq truncate-partial-width-windows nil)
 183       (setq navi2ch-article-view-range nil)
 184       (setq navi2ch-article-through-next-function 'navi2ch-popup-article-exit)
 185       (setq navi2ch-article-through-previous-function
 186             'navi2ch-popup-article-exit)
 187       (let ((buffer-read-only nil))
 188         (erase-buffer)
 189         (navi2ch-article-insert-messages
 190          popup-message-list
 191          nil))
 192       (setq navi2ch-article-current-article nil
 193             navi2ch-article-message-list
 194             (mapcar (lambda (x)
 195                       (let ((num (car x))
 196                             item)
 197                         (or (assq num popup-message-list)
 198                             (cons num
 199                                   (if (consp (setq item (cdr x)))
 200                                       (delete (assq 'point item) item)
 201                                     item)))))
 202                     navi2ch-article-message-list))
 203       (goto-char (point-min)))))
 204
 205 (defun navi2ch-popup-article-scroll-up ()
 206   "\e$B2hLL$r%9%/%m!<%k$9$k!#\e(B"
 207   (interactive)
 208   (condition-case nil
 209       (scroll-up)
 210     (end-of-buffer
 211      (navi2ch-popup-article-exit)))
 212   (force-mode-line-update t))
 213
 214 (defun navi2ch-popup-article-select-current-link (&optional browse-p)
 215   ;; \e$B$[$\\e(B navi2ch-article-select-current-link \e$B$HF1$8!#\e(B
 216   "\e$B%+!<%=%k0LCV$K1~$8$F!"%j%s%/@h$NI=<($d%U%!%$%k$X$NJ]B8$r9T$&!#\e(B"
 217   (interactive "P")
 218   (let ((type (get-text-property (point) 'navi2ch-link-type))
 219         (prop (get-text-property (point) 'navi2ch-link)))
 220     (cond
 221      ((eq type 'number)
 222       (setq prop (navi2ch-article-str-to-num (japanese-hankaku prop)))
 223       (if (and (integerp prop)
 224                (memq prop navi2ch-popup-number-list))
 225           (navi2ch-article-goto-number prop t t)
 226         (navi2ch-popup-article-exit)
 227         (navi2ch-article-select-current-link-number prop browse-p)))
 228      ((eq type 'url)
 229       (navi2ch-article-select-current-link-url prop browse-p t))
 230      ((eq type 'content)
 231       (navi2ch-article-save-content)))))
 232
 233 (defun navi2ch-popup-article-mouse-select (e)
 234   "\e$B%^%&%9$N0LCV$K1~$8$F!"%j%s%/@h$NI=<($d%U%!%$%k$X$NJ]B8$r9T$&!#\e(B"
 235   (interactive "e")
 236   (mouse-set-point e)
 237   (navi2ch-popup-article-select-current-link))
 238
 239 (defun navi2ch-popup-article-show-url ()
 240   "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"
 241   (interactive)
 242   (let ((navi2ch-article-current-board navi2ch-popup-article-current-board)
 243         (navi2ch-article-current-article navi2ch-popup-article-current-article))
 244     (navi2ch-article-show-url)))
 245
 246 (defun navi2ch-popup-article-exclude-message (&optional prefix)
 247   "\e$B%l%9$rI=<($+$i=|30$9$k!#\e(B"
 248   (interactive "P")
 249   (if prefix
 250       (navi2ch-popup-article-undo-exclude-message)
 251     (let ((buffer-read-only nil)
 252           (num (navi2ch-article-get-current-number)))
 253       (if (null num)
 254           (message "No message")
 255         (push num navi2ch-popup-article-exclude-stack)
 256         (save-excursion
 257           (delete-region
 258            (if (get-text-property (point) 'current-number)
 259                (point)
 260              (navi2ch-previous-property (point) 'current-number))
 261            (or (navi2ch-next-property (point) 'current-number)
 262                (point-max))))
 263         (message "Exclude message")))))
 264
 265 (defun navi2ch-popup-article-undo-exclude-message ()
 266   "\e$BI=<($+$i=|30$7$?%l%9$rI|3h$5$;$k!#\e(B"
 267   (interactive)
 268   (let ((buffer-read-only nil)
 269         (num (pop navi2ch-popup-article-exclude-stack)))
 270     (if (null num)
 271         (message "No message excluded")
 272       (save-excursion
 273         (navi2ch-article-reinsert-partial-messages num num))
 274       (navi2ch-article-goto-number num t)
 275       (message "Push point and undo exclude message"))))
 276
 277 (defun navi2ch-popup-article-sift-messages (sym msg)
 278   (let ((list (navi2ch-article-get-visible-numbers)))
 279     (if (null list)
 280         (message "No popup message")
 281       (navi2ch-popup-article-exit)
 282       (setq navi2ch-article-current-article
 283             (navi2ch-put-alist
 284              sym
 285              (navi2ch-union (cdr (assq sym navi2ch-article-current-article))
 286                             list)
 287              navi2ch-article-current-article))
 288       (let ((buffer-read-only nil))
 289         (navi2ch-article-save-view
 290           (erase-buffer)
 291           (navi2ch-article-insert-messages
 292            navi2ch-article-message-list
 293            navi2ch-article-view-range)))
 294       (message msg))))
 295
 296 (defun navi2ch-popup-article-hide-messages ()
 297   "\e$BI=<(Cf$N%l%9$r$^$H$a$F1#$9!#\e(B"
 298   (interactive)
 299   (if (navi2ch-y-or-n-p "Hide popup messages? ")
 300       (navi2ch-popup-article-sift-messages 'hide
 301                                            "Hide messages")
 302     (message "Don't hide messages")))
 303
 304 (defun navi2ch-popup-article-add-important-messages ()
 305   "\e$BI=<(Cf$N%l%9$r$^$H$a$F%V%C%/%^!<%/$KEPO?$9$k!#\e(B"
 306   (interactive)
 307   (if (navi2ch-y-or-n-p "Add important popup messages? ")
 308       (navi2ch-popup-article-sift-messages 'important
 309                                            "Add important messages")
 310     (message "Don't add important messages")))
 311
 312 (defun navi2ch-popup-article-url-at-point (point)
 313   "POINT \e$B$N2<$N%j%s%/$r;X$9\e(B URL \e$B$rF@$k!#\e(B"
 314   (let ((navi2ch-article-current-board navi2ch-popup-article-current-board)
 315         (navi2ch-article-current-article navi2ch-popup-article-current-article))
 316     (navi2ch-article-url-at-point point)))
 317
 318 (run-hooks 'navi2ch-popup-article-load-hook)
 319 ;;; navi2ch-popup-article.el ends here