dot-files/_navi2ch/elisp/sinsure_el

   1 (require 'navi2ch)
   2
   3 (defun navi2ch-new-thread-check (new old)
   4   (let* ((article (navi2ch-article-url-to-article new))
   5          (board   (navi2ch-board-url-to-board new))
   6          (file (navi2ch-article-get-file-name board article))
   7          (regex (regexp-quote (navi2ch-replace-string
   8                                ;; »ª°ÜÅ¾¤â¤¢¤ë¤Î¤Ç¡¢»ªÌ¾¤Þ¤Çºï¤ë
   9                                "^http://[^.]+\\|/$"
  10                                "" old 'all))))
  11     (unless (file-exists-p file)
  12       (when (navi2ch-article-fetch-article board article)
  13         (navi2ch-bm-remember-fetched-article board article)))
  14     (when (file-exists-p file)
  15       (with-temp-buffer
  16         (navi2ch-insert-file-contents file)
  17         ;; µì¥¹¥ì¥Ã¥É¤ÎURL¤¬½ñ¤¤¤Æ¤¢¤ë¤«¥Á¥§¥Ã¥¯
  18         (if (re-search-forward regex
  19                                ;; 1-5¤ò¥Á¥§¥Ã¥¯
  20                                (navi2ch-line-beginning-position 6)
  21                                t)
  22             t
  23           ;; (navi2ch-bm-remove-article-subr board article)
  24           nil)))))
  25
  26 (defun navi2ch-subject-seriese-format (subject)
  27   ;; Á´³Ñ/È¾³Ñ¤ò¶èÊÌ¤·¤Ê¤¤
  28   (setq subject (japanese-zenkaku subject))
  29   (setq subject (japanese-hankaku subject 'ascii-only))
  30   ;; ÂçÊ¸»ú/¾®Ê¸»ú¤ò¶èÊÌ¤·¤Ê¤¤
  31   (setq subject (upcase subject))
  32   ;; ¤Ò¤é¤¬¤Ê/¥«¥¿¥«¥Ê¤ò¶èÊÌ¤·¤Ê¤¤
  33   (setq subject (japanese-hiragana subject))
  34   ;; ¶õÇò¡¦¿ô»ú¤òÌµ»ë
  35   (setq subject (navi2ch-replace-string "[ \t0-9]" "" subject 'all)))
  36
  37 (defun navi2ch-subject-seriese-p (subject1 subject2)
  38   ;; ¥¹¥ì¥¿¥¤¤ÎÈæ³Ó¤Ã¤Æ¤É¤¦¤ä¤ì¤Ð¤¤¤¤¤Î¤«Ê¬¤«¤é¤ó¡£
  39   ;; ¤È¤ê¤¢¤¨¤º¡¢Á´³Ñ/È¾³Ñ¡¦¤Ò¤é¤¬¤Ê/¥«¥¿¥«¥Ê¤òÂ·¤¨¤¿¸å¤Ç
  40   ;; Ã»¤¤¤Û¤¦¤ÎÁ°¸å10%¤Å¤Ä¤òÀÚ¤ê¼Î¤Æ¤Æ
  41   ;; (string-match "Ã»¤¤Êý" "Ä¹¤¤Êý") ¤È¤·¤Æ¤ë¡£
  42   (unless (string= subject1 subject2)
  43     (let* ((subj1 (navi2ch-subject-seriese-format subject1))
  44            (subj2 (navi2ch-subject-seriese-format subject2))
  45            (ratio 0.1)
  46            from to)
  47       (when (> (length subj1) (length subj2))
  48         (let ((tmp subj1))
  49           (setq subj1 subj2
  50                 subj2 tmp)))
  51       (setq from (round (* (length subj1) ratio)))
  52       (unless (= from 0)
  53         (setq to (- from)))
  54       (string-match (regexp-quote (substring subj1 from to))
  55                     subj2))))
  56
  57 (defun navi2ch-article-search-new-thread-with-subject ()
  58   ;; Îà»÷¥µ¥Ö¥¸¥§¥¯¥È¤Î¥¹¥ì¤ò¥Á¥§¥Ã¥¯
  59   (let* ((article navi2ch-article-current-article)
  60          (board navi2ch-article-current-board)
  61          (subject (cdr (assoc 'subject article)))
  62          (curl (navi2ch-article-to-url board article))
  63          (file (navi2ch-board-get-file-name board))
  64          list nurl found)
  65     (unless navi2ch-offline
  66       (navi2ch-board-save-old-subject-file board)
  67       (navi2ch-board-update-file board))
  68     (setq list (navi2ch-board-get-subject-list file))
  69     (catch 'find
  70       (while list
  71         (let* ((atcl (car list))
  72                (sbj (cdr (assoc 'subject atcl))))
  73           (setq nurl (navi2ch-article-to-url board atcl)
  74                 list (cdr list))
  75           (when (and (navi2ch-subject-seriese-p subject sbj)
  76                      (navi2ch-new-thread-check nurl curl))
  77             (throw 'find (setq found t))))))
  78     (if found nurl)))
  79
  80 (defun navi2ch-article-search-new-thread-with-lead ()
  81   ;; ¿·¥¹¥ì¤Ø¤ÎÍ¶Æ³¤ò¥Á¥§¥Ã¥¯
  82   (let ((cboard (cdr (assoc 'name navi2ch-article-current-board)))
  83         (curl (navi2ch-article-to-url navi2ch-article-current-board
  84                                       navi2ch-article-current-article))
  85         (msg-list (reverse navi2ch-article-message-list))
  86         (num 850)                       ;¿·¥¹¥ì°Ü¹Ô¤Ï850°Ê¹ß¤«¤Ê¡£
  87         nboard url body start found)
  88     (catch 'find
  89       (while (> (length msg-list) num)
  90         (setq body (if (listp (cdar msg-list))
  91                        (cdr (assoc 'data (cdar msg-list)))
  92                      (cdar msg-list))
  93               msg-list (cdr msg-list))
  94         (setq start 0)
  95         (while (string-match navi2ch-article-url-regexp body start)
  96           (setq url (match-string 0 body)
  97                 start (match-end 0))
  98           (setq nboard (cdr (assoc 'name (navi2ch-board-url-to-board url))))
  99           ;; Æ±¤¸ÈÄ¤À¤Ã¤¿¤é¥Á¥§¥Ã¥¯
 100           (when (and nboard
 101                      ;; °ÜÅ¾¤·¤Æ¤Æ¤âÇ°¤Î¤¿¤á¥Á¥§¥Ã¥¯
 102                      (or (string= nboard "No Name") (string= nboard cboard))
 103                      (navi2ch-new-thread-check url curl))
 104             (throw 'find (setq found t))))
 105         (setq num (1+ num))))
 106     (if found url)))
 107
 108 (defun navi2ch-article-new-thread ()
 109   "¿·¥¹¥ì¤Ë°ÜÆ°¤¹¤ë¡£"
 110   (interactive)
 111   (let ((url (or (navi2ch-article-search-new-thread-with-lead)
 112                  (navi2ch-article-search-new-thread-with-subject))))
 113     (if url
 114         (let* ((article (navi2ch-article-url-to-article url))
 115                (board (navi2ch-board-url-to-board url))
 116                (subj (navi2ch-article-cached-subject board article)))
 117           (when (navi2ch-y-or-n-p (concat "¡Ö" subj "¡×¤Ë°ÜÆ°¤¹¤ë¡©"))
 118             (navi2ch-goto-url url)))
 119       (message (concat "¿·¥¹¥ì¤òÈ¯¸«¤Ç¤¤Þ¤»¤ó¤Ç¤·¤¿¡£"
 120                        (substitute-command-keys
 121                         "`\\[navi2ch-article-goto-current-board]'")
 122                        " ¤·¤Æ¼êÆ°¤ÇÃµ¤·¤Æ¤Í¡£")))))
 123
 124 (define-key navi2ch-article-mode-map "\C-c\C-n" 'navi2ch-article-new-thread)
 125
 126 (provide 'sinsure)