home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / irchat-pj / irchat-pj-2.4.24.22.tar.gz / irchat-pj-2.4.24.22.tar / irchat-pj-2.4.24.22 / irchat.el < prev    next >
Lisp/Scheme  |  2002-07-20  |  62KB  |  1,614 lines
  1. ;;; see file irchat-copyright.el for change log and copyright info
  2.  
  3. ;; irchat-2.4jp version by kick@wide.ad.jp (1994/03/17 - 1998/12/21)
  4. ;; Copyright (C) 1994,1995,1996,1997,1998 KIKUCHI Takahiro
  5.  
  6. ;; irchat-pj 2.4.24.x version by simm@irc.fan.gr.jp (1999/01/16-2002/07/19)
  7. ;; Copyright (C) 1998-2002 irchat-PJ Project
  8.  
  9. ;; modified by simm@irc.fan.gr.jp, Wed, 05 Jan 2000 02:51:10 +0900
  10. (or (fboundp 'defsubst)
  11.     (fset 'defsubst 'defun))
  12.  
  13. (require 'irchat-commands)
  14. (require 'irchat-handle)
  15. (require 'irchat-inlines)
  16. (require 'irchat-filter)
  17. (require 'irchat-vars)
  18. (require 'irchat-pj-jisx0201)
  19. (require 'irchat-pj-modeline)
  20. (require 'irchat-pj-coding-system)
  21. (require 'irchat-pj-version-string)
  22. (require 'irchat-pj-sound)
  23. (require 'irchat-pj-action)
  24.  
  25. (provide 'irchat)
  26.  
  27. (defconst irchat-ctcp-error-msg "Unrecognized command: '%s'"
  28.   "*Error message given to anyone asking wrong CTCP command.")
  29.  
  30. (defvar irchat-ctcp-lastcommand nil
  31.   "*Place to keep last entered command")
  32.  
  33. (defvar irchat-ctcp-lastnick nil
  34.   "*Place to keep last queried nick")
  35.  
  36. (defvar kanji-flag nil) ;; for original emacs and mule
  37. (defun irchat-mule-version ()
  38.     (and (boundp 'MULE)
  39.      (string-match "^[0-9.]*" mule-version)
  40.      (concat "Mule-"
  41.          (substring mule-version (match-beginning 0) (match-end 0)))))
  42.  
  43. (defvar irchat-system-fqdname (system-name)
  44.   "*The fully qualified domain name of the system.
  45. Default is what (system-name) returns.")
  46.  
  47. (if irchat-want-traditional
  48.     (defvar irchat-command-window-on-top nil
  49.       "*If non-nil, the Command window will be put at the top of the screen.
  50. Else it is put at the bottom.")
  51.  
  52.   (defvar irchat-command-window-on-top t
  53.     "*If non-nil, the Command window will be put at the top of the screen.
  54. Else it is put at the bottom."))
  55.   
  56. (defvar irchat-use-full-window t
  57.   "*If non-nil, IRCHAT will use whole emacs window. Annoying for GNUS-
  58. users, therefore added by nam.")
  59.  
  60. (defvar irchat-ignore-changes nil
  61.   "*Ignore changes? Good in topic-wars/link troubles.")
  62.  
  63. (defvar irchat-ignore-noauths nil
  64.   "*If non nil, ignore no-auth notices if receiving them.")
  65.  
  66. (defvar irchat-ignore-fakes nil
  67.   "*If non nil, ignore fake notices if receiving them.")
  68.  
  69. (defvar irchat-ignore-kills nil
  70.   "*If non nil, ignore kill notices if receiving them.")
  71.  
  72. (defvar irchat-display-channel-always nil
  73.   "*If non nil, display channel name still in channel buffer.")
  74.  
  75. (defvar irchat-default-freeze-local t
  76.   "*If non nil, channel buffer local freeze flag is on at starting.")
  77.  
  78. (defsubst irchat-channel-freeze-local (chan value)
  79.   (put (intern chan) 'freeze value))
  80.  
  81. (defvar irchat-default-beep-local nil
  82.   "*If non nil, channel buffer local beep flag is on at starting.")
  83.  
  84. (defsubst irchat-channel-beep-local (chan value)
  85.   (put (intern chan) 'beep value))
  86.  
  87. (defvar irchat-default-suppress-local nil
  88.   "*If non nil, channel buffer local suppress flag is on at starting.")
  89.  
  90. (defsubst irchat-channel-suppress-local (chan value)
  91.   (put (intern chan) 'suppress value))
  92.  
  93. (defvar irchat-message-try-to-connect-server nil
  94.   "*If non nil, notify to mini buffer when trying to connect server.")
  95.  
  96. (defvar irchat-reconnect-automagic nil
  97.   "*Automatic reconnection, default is disabled")
  98.  
  99. (defvar irchat-ask-for-nickname nil
  100.   "*Ask for nickname if irchat was entered with \\[universal-argument].")
  101.  
  102. (defvar irchat-ask-for-password nil
  103.   "*Ask for password when connecting to server.")
  104.  
  105. (defvar irchat-ask-for-channel-password nil
  106.   "*Ask for channel password when joining channel with password.")
  107.  
  108. (defvar irchat-reconnect-with-password nil
  109.   "*auto recconect to server with password after incorrect password.")
  110.  
  111. (defvar irchat-blink-parens t
  112.   "*Should we blink matching parenthesis in irchat command buffer?")
  113.  
  114. (defvar irchat-one-buffer-mode nil
  115.   "*When non-nil, irchat will put up only a dialogue-buffer (on the
  116. screen). Useful for those (perverts) who use 24 line terminals.")
  117.  
  118. (defvar irchat-channel-buffer-mode nil
  119.   "*When non-nil, irchat will display a channel buffer.")
  120.  
  121. (defvar irchat-channel-filter "" 
  122.   "*Enables use of \\[universal-argument] with NAMES and TOPIC.")
  123.  
  124. (defvar irchat-how-to-show-links-reply nil
  125.   "*how to show LINKS reply.")
  126.  
  127. (defvar irchat-links-reply-count 0
  128.   "*the number of LINKS reply.")
  129.  
  130. (defvar irchat-long-reply-count 0
  131.   "*the number of NAMES/LIST/WHO reply.")
  132.  
  133. (defvar irchat-no-configure-windows t
  134.   "*not yet configure windows")
  135.  
  136. (defvar irchat-fatal-error-message nil
  137.   "*ERROR message")
  138.  
  139. (defvar irchat-while-whois-reply nil
  140.   "*true while whois reply.")
  141.  
  142. (defvar irchat-auto-whois-nick ""
  143.   "*nick which automatically whois.")
  144.  
  145. (defvar irchat-nickname-already-in-use nil
  146.   "*Need ask another nickname.")
  147.  
  148. (defvar irchat-nickname-erroneus nil
  149.   "*Need ask another nickname.")
  150.  
  151. (defvar irchat-grow-tail "_"
  152.   "*Add irchat-grow-tail to nick when reconnecting. Otherwise you might get
  153. killed again if automagic reconnect is too fast.")
  154.  
  155. (defvar irchat-shorten-kills t
  156.   "*Shorten KILL messages to about one line.")
  157.  
  158. (defvar irchat-invited-channel)
  159. (setq irchat-invited-channel nil)
  160.  
  161. (defvar irchat-Command-mode-hook nil
  162.   "*A hook for IRCHAT Command mode.")
  163.  
  164. (defvar irchat-Dialogue-mode-hook nil
  165.   "*A hook for IRCHAT Dialogue mode.")
  166.  
  167. (defvar irchat-Others-mode-hook nil
  168.   "*A hook for IRCHAT Others mode.")
  169.  
  170. (defvar irchat-Channel-mode-hook nil
  171.   "*A hook for IRCHAT Current channel mode.")
  172.  
  173. (defvar irchat-Exit-hook nil
  174.   "*A hook executed when signing off IRC.")
  175.  
  176. (defvar irchat-ignore-nickname nil
  177.   "*A list of nicknames, as symbols, to ignore.  Messages from these people
  178. won't be displayed.")
  179.  
  180. (defvar irchat-kill-realname nil
  181.   "*A list of real names of people to ignore. Messages from them
  182. won't be displayed.")
  183.  
  184. (defvar irchat-kill-logon nil
  185.   "*A list of logon names (user@host.dom.ain). Messages from them
  186. won't be displayed.")
  187.  
  188. (defvar irchat-buggy-emacs-pos-visible-in-window-p nil
  189.   "*You should set non-nil if your emacs has buggy pos-visible-in-window-p.")
  190.  
  191. (defvar irchat-trying-nickname nil
  192.   "the nickname that I'm trying to be.")
  193.  
  194. ;; add by simm@irc.fan.gr.jp, Mon, 08 Nov 1999 02:57:29 +0900
  195. (defvar irchat-pj-startup-nickname-rest nil
  196.   "rest nickname list when startup")
  197.  
  198. (defvar irchat-old-window-configuration nil
  199.   "the window configuration before starting irchat.")
  200.  
  201. (defvar irchat-after-registration nil
  202.   "after my registration")
  203.  
  204. (defvar irchat-debugging nil
  205.   "for debugging only")
  206.  
  207. ;; Define hooks for each IRC message the server might send us.
  208. ;; The newer IRC servers use numeric reply codes instead of words.
  209.  
  210. (defvar irchat-msg-list
  211.   '(channel error invite linreply msg namreply nick ping pong quit2
  212.     privmsg quit topic wall whoreply kill wallops mode kick part join
  213.     200 203 204 205 206 209 211 212 213 214 215 216 217 218 219
  214.     301 311 312 313 314 315 317 318 321 322 323 331 332 341 
  215.     351 352 353 361 364 365 366 367 368 371 372 381 382 391
  216.     401 402 403 411 412 421 431 432 433 441 451 461 462 463 
  217.     464 465 471 472 473 474 481 482 491)
  218.   "A list of the IRC messages and numeric reply codes irchat can handle.")
  219.  
  220.  
  221. (mapcar (function
  222.      (lambda (sym)
  223.        (eval (list 'defvar (intern (concat "irchat-"
  224.                            (prin1-to-string sym)
  225.                            "-hook"))
  226.                nil
  227.                (concat "*A hook that is executed when the IRC "
  228.                  "message \"" (upcase (prin1-to-string sym))
  229.                  "\" is received.
  230. The hook function is called with two arguments, PREFIX and REST-OF-LINE.
  231. It should return non NIL if no further processing of the message is to be
  232. carried out.")))))
  233.     irchat-msg-list)
  234.  
  235. (defvar irchat-current-channel nil
  236.   "The channel you currently have joined.")
  237.  
  238. (defvar irchat-current-channels nil
  239.   "The channels you have currently joined.")
  240.  
  241. (defvar irchat-chanbuf-num 0
  242.   "The channel buffer you currently have selected.")
  243.  
  244. (defvar irchat-chanbuf-list nil
  245.   "The channel buffers list you have currently joined.")
  246.  
  247. (defvar irchat-chanbuf-indicator "Private"
  248.   "The current channel buffer, \"pretty-printed.\"")
  249.  
  250. (defvar irchat-chanbufs-indicator "No channel"
  251.   "The channel buffers list, \"pretty-printed.\"")
  252.  
  253. (defvar irchat-polling nil
  254.   "T when we are automatically polling the server.")
  255.  
  256. (defvar irchat-last-poll-minute nil
  257.   "The minute when we last polled the server.")
  258.  
  259. (defvar irchat-last-timestamp 0
  260.   "The minute we inserted the previous timestamp")
  261.  
  262. (defvar irchat-previous-pattern nil )
  263.  
  264. (defvar irchat-freeze nil
  265.   "If non-nil the Dialogue window will not be scrolled automatically to bring
  266. new entries into view.")
  267.  
  268. (defvar irchat-privmsg-partner nil
  269.   "The person who got your last private message.")
  270.  
  271. (defvar irchat-current-chat-partner nil
  272.   "The person you are in a private conversation with.")
  273.  
  274. (defvar irchat-current-chat-partners nil
  275.   "An list containing nics user is chatting with.")
  276.  
  277. (defvar irchat-chat-partner-alist nil
  278.   "An alist containing nics user is chatting with.")
  279.  
  280. (defvar irchat-command-buffer-mode 'channel
  281.   "symbol chat or channel depending on which is current mode at 
  282. command buffer.")
  283.  
  284. (defvar irchat-nick-alist nil
  285.   "An alist containing the nicknames of users known to currently be on IRC.
  286. Each element in the list is a list containing a nickname.")
  287.  
  288. (defvar irchat-channel-alist nil 
  289.   "An alist containing the channels on IRC.  Each element in the list is 
  290. a list containing a channel name.")
  291.  
  292. (defvar irchat-userhost ""
  293.   "The user@host for the current line.")
  294.  
  295. (defvar irchat-debug-buffer nil)
  296. (defvar irchat-server-buffer nil)
  297. (defvar irchat-server-name nil)
  298. (defvar irchat-my-userhost nil)
  299. (defvar irchat-my-user nil)
  300. (defvar irchat-my-host nil)
  301. (defvar irchat-my-server nil)
  302.  
  303. ;; begin: modified by simm@irc.fan.gr.jp, Wed, 21 Jul 1999
  304. (defvar irchat-buffer-base " IRC:")
  305. (defvar irchat-Command-buffer "*IRC*")
  306. (defvar irchat-Dialogue-buffer (concat irchat-buffer-base " Dialogue"))
  307. (defvar irchat-Others-buffer (concat irchat-buffer-base " Others"))
  308. (defvar irchat-Private-buffer (concat irchat-buffer-base " Private"))
  309. (defvar irchat-Channel-buffer nil)
  310. (defvar irchat-KILLS-buffer  (concat irchat-buffer-base " KILLS"))
  311. (defvar irchat-IGNORED-buffer (concat irchat-buffer-base " IGNORED"))
  312. (defvar irchat-WALLOPS-buffer (concat irchat-buffer-base " WALLOPS"))
  313. (defvar irchat-pj-CONVERT-buffer (concat irchat-buffer-base " CONVERT"))
  314. (defvar irchat-show-wallops t)
  315. ;; end
  316.  
  317. (defvar irchat-server-process nil)
  318. (defvar irchat-status-message-string nil)
  319.  
  320. (defvar irchat-command-map nil)
  321. (defvar irchat-Command-mode-map nil)
  322. (defvar irchat-Dialogue-mode-map nil)
  323. (defvar irchat-Others-mode-map nil)
  324. (defvar irchat-Channel-mode-map nil)
  325. (defvar irchat-CTCP-command-map nil)
  326. (defvar irchat-DCC-command-map nil)
  327. (defvar irchat-STATS-command-map nil)
  328. (defvar irchat-buffer-switch-map nil)
  329.  
  330. (put 'irchat-Command-mode 'mode-class 'special)
  331. (put 'irchat-Dialogue-mode 'mode-class 'special)
  332. (put 'irchat-Others-mode 'mode-class 'special)
  333. (put 'irchat-Channel-mode 'mode-class 'special)
  334.  
  335. (if irchat-command-map
  336.     nil
  337.   (define-prefix-command 'irchat-command-map)
  338.   (setq irchat-command-map (make-keymap))
  339.   (fset 'irchat-command-prefix irchat-command-map)
  340.   (define-key irchat-command-map "0" 'irchat-Command-jump-channel0)
  341.   (define-key irchat-command-map "1" 'irchat-Command-jump-channel1)
  342.   (define-key irchat-command-map "2" 'irchat-Command-jump-channel2)
  343.   (define-key irchat-command-map "3" 'irchat-Command-jump-channel3)
  344.   (define-key irchat-command-map "4" 'irchat-Command-jump-channel4)
  345.   (define-key irchat-command-map "5" 'irchat-Command-jump-channel5)
  346.   (define-key irchat-command-map "6" 'irchat-Command-jump-channel6)
  347.   (define-key irchat-command-map "7" 'irchat-Command-jump-channel7)
  348.   (define-key irchat-command-map "8" 'irchat-Command-jump-channel8)
  349.   (define-key irchat-command-map "9" 'irchat-Command-jump-channel9)
  350.   (define-key irchat-command-map "\C-a" 'irchat-Command-alternative-channel)
  351.   (define-key irchat-command-map "A" 'irchat-Command-admin)
  352.   (define-key irchat-command-map "a" 'irchat-Command-away)
  353.   (define-key irchat-command-map "\C-b" 'irchat-buffer-switch-prefix)
  354.   (define-key irchat-command-map "B" 'irchat-Command-beep-on-message)
  355.   (define-key irchat-command-map "b" 'irchat-Command-scroll-down)
  356.   (define-key irchat-command-map "\C-c" 'irchat-CTCP-command-prefix)
  357.   (define-key irchat-command-map "c" 'irchat-Command-inline)
  358.   (define-key irchat-command-map "\C-d" 'irchat-DCC-command-prefix)
  359.   (define-key irchat-command-map "D" 'irchat-Command-debug)
  360.   (define-key irchat-command-map "\C-f" 'irchat-Command-scroll-freeze)
  361.   (define-key irchat-command-map "F" 'irchat-Command-finger-direct)
  362.   (define-key irchat-command-map "f" 'irchat-Command-finger)
  363.   (define-key irchat-command-map "\C-i" 'irchat-Command-ignore)
  364.   (define-key irchat-command-map "i" 'irchat-Command-invite)
  365.   (define-key irchat-command-map "\C-j" 'irchat-Command-next-channel)
  366.   (define-key irchat-command-map "j" 'irchat-Command-join)
  367.   (define-key irchat-command-map "\C-k" 'irchat-Command-kick)
  368.   (define-key irchat-command-map "\C-l" 'irchat-Command-redisplay)
  369.   (define-key irchat-command-map "L" 'irchat-Command-load-vars)
  370.   (define-key irchat-command-map "l" 'irchat-Command-list)
  371.   (define-key irchat-command-map "M" 'irchat-pj-Command-broadcast-minibuffer)
  372.   (define-key irchat-command-map "m" 'irchat-Command-send-minibuffer)
  373.   (define-key irchat-command-map "\C-m" 'irchat-Command-modec)
  374.   (define-key irchat-command-map "\C-n" 'irchat-Command-names)
  375.   (define-key irchat-command-map "n" 'irchat-Command-nickname)
  376.   (define-key irchat-command-map "\C-o" 'irchat-Command-toggle-display-mode)
  377.   (define-key irchat-command-map "o" 'irchat-Command-ison)
  378.   (define-key irchat-command-map "\C-p" 'irchat-Command-part)
  379.   (define-key irchat-command-map "P" 'irchat-Channel-ctcp-ping)
  380.   (define-key irchat-command-map "p" 'irchat-Command-send-private)
  381.   (define-key irchat-command-map "q" 'irchat-Command-quit)
  382.   (define-key irchat-command-map "\C-r" 'irchat-Command-caesar-line)
  383.   (define-key irchat-command-map "r" 'irchat-Command-reconfigure-windows)
  384.   (define-key irchat-command-map "\C-s" 'irchat-STATS-command-prefix)
  385.   (define-key irchat-command-map "S" 'irchat-Command-suppress-others)
  386.   (define-key irchat-command-map "s" 'irchat-Command-servers)
  387.   (define-key irchat-command-map "\C-t" 'irchat-Command-trace)
  388.   (define-key irchat-command-map "T" 'irchat-Channel-ctcp-time)
  389.   (define-key irchat-command-map "t" 'irchat-Command-topic)
  390.   (define-key irchat-command-map "\C-u" 'irchat-Command-userhost)
  391.   (define-key irchat-command-map "U" 'irchat-Channel-ctcp-userinfo)
  392.   (define-key irchat-command-map "u" 'irchat-Command-users)
  393.   (define-key irchat-command-map "V" 'irchat-Channel-ctcp-version)
  394.   (define-key irchat-command-map "v" 'irchat-Command-version)
  395.   (define-key irchat-command-map "w" 'irchat-Command-who)
  396.   (define-key irchat-command-map "W" 'irchat-Command-wait)
  397.   (define-key irchat-command-map "\C-y" 'irchat-Command-send-yank)
  398.   (define-key irchat-command-map "Y" 'irchat-Command-debug-user)
  399.   (define-key irchat-command-map "z" 'irchat-pj-Command-broadcast-message)
  400.   (define-key irchat-command-map "\C-?" 'irchat-Command-scroll-down)
  401.   (define-key irchat-command-map " " 'irchat-Command-scroll-up)
  402.   (define-key irchat-command-map "!" 'irchat-Command-send-exec)
  403.   (define-key irchat-command-map "$" 'irchat-Command-eod-buffer)
  404.   (define-key irchat-command-map ">" 'irchat-Command-next-channel)
  405.   (define-key irchat-command-map "<" 'irchat-Command-previous-channel)
  406.   (define-key irchat-command-map "/" 'irchat-Command-generic))
  407.  
  408. (if irchat-CTCP-command-map
  409.     nil
  410.   (define-prefix-command 'irchat-CTCP-command-map)
  411.   (setq irchat-CTCP-command-map (make-keymap))
  412.   (fset 'irchat-CTCP-command-prefix irchat-CTCP-command-map)
  413.   (define-key irchat-CTCP-command-map "0" 'irchat-Command-jump-channel10)
  414.   (define-key irchat-CTCP-command-map "1" 'irchat-Command-jump-channel11)
  415.   (define-key irchat-CTCP-command-map "2" 'irchat-Command-jump-channel12)
  416.   (define-key irchat-CTCP-command-map "3" 'irchat-Command-jump-channel13)
  417.   (define-key irchat-CTCP-command-map "4" 'irchat-Command-jump-channel14)
  418.   (define-key irchat-CTCP-command-map "5" 'irchat-Command-jump-channel15)
  419.   (define-key irchat-CTCP-command-map "6" 'irchat-Command-jump-channel16)
  420.   (define-key irchat-CTCP-command-map "7" 'irchat-Command-jump-channel17)
  421.   (define-key irchat-CTCP-command-map "8" 'irchat-Command-jump-channel18) 
  422.   (define-key irchat-CTCP-command-map "9" 'irchat-Command-jump-channel19)
  423.   (define-key irchat-CTCP-command-map "g" 'irchat-Command-ctcp-generic)
  424.   (define-key irchat-CTCP-command-map "v" 'irchat-Command-ctcp-version)
  425.   (define-key irchat-CTCP-command-map "t" 'irchat-Command-ctcp-time)
  426.   (define-key irchat-CTCP-command-map "f" 'irchat-Command-ctcp-finger)
  427.   (define-key irchat-CTCP-command-map "a" 'irchat-Command-ctcp-action)
  428.   (define-key irchat-CTCP-command-map "r" 'irchat-Command-ctcp-caesar)
  429.   (define-key irchat-CTCP-command-map "u" 'irchat-Command-ctcp-userinfo)
  430.   (define-key irchat-CTCP-command-map "p" 'irchat-Command-ctcp-ping)
  431.   (define-key irchat-CTCP-command-map "c" 'irchat-Command-ctcp-clientinfo)
  432.   (define-key irchat-CTCP-command-map "\C-c"
  433.     'irchat-Command-ctcp-clientinfo-generic)
  434.   (define-key irchat-CTCP-command-map "U" 
  435.     'irchat-Command-ctcp-userinfo-from-minibuffer)
  436.   (define-key irchat-CTCP-command-map "\C-u" 
  437.     'irchat-Command-ctcp-userinfo-from-commandbuffer)
  438.   )
  439.  
  440.  
  441. (if irchat-DCC-command-map
  442.     nil
  443.   (define-prefix-command 'irchat-DCC-command-map)
  444.   (setq irchat-DCC-command-map (make-keymap))
  445.   (fset 'irchat-DCC-command-prefix irchat-DCC-command-map)
  446.   (define-key irchat-DCC-command-map "c" 'irchat-Command-dcc-chat)
  447.   (define-key irchat-DCC-command-map "g" 'irchat-Command-dcc-get)
  448.   (define-key irchat-DCC-command-map "k" 'irchat-Command-dcc-kill)
  449.   (define-key irchat-DCC-command-map "l" 'irchat-Command-dcc-list)
  450.   (define-key irchat-DCC-command-map "s" 'irchat-Command-dcc-send)
  451.   )
  452.  
  453. (if irchat-STATS-command-map
  454.     nil
  455.   (define-prefix-command 'irchat-STATS-command-map)
  456.   (setq irchat-STATS-command-map (make-keymap))
  457.   (fset 'irchat-STATS-command-prefix irchat-STATS-command-map)
  458.   (define-key irchat-STATS-command-map "c" 'irchat-Command-stats-connection)
  459.   )
  460. (defun irchat-Command-stats-connection ()
  461.   (interactive)
  462.   (if current-prefix-arg
  463.       (irchat-send "STATS C %s" "")
  464.     (irchat-send "STATS C")))
  465.  
  466.  
  467. (if irchat-buffer-switch-map
  468.     nil
  469.   (define-prefix-command 'irchat-buffer-switch-map)
  470.   (setq irchat-buffer-switch-map (make-keymap))
  471.   (fset 'irchat-buffer-switch-prefix irchat-buffer-switch-map)
  472.   (define-key irchat-buffer-switch-map "k" 'irchat-buffer-switch-kill)
  473.   )
  474. (defun irchat-buffer-switch-kill ()
  475.   (interactive)
  476.   (switch-to-buffer-other-window irchat-KILLS-buffer)
  477.   nil)
  478.  
  479.  
  480. (if irchat-Others-mode-map
  481.     nil
  482.   (setq irchat-Others-mode-map (make-keymap))
  483.   (suppress-keymap irchat-Others-mode-map t)
  484.   (let ((i 0))
  485.     (while (< i 128)
  486.       (define-key irchat-Others-mode-map (format "%c" i) 'other-window)
  487.       (setq i (1+ i))))
  488.   (define-key irchat-Others-mode-map "\C-[" nil))
  489.  
  490. (if irchat-Channel-mode-map
  491.     nil
  492.   (setq irchat-Channel-mode-map (make-keymap))
  493.   (suppress-keymap irchat-Channel-mode-map)
  494.   (define-key irchat-Channel-mode-map "0" 'irchat-Command-jump-channel0)
  495.   (define-key irchat-Channel-mode-map "1" 'irchat-Command-jump-channel1)
  496.   (define-key irchat-Channel-mode-map "2" 'irchat-Command-jump-channel2)
  497.   (define-key irchat-Channel-mode-map "3" 'irchat-Command-jump-channel3)
  498.   (define-key irchat-Channel-mode-map "4" 'irchat-Command-jump-channel4)
  499.   (define-key irchat-Channel-mode-map "5" 'irchat-Command-jump-channel5)
  500.   (define-key irchat-Channel-mode-map "6" 'irchat-Command-jump-channel6)
  501.   (define-key irchat-Channel-mode-map "7" 'irchat-Command-jump-channel7)
  502.   (define-key irchat-Channel-mode-map "8" 'irchat-Command-jump-channel8)
  503.   (define-key irchat-Channel-mode-map "9" 'irchat-Command-jump-channel9)
  504.   (define-key irchat-Channel-mode-map "a" 'irchat-Command-away)
  505.   (define-key irchat-Channel-mode-map "A" 'irchat-Command-alternative-channel)
  506.   (define-key irchat-Channel-mode-map "B" 'irchat-Command-beep-on-message)
  507.   (define-key irchat-Channel-mode-map "b" 'irchat-Current-scroll-down)
  508.   (define-key irchat-Channel-mode-map "F" 'irchat-Command-finger-direct)
  509.   (define-key irchat-Channel-mode-map "f" 'irchat-Channel-freeze)
  510.   (define-key irchat-Channel-mode-map "i" 'irchat-Command-invite)
  511.   (define-key irchat-Channel-mode-map "J" 'irchat-Command-next-channel)
  512.   (define-key irchat-Channel-mode-map "j" 'irchat-Command-join)
  513.   (define-key irchat-Channel-mode-map "L" 'irchat-Command-load-vars)
  514.   (define-key irchat-Channel-mode-map "l" 'irchat-Command-list)
  515.   (define-key irchat-Channel-mode-map "m" 'irchat-Command-modec)
  516.   (define-key irchat-Channel-mode-map "n" 'irchat-Command-names)
  517.   (define-key irchat-Channel-mode-map "o" 'other-window)
  518.   (define-key irchat-Channel-mode-map "p" 'irchat-Command-part)
  519.   (define-key irchat-Channel-mode-map "r" 'irchat-Command-reconfigure-windows)
  520.   (define-key irchat-Channel-mode-map "S" 'irchat-Command-suppress-others)
  521.   (define-key irchat-Channel-mode-map "t" 'irchat-Command-topic)
  522.   (define-key irchat-Channel-mode-map "u" 'irchat-Command-users)
  523.   (define-key irchat-Channel-mode-map "v" 'irchat-Command-version)
  524.   (define-key irchat-Channel-mode-map "w" 'irchat-Command-who)
  525.   (define-key irchat-Channel-mode-map "!" 'irchat-Command-send-exec)
  526.   (define-key irchat-Channel-mode-map "$" 'end-of-buffer)
  527.   (define-key irchat-Channel-mode-map "/" 'irchat-Command-generic)
  528.   (define-key irchat-Channel-mode-map ">" 'irchat-Command-next-channel)
  529.   (define-key irchat-Channel-mode-map "<" 'irchat-Command-previous-channel)
  530.   (define-key irchat-Channel-mode-map " " 'irchat-Current-scroll-up)
  531.   (define-key irchat-Channel-mode-map "\C-?" 'irchat-Current-scroll-down)
  532.   (define-key irchat-Channel-mode-map "\C-n" 'forward-line)
  533.   (define-key irchat-Channel-mode-map "\C-m" 'irchat-Command-enter-message)
  534.   (define-key irchat-Channel-mode-map "\C-c" 'irchat-command-prefix))
  535.  
  536. (if irchat-Dialogue-mode-map
  537.     nil
  538.   (setq irchat-Dialogue-mode-map (make-keymap))
  539.   (suppress-keymap irchat-Dialogue-mode-map)
  540.   (define-key irchat-Dialogue-mode-map "0" 'irchat-Command-jump-channel0)
  541.   (define-key irchat-Dialogue-mode-map "1" 'irchat-Command-jump-channel1)
  542.   (define-key irchat-Dialogue-mode-map "2" 'irchat-Command-jump-channel2)
  543.   (define-key irchat-Dialogue-mode-map "3" 'irchat-Command-jump-channel3)
  544.   (define-key irchat-Dialogue-mode-map "4" 'irchat-Command-jump-channel4)
  545.   (define-key irchat-Dialogue-mode-map "5" 'irchat-Command-jump-channel5)
  546.   (define-key irchat-Dialogue-mode-map "6" 'irchat-Command-jump-channel6)
  547.   (define-key irchat-Dialogue-mode-map "7" 'irchat-Command-jump-channel7)
  548.   (define-key irchat-Dialogue-mode-map "8" 'irchat-Command-jump-channel8)
  549.   (define-key irchat-Dialogue-mode-map "9" 'irchat-Command-jump-channel9)
  550.   (define-key irchat-Dialogue-mode-map "A" 'irchat-Command-alternative-channel)
  551.   (define-key irchat-Dialogue-mode-map "a" 'irchat-Command-away)
  552.   (define-key irchat-Dialogue-mode-map "b" 'irchat-Current-scroll-down)
  553.   (define-key irchat-Dialogue-mode-map "F" 'irchat-Command-finger-direct)
  554.   (define-key irchat-Dialogue-mode-map "f" 'irchat-Dialogue-freeze)
  555.   (define-key irchat-Dialogue-mode-map "i" 'irchat-Command-invite)
  556.   (define-key irchat-Dialogue-mode-map "J" 'irchat-Command-next-channel)
  557.   (define-key irchat-Dialogue-mode-map "j" 'irchat-Command-join)
  558.   (define-key irchat-Dialogue-mode-map "L" 'irchat-Command-load-vars)
  559.   (define-key irchat-Dialogue-mode-map "l" 'irchat-Command-list)
  560.   (define-key irchat-Dialogue-mode-map "m" 'irchat-Command-modec)
  561.   (define-key irchat-Dialogue-mode-map "n" 'irchat-Command-names)
  562.   (define-key irchat-Dialogue-mode-map "o" 'other-window)
  563.   (define-key irchat-Dialogue-mode-map "p" 'irchat-Command-part)
  564.   (define-key irchat-Dialogue-mode-map "r" 'irchat-Command-reconfigure-windows)
  565.   (define-key irchat-Dialogue-mode-map "t" 'irchat-Command-topic)
  566.   (define-key irchat-Dialogue-mode-map "u" 'irchat-Command-users)
  567.   (define-key irchat-Dialogue-mode-map "v" 'irchat-Command-version)
  568.   (define-key irchat-Dialogue-mode-map "w" 'irchat-Command-who)
  569.   (define-key irchat-Dialogue-mode-map "!" 'irchat-Command-send-exec)
  570.   (define-key irchat-Dialogue-mode-map "$" 'end-of-buffer)
  571.   (define-key irchat-Dialogue-mode-map "/" 'irchat-Command-generic)
  572.   (define-key irchat-Dialogue-mode-map ">" 'irchat-Command-next-channel)
  573.   (define-key irchat-Dialogue-mode-map "<" 'irchat-Command-previous-channel)
  574.   (define-key irchat-Dialogue-mode-map " " 'irchat-Current-scroll-up)
  575.   (define-key irchat-Dialogue-mode-map "\C-?" 'irchat-Current-scroll-down)
  576.   (define-key irchat-Dialogue-mode-map "\C-n" 'forward-line)
  577.   (define-key irchat-Dialogue-mode-map "\C-m" 'irchat-Command-enter-message)
  578.   (define-key irchat-Dialogue-mode-map "\C-c" 'irchat-command-prefix))
  579.  
  580. (if irchat-Command-mode-map
  581.     nil
  582.   (setq irchat-Command-mode-map (make-sparse-keymap))
  583. ;;(define-key irchat-Command-mode-map "/" 'irchat-Command-irc-compatible)
  584.   (define-key irchat-Command-mode-map "\C-[\C-i" 'lisp-complete-symbol)
  585.   (define-key irchat-Command-mode-map "\C-i" 'irchat-Command-complete)
  586.   (define-key irchat-Command-mode-map "\C-m" 'irchat-pj-Command-send-line)
  587.   (define-key irchat-Command-mode-map "\C-c" 'irchat-command-prefix))
  588.  
  589. ;;;
  590. ;;;
  591. ;;;
  592.  
  593. (defun irchat (&optional confirm)
  594.   "Connect to the IRC server and start chatting.
  595. If optional argument CONFIRM is non-nil, ask which IRC server to connect.
  596. If already connected, just pop up the windows."
  597.   (interactive "P")
  598.   (if (fboundp 'add-hook)
  599.       (add-hook 'kill-emacs-hook 'irchat-quit))
  600.   (if (file-exists-p (expand-file-name irchat-variables-file))
  601.       (load (expand-file-name irchat-variables-file)))
  602.   (if (irchat-server-opened)
  603.       (irchat-configure-windows)
  604.     (unwind-protect
  605.     (progn
  606.       (setq irchat-fatal-error-message nil)
  607.       (irchat-Command-setup-buffer)
  608.       (irchat-start-server confirm))
  609.       (if (not (irchat-server-opened))
  610.       (irchat-Command-quit 'error)
  611.     ;; IRC server is successfully open. 
  612.     (irchat-pj-window-init)
  613.     (setq irchat-pj-initialize-p  t
  614.           irchat-current-channels nil
  615.           irchat-chanbuf-list     nil)
  616.     (run-hooks 'irchat-Startup-hook)
  617.     (irchat-pj-startup-check-nick)
  618.     (irchat-pj-startup-join)
  619.     (irchat-Channel-select 0)
  620.     (irchat-Channel-change)
  621.     (irchat-Command-describe-briefly)))))
  622.  
  623. ;; split by simm@irc.fan.gr.jp, Mon, 24 Jan 2000 19:12:24 +0900
  624. (defun irchat-pj-window-init ()
  625.   "Window initialization for irchat-pj"
  626.   (if (not  irchat-old-window-configuration)
  627.       (setq irchat-old-window-configuration
  628.         (current-window-configuration)))
  629.   (set-buffer irchat-Command-buffer)
  630.   (let ((buffer-read-only nil))
  631.     (erase-buffer)
  632.     (sit-for 0))
  633.   (make-variable-buffer-local 'irchat-freeze-local)
  634.   (set-default 'irchat-freeze-local irchat-default-freeze-local)
  635.   (make-variable-buffer-local 'irchat-beep-local)
  636.   (set-default 'irchat-beep-local irchat-default-beep-local)
  637.   (make-variable-buffer-local 'irchat-suppress-local)
  638.   (set-default 'irchat-suppress-local irchat-default-suppress-local)
  639.   (make-variable-buffer-local 'irchat-previous-pattern)
  640.   (irchat-Dialogue-setup-buffer)
  641.   (irchat-Others-setup-buffer)
  642.   (irchat-Private-setup-buffer)
  643.   (irchat-KILLS-setup-buffer)
  644.   (irchat-IGNORED-setup-buffer)
  645.   (irchat-WALLOPS-setup-buffer)
  646.   (setq irchat-no-configure-windows t))
  647.  
  648.  
  649. ;; split by simm@irc.fan.gr.jp, Mon, 08 Nov 1999 02:28:38 +0900
  650. (defun irchat-pj-startup-check-nick ()
  651.   "Nick check when startup"
  652.   (let (ok)
  653.     (while (and (not ok) (irchat-server-opened))
  654.       (accept-process-output irchat-server-process)
  655.       (if (or irchat-nickname-already-in-use irchat-nickname-erroneus)
  656.       (progn
  657.         (if irchat-pj-startup-nickname-rest
  658.         (setq irchat-trying-nickname          (car irchat-pj-startup-nickname-rest)
  659.               irchat-pj-startup-nickname-rest (cdr irchat-pj-startup-nickname-rest))
  660.           ;; modified by simm@irc.fan.gr.jp, Mon, 20 Dec 1999 21:44:10 +0900
  661.           (funcall irchat-pj-sound-error-function)
  662.           (setq irchat-trying-nickname
  663.             (read-from-minibuffer
  664.              (format
  665.               (if irchat-nickname-already-in-use
  666.               "IRC: Nickname \"%s\" already in use. Choose another one: "
  667.             "IRC: Erroneus nickname \"%s\". Choose another one: ")
  668.               irchat-trying-nickname))))
  669.         (if (irchat-server-opened)
  670.         (irchat-send "NICK %s" irchat-trying-nickname)
  671.           (setq irchat-nickname irchat-trying-nickname)
  672.           (setq irchat-nickname-already-in-use nil
  673.             irchat-nickname-erroneus nil)
  674.           (irchat 'always))))
  675.       (setq irchat-nickname-already-in-use nil
  676.         irchat-nickname-erroneus nil)
  677.       (if (not irchat-no-configure-windows)
  678.       (setq ok t)))))
  679.  
  680. (defun irchat-pj-startup-join ()
  681.   "Join channels when startup"
  682.   (let ((chans (or irchat-current-channels irchat-startup-channel-list)))
  683.     (if chans
  684.     (while chans
  685.       (and (stringp (car chans))
  686.            (irchat-Command-join (car chans)))
  687.       (setq chans (cdr chans)))
  688.       (and (stringp irchat-startup-channel)
  689.        (irchat-Command-join irchat-startup-channel)))))
  690. ;; end
  691.  
  692. (defun irchat-Command-mode ()
  693.   "Major mode for IRCHAT.  Normal edit function are available.
  694. Typing Return or Linefeed enters the current line in the dialogue.
  695. The following special commands are available:
  696. For a list of the generic commands type \\[irchat-Command-generic] ? RET.
  697. \\{irchat-Command-mode-map}"
  698.   (interactive)
  699.   (kill-all-local-variables)
  700.  
  701.   ;; modified by negi@KU3G.org, 1 Jun 1999
  702.   (define-abbrev-table 'irchat-pj-abbrev-table ())
  703.  
  704.   (setq irchat-nick-alist (list (list irchat-nickname))
  705.     major-mode 'irchat-Command-mode
  706.     mode-name "IRC Commands"
  707.     irchat-privmsg-partner nil
  708.     irchat-pj-away-p nil
  709.     ;; modified by negi@KU3G.org, 1 Jun 1999
  710.     local-abbrev-table irchat-pj-abbrev-table)
  711.   (irchat-pj-modeline-set
  712.    irchat-pj-modeline-global-status
  713.    irchat-pj-modeline-Command-buffer
  714.    'irchat-pj-modeline-Command)
  715.   (use-local-map irchat-Command-mode-map)
  716.   (if irchat-blink-parens
  717.       nil
  718.     (make-variable-buffer-local 'blink-matching-paren)
  719.     (set-default 'blink-matching-paren t)
  720.     (setq blink-matching-paren nil))
  721.   (run-hooks 'irchat-Command-mode-hook))
  722.   
  723.  
  724. (defun irchat-Dialogue-mode ()
  725.   "Major mode for displaying the IRC dialogue.
  726. All normal editing commands are turned off.
  727. Instead, these commands are available:
  728. \\{irchat-Dialogue-mode-map}"
  729.   (kill-all-local-variables)
  730.   (setq major-mode 'irchat-Dialogue-mode
  731.     mode-name "IRC Dialogue")
  732.   (irchat-pj-modeline-set
  733.    irchat-pj-modeline-global-status
  734.    irchat-pj-modeline-Dialogue-buffer
  735.    'irchat-pj-modeline-Dialogue)
  736.   (use-local-map irchat-Dialogue-mode-map)
  737.   (set-buffer irchat-Dialogue-buffer)
  738.   (setq buffer-read-only t)
  739.   (run-hooks 'irchat-Dialogue-mode-hook))
  740.  
  741.  
  742. (defun irchat-Others-mode ()
  743.   "Major mode for displaying the IRC others message except current channel.
  744. All normal editing commands are turned off.
  745. Instead, these commands are available:
  746. \\{irchat-Others-mode-map}"
  747.   (kill-all-local-variables)
  748.   (setq major-mode 'irchat-Others-mode
  749.     mode-name "IRC Others")
  750.   (irchat-pj-modeline-set
  751.    irchat-pj-modeline-global-status
  752.    irchat-pj-modeline-Others-buffer
  753.    'irchat-pj-modeline-Others)
  754.   (use-local-map irchat-Others-mode-map)
  755.   (set-buffer irchat-Others-buffer)
  756.   (setq buffer-read-only t)
  757.   (run-hooks 'irchat-Others-mode-hook))
  758.  
  759.  
  760. (defun irchat-Channel-mode ()
  761.   "Major mode for displaying the IRC current channel buffer.
  762. All normal editing commands are turned off.
  763. Instead, these commands are available:
  764. \\{irchat-Channel-mode-map}"
  765.   (kill-all-local-variables)
  766.   (setq major-mode 'irchat-Channel-mode
  767.     mode-name "IRC Current channel")
  768.   (irchat-pj-modeline-set
  769.    irchat-pj-modeline-local-status
  770.    irchat-pj-modeline-Channel-buffer
  771.    'irchat-pj-modeline-Channel)
  772.   (use-local-map irchat-Channel-mode-map)
  773.   (setq buffer-read-only t)
  774.   (run-hooks 'irchat-Channel-mode-hook))
  775.  
  776.  
  777. (defun irchat-configure-windows ()
  778.   "Configure Command mode and Dialogue mode windows.
  779. One is for entering commands and text, the other displays the IRC dialogue."
  780.   (setq irchat-no-configure-windows nil)
  781.   (let ((obuf (current-buffer)))
  782.     (if (or (one-window-p t)
  783.         (null (get-buffer-window irchat-Command-buffer))
  784.         (null (get-buffer-window irchat-Dialogue-buffer))
  785.         (and irchat-channel-buffer-mode
  786.          (or (null (get-buffer-window irchat-Channel-buffer))
  787.              (null (get-buffer-window irchat-Others-buffer))))
  788.         (and (null irchat-channel-buffer-mode)
  789.          (or (get-buffer-window irchat-Channel-buffer)
  790.              (get-buffer-window irchat-Others-buffer))))
  791.     (progn
  792.       (if irchat-command-window-on-top
  793.           (progn
  794.         (if (not irchat-use-full-window)
  795.             (set-window-configuration irchat-old-window-configuration))
  796.         (switch-to-buffer irchat-Command-buffer)
  797.         (if irchat-use-full-window
  798.             (delete-other-windows))
  799.         (if irchat-one-buffer-mode
  800.             (switch-to-buffer irchat-Dialogue-buffer)
  801.           (split-window-vertically (max window-min-height 
  802.                         (or (and (featurep 'xemacs)
  803.                              (irchat-pj-tab-supported-xemacs-p)
  804.                              (+ 2 irchat-command-window-height))
  805.                             irchat-command-window-height)))
  806.           (other-window 1)
  807.           (if irchat-channel-buffer-mode
  808.               (progn
  809.             (split-window-vertically
  810.              (max window-min-height 
  811.                   (/ (* (window-height)
  812.                     irchat-channel-window-height-percent)
  813.                  100)))
  814.             (switch-to-buffer irchat-Channel-buffer)
  815.             (other-window 1)
  816.             (switch-to-buffer irchat-Others-buffer)
  817.             (goto-char (point-max))
  818.             (recenter (- (window-height) 1))
  819.             (select-window
  820.              (get-buffer-window irchat-Command-buffer)))
  821.             (switch-to-buffer irchat-Dialogue-buffer)
  822.             (if (not irchat-freeze)
  823.             (progn
  824.               (goto-char (point-max))
  825.               (recenter (- (window-height) 1))))
  826.             (select-window
  827.              (get-buffer-window irchat-Command-buffer)))))
  828.         ;; mta@tut.fi wants it like this
  829.         (switch-to-buffer irchat-Dialogue-buffer)
  830.         (if (not irchat-freeze)
  831.         (progn
  832.           (goto-char (point-max))
  833.           (recenter (- (window-height) 1))))
  834.         (if irchat-use-full-window
  835.         (delete-other-windows))
  836.         (if irchat-one-buffer-mode
  837.         nil
  838.           (split-window-vertically
  839.            (- (window-height) (max window-min-height 
  840.                        irchat-command-window-height)))
  841.           (if irchat-channel-buffer-mode
  842.           (progn
  843.             (split-window-vertically
  844.              (max window-min-height 
  845.               (/ (* (window-height)
  846.                 (- 100 irchat-channel-window-height-percent))
  847.                  100)))
  848.             (switch-to-buffer irchat-Others-buffer)
  849.             (goto-char (point-max))
  850.             (recenter (- (window-height) 1))
  851.             (other-window 1)
  852.             (switch-to-buffer irchat-Channel-buffer)))
  853.           (other-window 1)
  854.           (switch-to-buffer irchat-Command-buffer)
  855.           (if (not irchat-channel-buffer-mode)
  856.           (progn
  857.             (select-window
  858.              (get-buffer-window irchat-Dialogue-buffer))
  859.             (if (not irchat-freeze)
  860.             (progn
  861.               (goto-char (point-max))
  862.               (recenter (- (window-height) 1))))))
  863.           (select-window
  864.            (get-buffer-window irchat-Command-buffer))))))
  865.     (set-buffer obuf)))
  866.  
  867.  
  868. (defun irchat-Command-setup-buffer ()
  869.   "Initialize Command mode buffer."
  870.   (or (get-buffer irchat-Command-buffer)
  871.       (save-excursion
  872.     (set-buffer (get-buffer-create irchat-Command-buffer))
  873.     (irchat-Command-mode))))
  874.  
  875. (defun irchat-Dialogue-setup-buffer ()
  876.   "Initialize Dialogue mode buffer."
  877.   (or (get-buffer irchat-Dialogue-buffer)
  878.       (save-excursion
  879.     (set-buffer (get-buffer-create irchat-Dialogue-buffer))
  880.     (irchat-Dialogue-mode))))
  881.  
  882. (defun irchat-Others-setup-buffer ()
  883.   "Initialize Others mode buffer."
  884.   (or (get-buffer irchat-Others-buffer)
  885.       (save-excursion
  886.     (set-buffer (get-buffer-create irchat-Others-buffer))
  887.     (irchat-Others-mode))))
  888.  
  889. (defun irchat-Private-setup-buffer ()
  890.   "Initialize private conversation buffer."
  891.   (or (get-buffer irchat-Private-buffer)
  892.       (save-excursion
  893.     (set-buffer (get-buffer-create irchat-Private-buffer))
  894.     (insert "This is my private buffer.\n")
  895.     (irchat-Channel-mode)))
  896.   (setq irchat-Private-buffer (get-buffer irchat-Private-buffer))
  897.   (setq irchat-Channel-buffer irchat-Private-buffer))
  898.  
  899. (defun irchat-KILLS-setup-buffer ()
  900.   "Initialize KILLS buffer."
  901.   (or (get-buffer irchat-KILLS-buffer)
  902.       (save-excursion
  903.     (set-buffer (get-buffer-create irchat-KILLS-buffer)))))
  904.  
  905. (defun irchat-IGNORED-setup-buffer ()
  906.   "Initialize IGNORED buffer."
  907.   (or (get-buffer irchat-IGNORED-buffer)
  908.       (save-excursion
  909.     (set-buffer (get-buffer-create irchat-IGNORED-buffer)))))
  910.  
  911. (defun irchat-WALLOPS-setup-buffer ()
  912.   "Initialize WALLOPS buffer."
  913.   (or (get-buffer irchat-WALLOPS-buffer)
  914.       (save-excursion
  915.     (set-buffer (get-buffer-create irchat-WALLOPS-buffer)))))
  916.  
  917. (defun irchat-clear-system ()
  918.   "Clear all IRCHAT variables and buffers."
  919.   (interactive)
  920.   (if (and irchat-Command-buffer (get-buffer irchat-Command-buffer))
  921.       (bury-buffer irchat-Command-buffer))
  922.   (if (and irchat-Dialogue-buffer (get-buffer irchat-Dialogue-buffer))
  923.       (bury-buffer irchat-Dialogue-buffer))
  924.   (if (and irchat-KILLS-buffer (get-buffer irchat-KILLS-buffer))
  925.       (bury-buffer irchat-KILLS-buffer))
  926.   (if (and irchat-IGNORED-buffer (get-buffer irchat-IGNORED-buffer))
  927.       (bury-buffer irchat-IGNORED-buffer))
  928.   (if (and irchat-WALLOPS-buffer (get-buffer irchat-WALLOPS-buffer))
  929.       (bury-buffer irchat-WALLOPS-buffer))
  930.   (if (and irchat-debug-buffer (get-buffer irchat-debug-buffer))
  931.       (bury-buffer irchat-debug-buffer))
  932.   (setq irchat-debug-buffer nil))
  933.  
  934. (defun irchat-start-server (&optional confirm)
  935.   "Open network stream to remote irc server.
  936. If optional argument CONFIRM is non-nil, ask the host that the server
  937. is running on."
  938.   (if (irchat-server-opened)
  939.       ;; Stream is already opened.
  940.       nil
  941.     ;; Open IRC server.
  942.     (if (or
  943.      (and confirm
  944.           (not (eq confirm 'always)))
  945.      (null irchat-server))
  946.     (setq irchat-server
  947.           (irchat-completing-default-read    
  948.            "IRC server: "
  949.            irchat-server-alist
  950.            '(lambda (s) t) nil irchat-server)))
  951.     ;; modified by simm@irc.fan.gr.jp, Mon, 08 Nov 1999 02:59:18 +0900
  952.     (cond ((and confirm
  953.         (not (eq confirm 'always))
  954.         irchat-ask-for-nickname)
  955.        (setq irchat-nickname
  956.          (read-string "Enter your nickname: " irchat-nickname)))
  957.       (irchat-pj-startup-nickname-list
  958.        (setq irchat-nickname (car irchat-pj-startup-nickname-list)
  959.          irchat-pj-startup-nickname-rest (cdr irchat-pj-startup-nickname-list))))
  960.     ;; If no server name is given, local host is assumed.
  961.     (if (string-equal irchat-server "")
  962.     (setq irchat-server (system-name)))
  963.     (or (irchat-open-server irchat-server irchat-service)
  964.     (and (stringp irchat-status-message-string)
  965.          (string= irchat-status-message-string "Searching for program")
  966.          (error "ERROR: Cannot execute \"%s\" -- Cannot connect IRC server \"%s\""
  967.             irchat-dcc-program (irchat-pj-server-name)))
  968.     (and (stringp irchat-status-message-string)
  969.          (< 0 (length irchat-status-message-string))
  970.          (error "ERROR: %s -- Cannot connect IRC server \"%s\""
  971.             irchat-status-message-string (irchat-pj-server-name)))
  972.     (error "ERROR: Cannot connect IRC server \"%s\"" (irchat-pj-server-name)))))
  973.  
  974. (defun irchat-pj-server-name ()
  975.   "`serverhost:port'-formatted server name.
  976. When display message of irchat-server.
  977. If port is omitted, only `serverhost' displays."
  978.   (if (string-match "\\([^:]+\\):\\([^:]+\\):.*" irchat-server)
  979.       (format "%s:%s"
  980.           (substring irchat-server (match-beginning 1) (match-end 1))
  981.           (substring irchat-server (match-beginning 2) (match-end 2)))
  982.     irchat-server))
  983.  
  984. (defun irchat-open-server (host &optional service)
  985.   "Open chat server on HOST.
  986. If HOST is nil, use value of environment variable \"IRCSERVER\".
  987. If optional argument SERVICE is non-nil, open by the service name."
  988.   (let (status
  989.     tmp
  990.     (host (or host (getenv "IRCSERVER"))))
  991.     (setq irchat-status-message-string "")
  992.     (if (and host (assoc host irchat-server-alist)
  993.          (cdr (assoc host irchat-server-alist)))
  994.     (setq host (cdr (assoc host irchat-server-alist))))
  995.     (if (string-match "^\\([^:]+\\):\\([0-9]+\\)\\(.*\\)" host)
  996.     (progn
  997.       (setq tmp (matching-substring host 3))
  998.       (setq service (string-to-int (matching-substring host 2)))
  999.       (setq host (matching-substring host 1))
  1000.       (if (string-match "^:\\(.*\\)" tmp)
  1001.           (if (string= (matching-substring tmp 1) "")
  1002.           (setq irchat-ask-for-password t)
  1003.         (setq irchat-ask-for-password nil)
  1004.         (setq irchat-password (matching-substring tmp 1))))))
  1005.     (setq irchat-servername host) ;; temporary
  1006.     (message "Connecting to IRC server %s..." host)
  1007.     (if (not host)
  1008.     (setq irchat-status-message-string "IRC server is not specified.")
  1009.       (if (irchat-open-server-internal host service)
  1010.       (let (password)
  1011.         (setq irchat-after-registration nil)
  1012.         (if irchat-pj-enable-undernet-server
  1013.         (setq status t)
  1014.           (irchat-send "PING :%s" host)
  1015.           (setq status (irchat-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]")))
  1016.         (if (not status)
  1017.         ;; We have to close connection here, since the function
  1018.         ;;  `irchat-server-opened' may return incorrect status.
  1019.         (irchat-close-server-internal)
  1020.           (setq irchat-after-registration t)
  1021.           (set-process-sentinel irchat-server-process 'irchat-sentinel)
  1022.           (set-process-filter   irchat-server-process 'irchat-filter)
  1023.           (setq password
  1024.             (if (or irchat-ask-for-password irchat-reconnect-with-password)
  1025.             (irchat-read-passwd "Server Password: ")
  1026.  
  1027.               irchat-password))
  1028.           (and password
  1029.            (stringp password)
  1030.            (not (string= "" password))
  1031.            (irchat-send "PASS %s" password))
  1032.           (setq irchat-reconnect-with-password nil)
  1033.           (irchat-send "USER %s * * :%s" 
  1034.                (or (user-real-login-name) "Nobody")
  1035.                (if (and irchat-name (not (string= irchat-name "")))
  1036.                    irchat-name "Nanashi no Gombei"))
  1037.           (setq irchat-trying-nickname irchat-nickname)
  1038.           (irchat-send "NICK %s" irchat-nickname)
  1039.           (setq irchat-after-registration t)))))
  1040.     status))
  1041.  
  1042.  
  1043. (defun irchat-close-server ()
  1044.   "Close chat server."
  1045.   (unwind-protect
  1046.       (progn
  1047.     ;; Un-set default sentinel function before closing connection.
  1048.     (and irchat-server-process
  1049.          (eq 'irchat-sentinel
  1050.          (process-sentinel irchat-server-process))
  1051.          (set-process-sentinel irchat-server-process nil))
  1052.     ;; We cannot send QUIT command unless the process is running.
  1053.     (if (irchat-server-opened)
  1054.         (irchat-send "QUIT")))
  1055.     (irchat-close-server-internal)))
  1056.  
  1057.  
  1058. (defun irchat-server-opened ()
  1059.   "Return server process status, T or NIL.
  1060. If the stream is opened, return T, otherwise return NIL."
  1061.   (and irchat-server-process
  1062.        (memq (process-status irchat-server-process) '(open run))))
  1063.  
  1064.  
  1065. (defun irchat-open-server-internal (host service)
  1066.   "Open connection to chat server on HOST by SERVICE (default is irc)."
  1067.   (irchat-pj-define-service-coding-system service)
  1068.   (condition-case err 
  1069.       (save-excursion
  1070.     ;; Initialize communication buffer.
  1071.     (setq irchat-server-buffer (get-buffer-create " *IRC*"))
  1072.     (set-buffer irchat-server-buffer)
  1073.     (kill-all-local-variables)
  1074.     (erase-buffer)
  1075.     (if (string-match "^[^\\[]" host)
  1076.         (setq irchat-server-process
  1077.           (open-network-stream "IRC" (current-buffer)
  1078.                        host service))
  1079.       (if (not (string-match
  1080.             "^\\[\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)\\]$" host))
  1081.           (setq irchat-status-message-string "Use [nnn.nnn.nnn.nnn]"
  1082.             irchat-server-process nil)
  1083.         (setq irchat-server-process
  1084.           (start-process "IRC" (current-buffer)
  1085.                  irchat-dcc-program "tcp" "connect"
  1086.                  (matching-substring host 1) 
  1087.                  (format "%s" service)))
  1088.         (set-process-sentinel irchat-server-process
  1089.                   'irchat-sentinel)))
  1090.     (setq irchat-server-name host)
  1091.     (run-hooks 'irchat-server-hook)
  1092.     ;; Return the server process.
  1093.     irchat-server-process)
  1094.     (error (setq irchat-status-message-string (car (cdr err)))
  1095.        nil)))
  1096.  
  1097.  
  1098. (defun irchat-close-server-internal ()
  1099.   "Close connection to chat server."
  1100.   (if irchat-server-process
  1101.       (delete-process irchat-server-process))
  1102.   (if irchat-server-buffer
  1103.       (kill-buffer irchat-server-buffer))
  1104.   (setq irchat-server-buffer nil
  1105.     irchat-server-process nil))
  1106.  
  1107.  
  1108. (defun irchat-wait-for-response (regexp)
  1109.   "Wait for server response which matches REGEXP."
  1110.   (save-excursion
  1111.     (let ((status t)
  1112.       (wait t))
  1113.       (set-buffer irchat-server-buffer)
  1114.       (irchat-accept-response)
  1115.       (while wait
  1116.     (goto-char (point-min))
  1117.     (cond ((looking-at "ERROR")
  1118.            (setq status nil)
  1119.            (setq wait nil))
  1120.           ((looking-at ".")
  1121.            (setq wait nil))
  1122.           (t (irchat-accept-response))))
  1123.       ;; Save status message.
  1124.       (end-of-line)
  1125.       (setq irchat-status-message-string
  1126.         (buffer-substring (point-min) (point)))
  1127.       (if status
  1128.       (progn
  1129.         (setq wait t)
  1130.         (while wait
  1131.           (goto-char (point-max))
  1132.           (forward-line -1)        ;(beginning-of-line)
  1133.           (if (looking-at regexp)
  1134.           (setq wait nil)
  1135.         (message "IRCHAT: Reading...")
  1136.         (irchat-accept-response)
  1137.         (message "")))
  1138.         ;; Successfully received server response.
  1139.         (delete-region (point-min) (point-max))
  1140.         t)))))
  1141.  
  1142.  
  1143. (defun irchat-accept-response ()
  1144.   "Read response of server. Only used at startup time"
  1145.   ;; To deal with server process exiting before accept-process-output is called.
  1146.   (or (memq (process-status irchat-server-process) '(open run))
  1147.       (if (not irchat-reconnect-automagic)
  1148.       (error "IRCHAT: Connection closed.")
  1149.     (if irchat-grow-tail
  1150.         (irchat 'always)
  1151.       (irchat))))
  1152.   (condition-case errorcode
  1153.       (accept-process-output irchat-server-process)
  1154.     (error
  1155.      (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode))
  1156.         ;; Ignore select error.
  1157.         nil)
  1158.        (t (signal (car errorcode) (cdr errorcode)))))))
  1159.  
  1160.  
  1161. (defun irchat-send-poll (now)
  1162.   (setq irchat-last-poll-minute now
  1163.         irchat-nick-alist nil
  1164.         irchat-channel-alist nil)
  1165.   (irchat-send "PING irchat-polling")
  1166.   (irchat-send "NAMES"))
  1167.  
  1168. (defun irchat-send-pong (&optional msg)
  1169.   (irchat-send "PONG :%s" (or msg irchat-servername)))
  1170.  
  1171. ;;; As the server PINGs us regularly, we can be sure that we will 
  1172. ;;; have the opportunity to poll it with a NAMES as often.
  1173. ;;; We do this so that we can keep the irchat-nick-alist up-to-date.
  1174. ;;; We send a PING after the NAMES so that we notice when the final
  1175. ;;; NAMREPLY has come.
  1176. (defun irchat-maybe-poll ()
  1177.   (let* ((now (substring (current-time-string) 14 16))
  1178.          (nowint (string-to-int now))
  1179.          (stampint (mod (+ irchat-last-timestamp
  1180.                            (or irchat-timestamp-interval 0))
  1181.                         60)))
  1182.     ;; Print timestamp, this should use timer.el or something
  1183.     (if (or (not irchat-timestamp-interval)
  1184.             (> stampint nowint)
  1185.             (> (- nowint stampint) 30))
  1186.         nil
  1187.       (let ((obuf (current-buffer)))
  1188.         (if (get-buffer irchat-Dialogue-buffer)
  1189.             (progn
  1190.               (set-buffer irchat-Dialogue-buffer)
  1191.               (setq irchat-last-timestamp stampint)
  1192.               (insert (format "%s\n" (format irchat-timestamp-format 
  1193.                                              (current-time-string))))
  1194.               (set-buffer obuf)))))
  1195.     ;; Update names lists
  1196.     (if (or (not irchat-global-names) irchat-pj-away-p)
  1197.         ;; not polling or away, forget it
  1198.         nil
  1199.       ;; polling, see if enoung time has  passed since last poll, or this is 
  1200.       ;; the first poll
  1201.       (if (not irchat-last-poll-minute)
  1202.           (irchat-send-poll nowint)
  1203.         (if (and (numberp irchat-global-names) 
  1204.                  (> irchat-global-names 0))
  1205.             (if (>= (mod (+ irchat-last-poll-minute irchat-global-names) 60)
  1206.                     nowint)
  1207.                 (irchat-send-poll nowint))
  1208.           (if (not (= nowint irchat-last-poll-minute))
  1209.               (irchat-send-poll nowint)))))))
  1210.  
  1211. (defun irchat-ischannel (chan)
  1212.   (string-match "^[+&#!]" chan))
  1213.  
  1214. (defun irchat-send (&rest args)
  1215.   (let ((item (apply 'format args)) ditem)
  1216.     ;; add by simm@irc.fan.gr.jp, Thu, 19 Nov 1998
  1217.     (if (and item irchat-pj-katakana-convert)
  1218.     (setq item (irchat-pj-zenkaku-katakana-string item)))
  1219.     (process-send-string irchat-server-process
  1220.              (concat (irchat-string-out item) "\n"))
  1221.     (if (and irchat-debug-buffer (get-buffer irchat-debug-buffer))
  1222.     (let ((obuf (current-buffer)) opoint)
  1223.       (set-buffer irchat-debug-buffer)
  1224.       (setq opoint (point))
  1225.       (goto-char (point-max))
  1226.       (insert (concat item "\n"))
  1227.       (goto-char opoint)
  1228.       (set-buffer obuf)))
  1229.     (setq ditem (downcase item))
  1230.     (if (string-match "^list" (downcase ditem))
  1231.     (if (string-match "\\(^list\\) \\([^ ,]+\\)$" ditem)
  1232.         (setq irchat-channel-filter (matching-substring ditem 2))
  1233.       (setq irchat-channel-filter "")))))
  1234.  
  1235. (defun irchat-scroll-if-visible (window)
  1236.   (if window (set-window-point window (point-max))))
  1237.  
  1238.  
  1239. (defun irchat-insert0 (message)
  1240.   (irchat-insert message nil t))
  1241.  
  1242.  
  1243. (defun irchat-insert-special (string &optional pattern)
  1244.   (irchat-insert string irchat-Private-buffer pattern))
  1245.  
  1246.  
  1247. (defun irchat-insert-allchan (string &optional pattern)
  1248.   (irchat-insert string (cons irchat-Private-buffer
  1249.                   (get (intern irchat-nickname) 'chnl)) pattern))
  1250.  
  1251. (defun irchat-insert (body &optional chans pattern flag head)
  1252.   (let ((obuf (current-buffer)) opoint chan buf win visible )
  1253.     (while chans
  1254.       (setq chan (if (listp chans) (car chans) chans))
  1255.       (setq chans (if (listp chans) (cdr chans) nil))
  1256.       (if (setq buf (if (bufferp chan) chan (irchat-Channel-exist chan)))
  1257.       (progn
  1258.         (set-buffer buf)
  1259.         (setq opoint (point))
  1260.         (goto-char (point-max))
  1261.         (if (setq win (get-buffer-window buf))
  1262.           (if (or irchat-buggy-emacs-pos-visible-in-window-p
  1263.               (pos-visible-in-window-p (point-max) win))
  1264.               (setq visible t)))
  1265.         (let* ((buffer-read-only nil))
  1266.           (setq irchat-hoge (point))
  1267.           (if (and (stringp pattern)
  1268.                        (stringp irchat-previous-pattern)
  1269.                (string= pattern irchat-previous-pattern))
  1270.           (progn
  1271.             (previous-line 1)
  1272.             (if flag
  1273.             (if irchat-print-time (forward-char 6))
  1274.               (end-of-line))
  1275.             (insert head)
  1276.             (goto-char (point-max)))
  1277.                 (and (eq pattern 'privmsg)
  1278.                      irchat-beep-local
  1279.                      (funcall irchat-pj-sound-bell-function))
  1280.                 (if irchat-print-time
  1281.                     (insert (substring (current-time-string) 11 16) " "))
  1282.                 (if (and (not irchat-display-channel-always)
  1283.                          (string-match "^\\([<>(]\\)[^ ]+:\\([^ :]+ .*\\)" body))
  1284.                     (insert (matching-substring body 1) (matching-substring body 2) "\n")
  1285.                   (insert body))
  1286.                 (setq irchat-previous-pattern pattern)))
  1287.         (if irchat-freeze-local
  1288.         (goto-char opoint))
  1289.             ;; modified by simm@irc.fan.gr.jp, Sun, 27 Jun 1999
  1290.         (if (setq win (get-buffer-window buf irchat-pj-scroll-condition))
  1291.         (progn
  1292.           (if (or irchat-buggy-emacs-pos-visible-in-window-p
  1293.               (pos-visible-in-window-p (point-max) win))
  1294.               (setq visible t))
  1295.           (if (not irchat-freeze-local)
  1296.               (set-window-point win (point-max)))))
  1297.         (if irchat-suppress-local
  1298.         (setq visible t))
  1299.         (set-buffer obuf))))
  1300.     (if (not visible)
  1301.     (progn
  1302.       (set-buffer irchat-Others-buffer)
  1303.       (if (> (point-max) irchat-others-high-watermark)
  1304.           (let ((buffer-read-only nil))
  1305.         (delete-region 1 (- (point-max) irchat-others-low-watermark))))
  1306.       (goto-char (point-max))
  1307.       (let ((buffer-read-only nil))
  1308.         (if irchat-print-time
  1309.         (insert (substring (current-time-string) 11 16) " "))
  1310.         (insert body))
  1311.       (setq irchat-previous-pattern nil)
  1312.           ;; begin: modified by simm@irc.fan.gr.jp, Sun, 27 Jun 1999
  1313.           ;;        last-modified by simm@irc.fan.gr.jp, Sat, 3 Jul 1999 
  1314.           (if (setq win (get-buffer-window irchat-Others-buffer irchat-pj-scroll-condition))
  1315.               (let ((cwin nil)
  1316.                     (owin (selected-window)))
  1317.                 (set-window-point win (point-max))
  1318.                 (select-window win)
  1319.                 (recenter (- (window-height) 1))
  1320.                 (and irchat-pj-scroll-condition
  1321.                      (setq cwin (get-buffer-window irchat-Command-buffer
  1322.                                                    irchat-pj-scroll-condition))
  1323.                      (select-window cwin))
  1324.                 (select-window owin)))
  1325.       (set-buffer obuf)))
  1326.           ;; end
  1327.     (set-buffer irchat-Dialogue-buffer)
  1328.     (let ((opoint (point)))
  1329.       (goto-char (point-max))
  1330.       (let ((buffer-read-only nil))
  1331.     (if irchat-print-time
  1332.         (insert (substring (current-time-string) 11 16) " "))
  1333.     (insert body))
  1334.       (setq irchat-previous-pattern nil)
  1335.       ;; modified by simm@irc.fan.gr.jp, Sun, 27 Jun 1999
  1336.       (if (setq win (get-buffer-window irchat-Dialogue-buffer irchat-pj-scroll-condition))
  1337.       (if irchat-freeze
  1338.           (goto-char opoint)
  1339.         ;;(set-window-point win (point-max))
  1340.         (if (not (pos-visible-in-window-p (point-max) win))
  1341.         (let ((owin (selected-window)))
  1342.           (select-window win)
  1343.           (goto-char (point-max))
  1344.           (recenter (- (window-height) 1))
  1345.           (select-window owin))))))
  1346.     (set-buffer obuf)))
  1347.  
  1348.  
  1349. (defun irchat-insert-private (to-me partner xmsg)
  1350.   (if (not (irchat-ischannel partner))
  1351.       (if (null to-me)
  1352.       ;; my message to partner
  1353.       (irchat-insert (format ">%s< %s\n" partner xmsg)
  1354.              (or (irchat-Channel-exist partner) irchat-Private-buffer)
  1355.              'my-privmsg)
  1356.     ;; message from partner
  1357.     ;; begin sound extension: modified by kaoru@kaisei.org
  1358.     (if irchat-pj-sound-when-private
  1359.         (or (irchat-Channel-exist partner)
  1360.         (funcall irchat-pj-sound-private-function)))
  1361.     (irchat-insert (format "=%s= %s\n" partner xmsg)
  1362.                (or (irchat-Channel-exist partner) irchat-Private-buffer)
  1363.                'privmsg))
  1364.     ;; my message to channel (partner is channel)
  1365.     (irchat-insert (format ">%s:%s< %s\n"
  1366.                (irchat-chan-virtual partner)
  1367.                irchat-nickname xmsg)
  1368.            partner 'my-privmsg)))
  1369.  
  1370. ;;;
  1371. ;;; this function handles default arguments more user friendly
  1372. ;;;
  1373. (defun irchat-pj-cut-nil-from-list (table)
  1374.   (let ((tmp table) (result nil))
  1375.     (while tmp
  1376.       (if (car (car tmp))
  1377.       (setq result (append result (list (car tmp)))))
  1378.       (setq tmp (cdr tmp)))
  1379.     result))
  1380.  
  1381. (defun irchat-pj-completing-read
  1382.   (prompt table &optional predicate require-match initial-input)
  1383.   (if (boundp 'xemacs-logo)
  1384.       (completing-read prompt (irchat-pj-cut-nil-from-list table)
  1385.                predicate require-match initial-input)
  1386.     (completing-read prompt table predicate require-match initial-input)))
  1387.  
  1388. (defun irchat-completing-default-read
  1389.   (prompt table predicate require-match initial-input)
  1390.   "completing-read w/ default argument like in 'kill-buffer'"
  1391.   (let ((default-read
  1392.       (irchat-pj-completing-read
  1393.        (if initial-input
  1394.            (format "%s(default %s) "
  1395.                prompt initial-input)
  1396.          (format "%s" prompt))
  1397.        table predicate require-match nil)))
  1398.     (if (and (string= default-read "") initial-input)
  1399.     initial-input
  1400.       default-read)))
  1401.  
  1402. ;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
  1403. ;;; modified by tower@prep Nov 86
  1404. ;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
  1405.  
  1406. ;;; irchat-pj-caesar-region by simm@irc.fan.gr.jp for ROT5-13-47-48
  1407. ;;; on Sun, 29 Aug 1999 22:25:51 +0900
  1408. ;;; from mule-caesar-region (in APEL)
  1409. ;;; so, irchat-caesar-region is obsolete.
  1410.  
  1411. (cond ((and (fboundp 'charset-chars) (fboundp 'char-charset))
  1412.        (defsubst irchat-pj-get-rotate-times (chr)
  1413.          (lsh (charset-chars (char-charset chr)) -1)))
  1414.       ((fboundp 'char-leading-char)
  1415.        (defsubst irchat-pj-get-rotate-times (chr)
  1416.          (if (= (logand (nth 2 (character-set (char-leading-char chr))) 1) 1) 48 47)))
  1417.       (t
  1418.        (defsubst irchat-pj-get-rotate-times (chr)
  1419.          47)))
  1420.  
  1421. (if (fboundp 'split-char)
  1422.     (defalias 'irchat-pj-split-char 'split-char)
  1423.   (defun irchat-pj-split-char (chr)
  1424.     "Return list charset and wone or two position-codes-of CHR."
  1425.     (let (dst (p (1- (char-bytes chr))))
  1426.       (while (>= p 1)
  1427.         (setq dst (cons (- (char-component chr p) 128) dst)
  1428.               p (1- p)))
  1429.       (cons (char-leading-char chr) dst))))
  1430.  
  1431. (cond ((and (fboundp 'make-char) (fboundp 'char-charset))
  1432.        (defsubst irchat-pj-rotate-result (chr ret)
  1433.          (make-char (char-charset chr) (car ret) (car (cdr ret)))))
  1434.       ((and (fboundp 'make-character) (fboundp 'char-leading-char))
  1435.        (defsubst irchat-pj-rotate-result (chr ret)
  1436.          (make-character (char-leading-char chr) (car ret) (car (cdr ret)))))
  1437.       (t
  1438.        (defsubst irchat-pj-rotate-result (chr ret)
  1439.          (+ 128 ret))))
  1440.  
  1441. (defun irchat-pj-caesar-region (start end &optional num-rotate ascii-rotate)
  1442.   "Caesar rotation of current region.
  1443. Optional argument NUM-ROTATE is rotation-size for Latin number \(0-9).
  1444. Optional argument ASCII-ROTATE is rotation-size for Latin alphabet
  1445. \(A-Z and a-z).  For non-ASCII text, ROT-N/2 will be performed in any
  1446. case (N=charset-chars; 94 for 94 or 94x94 graphic character set; 96
  1447. for 96 or 96x96 graphic character set).
  1448.  
  1449. Default NUM-ROTATE is 5, and ASCII-ROTATE is 13, so this performes ROT5-13-47-48."
  1450.   (interactive "r\nP")
  1451.   (setq ascii-rotate (if ascii-rotate
  1452.              (mod ascii-rotate 26)
  1453.                13)
  1454.         num-rotate (if num-rotate
  1455.                        (mod num-rotate 10)
  1456.                      5))
  1457.   (save-excursion
  1458.     (save-restriction
  1459.       (narrow-to-region start end)
  1460.       (goto-char start)
  1461.       (while (< (point)(point-max))
  1462.     (let* ((chr (char-after (point))))
  1463.       (cond ((and (<= ?A chr) (<= chr ?Z))
  1464.          (setq chr (+ chr ascii-rotate))
  1465.          (if (> chr ?Z)
  1466.              (setq chr (- chr 26)))
  1467.          (delete-char 1)
  1468.          (insert chr))
  1469.         ((and (<= ?a chr) (<= chr ?z))
  1470.          (setq chr (+ chr ascii-rotate))
  1471.          (if (> chr ?z)
  1472.              (setq chr (- chr 26)))
  1473.          (delete-char 1)
  1474.          (insert chr))
  1475.                 ((and (<= ?0 chr) (<= chr ?9))
  1476.                  (setq chr (+ chr num-rotate))
  1477.                  (if (> chr ?9)
  1478.                      (setq chr (- chr 10))))
  1479.         ((<= chr ?\x9f)
  1480.          (forward-char))
  1481.         (t
  1482.          (let* ((multi-rotate (irchat-pj-get-rotate-times chr))
  1483.             (ret (mapcar (function
  1484.                       (lambda (octet)
  1485.                     (if (< octet 80)
  1486.                         (+ octet multi-rotate)
  1487.                       (- octet multi-rotate))))
  1488.                      (cdr (irchat-pj-split-char chr)))))
  1489.            (delete-char 1)
  1490.                    (insert (irchat-pj-rotate-result chr ret)))))))))
  1491.   (goto-char end))
  1492.  
  1493. (defun irchat-pj-caesar-string (string &optional num-rotate ascii-rotate)
  1494.   (interactive)
  1495.   (let (beg end str)
  1496.     (save-excursion
  1497.       (if (get-buffer irchat-pj-CONVERT-buffer)
  1498.           (set-buffer irchat-pj-CONVERT-buffer)
  1499.         (get-buffer-create irchat-pj-CONVERT-buffer))
  1500.       (setq beg (point))
  1501.       (insert string)
  1502.       (setq end (point))
  1503.       (irchat-pj-caesar-region beg end num-rotate ascii-rotate)
  1504.       (setq str (buffer-substring beg end))
  1505.       (delete-region beg end))
  1506.     str))
  1507.  
  1508. ; (defun irchat-caesar-region (&optional n)
  1509. ;   "Caesar rotation of region by N, default 13, for decrypting netnews.
  1510. ; ROT47 will be performed for Japanese text in any case."
  1511. ;   (interactive (if current-prefix-arg    ; Was there a prefix arg?
  1512. ;            (list (prefix-numeric-value current-prefix-arg))
  1513. ;          (list nil)))
  1514. ;   (cond ((not (numberp n)) (setq n 13))
  1515. ;     ((< n 0) (setq n (- 26 (% (- n) 26))))
  1516. ;     (t (setq n (% n 26))))        ;canonicalize N
  1517. ;   (if (not (zerop n))        ; no action needed for a rot of 0
  1518. ;       (progn
  1519. ;     (if (or (not (boundp 'caesar-translate-table))
  1520. ;         (/= (aref caesar-translate-table ?a) (+ ?a n)))
  1521. ;         (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
  1522. ;           (message "Building caesar-translate-table...")
  1523. ;           (setq caesar-translate-table (make-vector 256 0))
  1524. ;           (while (< i 256)
  1525. ;         (aset caesar-translate-table i i)
  1526. ;         (setq i (1+ i)))
  1527. ;           (setq lower (concat lower lower) upper (upcase lower) i 0)
  1528. ;           (while (< i 26)
  1529. ;         (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
  1530. ;         (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
  1531. ;         (setq i (1+ i)))
  1532. ;           ;; ROT47 for Japanese text.
  1533. ;           ;; Thanks to ichikawa@flab.fujitsu.junet.
  1534. ;           (setq i 161)
  1535. ;           (let ((t1 (logior ?O 128))
  1536. ;             (t2 (logior ?! 128))
  1537. ;             (t3 (logior ?~ 128)))
  1538. ;         (while (< i 256)
  1539. ;           (aset caesar-translate-table i
  1540. ;             (let ((v (aref caesar-translate-table i)))
  1541. ;               (if (<= v t1) (if (< v t2) v (+ v 47))
  1542. ;                 (if (<= v t3) (- v 47) v))))
  1543. ;           (setq i (1+ i))))
  1544. ;           (message "Building caesar-translate-table... done")))
  1545. ;     (let ((from (region-beginning))
  1546. ;           (to (region-end))
  1547. ;           (i 0) str len)
  1548. ;       (setq str (buffer-substring from to))
  1549. ;       (setq len (length str))
  1550. ;       (while (< i len)
  1551. ;         (aset str i (aref caesar-translate-table (aref str i)))
  1552. ;         (setq i (1+ i)))
  1553. ;       (goto-char from)
  1554. ;       (delete-region from to)
  1555. ;       (insert str)))))
  1556.  
  1557. ;;;
  1558. ;;; this function from ange-ftp.el by Andy Norman (ange@hplb.hpl.hp.com)
  1559. ;;;
  1560. (defun irchat-read-passwd (prompt)
  1561.   "Read a password from the user. Echos a . for each character typed.
  1562. End with RET, LFD, or ESC. DEL or C-h rubs out."
  1563.   (let ((pass "")
  1564.     (c 0)
  1565.     (echo-keystrokes 0)
  1566.     (cursor-in-echo-area t))
  1567.     (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e))
  1568.       (message "%s%s"
  1569.            prompt
  1570.            (make-string (length pass) ?.))
  1571.       (setq c (read-char))
  1572.       (if (and (/= c ?\b) (/= c ?\177))
  1573.       (setq pass (concat pass (char-to-string c)))
  1574.     (if (> (length pass) 0)
  1575.         (setq pass (substring pass 0 -1)))))
  1576.     (substring pass 0 -1)))
  1577.  
  1578. ;;;
  1579. ;;; save log by negi@KU3G.org, Tue, 1 Jun 1999
  1580. ;;;   last modify by simm@irc.fan.gr.jp, Sat, 5 Jun 1999
  1581. ;;;
  1582.  
  1583. (defun irchat-pj-save-log ()
  1584.   "Save log according to irchat-pj-save-log-channel-alist.
  1585. See also irchat-pj-save-log-channel-alist."
  1586.   (interactive)
  1587.   (let ((cur nil)
  1588.         (backup (current-buffer)))
  1589.     (or (eq ?/ (elt irchat-pj-save-log-directory
  1590.                     (1- (length irchat-pj-save-log-directory))))
  1591.         (setq irchat-pj-save-log-directory
  1592.               (concat irchat-pj-save-log-directory "/")))
  1593.     (unwind-protect
  1594.         (mapcar
  1595.          '(lambda (buf-list)
  1596.             (setq cur (or (get-buffer (concat " IRC:" (car buf-list)))
  1597.                           (get-buffer (concat " IRC: " (car buf-list)))))
  1598.             (if cur
  1599.                 (progn
  1600.                   (set-buffer cur)
  1601.                   (append-to-file
  1602.                    (point-min) (point-max)
  1603.                    (concat (expand-file-name irchat-pj-save-log-directory)
  1604.                            (cdr buf-list)
  1605.                            "-"
  1606.                            (format-time-string "%m%d" (current-time)))))))
  1607.          irchat-pj-save-log-channel-alist)
  1608.       (set-buffer backup)
  1609.       (message ""))))
  1610.                      
  1611. ;;;
  1612. ;;; eof
  1613. ;;;
  1614.