1;;; navi2ch-util.el --- useful utilities for navi2ch -*- coding: iso-2022-7bit; -*- 2 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 4;; 2009 by Navi2ch Project 5 6;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000 Free 7;; Software Foundation, Inc. 8 9;; Author: Taiki SUGAWARA <taiki@users.sourceforge.net> 10;; Keywords: network, 2ch 11 12;; This file is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; This file is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to 24;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25;; Boston, MA 02111-1307, USA. 26 27;;; Commentary: 28 29;; 30 31;;; Code: 32(provide 'navi2ch-util) 33(defconst navi2ch-util-ident 34 "$Id$") 35 36(eval-when-compile (require 'cl)) 37(require 'timezone) 38(require 'browse-url) 39(require 'base64) 40 41(require 'navi2ch-vars) 42 43(defun navi2ch-alist-to-hash (alist &rest keywords-args) 44 (let ((table (apply #'make-hash-table :size (length alist) keywords-args))) 45 (dolist (x alist table) 46 (puthash (car x) (cdr x) table)))) 47 48(defvar navi2ch-mode-line-identification nil) 49(make-variable-buffer-local 'navi2ch-mode-line-identification) 50 51(defvar navi2ch-replace-html-tag-alist 52 '((">" . ">") 53 ("<" . "<") 54 (""" . "\"") 55 (" " . " ") 56 ("&" . "&") 57 ("<br>" . "\n") 58 ("<hr>" . "\n--\n")) 59 "$BCV49$9$k(B html $B$N%?%0$NO"A[%j%9%H(B ($B@55,I=8=$O;H$($J$$(B)$B!#(B") 60 61(defvar navi2ch-replace-html-tag-regexp-alist 62 '(("</?[?!a-zA-Z][^<>]*>" . "") 63 ("&[a-z][a-z0-9]*;?" . navi2ch-entity-reference-to-str) 64 ("&#[0-9]+;?" . navi2ch-numeric-reference-to-str) 65 ("&#[xX][0-9a-fA-f]+;?" . navi2ch-hexadecimal-reference-to-str)) 66 "$BCV49$9$k(B html $B$N%?%0$NO"A[%j%9%H(B($B@55,I=8=(B) 67$BCV49@h$,4X?t$@$H!"CV4985$r0z?t$H$7$F$=$N4X?t$r8F$S$@$7$?$b$N$GCV$-BX$($k!#(B 68$B@55,I=8=$,I,MW$J$$>l9g$O(B `navi2ch-replace-html-tag-alist' $B$KF~$l$k(B") 69 70(defvar navi2ch-replace-html-tag-regexp-internal nil 71 "$BCV49$9$k(B html $B$N%?%0$N@55,I=8=!#(B") 72 73(defvar navi2ch-entity-table 74 (navi2ch-alist-to-hash 75 '(("iexcl" . 161) ("cent" . 162) ("pound" . 163) 76 ("curren" . 164) ("yen" . 165) ("brvbar" . 166) 77 ("sect" . 167) ("uml" . 168) ("copy" . 169) 78 ("ordf" . 170) ("laquo" . 171) ("not" . 172) 79 ("shy" . 173) ("reg" . 174) ("macr" . 175) 80 ("deg" . 176) ("plusmn" . 177) ("sup2" . 178) 81 ("sup3" . 179) ("acute" . 180) ("micro" . 181) 82 ("para" . 182) ("middot" . 183) ("cedil" . 184) 83 ("sup1" . 185) ("ordm" . 186) ("raquo" . 187) 84 ("frac14" . 188) ("frac12" . 189) ("frac34" . 190) 85 ("iquest" . 191) ("Agrave" . 192) ("Aacute" . 193) 86 ("Acirc" . 194) ("Atilde" . 195) ("Auml" . 196) 87 ("Aring" . 197) ("AElig" . 198) ("Ccedil" . 199) 88 ("Egrave" . 200) ("Eacute" . 201) ("Ecirc" . 202) 89 ("Euml" . 203) ("Igrave" . 204) ("Iacute" . 205) 90 ("Icirc" . 206) ("Iuml" . 207) ("ETH" . 208) 91 ("Ntilde" . 209) ("Ograve" . 210) ("Oacute" . 211) 92 ("Ocirc" . 212) ("Otilde" . 213) ("Ouml" . 214) 93 ("times" . 215) ("Oslash" . 216) ("Ugrave" . 217) 94 ("Uacute" . 218) ("Ucirc" . 219) ("Uuml" . 220) 95 ("Yacute" . 221) ("THORN" . 222) ("szlig" . 223) 96 ("agrave" . 224) ("aacute" . 225) ("acirc" . 226) 97 ("atilde" . 227) ("auml" . 228) ("aring" . 229) 98 ("aelig" . 230) ("ccedil" . 231) ("egrave" . 232) 99 ("eacute" . 233) ("ecirc" . 234) ("euml" . 235) 100 ("igrave" . 236) ("iacute" . 237) ("icirc" . 238) 101 ("iuml" . 239) ("eth" . 240) ("ntilde" . 241) 102 ("ograve" . 242) ("oacute" . 243) ("ocirc" . 244) 103 ("otilde" . 245) ("ouml" . 246) ("divide" . 247) 104 ("oslash" . 248) ("ugrave" . 249) ("uacute" . 250) 105 ("ucirc" . 251) ("uuml" . 252) ("yacute" . 253) 106 ("thorn" . 254) ("yuml" . 255) ("fnof" . 402) 107 ("Alpha" . 913) ("Beta" . 914) ("Gamma" . 915) 108 ("Delta" . 916) ("Epsilon" . 917) ("Zeta" . 918) 109 ("Eta" . 919) ("Theta" . 920) ("Iota" . 921) 110 ("Kappa" . 922) ("Lambda" . 923) ("Mu" . 924) 111 ("Nu" . 925) ("Xi" . 926) ("Omicron" . 927) 112 ("Pi" . 928) ("Rho" . 929) ("Sigma" . 931) 113 ("Tau" . 932) ("Upsilon" . 933) ("Phi" . 934) 114 ("Chi" . 935) ("Psi" . 936) ("Omega" . 937) 115 ("alpha" . 945) ("beta" . 946) ("gamma" . 947) 116 ("delta" . 948) ("epsilon" . 949) ("zeta" . 950) 117 ("eta" . 951) ("theta" . 952) ("iota" . 953) 118 ("kappa" . 954) ("lambda" . 955) ("mu" . 956) 119 ("nu" . 957) ("xi" . 958) ("omicron" . 959) 120 ("pi" . 960) ("rho" . 961) ("sigmaf" . 962) 121 ("sigma" . 963) ("tau" . 964) ("upsilon" . 965) 122 ("phi" . 966) ("chi" . 967) ("psi" . 968) 123 ("omega" . 969) ("thetasym" . 977) ("upsih" . 978) 124 ("piv" . 982) ("bull" . 8226) ("hellip" . 8230) 125 ("prime" . 8242) ("Prime" . 8243) ("oline" . 8254) 126 ("frasl" . 8260) ("weierp" . 8472) ("image" . 8465) 127 ("real" . 8476) ("trade" . 8482) ("alefsym" . 8501) 128 ("larr" . 8592) ("uarr" . 8593) ("rarr" . 8594) 129 ("darr" . 8595) ("harr" . 8596) ("crarr" . 8629) 130 ("lArr" . 8656) ("uArr" . 8657) ("rArr" . 8658) 131 ("dArr" . 8659) ("hArr" . 8660) ("forall" . 8704) 132 ("part" . 8706) ("exist" . 8707) ("empty" . 8709) 133 ("nabla" . 8711) ("isin" . 8712) ("notin" . 8713) 134 ("ni" . 8715) ("prod" . 8719) ("sum" . 8721) 135 ("minus" . 8722) ("lowast" . 8727) ("radic" . 8730) 136 ("prop" . 8733) ("infin" . 8734) ("ang" . 8736) 137 ("and" . 8743) ("or" . 8744) ("cap" . 8745) 138 ("cup" . 8746) ("int" . 8747) ("there4" . 8756) 139 ("sim" . 8764) ("cong" . 8773) ("asymp" . 8776) 140 ("ne" . 8800) ("equiv" . 8801) ("le" . 8804) 141 ("ge" . 8805) ("sub" . 8834) ("sup" . 8835) 142 ("nsub" . 8836) ("sube" . 8838) ("supe" . 8839) 143 ("oplus" . 8853) ("otimes" . 8855) ("perp" . 8869) 144 ("sdot" . 8901) ("lceil" . 8968) ("rceil" . 8969) 145 ("lfloor" . 8970) ("rfloor" . 8971) ("lang" . 9001) 146 ("rang" . 9002) ("loz" . 9674) ("spades" . 9824) 147 ("clubs" . 9827) ("hearts" . 9829) ("diams" . 9830) 148 ("OElig" . 338) ("oelig" . 339) ("Scaron" . 352) 149 ("scaron" . 353) ("Yuml" . 376) ("circ" . 710) 150 ("tilde" . 732) ("ensp" . 8194) ("emsp" . 8195) 151 ("thinsp" . 8201) ("zwnj" . 8204) ("zwj" . 8205) 152 ("lrm" . 8206) ("rlm" . 8207) ("ndash" . 8211) 153 ("mdash" . 8212) ("lsquo" . 8216) ("rsquo" . 8217) 154 ("sbquo" . 8218) ("ldquo" . 8220) ("rdquo" . 8221) 155 ("bdquo" . 8222) ("dagger" . 8224) ("Dagger" . 8225) 156 ("permil" . 8240) ("lsaquo" . 8249) ("rsaquo" . 8250) 157 ("euro" . 8364)) 158 :test 'equal)) 159 160(defconst navi2ch-uuencode-begin-delimiter-regexp 161 "^begin \\([0-7]+\\) \\([^ \n]+\\)$" 162 "uuencode $B$5$l$?%3!<%I$NA0$N%G%j%_%?$K%^%C%A$9$k@55,I=8=!#(B") 163(defconst navi2ch-uuencode-end-delimiter-regexp 164 "^end\\([ \t]*\\)$" 165 "uuencode $B$5$l$?%3!<%I$N8e$N%G%j%_%?$K%^%C%A$9$k@55,I=8=!#(B") 166 167(defconst navi2ch-uuencode-line-regexp 168 "^[!-`]+$" 169 "uuencode $B$5$l$?%3!<%I$N$_$,4^$^$l$k9T$K%^%C%A$9$k@55,I=8=!#(B") 170 171(defconst navi2ch-base64-begin-delimiter "----BEGIN BASE64----" 172 "base64 $B%3!<%I$NA0$KA^F~$9$k%G%j%_%?!#(B") 173(defconst navi2ch-base64-end-delimiter "----END BASE64----" 174 "base64 $B%3!<%I$N8e$KA^F~$9$k%G%j%_%?!#(B") 175 176(defconst navi2ch-base64-begin-delimiter-regexp 177 (format "^%s\\((\\([^\)]+\\))\\)?.*$" 178 (regexp-quote navi2ch-base64-begin-delimiter)) 179 "base64 $B%3!<%I$NA0$N%G%j%_%?$K%^%C%A$9$k@55,I=8=!#(B") 180(defconst navi2ch-base64-end-delimiter-regexp 181 (format "^%s.*$" (regexp-quote navi2ch-base64-end-delimiter)) 182 "base64 $B%3!<%I$N8e$N%G%j%_%?$K%^%C%A$9$k@55,I=8=!#(B") 183(defconst navi2ch-base64-susv3-begin-delimiter-regexp 184 "^begin-base64 \\([0-7]+\\) \\([^ \n]+\\)$" 185 "SUSv3 $B$N(B uuencode $B$G:n@.$5$l$k(B base64 $B%3!<%I$NA0$N%G%j%_%?$K%^%C%A$9$k@55,I=8=(B") 186(defconst navi2ch-base64-susv3-end-delimiter-regexp 187 "^====$" 188 "SUSv3 $B$N(B uuencode $B$G:n@.$5$l$k(B base64 $B%3!<%I$N8e$N%G%j%_%?$K%^%C%A$9$k@55,I=8=(B") 189 190(defconst navi2ch-base64-line-regexp 191 (concat 192 "^\\([+/0-9A-Za-z][+/0-9A-Za-z][+/0-9A-Za-z][+/0-9A-Za-z]\\)*" 193 "[+/0-9A-Za-z][+/0-9A-Za-z][+/0-9A-Za-z=][+/0-9A-Za-z=] *$") 194 "base64 $B%3!<%I$N$_$,4^$^$l$k9T$K%^%C%A$9$k@55,I=8=!#(B") 195 196(defvar navi2ch-offline nil "$B%*%U%i%$%s%b!<%I$+$I$&$+!#(B") 197(defvar navi2ch-online-indicator "[ON] ") 198(defvar navi2ch-offline-indicator "[--] ") 199(defvar navi2ch-modeline-online navi2ch-online-indicator) 200(defvar navi2ch-modeline-offline navi2ch-offline-indicator) 201(defvar navi2ch-modeline-be2ch-login "[BE] ") 202(defvar navi2ch-modeline-be2ch-logout "") 203(put 'navi2ch-modeline-online 'risky-local-variable t) 204(put 'navi2ch-modeline-offline 'risky-local-variable t) 205(put 'navi2ch-modeline-be2ch-login 'risky-local-variable t) 206(put 'navi2ch-modeline-be2ch-logout 'risky-local-variable t) 207 208;; shut up XEmacs warnings 209(eval-when-compile 210 (defvar minibuffer-allow-text-properties)) 211 212;;;; macros 213(defmacro navi2ch-ifxemacs (then &rest else) 214 "If on XEmacs, do THEN, else do ELSE. 215Like \"(if (featurep 'xemacs) THEN ELSE)\", but expanded at 216compilation time. Because byte-code of XEmacs is not compatible with 217GNU Emacs's one, this macro is very useful." 218 (if (featurep 'xemacs) 219 then 220 (cons 'progn else))) 221;; Navi2ch$B$N%3!<%I$r%O%/$9$k?M$O"-$r(B~/.emacs$B$K$bF~$l$H$-$^$7$g$&!#(B 222(put 'navi2ch-ifxemacs 'lisp-indent-function 1) 223 224(defmacro navi2ch-ifemacsce (then &rest else) 225 "If on EmacsCE, do THEN, else do ELSE. 226Expanded at compilation time." 227 `(if (string-match "windowsce" system-configuration) 228 ,then 229 (progn ,@else))) 230(put 'navi2ch-ifemacsce 'lisp-indent-function 1) 231 232;; from apel 233(eval-and-compile 234 (defmacro navi2ch-defalias-maybe (symbol definition) 235 "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined. 236See also the function `defalias'." 237 (setq symbol (eval symbol)) 238 (or (and (fboundp symbol) 239 (not (get symbol 'defalias-maybe))) 240 `(or (fboundp (quote ,symbol)) 241 (prog1 242 (defalias (quote ,symbol) ,definition) 243 ;; `defalias' updates `load-history' internally. 244 (put (quote ,symbol) 'defalias-maybe t)))))) 245 246(defmacro navi2ch-with-default-file-modes (mode &rest body) 247 "default-file-modes $B$r(B MODE $B$K$7$F(B BODY $B$r<B9T$9$k!#(B" 248 (let ((temp (make-symbol "--file-modes-temp--"))) 249 `(let ((,temp (default-file-modes))) 250 (unwind-protect 251 (progn 252 (set-default-file-modes 253 (navi2ch-ifxemacs 254 (if (integerp ,mode) 255 ,mode 256 (char-to-int ,mode)) 257 ,mode)) 258 ,@body) 259 (set-default-file-modes ,temp))))) 260 261(put 'navi2ch-with-default-file-modes 'lisp-indent-function 1) 262 263(defsubst navi2ch-cache-limit (cache) 264 (elt cache 0)) 265 266(defsubst navi2ch-cache-hash-table (cache) 267 (elt cache 1)) 268 269(defmacro navi2ch-cache-get (key value cache) 270 `(or (gethash ,key (navi2ch-cache-hash-table ,cache)) 271 (navi2ch-cache-put ,key ,value ,cache))) 272 273 274;;;; other misc stuff 275(defun navi2ch-mouse-key (num) 276 (navi2ch-ifxemacs 277 (intern (format "button%d" num)) 278 (vector (intern (format "mouse-%d" num))))) 279 280(defun navi2ch-define-mouse-key (map num command) 281 (define-key map (navi2ch-mouse-key num) command)) 282 283(defvar navi2ch-delete-keys 284 (list "\d" [del] [delete] [backspace] 285 (navi2ch-ifxemacs 286 [(shift space)] 287 [(shift ? )]))) 288 289(defun navi2ch-define-delete-keys (map command) 290 (dolist (key navi2ch-delete-keys) 291 (define-key map key command))) 292 293(eval-and-compile 294 (defalias 'navi2ch-set-buffer-multibyte 295 (if (fboundp 'set-buffer-multibyte) 296 #'set-buffer-multibyte 297 #'identity)) 298 299 (defalias 'navi2ch-match-string-no-properties 300 (if (fboundp 'match-string-no-properties) 301 #'match-string-no-properties 302 #'match-string))) 303 304(defun navi2ch-no-logging-message (fmt &rest args) 305 (navi2ch-ifxemacs 306 (apply #'lmessage 'no-log fmt args) 307 (let ((message-log-max nil)) 308 (apply #'message fmt args)))) 309 310(defun navi2ch-replace-string (regexp rep string 311 &optional all fixedcase literal) 312 "STRING $B$K4^$^$l$k(B REGEXP $B$r(B REP $B$GCV49$9$k!#(B 313REP $B$,4X?t$N>l9g$O!"%^%C%A$7$?J8;zNs$r0z?t$K$7$F$=$N4X?t$r8F$S=P$9!#(B 314 315FIXEDCASE$B!"(BLITERAL $B$O(B `replace-match' $B$K$=$N$^$^EO$5$l$k!#(B 316 317ALL $B$,(B non-nil $B$J$i$P!"%^%C%A$7$?%F%-%9%H$r$9$Y$FCV49$9$k!#(Bnil $B$J$i(B 318$B:G=i$N(B1$B$D$@$1$rCV49$9$k!#(B 319 320REGEXP $B$,8+$D$+$i$J$$>l9g!"(BSTRING $B$r$=$N$^$^JV$9!#(B" 321 (save-match-data 322 (if all 323 ;; Emacs 21 $B$N(B replace-regexp-in-string $B$N%Q%/$j!#(B 324 (let ((start 0) 325 (l (length string)) 326 mb me str matches) 327 (while (and (< start l) 328 (string-match regexp string start)) 329 (setq mb (match-beginning 0) 330 me (match-end 0)) 331 (if (= mb me) 332 (setq me (min l (1+ mb)))) 333 (string-match regexp (setq str (substring string mb me))) 334 (setq matches 335 (cons (replace-match (if (stringp rep) 336 rep 337 (funcall rep (match-string 0 str))) 338 fixedcase literal str) 339 (cons (substring string start mb) 340 matches))) 341 (setq start me)) 342 (apply #'concat (nreverse (cons (substring string start l) 343 matches)))) 344 (when (string-match regexp string) 345 (setq string (replace-match (if (stringp rep) 346 rep 347 (funcall rep (match-string 0 string))) 348 fixedcase literal string))) 349 string))) 350 351(defun navi2ch-replace-string-regexp-alist 352 (regexp-alist string &optional all fixedcase literal) 353 "STRING $BCf$+$i!"(BREGEXP-ALIST $B$N3FMWAG$N(B car $B$r@55,I=8=$H$7!"(Bcdr $B$GCV49$9$k!#(B 354cdr $B$,4X?t$N>l9g$O!"%^%C%A$7$?J8;zNs$r0z?t$K$7$F$=$N4X?t$r8F$S=P$9!#(B 355 356FIXEDCASE$B!"(BLITERAL $B$O(B `replace-match' $B$K$=$N$^$^EO$5$l$k!#(B 357 358ALL $B$,(B non-nil $B$J$i$P!"%^%C%A$7$?%F%-%9%H$r$9$Y$FCV49$9$k!#(Bnil $B$J$i(B 359$B:G=i$N(B1$B$D$@$1$rCV49$9$k!#(B 360 361REGEXP $B$,8+$D$+$i$J$$>l9g!"(BSTRING $B$r$=$N$^$^JV$9!#(B" 362 (save-match-data 363 (let ((internal (navi2ch-regexp-alist-to-internal regexp-alist)) 364 match rep) 365 (if all 366 ;; Emacs 21 $B$N(B replace-regexp-in-string $B$N%Q%/$j!#(B 367 (let ((start 0) 368 (l (length string)) 369 mb me str matches) 370 (while (and (< start l) 371 (setq match (navi2ch-string-match-regexp-alist 372 internal string start))) 373 (setq mb (match-beginning 0) 374 me (match-end 0)) 375 (if (= mb me) 376 (setq me (min l (1+ mb)))) 377 (string-match 378 (car match) 379 (setq str (substring string mb me))) 380 (setq rep (cdr match)) 381 (setq matches 382 (cons (replace-match (if (stringp rep) 383 rep 384 (funcall rep (match-string 0 str))) 385 fixedcase literal str) 386 (cons (substring string start mb) 387 matches))) 388 (setq start me)) 389 (apply #'concat (nreverse (cons (substring string start l) 390 matches)))) 391 (when (navi2ch-string-match-regexp-alist internal string) 392 (setq rep (cdr match)) 393 (setq string (replace-match (if (stringp rep) 394 rep 395 (funcall rep (match-string 0 string))) 396 fixedcase literal string))) 397 string)))) 398 399(defun navi2ch-insert-file-contents (file &optional begin end coding-system) 400 (setq coding-system (or coding-system navi2ch-coding-system)) 401 (let ((coding-system-for-read coding-system) 402 (coding-system-for-write coding-system)) 403 (insert-file-contents file nil begin end))) 404 405(defun navi2ch-expand-file-name (file) 406 (let ((result (expand-file-name 407 (mapconcat (lambda (ch) 408 (if (memq ch navi2ch-file-name-reserved-char-list) 409 (format "%%%02X" ch) 410 (char-to-string ch))) 411 (append file) 412 "") 413 navi2ch-directory))) 414 (if (string-match (concat "^" 415 (regexp-quote (file-name-as-directory 416 (expand-file-name navi2ch-directory)))) 417 result) 418 result 419 (error "Wrong file name")))) 420 421(eval-when-compile 422 (navi2ch-defalias-maybe 'assoc-string 'ignore)) 423 424(defun navi2ch-replace-html-tag (str) 425 (let ((case-fold-search t)) 426 (navi2ch-replace-string-regexp-alist 427 navi2ch-replace-html-tag-regexp-internal 428 str t nil t))) 429 430(defun navi2ch-replace-html-tag-with-buffer () 431 (goto-char (point-min)) 432 (let ((case-fold-search t) 433 match replace) 434 (while (setq match (navi2ch-re-search-forward-regexp-alist 435 navi2ch-replace-html-tag-regexp-internal nil t)) 436 (setq replace (cdr match)) 437 (replace-match (if (functionp replace) 438 (funcall replace (match-string 0)) 439 replace) 440 nil t)))) 441 442(defun navi2ch-replace-html-tag-with-temp-buffer (str) 443 (with-temp-buffer 444 (insert str) 445 (navi2ch-replace-html-tag-with-buffer) 446 (buffer-string))) 447 448(defun navi2ch-entity-reference-to-str (ref) 449 "$BJ8;z<BBN;2>H$r%G%3!<%I!#(B" 450 (save-match-data 451 (if (and navi2ch-decode-character-references 452 (string-match "&\\([^;]+\\)" ref)) 453 (let ((code (gethash (match-string 1 ref) navi2ch-entity-table))) 454 (or (and code (navi2ch-ucs-to-str code)) 455 ref)) 456 ref))) 457 458(defun navi2ch-numeric-reference-to-str (ref) 459 "$B?tCMJ8;z;2>H$r%G%3!<%I!#(B" 460 (save-match-data 461 (if (and navi2ch-decode-character-references 462 (string-match "&#\\([^;]+\\)" ref)) 463 (or (navi2ch-ucs-to-str (string-to-number (match-string 1 ref))) "$B".(B") 464 ref))) 465 466(defun navi2ch-hexadecimal-reference-to-str (ref) 467 "16$B?J?tCMJ8;z;2>H$r%G%3!<%I!#(B" 468 (save-match-data 469 (if (and navi2ch-decode-character-references 470 (string-match "&#[xX]\\([^;]+\\)" ref)) 471 (let ((num)) 472 (setq num (string-to-number (match-string 1 ref) 16)) 473 (or (and num 474 (navi2ch-ucs-to-str num)) 475 "$B".(B")) 476 ref))) 477 478;; shut up byte-compile warnings 479(eval-when-compile 480 (navi2ch-defalias-maybe 'unicode-to-char 'ignore) 481 (navi2ch-defalias-maybe 'decode-char 'ignore)) 482(eval-and-compile 483 ;; (autoload 'ucs-to-char "unicode") 484 (defalias 'navi2ch-char-valid-p 485 (if (fboundp 'characterp) #'characterp #'char-valid-p))) 486 487(defun navi2ch-ucs-to-str (code) 488 (let ((c (cond 489 ((featurep 'un-define) 490 (ucs-to-char code)) 491 ((and (fboundp 'unicode-to-char) 492 (subrp (symbol-function 'unicode-to-char))) 493 (unicode-to-char code)) 494 (navi2ch-on-emacs21 495 (decode-char 'ucs code))))) 496 (if (navi2ch-char-valid-p c) 497 (char-to-string c) 498 nil))) 499 500(defun navi2ch-read-char (&optional prompt) 501 "PROMPT (non-nil $B$N>l9g(B) $B$rI=<($7$F(B `read-char' $B$r8F$S=P$9!#(B" 502 (let ((cursor-in-echo-area t) 503 c) 504 (if prompt 505 (navi2ch-no-logging-message "%s" prompt)) 506 (setq c (read-char)) 507 (if (and prompt 508 (navi2ch-char-valid-p c)) 509 (navi2ch-no-logging-message "%s%c" prompt c)) 510 c)) 511 512(defun navi2ch-read-char-with-retry (prompt retry-prompt list) 513 "PROMPT $B$rI=<((B (non-nil $B$N>l9g(B) $B$7$F(B `read-char' $B$r8F$S=P$9!#(B 514$BF~NO$5$l$?J8;z$,(B LIST $B$K4^$^$l$J$$>l9g!"(BRETRY-PROMPT (nil $B$N>l9g$O(B 515PROMPT) $B$rI=<($7$F:FEY(B `read-char' $B$r8F$V!#(B" 516 (let ((retry t) c) 517 (while retry 518 (setq c (navi2ch-read-char prompt)) 519 (cond ((memq c list) 520 (setq retry nil)) 521 ((eq c 12) 522 (recenter)) 523 (t 524 (ding) 525 (setq prompt (or retry-prompt prompt))))) 526 c)) 527 528(defun navi2ch-read-event (&optional prompt) 529 "PROMPT (non-nil $B$N>l9g(B) $B$rI=<($7$F(B event $B$rFI$`!#(B" 530 (let ((cursor-in-echo-area t) 531 e) 532 (if prompt 533 (navi2ch-no-logging-message "%s" prompt)) 534 (navi2ch-ifxemacs 535 (setq e (next-command-event nil prompt)) 536 (setq e (read-event prompt))) 537 (if prompt 538 (navi2ch-no-logging-message "%s%s" prompt (single-key-description e))) 539 e)) 540 541(defun navi2ch-y-or-n-p (prompt &optional quit-symbol) 542 (let* ((prompt (concat prompt "(y, n, or q) ")) 543 (c (navi2ch-read-char-with-retry 544 prompt 545 (concat "Please answer y, n, or q. " prompt) 546 '(?q ?Q ?y ?Y ?\ ?n ?N ?\177)))) 547 (cond ((memq c '(?q ?Q)) 548 (or quit-symbol nil)) 549 ((memq c '(?y ?Y ?\ )) 550 t) 551 ((memq c '(?n ?N ?\177)) 552 nil)))) 553 554(eval-when-compile 555 (defvar browse-url-new-window-flag) 556 (defvar browse-url-new-window-p) 557 (defun navi2ch-net-send-request 558 (url method &optional other-header content)) 559 (defun navi2ch-net-get-status (proc))) 560 561(defun navi2ch-browse-url-internal (url &rest args) 562 (let ((browse-url-browser-function (or navi2ch-browse-url-browser-function 563 browse-url-browser-function)) 564 (new-window-flag (cond ((boundp 'browse-url-new-window-flag) 565 browse-url-new-window-flag) 566 ((boundp 'browse-url-new-window-p) 567 browse-url-new-window-p))) 568 proc status) 569 (if (eq browse-url-browser-function 'navi2ch-browse-url) 570 (error "Set navi2ch-browse-url-browser-function correctly")) 571 572 ;;sssp$B$r(Bhttp$B$K=q$-49$((B 573 (when (string= (substring url 0 4) "sssp") 574 (store-substring url 0 "http")) 575 576 ;;$BL5BL$r>J$/$?$a%V%i%&%:$9$kA0$K%?!<%2%C%H$N>uBV3NG'$9$k!#(B 577 ;;$B$A$g$C$H87$7$$$h$&$@$,!"(B302$B$@$HBgDq(B404$B$KHt$P$5$l$k$N$G!#(B 578 (when navi2ch-enable-status-check 579 (setq proc (navi2ch-net-send-request url "HEAD")) 580 (setq status (navi2ch-net-get-status proc)) 581 (if (or (string= status "404") 582 (string= status "403") 583 (string= status "503") 584 (string= status "302")) 585 (error "$B%V%i%&%:$9$k$N$d$a$^$7$?(B return code %s" status))) 586 587 (cond ((and navi2ch-browse-url-image-program ; images 588 (file-name-extension url) 589 (member (downcase (file-name-extension url)) 590 navi2ch-browse-url-image-extentions)) 591 (navi2ch-browse-url-image url)) 592 (t ; others 593 (setq args (or args (list new-window-flag))) 594 (apply 'browse-url url args))))) 595 596(defun navi2ch-browse-url-image (url &optional new-window) 597 ;; new-window ignored 598 "Ask the WWW browser defined by `browse-url-image-program' to load URL. 599Default to the URL around or before point. A fresh copy of the 600browser is started up in a new process with possible additional arguments 601`navi2ch-browse-url-image-args'. This is appropriate for browsers which 602don't offer a form of remote control." 603 (interactive (browse-url-interactive-arg "URL: ")) 604 (if (not navi2ch-browse-url-image-program) 605 (error "No browser defined (`navi2ch-browse-url-image-program')")) 606 (apply 'start-process (concat navi2ch-browse-url-image-program url) nil 607 navi2ch-browse-url-image-program 608 (append navi2ch-browse-url-image-args (list url)))) 609 610;; from apel 611(defsubst navi2ch-put-alist (item value alist) 612 "Modify ALIST to set VALUE to ITEM. 613If there is a pair whose car is ITEM, replace its cdr by VALUE. 614If there is not such pair, create new pair (ITEM . VALUE) and 615return new alist whose car is the new pair and cdr is ALIST. 616\[tomo's ELIS like function]" 617 (let ((pair (assoc item alist))) 618 (if pair 619 (progn 620 (setcdr pair value) 621 alist) 622 (cons (cons item value) alist)))) 623 624(defun navi2ch-next-property (point prop) 625 (setq point (next-single-property-change point prop)) 626 (when (and point 627 (null (get-text-property point prop))) 628 (setq point (next-single-property-change point prop))) 629 point) 630 631(defun navi2ch-previous-property (point prop) 632 (when (> point (point-min)) 633 (when (eq (get-text-property point prop) 634 (get-text-property (1- point) prop)) 635 (setq point (previous-single-property-change point prop))) 636 (when (and point 637 (null (get-text-property (1- point) prop))) 638 (setq point (previous-single-property-change point prop))) 639 (when point 640 (or (previous-single-property-change point prop) (point-min))))) 641 642(defun navi2ch-set-minor-mode (mode name map) 643 (make-variable-buffer-local mode) 644 (unless (assq mode minor-mode-alist) 645 (setq minor-mode-alist 646 (cons (list mode name) minor-mode-alist))) 647 (unless (assq mode minor-mode-map-alist) 648 (setq minor-mode-map-alist 649 (cons (cons mode map) minor-mode-map-alist)))) 650 651(defsubst navi2ch-default-directory () 652 (cond ((file-directory-p navi2ch-directory) 653 (file-name-as-directory navi2ch-directory)) 654 ((file-directory-p (expand-file-name "~/")) 655 (expand-file-name "~/")) 656 (t temporary-file-directory))) 657 658(defun navi2ch-call-process-buffer (program &rest args) 659 "$B:#$N(B buffer $B$G(B PROGRAM $B$r8F$s$GJQ99$9$k!#(B" 660 (let ((default-directory (navi2ch-default-directory))) 661 (apply 'call-process-region (point-min) (point-max) program t t nil args))) 662 663(defun navi2ch-alist-list-to-alist (list key1 &optional key2) 664 (mapcar 665 (lambda (x) 666 (cons (cdr (assq key1 x)) 667 (if key2 668 (cdr (assq key2 x)) 669 x))) 670 list)) 671 672(defun navi2ch-write-region (begin end filename) 673 (write-region begin end filename nil 'no-msg)) 674 675(defun navi2ch-get-major-mode (buffer) 676 (when (get-buffer buffer) 677 (with-current-buffer buffer 678 major-mode))) 679 680(defun navi2ch-set-mode-line-identification () 681 (let ((offline '(navi2ch-offline navi2ch-modeline-offline navi2ch-modeline-online)) 682 (belogin '(navi2ch-be2ch-login-flag navi2ch-modeline-be2ch-login 683 navi2ch-modeline-be2ch-logout))) 684 685 (unless navi2ch-mode-line-identification 686 (setq navi2ch-mode-line-identification 687 (default-value 'mode-line-buffer-identification))) 688 (setq mode-line-buffer-identification 689 (list offline 690 belogin 691 'navi2ch-message-samba24-mode-string 692 'navi2ch-mode-line-identification))) 693 (force-mode-line-update t)) 694 695(defun navi2ch-end-of-buffer () 696 "$B%P%C%U%!$N:G=*9T$K0\F0!#(B" 697 (interactive) 698 (call-interactively 'end-of-buffer) 699 (when (eobp) (forward-line -1))) 700 701(defun navi2ch-uudecode-region (start end &optional filename) 702 "START $B$H(B END $B$N4V$N%j!<%8%g%s$r(B uudecode $B$9$k!#(B 703FILENAME $B$,;XDj$5$l$k$H!"(BFILENAME $B$K$b=q$-=P$9!#(B" 704 (interactive "r") 705 (let* ((coding-system-for-read 'binary) 706 (coding-system-for-write 'binary) 707 (mode "600") 708 (file (expand-file-name 709 (or filename 710 (make-temp-name (navi2ch-temp-directory))))) 711 (default-directory (file-name-directory file)) 712 (buf (current-buffer)) 713 rc) 714 (unwind-protect 715 (progn 716 (with-temp-buffer 717 (insert-buffer-substring buf start end) 718 (goto-char (point-min)) 719 (when (re-search-forward navi2ch-uuencode-begin-delimiter-regexp 720 nil t) 721 (setq mode (navi2ch-match-string-no-properties 1)) 722 (forward-line) 723 (delete-region (point-min) (point))) 724 (insert (format "begin %s %s\n" 725 mode (file-name-nondirectory file))) 726 (goto-char (point-max)) 727 (when (re-search-backward navi2ch-uuencode-end-delimiter-regexp 728 nil t) 729 (delete-region (match-beginning 0) (point-max))) 730 (insert "end\n") 731 (setq rc (apply 'call-process-region 732 (point-min) (point-max) 733 navi2ch-uudecode-program 734 nil nil nil 735 navi2ch-uudecode-args))) 736 (when (and (= rc 0) 737 (file-exists-p file)) 738 (delete-region start end) 739 (insert-file-contents-literally file) 740 (when filename 741 (message "Wrote %s" filename)))) 742 (ignore-errors (unless filename (delete-file file)))) 743 (when (not (= rc 0)) 744 (error "uudecode error")))) 745 746(eval-and-compile 747 (defalias 'navi2ch-line-beginning-position 748 (if (fboundp 'point-at-bol) 749 #'point-at-bol 750 #'line-beginning-position)) 751 752 (defalias 'navi2ch-line-end-position 753 (if (fboundp 'point-at-eol) 754 #'point-at-eol 755 #'line-end-position))) 756 757(defun navi2ch-uudecode-write-region (start end &optional filename) 758 "START $B$H(B END $B$N4V$N%j!<%8%g%s$r(B uudecode $B$7!"(BFILENAME $B$K=q$-=P$9!#(B 759 760$B%j!<%8%g%sFb$K(B `navi2ch-uuencode-begin-delimiter-regexp' $B$K%^%C%A$9$k9T$,$"$k(B 761$B>l9g$O$=$l0JA0$rL5;k$7!"(B`navi2ch-uuencode-end-delimiter-regexp' $B$K%^%C%A$9$k9T(B 762$B$,$"$k>l9g$O:G8e$N$=$l0J9_$rL5;k$9$k!#(B 763$B$5$i$K!"(Buuencode $B$N%U%)!<%^%C%H$K=>$C$F$$$J$$9T$bL5;k$9$k!#(B" 764 (interactive "r") 765 (let ((buf (current-buffer)) 766 (default-filename nil)) 767 (save-excursion 768 (goto-char start) 769 (when (re-search-forward navi2ch-uuencode-begin-delimiter-regexp end t) 770 (setq start (match-beginning 0) 771 default-filename (match-string 2))) 772 (goto-char end) 773 (when (re-search-backward navi2ch-uuencode-end-delimiter-regexp start t) 774 ;; exclude "end" 775 (setq end (match-beginning 0)))) 776 (unless filename 777 (setq filename (expand-file-name 778 (read-file-name 779 (if default-filename 780 (format "Uudecode to file (default `%s'): " 781 default-filename) 782 "Uudecode to file: ") 783 nil default-filename)))) 784 (when (file-directory-p filename) 785 (if default-filename 786 (setq filename (expand-file-name default-filename filename)) 787 (error "%s is a directory" filename))) 788 (when (or (not (file-exists-p filename)) 789 (y-or-n-p (format "File `%s' exists; overwrite? " 790 filename))) 791 (with-temp-buffer 792 (insert-buffer-substring buf start end) 793 (goto-char (point-min)) 794 (while (search-forward "$B!)(B" nil t) ;for 2ch 795 (replace-match "&#" nil t)) 796 (goto-char (point-min)) 797 (forward-line) 798 (while (not (eobp)) 799 (let* ((char (char-after)) 800 (len (- (navi2ch-line-beginning-position 2) (point)))) 801 (when (char-equal char ?`) 802 (setq char ? )) 803 (if (and (looking-at navi2ch-uuencode-line-regexp) 804 (< len 63) 805 (= len (- (* (/ char 3) 4) 38))) 806 (forward-line) 807 (delete-region (point) (navi2ch-line-beginning-position 2))))) 808 (insert "end\n") 809 (navi2ch-uudecode-region (point-min) (point-max) filename))))) 810 811(defun navi2ch-base64-write-region (start end &optional filename) 812 "START $B$H(B END $B$N4V$N%j!<%8%g%s$r(B base64 $B%G%3!<%I$7!"(BFILENAME $B$K=q$-=P$9!#(B 813 814$B%j!<%8%g%sFb$K(B `navi2ch-base64-begin-delimiter-regexp' $B$+(B 815`navi2ch-base64-susv3-begin-delimiter-regexp' $B$K%^%C%A$9$k9T$,$"$k>l9g$O(B 816$B$=$l0JA0$rL5;k$7!"(B 817`navi2ch-base64-end-delimiter-regexp' $B$+(B 818`navi2ch-base64-susv3-end-delimiter-regexp' $B$K%^%C%A$9$k9T(B 819$B$,$"$k>l9g$O:G8e$N$=$l0J9_$rL5;k$9$k!#(B 820$B$5$i$K!"(B`navi2ch-base64-line-regexp' $B$K%^%C%A$7$J$$9T$bL5;k$9$k!#(B 821 822base64$B%G%3!<%I$9$Y$-FbMF$,$J$$>l9g$O%(%i!<$K$J$k!#(B" 823 (interactive "r") 824 (save-excursion 825 (let ((buf (current-buffer)) 826 (default-filename nil) 827 (mode nil) 828 (susv3 nil)) 829 ;; insert$B$7$?8e$K:o$k$N$OL5BL$J$N$G$"$i$+$8$a9J$j9~$s$G$*$/(B 830 (goto-char start) 831 (cond 832 ((re-search-forward navi2ch-base64-begin-delimiter-regexp end t) 833 (setq default-filename (match-string 2)) 834 (goto-char (match-end 0))) 835 ((re-search-forward navi2ch-base64-susv3-begin-delimiter-regexp end t) 836 (setq default-filename (match-string 2) 837 mode (string-to-number (match-string 1) 8) 838 susv3 t) 839 (goto-char (match-end 0)))) 840 (if (re-search-forward navi2ch-base64-line-regexp end t) 841 (setq start (match-beginning 0)) 842 (error "No base64 data")) 843 (goto-char end) 844 (if (or (and susv3 (re-search-backward 845 navi2ch-base64-susv3-end-delimiter-regexp start t)) 846 (re-search-backward navi2ch-base64-end-delimiter-regexp start t)) 847 (goto-char (match-beginning 0))) 848 (if (re-search-backward navi2ch-base64-line-regexp start t) 849 (setq end (match-end 0))) 850 (unless filename 851 (setq filename (expand-file-name 852 (read-file-name 853 (if default-filename 854 (format "Base64-decode to file (default `%s'): " 855 default-filename) 856 "Base64-decode to file: ") 857 nil default-filename)))) 858 (when (file-directory-p filename) 859 (if default-filename 860 (setq filename (expand-file-name default-filename filename)) 861 (error "%s is a directory" filename))) 862 (when (or (not (file-exists-p filename)) 863 (y-or-n-p (format "File `%s' exists; overwrite? " 864 filename))) 865 (with-temp-buffer 866 (let ((buffer-file-coding-system 'binary) 867 (coding-system-for-write 'binary) 868 ;; auto-compress-mode$B$r(Bdisable$B$K$9$k(B 869 (inhibit-file-name-operation 'write-region) 870 (inhibit-file-name-handlers (cons 'jka-compr-handler 871 inhibit-file-name-handlers))) 872 (insert-buffer-substring buf start end) 873 (goto-char (point-min)) 874 (while (not (eobp)) 875 (if (looking-at navi2ch-base64-line-regexp) 876 (forward-line) 877 (delete-region (point) (navi2ch-line-beginning-position 2)))) 878 (base64-decode-region (point-min) (point-max)) 879 (write-region (point-min) (point-max) filename) 880 (if (and susv3 mode) 881 (condition-case nil 882 ;; 511 = (string-to-number "0777" 8) 883 (set-file-modes filename (logand mode 511)) 884 (error nil))))))))) 885 886(defun navi2ch-base64-insert-file (filename) 887 "FILENAME $B$r(B base64 $B%(%s%3!<%I$7!"8=:_$N%]%$%s%H$KA^F~$9$k!#(B" 888 (interactive "fEncode and insert file: ") 889 (save-excursion 890 (let ((str nil)) 891 (with-temp-buffer 892 (let ((buffer-file-coding-system 'binary)) 893 (insert-file-contents-literally filename) 894 (base64-encode-region (point-min) (point-max)) 895 (goto-char (point-min)) 896 (while (search-forward "\n" nil t) 897 (replace-match "")) 898 (goto-char (point-min)) 899 (insert (format "%s(%s)\n" navi2ch-base64-begin-delimiter 900 (file-name-nondirectory filename))) 901 (while (= (move-to-column navi2ch-base64-fill-column) 902 navi2ch-base64-fill-column) 903 (insert "\n")) 904 (goto-char (point-max)) 905 (insert (format "\n%s\n" navi2ch-base64-end-delimiter)) 906 (setq str (buffer-string)))) 907 (insert str)))) 908 909(defun navi2ch-url-to-host (url) 910 (when url 911 (cond 912 ((string-match "^http://\\([^/]+\\)" url) 913 (match-string 1 url)) 914 ((string-match "^x-localbbs://" url) 915 "localhost")))) 916 917(defun navi2ch-read-string (prompt &optional initial-input history) 918 (let ((minibuffer-allow-text-properties nil)) 919 (read-string prompt initial-input history))) 920 921(defun navi2ch-temp-directory () 922 (let ((dir (expand-file-name "tmp" navi2ch-directory))) 923 (or (file-directory-p dir) 924 (make-directory dir)) 925 dir)) 926 927(defun navi2ch-strip-properties (obj) 928 "OBJ $BCf$NJ8;zNs$r:F5"E*$KC5$7!"%F%-%9%HB0@-$r30$7$?%*%V%8%'%/%H$rJV$9!#(B 929$B85$N(B OBJ $B$OJQ99$7$J$$!#(B" 930 (cond 931 ((consp obj) 932 (let* ((ret (cons (car obj) (cdr obj))) 933 (seq ret)) 934 ;; $BD9$$%j%9%H$r%3%T!<$9$k:]$K%9%?%C%/%*!<%P!<%U%m!<$K$J$k$N$G(B 935 ;; $B:F5"$r%k!<%W$KE83+!#(B 936 (while (consp seq) 937 (setcar seq (navi2ch-strip-properties (car seq))) 938 (if (consp (cdr seq)) 939 (setcdr seq (cons (cadr seq) (cddr seq))) 940 (setcdr seq (navi2ch-strip-properties (cdr seq)))) 941 (setq seq (cdr seq))) 942 ret)) 943 ((stringp obj) 944 (let ((str (copy-sequence obj))) 945 (set-text-properties 0 (length str) nil str) 946 str)) 947 ((vectorp obj) 948 (vconcat (mapcar 'navi2ch-strip-properties obj))) 949 (t obj))) 950 951(defun navi2ch-update-html-tag-regexp () 952 "`navi2ch-replace-html-tag-regexp-internal' $B$r99?7$9$k!#(B" 953 (setq navi2ch-replace-html-tag-regexp-internal 954 (navi2ch-regexp-alist-to-internal 955 (nconc (mapcar (lambda (x) 956 (cons (regexp-quote (car x)) 957 (cdr x))) 958 navi2ch-replace-html-tag-alist) 959 navi2ch-replace-html-tag-regexp-alist)))) 960 961(defun navi2ch-add-replace-html-tag (tag value) 962 "TAG $B$rI=<($9$k:]$K(B VALUE $B$GCV$-49$($k!#(B" 963 (let ((as-regexp (condition-case nil 964 (progn 965 ;; $BJ8;zNs$K$h$C$F$O(B regexp-opt-group() $B$,L58B(B 966 ;; $B:F5"$K$J$k(B 967 (regexp-opt (list "$B$"(B" tag)) 968 nil) 969 (error t)))) 970 (if as-regexp 971 (navi2ch-add-replace-html-tag-regexp (regexp-quote tag) value) 972 (add-to-list 'navi2ch-replace-html-tag-alist 973 (cons tag value)) 974 (navi2ch-update-html-tag-regexp)))) 975 976(defun navi2ch-add-replace-html-tag-regexp (regexp value) 977 "REGEXP $B$K%^%C%A$9$k(B tag $B$rI=<($9$k:]$K(B VALUE $B$GCV$-49$($k!#(B" 978 (add-to-list 'navi2ch-replace-html-tag-regexp-alist 979 (cons regexp value)) 980 (navi2ch-update-html-tag-regexp)) 981 982(defsubst navi2ch-filename-to-url (filename) 983 (concat "file://" (expand-file-name filename))) 984 985(defun navi2ch-chop-/ (dirname) 986 (save-match-data 987 (if (string-match "/\\'" dirname) 988 (replace-match "" nil t dirname) 989 dirname))) 990 991(defsubst navi2ch-rename-file (file newname &optional ok-if-already-exists) 992 (rename-file (navi2ch-chop-/ file) 993 (navi2ch-chop-/ newname) ok-if-already-exists)) 994 995(eval-and-compile 996 (defalias 'navi2ch-set-keymap-default-binding 997 (if (fboundp 'set-keymap-default-binding) 998 #'set-keymap-default-binding 999 (lambda (map command) 1000 "$B%-!<%^%C%W$N%G%U%)%k%H%P%$%s%I$r@_Dj$9$k!#(B" 1001 (define-key map [t] command))))) 1002 1003;;; $B%m%C%/(B 1004;; $B:G$bHFMQE*$J(B mkdir $B%m%C%/$r<BAu$7$F$_$?!#(B 1005;; DIRECTORY $B$K(B LOCKNAME $B$H$$$&%G%#%l%/%H%j$,$"$k>l9g$O$=$N%G%#%l%/%H%j$O(B 1006;; $B%m%C%/$5$l$F$$$k$H$$$&$3$H$K$J$k!#(B 1007(defun navi2ch-lock-directory (directory &optional lockname) 1008 "LOCKNAME $B$r;H$$!"(BDIRECTORY $B$r%m%C%/$9$k!#(B 1009LOCKNAME $B$,>JN,$5$l$?>l9g$O(B \"lockdir\" $B$r;HMQ$9$k!#(B 1010LOCKNAME $B$,@dBP%Q%9$G$O$J$$>l9g!"(BDIRECTORY $B$+$i$NAjBP%Q%9$H$7$F07$&!#(B 1011$B%m%C%/$K@.8y$7$?$i(B non-nil $B$r!"<:GT$7$?$i(B nil $B$rJV$9!#(B" 1012 (setq lockname (navi2ch-chop-/ (expand-file-name (or lockname "lockdir") 1013 directory)) 1014 directory (file-name-directory lockname)) 1015 (let ((make-directory-function (if (fboundp 'make-directory-internal) 1016 #'make-directory-internal 1017 #'make-directory))) 1018 (if (not (file-exists-p lockname)) ; lockdir $B$,$9$G$K$"$k$H<:GT(B 1019 (condition-case error 1020 (and (progn 1021 ;; $B$^$:!"?F%G%#%l%/%H%j$r:n$C$F$*$/!#(B 1022 (unless (file-directory-p directory) 1023 (make-directory directory t)) 1024 (file-directory-p directory)) 1025 (progn 1026 ;; file-name-handler-alist $B$,$"$k$H(B mkdir $B$,D>@\8F(B 1027 ;; $B$P$l$J$$2DG=@-$,$"$k!#(B 1028 (let ((file-name-handler-alist nil)) 1029 (funcall make-directory-function lockname)) 1030 (file-exists-p lockname))) ; $BG0$N$?$a!"3NG'$7$F$*$/(B 1031 (error 1032 (message "%s" (error-message-string error)) 1033 (sit-for 3) 1034 (discard-input) 1035 nil))))) 1036 1037(defun navi2ch-unlock-directory (directory &optional lockname) 1038 "LOCKNAME $B$r;H$$!"(BDIRECTORY $B$N%m%C%/$r2r=|$9$k!#(B 1039LOCKNAME $B$,>JN,$5$l$?>l9g$O(B \"lockdir\" $B$r;HMQ$9$k!#(B 1040LOCKNAME $B$,@dBP%Q%9$G$O$J$$>l9g!"(BDIRECTORY $B$+$i$NAjBP%Q%9$H$7$F07$&!#(B 1041$B%m%C%/$N2r=|$K@.8y$7$?$i(B non-nil $B$r!"<:GT$7$?$i(B nil $B$rJV$9!#(B" 1042 (setq lockname (navi2ch-chop-/ (expand-file-name (or lockname "lockdir") 1043 directory))) 1044 (ignore-errors 1045 (delete-directory lockname)) 1046 (not (file-exists-p lockname))) 1047 1048(defsubst navi2ch-count-lines-file (file) 1049 "$B$=$N%U%!%$%k$N9T?t$r?t$($k!#(B" 1050 (with-temp-buffer 1051 (insert-file-contents file) 1052 (count-lines (point-min) (point-max)))) 1053 1054(eval-and-compile 1055 (defalias 'navi2ch-float-time 1056 (if (fboundp 'float-time) 1057 'float-time 1058 (lambda (&optional specified-time) 1059 "Return the current time, as a float number of seconds since the epoch. 1060If an argument is given, it specifies a time to convert to float 1061instead of the current time." 1062 (apply (lambda (high low &optional usec) 1063 (+ (* high 65536.0) low (/ (or usec 0) 1000000.0))) 1064 (or specified-time (current-time)))))) 1065(defalias 'navi2ch-make-local-hook 1066 (if (>= emacs-major-version 22) 1067 #'ignore 1068 #'make-local-hook)) 1069(defalias 'navi2ch-cache-p #'vectorp)) 1070 1071(defun navi2ch-compare-times (t1 t2) 1072 "T1 $B$,(B T2 $B$h$j?7$7$1$l$P(B non-nil $B$rJV$9!#(B" 1073 (> (navi2ch-float-time t1) (navi2ch-float-time t2))) 1074 1075(defun navi2ch-add-days-to-time (time days) 1076 "TIME $B$N(B DAYS $BF|8e(B ($BIi$N>l9g$OA0(B) $B$N(B TIME $B$rJV$9!#(B" 1077 (let ((decoded (decode-time time))) 1078 (setf (nth 3 decoded) (+ (nth 3 decoded) days)) 1079 (apply #'encode-time decoded))) 1080 1081(defun navi2ch-which (file) 1082 (when (stringp file) 1083 (catch 'loop 1084 (dolist (path exec-path) 1085 (setq path (expand-file-name file path)) 1086 (dolist (candidate (list path (concat path ".exe"))) 1087 (when (and (file-exists-p candidate) 1088 (file-executable-p candidate) 1089 (not (file-directory-p candidate))) 1090 (throw 'loop candidate))))))) 1091 1092(defun navi2ch-union (list1 list2) 1093 "Combine LIST1 and LIST2. 1094This function is a cutdown version of cl-seq's one." 1095 (cond ((null list1) list2) ((null list2) list1) 1096 ((equal list1 list2) list1) 1097 (t (dolist (x list2) 1098 (unless (member x list1) 1099 (setq list1 (cons x list1)))) 1100 list1))) 1101 1102(defun navi2ch-set-difference (list1 list2) 1103 "Combine LIST1 and LIST2. 1104This function is a cutdown version of cl-seq's one." 1105 (if (or (null list1) (null list2)) list1 1106 (let ((res nil)) 1107 (dolist (x list1) 1108 (unless (member x list2) 1109 (setq res (cons x res)))) 1110 res))) 1111 1112(defun navi2ch-expand-newtext (newtext original) 1113 (substring (replace-match newtext (not case-fold-search) nil original) 1114 (match-beginning 0) 1115 (and (< (match-end 0) (length original)) 1116 (- (match-end 0) (length original))))) 1117 1118(defun navi2ch-fuzzy-regexp (string &optional kana-fold-search regexp) 1119 "STRING $B$KBP$7!"A43Q$HH>3Q$r6hJL$;$:%^%C%A$9$k$h$&$J@55,I=8=$rJV$9!#(B 1120$B$=$N:](B `case-fold-search' $B$,(B non-nil $B$J$i!"A43Q1Q;z$bBgJ8;z$H>.J8;z$N(B 1121$BN>J}$r4^$`$b$N$r@8@.$9$k!#(B 1122 1123KANA-FOLD-SEARCH $B$K(B non-nil $B$r;XDj$9$k$H!"$R$i$,$J$H%+%?%+%J$b6hJL$7$J(B 1124$B$$@55,I=8=$rJV$9!#(B 1125 1126REGEXP $B$r;XDj$9$k$H!"@55,I=8=$N@8@.$K@hN)$A(B REGEXP $B$K%^%C%A$7$?J8;zNs(B 1127$B$r(B REGEXP $B$KCV$-49$($k!#(B 1128$B$=$l$K$h$j!"Nc$($P(B REGEXP $B$K(B \"[$B!!(B \\f\\t\\n\\r\\v]+\" $B$rM?$($k$H6uGr$d2~9T$N(B 1129$BB?>/$rL5;k$7$F%^%C%A$9$k$h$&$J@55,I=8=$r@8@.$9$k!#(B" 1130 (let ((default-case-fold-search case-fold-search)) 1131 (with-current-buffer (get-buffer-create " *Navi2ch fuzzy work*") 1132 (erase-buffer) 1133 (insert string) 1134 (goto-char (point-min)) 1135 (let ((last (point))) 1136 (while (progn 1137 (while (and regexp 1138 (not (eobp)) 1139 (looking-at regexp) 1140 (< last (match-end 0))) 1141 (insert "\\(?:" regexp "\\)") 1142 (delete-char (- (match-end 0) (match-beginning 0))) 1143 (setq last (point))) 1144 (not (eobp))) 1145 (let ((char (following-char)) 1146 prop next slot) 1147 (cond 1148 ((and (setq prop (get-char-code-property char 'kana-composition)) 1149 (setq next (or (char-after (1+ (point))) 0)) 1150 (setq slot (assq next prop))) 1151 (cond 1152 ((eq (char-charset char) 'katakana-jisx0201) 1153 ;; (char = $BH>3Q%+%J(B) + (next = $BH>3QByE@Ey(B) 1154 ;; (cdr slot) = $BA43Q%+%J(B 1155 (let (hira) 1156 (if (and kana-fold-search 1157 (setq hira 1158 (get-char-code-property (cdr slot) 'hiragana))) 1159 (if (stringp hira) 1160 (insert "\\(?:" char next 1161 "\\|" (cdr slot) "\\|" hira "\\)") 1162 (insert "\\(?:" char next 1163 "\\|[" (cdr slot) hira "]\\)")) 1164 (insert "\\(?:" char next "\\|" (cdr slot) "\\)"))) 1165 (delete-char 2)) 1166 (kana-fold-search 1167 ;; (char = $B$R$i$,$J(B) + (next = $BA43QByE@Ey(B) 1168 ;; (cdr slot) = $BA43Q%+%J(B 1169 (insert "\\(?:" char next "\\|" 1170 (get-char-code-property char 'jisx0201) 1171 (get-char-code-property next 'jisx0201) 1172 "\\|" (cdr slot) "\\)") 1173 (delete-char 2)) 1174 (t 1175 (forward-char)))) 1176 ((or (setq prop (get-char-code-property char 'jisx0201)) 1177 (eq (char-charset char) 'katakana-jisx0201)) 1178 (let (kata) 1179 (cond 1180 ((null prop) 1181 ;; char = $BH>3Q%+%J(B 1182 (setq kata (get-char-code-property char 'jisx0208)) 1183 (let (hira) 1184 (if (and kana-fold-search 1185 (setq hira (get-char-code-property char 1186 'hiragana))) 1187 (insert ?\[ char kata hira ?\]) 1188 (insert ?\[ char kata ?\]))) 1189 (delete-char 1)) 1190 ((null (setq kata (get-char-code-property char 'katakana))) 1191 ;; char = $BA43Q%+%J!"(Bprop = $BH>3Q%+%J(B 1192 (let (hira) 1193 (if (and kana-fold-search 1194 (setq hira (get-char-code-property char 1195 'hiragana))) 1196 (cond 1197 ((stringp hira) 1198 (insert "\\(?:" char "\\|" hira "\\|" prop "\\)")) 1199 ((stringp prop) 1200 (insert "\\(?:[" char hira "]\\|" prop "\\)")) 1201 (t 1202 (insert ?\[ char hira prop ?\]))) 1203 (if (stringp prop) 1204 (insert "\\(?:" char "\\|" prop "\\)") 1205 (insert ?\[ char prop ?\])))) 1206 (delete-char 1)) 1207 (kana-fold-search 1208 ;; char = $B$R$i$,$J!"(Bprop = $BH>3Q%+%J!"(Bkata = $BA43Q%+%J(B 1209 (if (stringp prop) 1210 (insert "\\(?:[" char kata "]\\|" prop "\\)") 1211 (insert ?\[ char kata prop ?\])) 1212 (delete-char 1)) 1213 (t 1214 (forward-char))))) 1215 ((and (eq (char-charset char) 'ascii) 1216 (setq prop (get-char-code-property char 'jisx0208))) 1217 ;; char = $BH>3Q1Q?t!"(Bprop = $BA43Q1Q?t(B 1218 (if (or (not case-fold-search) 1219 (eq (upcase char) (downcase char))) 1220 (if (memq char '(?- ?^)) 1221 (insert ?\[ prop char ?\]) 1222 (insert ?\[ char prop ?\])) 1223 (insert ?\[ char 1224 (get-char-code-property (upcase char) 'jisx0208) 1225 (get-char-code-property (downcase char) 'jisx0208) 1226 ?\])) 1227 (delete-char 1)) 1228 ((setq prop (get-char-code-property char 'ascii)) 1229 ;; char = $BA43Q1Q?t!"(Bprop = $BH>3Q1Q?t(B 1230 (if (or (not case-fold-search) 1231 (eq (upcase prop) (downcase prop))) 1232 (if (eq prop ?\]) 1233 (insert ?\[ prop char ?\]) 1234 (insert ?\[ char prop ?\])) 1235 (insert ?\[ 1236 (get-char-code-property (upcase prop) 'jisx0208) 1237 (get-char-code-property (downcase prop) 'jisx0208) 1238 prop ?\])) 1239 (delete-char 1)) 1240 (t 1241 (forward-char)))))) 1242 (buffer-string)))) 1243 1244(defun navi2ch-apply-filters (board filter-list) 1245 (dolist (filter filter-list) 1246 (if (stringp (car-safe filter)) 1247 (apply 'navi2ch-call-process-buffer 1248 (mapcar (lambda (x) 1249 (if (eq x 'board) 1250 (cdr (assq 'id board)) 1251 x)) 1252 filter)) 1253 (funcall filter)))) 1254 1255;; shut up byte-compile warnings 1256(eval-when-compile 1257 (navi2ch-defalias-maybe 'keywordp 'ignore) 1258 (navi2ch-defalias-maybe 'characterp 'ignore)) 1259 1260(defun navi2ch-quote-maybe (sexp) 1261 "Quote SEXP iff it is not self quoting." 1262 ;; `custom-quote'$B$N%Q%/$j!#(B 1263 (if (or (memq sexp '(t nil)) 1264 (if (fboundp 'keywordp) 1265 (keywordp sexp) 1266 (and (symbolp sexp) 1267 (eq (aref (symbol-name sexp) 0) ?:))) 1268 (eq (car-safe sexp) 'lambda) 1269 (stringp sexp) 1270 (numberp sexp) 1271 (and (fboundp 'characterp) 1272 (characterp sexp)) 1273 (vectorp sexp) 1274 (navi2ch-ifxemacs 1275 (bit-vector-p sexp))) 1276 sexp 1277 (list 'quote sexp))) 1278 1279(defun navi2ch-right-align-strings (s1 s2) 1280 (let* ((l (max (length s1) (length s2))) 1281 (f (format "%%%ds" l))) 1282 (list (format f s1) (format f s2)))) 1283 1284(defun navi2ch-right-aligned-string< (s1 s2) 1285 (apply #'string< (navi2ch-right-align-strings s1 s2))) 1286 1287(defstruct (navi2ch-regexp-internal 1288 (:constructor navi2ch-make-regexp-internal) 1289 (:copier nil) (:type vector)) 1290 number-list 1291 regexp 1292 table) 1293 1294(eval-and-compile 1295 (defalias 'navi2ch-regexp-internal-p #'vectorp)) 1296 1297(defun navi2ch-regexp-alist-to-internal (regexp-alist) 1298 (if (navi2ch-regexp-internal-p regexp-alist) 1299 regexp-alist 1300 (let ((alist (let ((n 1)) 1301 (mapcar (lambda (elt) 1302 (let ((r (concat "\\(" (car elt) "\\)"))) 1303 (prog1 1304 (list n r elt) 1305 (setq n (+ n (regexp-opt-depth r)))))) 1306 regexp-alist)))) 1307 (navi2ch-make-regexp-internal 1308 :number-list (mapcar #'car alist) 1309 :regexp (mapconcat #'cadr alist "\\|") 1310 :table (navi2ch-alist-to-hash 1311 (mapcar (lambda (x) 1312 (cons (car x) 1313 (caddr x))) 1314 alist)))))) 1315 1316(defun navi2ch-match-regexp-alist-subr (match-function regexp-alist) 1317 "REGEXP-ALIST $B$N3FMWAG$N(B car $B$r@55,I=8=$H$7!"(BMATCH-FUNCTION $B$r8F$S=P$9!#(B 1318$B%^%C%A$7$?MWAG$rJV$9!#(B 1319REGEXP-ALIST $BCf$N@55,I=8=$OO"7k$5$l$k$?$a!"@55,I=8=Cf$N(B \\$B?t;zEy$N(B 1320back reference $B$OM-8z$KF0:n$7$J$$!#(B 1321`navi2ch-regexp-alist-to-internal' $B$r;HMQ$7$F(B REGEXP-ALIST $B$r(B 1322$B$"$i$+$8$aFbIt7A<0$KJQ49$7$F$*$/$3$H$b2DG=!#(B" 1323 (let* ((internal (navi2ch-regexp-alist-to-internal regexp-alist)) 1324 (number-list (navi2ch-regexp-internal-number-list internal)) 1325 (combined-regexp (navi2ch-regexp-internal-regexp internal))) 1326 (when (funcall match-function combined-regexp) 1327 (dolist (n number-list) 1328 (when (match-beginning n) 1329 (return (gethash n (navi2ch-regexp-internal-table internal)))))))) 1330 1331(defun navi2ch-string-match-regexp-alist (regexp-alist string &optional start) 1332 "REGEXP-ALIST $B$N3FMWAG$N(B car $B$r@55,I=8=$H$7!"(B`string-match' $B$r8F$S=P$9!#(B 1333`match-data' $B$r%^%C%A$7$?@55,I=8=$NJ*$K$7!"%^%C%A$7$?MWAG$rJV$9!#(B 1334REGEXP-ALIST $B$K$D$$$F$O(B `navi2ch-match-regexp-alist-subr' $B$r;2>H!#(B 1335STRING START $B$O(B `string-match' $B$K$=$N$^$^EO$5$l$k!#(B" 1336 (let ((matched-elt 1337 (lexical-let ((string string) 1338 (start start)) 1339 (navi2ch-match-regexp-alist-subr (lambda (regexp) 1340 (string-match regexp string start)) 1341 regexp-alist)))) 1342 (when matched-elt 1343 (string-match (car matched-elt) string start)) 1344 matched-elt)) 1345 1346(defun navi2ch-re-search-forward-regexp-alist 1347 (regexp-alist &optional bound noerror count) 1348 "REGEXP-ALIST $B$N3FMWAG$N(B car $B$r@55,I=8=$H$7!"(B`re-search-forward' $B$r8F$S=P$9!#(B 1349`match-data' $B$r%^%C%A$7$?@55,I=8=$NJ*$K$7!"%^%C%A$7$?MWAG$rJV$9!#(B 1350REGEXP-ALIST $B$K$D$$$F$O(B `navi2ch-match-regexp-alist-subr' $B$r;2>H!#(B 1351BOUND NOERROR COUNT $B$O(B `re-search-forward' $B$K$=$N$^$^EO$5$l$k!#(B" 1352 (let ((matched-elt 1353 (lexical-let 1354 ((bound bound) 1355 (noerror noerror) 1356 (count count)) 1357 (navi2ch-match-regexp-alist-subr 1358 (lambda (regexp) 1359 (re-search-forward regexp bound noerror count)) 1360 regexp-alist)))) 1361 (when matched-elt 1362 (goto-char (match-beginning 0)) 1363 (re-search-forward (car matched-elt) bound noerror count)) 1364 matched-elt)) 1365 1366;; XEmacs $B$G$O(B `char-width' $B$r9MN8$7$F$/$l$J$$$N$G!#(B 1367(defun navi2ch-truncate-string-to-width 1368 (str end-column &optional start-column padding) 1369 "`truncate-string-to-width' $B$HF1Ey!#(B" 1370 (let ((col 0) 1371 (start-column (or start-column 0)) 1372 r) 1373 (dolist (c (string-to-list str)) 1374 (when (and (>= col start-column) 1375 (< col end-column)) 1376 (push c r) 1377 (setq col (+ col (char-width c))))) 1378 (when padding 1379 (while (and (>= col start-column) 1380 (< col end-column)) 1381 (push padding r) 1382 (setq col (+ col (char-width padding))))) 1383 (concat (nreverse r)))) 1384 1385(defun navi2ch-disabled-key () 1386 (interactive) 1387 (ding) 1388 (let ((key (this-command-keys))) 1389 (message "%s (%s) is disabled in Navi2ch." 1390 (key-description key) 1391 (lookup-key (current-global-map) key)))) 1392 1393(defun navi2ch-verify-signature-file (signature-file file) 1394 "FILE $B$r(B SIGNATURE-FILE $B$G8!>Z$9$k!#(B 1395$B@5$7$/8!>Z$G$-$k$H(B non-nil $B$rJV$9!#(B" 1396 (interactive "f$B=pL>%U%!%$%k(B: \nf$B8!>Z%U%!%$%k(B: ") 1397 (let (exitcode) 1398 (with-temp-buffer 1399 (setq exitcode 1400 (let ((default-directory (navi2ch-default-directory))) 1401 (call-process shell-file-name nil t nil 1402 shell-command-switch 1403 (format navi2ch-pgp-verify-command-line 1404 signature-file file)))) 1405 (goto-char (point-min)) 1406 ;; $B8e$+$i(B *Message* $B%P%C%U%!$G;2>H$G$-$k$h$&!"%3%^%s%I=PNO$r$9$Y(B 1407 ;; $B$FI=<($7$F$*$/(B 1408 (while (not (eobp)) 1409 (let ((s (buffer-substring (navi2ch-line-beginning-position) 1410 (navi2ch-line-end-position)))) 1411 (when (> (length s) 0) 1412 (message "%s" s))) 1413 (forward-line))) 1414 (= exitcode 0))) 1415 1416(defun navi2ch-decode-coding-region-linewise (start end coding-system) 1417 (save-restriction 1418 (narrow-to-region start end) 1419 (let ((bol (point-min))) 1420 (while (< bol (point-max)) 1421 (goto-char bol) 1422 ;; decode $BA08e$G(B (navi2ch-line-end-position) $B$NCM$,$:$l$k$N$KCm0U(B 1423 (decode-coding-region bol (navi2ch-line-end-position) coding-system) 1424 (goto-char bol) ; $BG0$N$?$a(B 1425 (setq bol (1+ (navi2ch-line-end-position)))))) 1426 (goto-char start)) 1427 1428(eval-and-compile 1429 (if (fboundp 'propertize) 1430 (defalias 'navi2ch-propertize 'propertize) 1431 (defun navi2ch-propertize (string &rest properties) 1432 "Return a copy of STRING with text properties added. 1433First argument is the string to copy. 1434Remaining arguments form a sequence of PROPERTY VALUE pairs for text 1435properties to add to the result." 1436 (let ((str (copy-sequence string))) 1437 (add-text-properties 0 (length str) 1438 properties 1439 str) 1440 str)))) 1441 1442(defsubst navi2ch-read-only-string (string &optional front-nonsticky) 1443 (navi2ch-propertize string 1444 'read-only t 1445 'front-sticky (not front-nonsticky) 1446 'rear-nonsticky t)) 1447 1448(defsubst navi2ch-file-mtime (filename) 1449 (nth 5 (file-attributes filename))) 1450 1451(defsubst navi2ch-file-size (filename) 1452 (nth 7 (file-attributes filename))) 1453 1454(defsubst navi2ch-make-cache (&optional limit test) 1455 (vector limit 1456 (apply #'make-hash-table 1457 (append (list :rehash-threshold 0.9) 1458 (and limit 1459 (integerp limit) 1460 (not (zerop limit)) 1461 (list :size (1+ limit))) 1462 (and test 1463 (list :test test)))))) 1464 1465(defun navi2ch-cache-put (key val cache) 1466 (let ((limit (navi2ch-cache-limit cache)) 1467 (table (navi2ch-cache-hash-table cache))) 1468 (prog1 1469 (puthash key val table) 1470 (when (and limit 1471 (<= (hash-table-count table) limit)) 1472 (clrhash table))))) 1473 1474(defsubst navi2ch-cache-remove (key cache) 1475 (remhash key (navi2ch-cache-hash-table cache))) 1476 1477;; from emacs-w3m 1478(defun navi2ch-url-encode-string (str &optional coding encode-space) 1479 (apply (function concat) 1480 (mapcar 1481 (lambda (ch) 1482 (cond 1483 ((eq ch ?\n) ; newline 1484 "%0D%0A") 1485 ((string-match "[-a-zA-Z0-9_:/.]" (char-to-string ch)) ; xxx? 1486 (char-to-string ch)) ; printable 1487 ((and (char-equal ch ?\x20); space 1488 encode-space) 1489 "+") 1490 (t 1491 (format "%%%02X" ch)))) ; escape 1492 ;; Coerce a string into a list of chars. 1493 (append (encode-coding-string (or str "") 1494 (or coding 1495 navi2ch-coding-system 1496 'shift_jis)) 1497 nil)))) 1498 1499(eval-and-compile 1500 (defalias 'navi2ch-number-sequence 1501 (if (fboundp 'number-sequence) 1502 #'number-sequence 1503 (lambda (from to) 1504 (let ((n from) 1505 result) 1506 (while (<= n to) 1507 (setq result (cons n result)) 1508 (setq n (1+ n))) 1509 (nreverse result)))))) 1510 1511(defsubst navi2ch-eq-or-memq (item maybe-list) 1512 (if (listp maybe-list) 1513 (memq item maybe-list) 1514 (eq item maybe-list))) 1515 1516(defmacro navi2ch-region-active-p () 1517 "Say whether the region is active." 1518 (if (fboundp 'region-active-p) 1519 (list 'region-active-p) 1520 (list 'and 'transient-mark-mode 'mark-active))) 1521 1522(navi2ch-update-html-tag-regexp) 1523 1524(run-hooks 'navi2ch-util-load-hook) 1525;;; navi2ch-util.el ends here 1526