home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / irchat-pj / 2.5 / irchat-pj-2.5.6p.tar.gz / irchat-pj-2.5.6p.tar / irchat-pj-2.5.6p / irchat-commands.el < prev    next >
Lisp/Scheme  |  2001-06-05  |  51KB  |  1,524 lines
  1. ;;;
  2. ;;; $Id: irchat-commands.el,v 1.15 2001/06/05 16:45:03 simm Exp $
  3. ;;;
  4. ;;; see file irchat-copyright.el for change log and copyright info
  5.  
  6. (require 'pure-generic)
  7. (require 'pure-cs)
  8. (require 'pure-cs-japanese)
  9. (require 'pure-ds)
  10. (require 'pure-irc-dcc)
  11.  
  12. (defsubst irchat-pj-get-message-buffer ()
  13.   "Get Channel buffer or Dialogue buffer, according to `irchat-channel-buffer-mode'."
  14.   (if irchat-channel-buffer-mode irchat-Channel-buffer irchat-Dialogue-buffer))
  15.  
  16. (defun irchat-Command-describe-briefly ()
  17.   (message (substitute-command-keys "Type \\[describe-mode] for help")))
  18.  
  19.  
  20. (defun irchat-Command-redisplay (&optional center)
  21.   "Un-freezes and re-selects the Dialogue buffer in another window.
  22.    With argument, recenter with that argument."
  23.   (interactive "P")
  24.   (if irchat-channel-buffer-mode
  25.       (progn
  26.     (if (null (get-buffer-window irchat-Channel-buffer))
  27.         (irchat-configure-windows))
  28.     (set-buffer irchat-Channel-buffer)
  29.     (goto-char (point-max))
  30.     (set-window-point (get-buffer-window irchat-Channel-buffer)
  31.               (point-max)))
  32.     (setq irchat-freeze nil)
  33.     (if (get-buffer-window irchat-Dialogue-buffer)
  34.     (let ((owin (selected-window)) win)
  35.       (if (one-window-p)
  36.           (irchat-configure-windows)
  37.         (display-buffer irchat-Dialogue-buffer))
  38.       (if (setq win (get-buffer-window irchat-Dialogue-buffer))
  39.           (let ((obuf (current-buffer)))
  40.         (set-buffer irchat-Dialogue-buffer)
  41.         (goto-char (point-max))
  42.         (select-window win)
  43.         (recenter (- (window-height) 1))
  44.         (select-window owin)
  45.         (set-buffer obuf)))))))
  46.  
  47. (defun irchat-Command-send-message (xmsg)
  48.   "Send MESSAGE to current chat partner of current channel."
  49.   (if (eq irchat-command-buffer-mode 'chat)
  50.       (if irchat-current-chat-partner
  51.       (irchat-send-privmsg irchat-current-chat-partner xmsg)
  52.     (message 
  53.      (substitute-command-keys 
  54.       "Type \\[irchat-Command-join] to start private conversation")))
  55.     (if (not irchat-current-channel)
  56.     (progn
  57.       ;; modified by simm@irc.fan.gr.jp, Mon, 20 Dec 1999 21:44:10 +0900
  58.       (funcall irchat-pj-sound-error-function)
  59.       (message 
  60.        (substitute-command-keys 
  61.         "Type \\[irchat-Command-join] to join a channel")))
  62.       (irchat-send-privmsg irchat-current-channel xmsg))))
  63.  
  64. (defun irchat-Command-send-line ()
  65.   "Send the current line to the current channel."
  66.   (interactive)
  67.   (let (xmsg start)
  68.     (beginning-of-line)
  69.     (setq start (point))
  70.     (end-of-line)
  71.     ;; add by simm@irc.fan.gr.jp, Sun, 30 Jul 2000 21:48:50 +0900
  72.     (if irchat-pj-katakana-convert
  73.     (pure-cs-japanese-kana-convert-region start (point)))
  74.     (setq xmsg (buffer-substring start (point)))
  75.     (if (eobp) (newline) (forward-line))
  76.     (irchat-Command-send-message xmsg)))
  77.  
  78. ;; add by simm@irc.fan.gr.jp, Mon, 24 Jan 2000 22:51:04 +0900
  79. (defun irchat-pj-Command-send-line ()
  80.   "Send the current line to the current channel with SKK mode considered."
  81.   (interactive)
  82.   (cond ((not (boundp 'skk-mode))
  83.      (irchat-Command-send-line))
  84.     ((not skk-mode)
  85.      (irchat-Command-send-line))
  86.     ((not skk-henkan-on)
  87.      (irchat-Command-send-line))
  88.     (skk-egg-like-newline
  89.      (skk-kakutei))
  90.     (t
  91.      (skk-kakutei)
  92.      (irchat-Command-send-line))))
  93.  
  94. (defun irchat-Command-enter-message ()
  95.   "Ask for a line as an entry in the IRC dialogue on the current channel."
  96.   (interactive)
  97.   (let ((xmsg "x")
  98.     (to (if (eq irchat-command-buffer-mode 'chat)
  99.         irchat-current-chat-partner irchat-current-channel)))
  100.     (if to
  101.     (while (not (string= xmsg ""))
  102.       (setq xmsg (read-string (format "to %s> "
  103.                       (irchat-chan-virtual to))))
  104.       (or (string= xmsg "")
  105.           (irchat-Command-send-message xmsg)))
  106.       nil)))
  107.  
  108.  
  109. (defun irchat-Command-debug ()
  110.   "Start debugging irchat."
  111.   (interactive)
  112.   (if irchat-debug-buffer
  113.       (progn
  114.     (setq irchat-debug-buffer nil)
  115.     (other-window 1)
  116.     (delete-window)
  117.     (other-window -1))
  118.     (if irchat-use-full-window
  119.     (delete-other-windows))
  120.     (irchat-configure-windows)
  121.     (split-window-horizontally)
  122.     (other-window 1)
  123.     (setq irchat-debug-buffer (get-buffer-create "*IRC Debugging*"))
  124.     (switch-to-buffer irchat-debug-buffer)
  125.     (other-window -1)))
  126.  
  127.  
  128. (defun irchat-Command-inline ()
  129.   "Send current line as a message to the IRC server."
  130.   (interactive)
  131.   (let (message start stop)
  132.     (beginning-of-line)
  133.     (setq start (point))
  134.     (end-of-line)
  135.     (setq stop (point))
  136.     (setq message (buffer-substring start stop))
  137.     (newline)
  138.     (irchat-send "%s" message)))
  139.  
  140.  
  141. (defun irchat-Command-join (chan &optional key)
  142.   "Join a channel or private conversation.
  143. If user nicname is given, join the same set of channels as 
  144. the specified user. 
  145. If Command-buffer is in chat-mode, start private conversation 
  146. with specified user."
  147.   (interactive (let (chan key (completion-ignore-case t))
  148.                  ;; modified by simm@irc.fan.gr.jp, Fri, 23 Jul 1999
  149.          (setq chan 
  150.                (if (numberp current-prefix-arg)
  151.                            current-prefix-arg
  152.                          (irchat-completing-default-read
  153.                           "Join channel/nick: "
  154.                           (if (eq irchat-command-buffer-mode 'chat)
  155.                               (append irchat-nick-alist irchat-channel-alist)
  156.                             (append irchat-channel-alist irchat-nick-alist))
  157.                           '(lambda (s) t)
  158.                           nil
  159.                           (or (irchat-chan-virtual irchat-invited-channel)
  160.                               irchat-privmsg-partner))))
  161.                  (and current-prefix-arg
  162.                       (not (numberp current-prefix-arg))
  163.                       (setq key
  164.                             (if (eq current-prefix-arg '-)
  165.                                 (read-string (concat "Key for channel " chan ": "))
  166.                               (irchat-read-passwd (concat "Key for channel " chan ": ")))))
  167.          (list chan key)))
  168.   (if (numberp chan)
  169.       (irchat-Channel-jump chan)
  170.     ;; begin: add by simm@irc.fan.gr.jp, on Sat, 16 Jan 1999
  171.     (if irchat-pj-fix-gaga-problem
  172.     (let ((pt 0) (cur "") (enc "") (tmp (concat chan ",")))
  173.       (setq chan "")
  174.       (while (setq pt (string-match "," tmp))
  175.         (setq cur (substring tmp 0 pt)
  176.           pt  (1+ pt)
  177.           tmp (if (< pt (length tmp)) (substring tmp pt) "")
  178.           enc (pure-cs-encode-string cur irchat-pj-cs-encode))
  179.         (cond ((string-match "," enc)
  180.            ;; modified by simm@irc.fan.gr.jp, Mon, 20 Dec 1999 21:44:10 +0900
  181.            (funcall irchat-pj-sound-error-function)
  182.            (message "Invalid channel name. Cannot join %s" cur))
  183.           (t
  184.            (setq chan (if (string= "" chan) cur (concat chan "," cur))))))))
  185.     ;; end
  186.     (setq chan (irchat-chan-real chan)
  187.           irchat-invited-channel nil)
  188.     (if (irchat-ischannel chan)
  189.         (progn
  190.           (setq irchat-command-buffer-mode 'channel)
  191.           (or key
  192.               (setq key (get (intern chan) 'key)))
  193.           (put (intern chan) 'key key)
  194.           (or key
  195.               (setq key ""))
  196.           (irchat-Command-join-channel chan key))
  197.       (setq irchat-command-buffer-mode 'chat)
  198.       (irchat-Command-join-partner chan))
  199.     ;; refresh mode line
  200.     (set-buffer-modified-p (buffer-modified-p))))
  201.  
  202.  
  203. (defun irchat-Command-join-channel (chan key)
  204.   (and (catch 'found
  205.      (mapcar 
  206.       '(lambda (elem)
  207.          (and (string= (downcase chan) (downcase elem))
  208.           (setq chan elem)
  209.           (throw 'found t)))
  210.       irchat-current-channels)
  211.      (irchat-send "JOIN %s %s" chan key)
  212.      nil)
  213.        (irchat-Channel-join chan)))
  214.  
  215.  
  216. (defun irchat-Command-join-partner (partner)
  217.   (setq irchat-current-chat-partners
  218.     (cons partner
  219.           (delete (car (member-ignore-case partner irchat-current-chat-partners))
  220.               irchat-current-chat-partners))
  221.     irchat-current-chat-partner partner)
  222.   (irchat-Channel-join irchat-current-chat-partner))
  223.  
  224.  
  225. (defun irchat-Command-part (chan &optional reason)
  226.   "Part a channel or private conversation."
  227.   (interactive (let (chan msg clist default
  228.              (completion-ignore-case t)
  229.              (reason (or irchat-channel-signoff-msg "bye...")))
  230.          (if (eq 'chat irchat-command-buffer-mode)
  231.              (setq msg "End private conversation with: "
  232.                clist irchat-current-chat-partners
  233.                default irchat-current-chat-partner)
  234.            (setq msg "Part channel: "
  235.              clist irchat-current-channels
  236.              default (irchat-chan-virtual irchat-current-channel)))
  237.          (setq chan (irchat-completing-default-read
  238.                  msg (mapcar 'list clist) '(lambda (s) t) nil default))
  239.          (if current-prefix-arg
  240.              (setq reason (read-string "Reason: ")))
  241.          (list chan reason)))
  242.   (setq chan (irchat-chan-real chan))
  243.   (if (not (irchat-ischannel chan))
  244.       (setq irchat-current-chat-partners
  245.         (delete (car (member-ignore-case chan irchat-current-chat-partners))
  246.              irchat-current-chat-partners)
  247.         irchat-current-chat-partner (car irchat-current-chat-partners))
  248.     (if (member-ignore-case chan irchat-current-channels)
  249.     (setq irchat-current-channel chan)) ; just refocusing
  250.     (irchat-send "PART %s :%s" chan reason))
  251.   (if (not (irchat-ischannel chan))
  252.       (irchat-Channel-part chan)))
  253.  
  254.  
  255. (defun irchat-Command-ignore (nick)
  256.   "Ignore messages from this user.  If already ignoring him/her, toggle."
  257.   (interactive (let (nick (completion-ignore-case t))
  258.          (setq nick
  259.                (irchat-pj-completing-read 
  260.             "Ignore nickname: " 
  261.             irchat-nick-alist
  262.             '(lambda (s) t) nil nil))
  263.          (list nick)))
  264.   (if (string= "" nick)
  265.       (let ((mylist irchat-ignore-nickname) str)
  266.     (setq str "*** Currently ignored people:")
  267.     (while mylist
  268.       (setq str (format "%s %s" str (car mylist)))
  269.       (setq mylist (cdr mylist)))
  270.     (irchat-insert0 (format "%s\n" str)))
  271.     (if (memq (intern nick) irchat-ignore-nickname)
  272.     (progn
  273.       (irchat-insert0 (format "*** Ignore OFF: %s\n" nick))
  274.       (setq irchat-ignore-nickname 
  275.         (delq (intern nick) irchat-ignore-nickname)))
  276.       (irchat-insert0 (format "*** Ignore ON: %s\n" nick))
  277.       (setq irchat-ignore-nickname 
  278.         (cons (intern nick) irchat-ignore-nickname)))))
  279.  
  280.  
  281. (defun irchat-Command-kick (nick &optional reason)
  282.   "Kick this user out."
  283.   (interactive (let (nick (completion-ignore-case t)
  284.               (reason "heh..."))
  285.          (setq nick 
  286.                (irchat-pj-completing-read 
  287.             "Kick out nickname: " 
  288.             irchat-nick-alist
  289.             '(lambda (s) t) nil nil))
  290.          (if current-prefix-arg
  291.              (setq reason (read-string "Reason: ")))
  292.          (list nick reason)))
  293.   (irchat-send "KICK %s %s :%s"
  294.            irchat-current-channel nick reason))
  295.  
  296.  
  297. (defun irchat-Command-servers (regexp)
  298.   "List the given regexp servers.
  299. With Control-U as argument, show server conecting association."
  300.   (interactive "sServer name: ")
  301.   (setq irchat-how-to-show-links-reply current-prefix-arg)
  302.   (irchat-send "LINKS %s" regexp))
  303.  
  304.  
  305. (defun irchat-Command-list (&optional chan)
  306.   "List the given channel and its topics.
  307. If you enter only Control-U as argument, list the current channel.
  308. With - as argument, list all channels."
  309.   (interactive
  310.    (if (or current-prefix-arg (null irchat-current-channel))
  311.        (if (eq current-prefix-arg '-)
  312.        (list current-prefix-arg)
  313.      (list
  314.       (let ((completion-ignore-case t))
  315.         (irchat-pj-completing-read 
  316.          "LIST channel: " 
  317.          irchat-channel-alist
  318.          '(lambda (s) t) nil nil))))
  319.      nil))
  320.   (if (null chan)
  321.       (if irchat-current-channel
  322.       (irchat-send "LIST %s" irchat-current-channel)
  323.     (irchat-send "LIST %s" (irchat-Channel-lists)))
  324.     (if (eq chan '-)
  325.     (irchat-send "LIST")
  326.       (if (not (string= chan ""))
  327.       (irchat-send "LIST %s" (irchat-chan-real chan))
  328.     (irchat-send "LIST %s" (irchat-Channel-lists))))))
  329.  
  330. (defun irchat-Channel-lists ()
  331.   (if (null irchat-current-channels)
  332.       ""
  333.     (let ((chans (cdr irchat-current-channels))
  334.       (str (car irchat-current-channels)))
  335.       (while chans
  336.     (setq str (format "%s,%s" str (car chans)))
  337.     (setq chans (cdr chans)))
  338.       str)))
  339.   
  340. (defun irchat-Command-users ()
  341.   "List the number of users and servers"
  342.   (interactive)
  343.   (irchat-send "LUSERS"))
  344.  
  345. (defun irchat-Command-version ()
  346.   "Ask server version"
  347.   (interactive)
  348.   (irchat-send "VERSION"))
  349.  
  350. (defun irchat-Command-admin ()
  351.   "Ask server admin"
  352.   (interactive)
  353.   (irchat-send "ADMIN"))
  354.  
  355. (defun irchat-Command-modec (&optional chan)
  356.   "Send/Check the mode for you/channel."
  357.   (interactive
  358.    (if current-prefix-arg
  359.        (if (eq current-prefix-arg '-)
  360.        (list current-prefix-arg)
  361.      (list
  362.       (let ((completion-ignore-case t))
  363.         (irchat-completing-default-read 
  364.          "MODE channel: " 
  365.          irchat-channel-alist
  366.          '(lambda (s) t) nil nil))))
  367.      nil))
  368.   (if (null chan)
  369.       (setq chan irchat-current-channel))
  370.   (if (or (string= "" chan) (eq chan '-))
  371.       (setq chan nil))
  372.   (setq chan (irchat-chan-real chan))
  373.   (let (value)
  374.     (if chan
  375.     (setq value (read-string (format "Mode for channel %s: "
  376.                      (irchat-chan-virtual chan))))
  377.       (setq value (read-string "Mode for you: ")))
  378.     (irchat-send "MODE %s %s" (or chan irchat-nickname) value)))
  379.  
  380. (defun irchat-Command-send-minibuffer (chan xmsg)
  381.   "Send a message to another user/channel from minibuffer."
  382.   (interactive (let (chan (completion-ignore-case t))
  383.          (setq chan
  384.                (irchat-chan-real
  385.             (irchat-completing-default-read 
  386.              "Private message to: "
  387.              (append irchat-nick-alist irchat-channel-alist)
  388.              '(lambda (s) t) nil
  389.              (irchat-chan-virtual irchat-privmsg-partner))))
  390.          (list chan
  391.                (read-string 
  392.             (format "Private message to %s: "
  393.                 (irchat-chan-virtual chan))))))
  394.   (setq irchat-privmsg-partner chan)
  395.   (irchat-send-privmsg chan xmsg))
  396.  
  397. (defun irchat-send-privmsg (to xmsg)
  398.   (irchat-insert-private nil to xmsg)
  399.   (if (string-match "^=\\([^ ]+\\)" to)
  400.       (pure-irc-dcc-info-send-message
  401.        (cdr (assoc (match-string 1 to) pure-irc-dcc-chat-partner)) xmsg)
  402.     (irchat-send "PRIVMSG %s :%s" to xmsg)))
  403.  
  404. (defun irchat-Command-send-private ()
  405.   "Send a private message (current line) to another user."
  406.   (interactive)
  407.   (let ((completion-ignore-case t) xmsg start stop)
  408.     (setq irchat-privmsg-partner
  409.       (irchat-chan-real
  410.        (irchat-completing-default-read 
  411.         "To whom: "
  412.         (append irchat-nick-alist irchat-channel-alist)
  413.         '(lambda (s) t) 
  414.         nil (irchat-chan-virtual irchat-privmsg-partner))))
  415.     (beginning-of-line)
  416.     (setq start (point))
  417.     (end-of-line)
  418.     (setq stop (point))
  419.     (setq xmsg (buffer-substring start stop))
  420.     (if (eobp) (newline) (forward-line))
  421.     (irchat-send-privmsg irchat-privmsg-partner xmsg)))
  422.  
  423. ;; add by simm@irc.fan.gr.jp, Mon, 14 Jun 1999
  424. (defun irchat-pj-send-broadcast (xmsg)
  425.   (let (chanlist string count)
  426.     (mapcar
  427.      '(lambda (to)
  428.     (cond ((member to irchat-pj-broadcast-accept-list)
  429.            (setq chanlist (cons to chanlist)))
  430.           ((member to irchat-pj-broadcast-ignore-list)
  431.            nil)
  432.           ((or (eq ?# (elt to 0))
  433.            (eq ?! (elt to 0))
  434.            (eq ?% (elt to 0)))
  435.            (and irchat-pj-broadcast-channel
  436.             (setq chanlist (cons to chanlist))))
  437.           (t
  438.            (and irchat-pj-broadcast-private
  439.             (setq chanlist (cons to chanlist))))))
  440.      irchat-chanbuf-list)
  441.     (setq count 1)
  442.     (mapcar
  443.      '(lambda (chan)
  444.     (irchat-insert-private nil chan xmsg)
  445.     (cond ((eq 1 count)
  446.            (setq count (1+ count)
  447.              string chan))
  448.           ((eq irchat-pj-maximum-privmsg-channels count)
  449.            (irchat-send "PRIVMSG %s,%s :%s" chan string xmsg)
  450.            (setq count 1
  451.              string nil))
  452.           (t
  453.            (setq count (1+ count)
  454.              string (format "%s,%s" chan string)))))
  455.      chanlist)
  456.     (and string
  457.      (irchat-send "PRIVMSG %s :%s" string xmsg))))
  458.  
  459. (defun irchat-pj-Command-broadcast-minibuffer (xmsg)
  460.   "Broadcast a message from minibuffer."
  461.   (interactive (list (read-string "Broadcast Message: ")))
  462.   (irchat-pj-send-broadcast xmsg))
  463.  
  464. (defun irchat-pj-Command-broadcast-message ()
  465.   "Send a broadcast message (current line)."
  466.   (interactive)
  467.   (let (xmsg start stop)
  468.     (beginning-of-line)
  469.     (setq start (point))
  470.     (end-of-line)
  471.     (setq stop (point))
  472.     (setq xmsg (buffer-substring start stop))
  473.     (if (eobp) (newline) (forward-line))
  474.     (irchat-pj-send-broadcast xmsg)))
  475. ;; end
  476.  
  477. (defun irchat-Command-names (&optional chan)
  478.   "List the nicknames of the current IRC users on given channel.
  479. With an Control-U as argument, only the current channel is listed.
  480. With - as argument, list all channels."
  481.   (interactive
  482.    (if (or current-prefix-arg (null irchat-current-channel))
  483.        (if (eq current-prefix-arg '-)
  484.        (list current-prefix-arg)
  485.      (list
  486.       (let ((completion-ignore-case t))
  487.         (irchat-pj-completing-read 
  488.          "Names on channel: " 
  489.          irchat-channel-alist
  490.          '(lambda (s) t) nil nil))))
  491.      nil))
  492.   (if (null chan)
  493.       (if irchat-current-channel
  494.       (irchat-send "NAMES %s" irchat-current-channel)
  495.     (irchat-send "NAMES %s" (irchat-Channel-lists)))
  496.     (if (eq chan '-)
  497.     (irchat-send "NAMES")
  498.       (if (not (string= chan ""))
  499.       (irchat-send "NAMES %s" (irchat-chan-real chan))
  500.     (irchat-send "NAMES %s" (irchat-Channel-lists))))))
  501.  
  502. (defun irchat-Command-nickname (nick)
  503.   "Set your nickname."
  504.   (interactive "sEnter your nickname: ")
  505.   (setq irchat-trying-nickname nick)
  506.   (irchat-send "NICK %s" nick))
  507.  
  508. (defun irchat-Command-who (&optional chan)
  509.   "Lists tue users that match the given expression.
  510. If you enter only Control-U as argument, list the current channel.
  511. With - as argument, list all users."
  512.   (interactive 
  513.    (if (or current-prefix-arg (null irchat-current-channel))
  514.        (if (eq current-prefix-arg '-)
  515.        (list current-prefix-arg)
  516.      (list
  517.       (let ((completion-ignore-case t))
  518.         (irchat-pj-completing-read 
  519.          "WHO expression: " 
  520.          irchat-channel-alist
  521.          '(lambda (s) t) nil nil))))
  522.      nil))
  523.   (if (null chan)
  524.       (if irchat-current-channel
  525.       (irchat-send "WHO %s" irchat-current-channel)
  526.     (irchat-send "WHO %s" (irchat-Channel-lists)))
  527.     (if (eq chan '-)
  528.     (irchat-send "WHO")
  529.       (if (not (string= chan ""))
  530.       (irchat-send "WHO %s" (irchat-chan-real chan))
  531.     (irchat-send "WHO %s" irchat-nickname)))))
  532.  
  533.  
  534. (defun irchat-Command-wait (nick &optional greeting)
  535.   "Wait for NICK to enter IRC.  When this person appears, you will
  536. be informed. If the optional argument GREETING is non-nil, it should 
  537. be a string to send NICK upon entering."
  538.   (interactive 
  539.    (progn (setq nick (read-string "Wait for: ")
  540.         greeting (read-string 
  541.               (format "Message to send %s upon entering: " nick)))
  542.       (if (string= greeting "")
  543.           (setq greeting nil))
  544.       (list nick greeting)))
  545.   (put (intern nick) 'irchat-waited-for t)
  546.   (if greeting 
  547.       (put (intern nick) 'irchat-greeting greeting)))
  548.  
  549.  
  550. (defun irchat-Command-finger (finger-nick-var)
  551.   "Get information about a specific user."
  552.   (interactive (let (finger-nick-var (completion-ignore-case t))
  553.          (setq finger-nick-var 
  554.                (irchat-pj-completing-read 
  555.             "Finger whom: " irchat-nick-alist
  556.             '(lambda (s) t) nil nil))
  557.          (list finger-nick-var)))
  558.   (irchat-send "WHOIS %s" finger-nick-var))
  559.  
  560.  
  561. (defun irchat-Command-trace (trace-nick-var)
  562.   "Get information about a specific user."
  563.   (interactive (let (trace-nick-var (completion-ignore-case t))
  564.          (setq trace-nick-var 
  565.                (irchat-pj-completing-read 
  566.             "Trace whom: " irchat-nick-alist
  567.             '(lambda (s) t) nil nil))
  568.          (list trace-nick-var)))
  569.   (irchat-send "TRACE %s" trace-nick-var))
  570.  
  571.  
  572. (defun irchat-Command-finger-direct (finger-nick-var)
  573.   "Get information about a specific user."
  574.   (interactive (let (finger-nick-var (completion-ignore-case t))
  575.          (setq finger-nick-var 
  576.                (irchat-pj-completing-read 
  577.             "Finger whom: " irchat-nick-alist
  578.             '(lambda (s) t) nil nil))
  579.          (list finger-nick-var)))
  580.   (irchat-send "WHOIS %s %s" finger-nick-var finger-nick-var))
  581.  
  582.  
  583. (defun irchat-Command-topic ()
  584.   "Change topic/userinfo of channel/you."
  585.   (interactive)
  586.   (let (value)
  587.     (if irchat-current-channel
  588.     (setq value (read-string (format "Topic for channel %s: "
  589.                     (irchat-chan-virtual irchat-current-channel))))
  590.       (setq value (read-string "Userinfo for you: " irchat-ctcp-userinfo)))
  591.     (if irchat-current-channel
  592.     (irchat-send "TOPIC %s :%s" irchat-current-channel value)
  593.       (setq irchat-ctcp-userinfo value))))
  594.  
  595.  
  596. (defun irchat-Command-invite (&optional chan nick)
  597.   "Invite user to channel."
  598.   (interactive 
  599.    (list
  600.     (if current-prefix-arg
  601.     (let ((completion-ignore-case t))
  602.       (irchat-pj-completing-read 
  603.        "Invite channel: "
  604.        (mapcar '(lambda (x)
  605.               (list x))
  606.            irchat-current-channels)
  607.        '(lambda (s) t) nil nil))
  608.       nil)
  609.     (let ((completion-ignore-case t)) 
  610.       (irchat-pj-completing-read "Invite whom: " 
  611.                irchat-nick-alist
  612.                '(lambda (s) t) nil nil))))
  613.   (if chan
  614.       (setq chan (irchat-chan-real chan))
  615.     (if irchat-current-channel
  616.     (setq chan irchat-current-channel)
  617.       (setq chan irchat-nickname)))
  618.   (irchat-send "INVITE %s %s" nick chan))
  619.  
  620.  
  621. (defun irchat-Command-away (awaymsg)
  622.   "Mark/unmark yourself as being away."
  623.   (interactive "sAway message: ")
  624.   (irchat-send "AWAY :%s" awaymsg))
  625.  
  626.  
  627. (defun irchat-Current-scroll-down ()
  628.   "Scroll down current buffer"
  629.   (interactive)
  630.   (if (pos-visible-in-window-p (point-min))
  631.       (message "Beginning of buffer")
  632.     (scroll-down)))
  633.  
  634.  
  635. (defun irchat-Command-scroll-down ()
  636.   "Scroll Dialogue-buffer down from Command-buffer."
  637.   (interactive)
  638.   (pop-to-buffer (irchat-pj-get-message-buffer))
  639.   (if (pos-visible-in-window-p (point-min))
  640.       (message "Beginning of buffer")
  641.     (scroll-down))
  642.   (pop-to-buffer irchat-Command-buffer))
  643.  
  644. (defun irchat-Current-scroll-up ()
  645.   "Scroll up current buffer."
  646.   (interactive)
  647.   (if (pos-visible-in-window-p (point-max))
  648.       (progn
  649.     (goto-char (point-max))
  650.     (recenter 1))
  651.     (scroll-up)))
  652.  
  653.  
  654. (defun irchat-Command-scroll-up ()
  655.   "Scroll Dialogue-buffer up from Command-buffer."
  656.   (interactive)
  657.   (let ((obuf (current-buffer)) owin win)
  658.     (set-buffer (irchat-pj-get-message-buffer))
  659.     (if irchat-channel-buffer-mode
  660.     (set-buffer irchat-Channel-buffer)
  661.       (set-buffer irchat-Dialogue-buffer))
  662.     (if (setq win (get-buffer-window (current-buffer)))
  663.     (progn
  664.       (setq owin (selected-window))
  665.       (select-window win)
  666.       (if (not (pos-visible-in-window-p (point-max)))
  667.           (scroll-up 1))
  668.       (if (pos-visible-in-window-p (point-max))
  669.           (progn
  670.         (goto-char (point-max))
  671.         (recenter 1))
  672.         (scroll-up))
  673.       (select-window owin)))
  674.     (set-buffer obuf)))
  675.  
  676. (defun irchat-Command-scroll-freeze ()
  677.   "Toggle the automatic scrolling of the Current/Dialogue window."
  678.   (interactive)
  679.   (if irchat-channel-buffer-mode
  680.       (irchat-Channel-freeze)
  681.     (irchat-Dialogue-freeze)))
  682.  
  683. (defun irchat-Dialogue-freeze ()
  684.   "Toggle the automatic scrolling of the Dialogue window."
  685.   (interactive)
  686.   (setq irchat-freeze (not irchat-freeze))
  687.   (set-buffer-modified-p (buffer-modified-p)))
  688.  
  689. (defun irchat-Channel-freeze (&optional value)
  690.   "Toggle the automatic scrolling of the Channel window."
  691.   (interactive)
  692.   (save-excursion
  693.     (set-buffer irchat-Channel-buffer)
  694.     (cond ((eq value 'on)
  695.        (setq irchat-freeze-local t))
  696.       ((eq value 'off)
  697.        (setq irchat-freeze-local nil)))
  698.     (setq irchat-freeze-local (not irchat-freeze-local)))
  699.   (set-buffer-modified-p (buffer-modified-p)))
  700.  
  701.  
  702. (defun irchat-Command-beep-on-message (&optional value)
  703.   "Toggle the automatic beep notice when the channel mesage is received."
  704.   (interactive)
  705.   (save-excursion
  706.     (set-buffer irchat-Channel-buffer)
  707.     (cond ((eq value 'on)
  708.        (setq irchat-beep-local t))
  709.       ((eq value 'off)
  710.        (setq irchat-beep-local nil)))
  711.     (setq irchat-beep-local (not irchat-beep-local)))
  712.   (set-buffer-modified-p (buffer-modified-p)))
  713.  
  714.  
  715. (defun irchat-Command-suppress-others (&optional value)
  716.   "Toggle to suppress this channel messages display to Others-buffer."
  717.   (interactive)
  718.   (save-excursion
  719.     (set-buffer irchat-Channel-buffer)
  720.     (cond ((eq value 'on)
  721.        (setq irchat-suppress-local t))
  722.       ((eq value 'off)
  723.        (setq irchat-suppress-local nil)))
  724.     (setq irchat-suppress-local (not irchat-suppress-local)))
  725.   (set-buffer-modified-p (buffer-modified-p)))
  726.  
  727.  
  728. (defun irchat-quit ()
  729.   (irchat-Command-quit 'quit))
  730.  
  731. (defun irchat-Command-quit (&optional quit-msg)
  732.   "Quit irchat-pj."
  733.   (interactive "P")
  734.   (if (or (not (irchat-server-opened))
  735.       quit-msg
  736.       (y-or-n-p "Quit irchat-pj? "))
  737.       (let (quit-string)
  738.     (message "")
  739.     (if (and (get-buffer-process irchat-server-buffer)
  740.          (irchat-server-opened))
  741.         (progn
  742.           (if (and quit-msg (not (eq quit-msg 'quit)))
  743.           (setq quit-string (read-string "Signoff message: "))
  744.         (setq quit-string (or irchat-signoff-msg "nil")))
  745.           (irchat-send "QUIT :%s" quit-string)))
  746.         ;; modified by simm@irc.fan.gr.jp, Thu, 10 Jun 1999
  747.     (if (not (and quit-msg (or (eq quit-msg 'quit) (eq quit-msg 'error))))
  748.         (irchat-handle-quit irchat-nickname irchat-pj-my-userhost quit-string))
  749.     (irchat-clear-system)
  750.     (if irchat-use-full-window
  751.         (delete-other-windows))
  752.     (irchat-close-server)
  753.     (if (not (and quit-msg (or (eq quit-msg 'quit) (eq quit-msg 'error))))
  754.         (if irchat-old-window-configuration
  755.         (progn
  756.           (set-window-configuration irchat-old-window-configuration)
  757.           (setq irchat-old-window-configuration nil))))
  758.     (run-hooks 'irchat-Exit-hook)
  759.         ;; begin: add by simm@irc.fan.gr.jp, Sat, 5 Jun 1999
  760.         (if irchat-pj-save-log-channel-alist
  761.             (irchat-pj-save-log))
  762.         (if irchat-pj-quit-with-kill-buffer
  763.             (let (name)
  764.               (mapcar
  765.                '(lambda (item)
  766.                   (setq name (buffer-name item))
  767.                   ;; modified by simm@irc.fan.gr.jp, Wed, 21 Jul 1999
  768.                   (if (or (string-match irchat-buffer-base name)
  769.                           (string= irchat-Command-buffer name))
  770.                       (kill-buffer item)))
  771.                (buffer-list))
  772.               ;;(kill-buffer irchat-Command-buffer)
  773.               (setq irchat-Private-buffer (concat irchat-buffer-base " Private"))))
  774.         ;; end
  775.     (setq irchat-polling nil)
  776.     (setq irchat-current-channel nil)
  777.     (setq irchat-current-channels nil))))
  778.  
  779.  
  780. (defun irchat-Command-generic (message)
  781.   "Enter a generic IRC message, which is sent to the server.
  782.  A ? lists the useful generic messages."
  783.   (interactive "sIRC Command: ")
  784.   (if (string= message "?")
  785.       (with-output-to-temp-buffer "*IRC Help*"
  786.     (princ "The following generic IRC messages may be of interest to you:
  787. TOPIC <channel> <new topic>    set the topic of your channel
  788. INVITE <nickname> <channel>    invite another user to join your channel
  789. LINKS <mask>            lists the currently reachable IRC servers
  790. NAMES <channel>            lists users per channel
  791. ")
  792.     (message 
  793.      (substitute-command-keys 
  794.       "Type \\[irchat-Command-redisplay] to continue")))
  795.     (irchat-send "%s" message)))
  796.  
  797.  
  798. (defun irchat-Command-irc-compatible ()
  799.   "If entered at column 0, allows you to enter a generic IRC message to
  800. be sent to the server.  For a list of messages, see irchat-Command-generic."
  801.   (interactive)
  802.   (if (eq (current-column) 0)
  803.       (call-interactively (function irchat-Command-generic))
  804.     (self-insert-command 1)))
  805.  
  806.  
  807. (defun irchat-Command-send-exec (command)
  808.   "Execute command, and send it to the current channel."
  809.   (interactive "sShell Command: ")
  810.   (save-restriction
  811.     (narrow-to-region (point) (point))
  812.     (shell-command command t)
  813.     (let ((opoint (point)))
  814.       (while (< (point) (point-max))
  815.     (progn
  816.       (irchat-Command-send-line)
  817.       (set-buffer irchat-Command-buffer)))
  818.       (push-mark opoint t))))
  819.  
  820. ;;;
  821. ;;; CTCP (client-to-client protocol) queries
  822. ;;;
  823. (defun irchat-Channel-ctcp-ping ()
  824.   (interactive)
  825.   (irchat-send "PRIVMSG %s :\001PING %s %s\001" irchat-current-channel
  826.            (irchat-current-time) irchat-current-channel))
  827.  
  828. (defun irchat-Channel-ctcp-version ()
  829.   (interactive)
  830.   (irchat-send "PRIVMSG %s :\001VERSION\001" irchat-current-channel))
  831.  
  832. (defun irchat-Channel-ctcp-userinfo ()
  833.   (interactive)
  834.   (irchat-send "PRIVMSG %s :\001USERINFO\001" irchat-current-channel))
  835.  
  836. (defun irchat-Channel-ctcp-time ()
  837.   (interactive)
  838.   (irchat-send "PRIVMSG %s :\001TIME\001" irchat-current-channel))
  839.  
  840. (defun irchat-Command-ctcp (command)
  841.   (interactive)
  842.   (irchat-read-ctcp-nick command)
  843.   (irchat-send "PRIVMSG %s :\001%s\001" irchat-ctcp-lastnick command))
  844.  
  845. (defun irchat-Command-ctcp-version ()
  846.   "Ask about someones client version."
  847.   (interactive)
  848.   (irchat-Command-ctcp "VERSION"))
  849.  
  850. (defun irchat-Command-ctcp-time ()
  851.   "Ask about someones time."
  852.   (interactive)
  853.   (irchat-Command-ctcp "TIME"))
  854.  
  855. (defun irchat-Command-ctcp-ping ()
  856.   "Ask about someones ping."
  857.   (interactive)
  858.   (irchat-read-ctcp-nick "PING")
  859.   (irchat-send "PRIVMSG %s :\001PING %s\001" irchat-ctcp-lastnick
  860.            (irchat-current-time)))
  861.  
  862. (defun irchat-Command-ctcp-finger ()
  863.   "Ask about someones finger."
  864.   (interactive)
  865.   (irchat-Command-ctcp "FINGER"))
  866.  
  867. (defun irchat-Command-ctcp-userinfo ()
  868.   "Ask about someones userinfo."
  869.   (interactive)
  870.   (irchat-Command-ctcp "USERINFO"))
  871.  
  872. (defun irchat-Command-ctcp-clientinfo ()
  873.   "Ask about someones available ctcp commands."
  874.   (interactive)
  875.   (irchat-Command-ctcp "CLIENTINFO"))
  876.  
  877. (defun irchat-Command-ctcp-action ()
  878.   "Action."
  879.   (interactive)
  880.   (irchat-read-ctcp-nick "ACTION")
  881.   (let ((xmsg (read-string (format "CTCP ACTION argument: "))))
  882.     (irchat-send "PRIVMSG %s :\001ACTION %s\001" irchat-ctcp-lastnick xmsg)
  883.     (irchat-insert-private nil irchat-ctcp-lastnick
  884.                (format "*** %s %s" irchat-nickname xmsg))))
  885.  
  886. ;; add by simm@irc.fan.gr.jp, Sun, 29 Aug 1999 22:55:43 +0900
  887. (defun irchat-Command-ctcp-caesar ()
  888.   "Action."
  889.   (interactive)
  890.   (irchat-read-ctcp-nick "CAESAR")
  891.   (let ((xmsg (read-string (format "CTCP CAESAR argument: "))))
  892.     (irchat-send "PRIVMSG %s :\001CAESAR %s\001"
  893.                  irchat-ctcp-lastnick
  894.                  (irchat-pj-caesar-string xmsg))
  895.     (irchat-insert-private nil irchat-ctcp-lastnick
  896.                (format "*** %s %s" irchat-nickname xmsg))))
  897.  
  898. (defun irchat-Command-ctcp-clientinfo-generic ()
  899.   "Ask about someones available ctcp commands."
  900.   (interactive)
  901.   (irchat-read-ctcp-nick "clientinfo generic")
  902.   (let ((completion-ignore-case t))
  903.     (setq irchat-ctcp-lastcommand
  904.       (irchat-completing-default-read 
  905.        "What CTCP command: " 
  906.        irchat-ctcp-alist '(lambda (s) t) nil 
  907.        irchat-ctcp-lastcommand)))
  908.   (irchat-send "PRIVMSG %s :\001CLIENTINFO%s%s\001"
  909.            irchat-ctcp-lastnick
  910.            (if (string= irchat-ctcp-lastcommand "") "" " ")
  911.            irchat-ctcp-lastcommand))
  912.  
  913. (defun irchat-Command-ctcp-generic ()
  914.   "Generic CTCP"
  915.   (interactive)
  916.   (irchat-read-ctcp-nick "generic")
  917.   (let ((completion-ignore-case t) arg)
  918.     (setq irchat-ctcp-lastcommand
  919.       (irchat-completing-default-read 
  920.        "What CTCP command: " 
  921.        irchat-ctcp-alist '(lambda (s) t) nil 
  922.        irchat-ctcp-lastcommand))
  923.     (if current-prefix-arg
  924.     (setq arg (read-string (format "CTCP %s argument: "
  925.                        irchat-ctcp-lastcommand))))
  926.     (irchat-send "PRIVMSG %s :\001%s%s\001"
  927.          irchat-ctcp-lastnick irchat-ctcp-lastcommand
  928.          (if arg (format " %s" arg) ""))))
  929.  
  930. (defun irchat-Command-ctcp-userinfo-from-minibuffer ()
  931.   "Set my userinfo from minibuffer."
  932.   (interactive)
  933.   (setq irchat-ctcp-userinfo
  934.     (read-from-minibuffer "New userinfo: "
  935.                   irchat-ctcp-userinfo)))
  936.  
  937. (defun irchat-Command-ctcp-userinfo-from-commandbuffer ()
  938.   "Set my userinfo from commandbuffer."
  939.   (interactive)
  940.   (let (start stop)
  941.     (beginning-of-line)
  942.     (setq start (point))
  943.     (end-of-line)
  944.     (setq stop (point))
  945.     (setq irchat-ctcp-userinfo (buffer-substring start stop))
  946.     (if (eobp) (newline) (forward-line))))
  947.  
  948. (defun irchat-read-ctcp-nick (type)
  949.   (let ((completion-ignore-case t))
  950.     (setq irchat-ctcp-lastnick
  951.       (irchat-chan-real
  952.        (irchat-completing-default-read 
  953.         (format "CTCP %s query to: " type) irchat-nick-alist
  954.         '(lambda (s) t) nil
  955.         (irchat-chan-virtual irchat-ctcp-lastnick))))))
  956.  
  957. (defvar irchat-ctcp-alist
  958.   '(("ACTION") ("CAESAR") ("CLIENTINFO") ("DCC") ("ECHO") ("ERRMSG")
  959.     ("PING") ("TIME") ("USERINFO") ("VERSION"))
  960.   "*CTCP commands alist")
  961.  
  962. (defun irchat-ctcp-add-to-list (command)
  963.   (setq irchat-ctcp-alist (append irchat-ctcp-alist (list (list command)))))
  964.  
  965.  
  966. ;;;
  967. ;;; DCC (direct client connection) queries
  968. ;;;
  969.  
  970. (defun irchat-Command-dcc-chat ()
  971.   "send DCC CHAT request"
  972.   (interactive)
  973.   (let (proc
  974.     (pure-irc-dcc-irchat-program irchat-pj-irchat-dcc-program)
  975.     (pure-pr-server-exec-file irchat-pj-puresv-program))
  976.     (setq irchat-pj-previous-dcc-partner
  977.     (irchat-completing-default-read "With whom: "
  978.      (append irchat-nick-alist irchat-channel-alist)
  979.      '(lambda (s) t) nil (or irchat-pj-previous-dcc-partner irchat-nickname)))
  980.     (or irchat-pj-previous-dcc-partner
  981.     (setq irchat-pj-previous-dcc-partner irchat-nickname))
  982.     (pure-irc-dcc-info-start
  983.      (pure-irc-dcc-info-create irchat-pj-previous-dcc-partner) nil
  984.      irchat-pj-dcc-chat-server-method irchat-server-process irchat-pj-cs-encode)))
  985.  
  986. (defun irchat-Command-dcc-send ()
  987.   "Send file to user via DCC"
  988.   (interactive)
  989.   (let (proc
  990.     (pure-irc-dcc-irchat-program irchat-pj-irchat-dcc-program)
  991.     (pure-irc-dcc-dccput-program irchat-pj-dccput-program)
  992.     (file (expand-file-name
  993.            (read-file-name "File to send: " default-directory nil))))
  994.     (setq irchat-pj-previous-dcc-partner
  995.     (irchat-completing-default-read "To whom: "
  996.      (append irchat-nick-alist irchat-channel-alist)
  997.      '(lambda (s) t) nil (or irchat-pj-previous-dcc-partner irchat-nickname)))
  998.     (or irchat-pj-previous-dcc-partner
  999.     (setq irchat-pj-previous-dcc-partner irchat-nickname))
  1000.     (pure-irc-dcc-info-start
  1001.      (pure-irc-dcc-info-create irchat-pj-previous-dcc-partner nil nil file) nil
  1002.      irchat-pj-dcc-file-put-method irchat-server-process irchat-pj-cs-encode)))
  1003.  
  1004. (defun irchat-Command-dcc-list ()
  1005.   "Show DCC offer and process list"
  1006.   (interactive)
  1007.   (if (and (null pure-irc-dcc-offer-list) (null pure-irc-dcc-process-list))
  1008.       (irchat-insert0 "*** No DCC offer/process.\n")
  1009.     (if pure-irc-dcc-process-list
  1010.     (irchat-pj-Command-dcc-list-process))
  1011.     (if pure-irc-dcc-offer-list
  1012.     (irchat-pj-Command-dcc-list-offer))
  1013.     (irchat-insert0 "*** DCC list ends here\n")))
  1014.     
  1015. (defun irchat-pj-Command-dcc-list-process ()
  1016.   (let (dinfo (i 0)
  1017.     (dlist pure-irc-dcc-process-list))
  1018.     (irchat-insert0 "*** DCC process list:\n")
  1019.     (irchat-insert0 "*** Date   Time  Type[Stat] Nickname  Filename\n")
  1020.     ;               "01: Oct 23 12:34 Send[actv] simm00000 /tmp/file (1024 bytes)"
  1021.     (while dlist
  1022.       (setq dinfo (car dlist))
  1023.       (irchat-insert0
  1024.        (format "%02d: %s %4s%s %9s%s\n"
  1025.            (setq i (1+ i))
  1026.            (substring (or (pure-irc-dcc-info-get-time dinfo)
  1027.                   (current-time-string)) 4 16)
  1028.            (if (pure-irc-dcc-info-get-size dinfo) "file" "chat")
  1029.            (irchat-pj-Command-dcc-list-short-status dinfo)
  1030.            (substring
  1031.         (concat (pure-irc-dcc-info-get-nick dinfo) "        ") 0 9)
  1032.            (if (pure-irc-dcc-info-chatp dinfo)
  1033.            ""
  1034.          (concat " " (pure-irc-dcc-info-get-file dinfo)
  1035.              "(" (pure-irc-dcc-info-get-size dinfo) " bytes)"))))
  1036.       (setq dlist (cdr dlist)))))
  1037.    
  1038. (defun irchat-pj-Command-dcc-list-offer ()
  1039.   (let (dinfo (i 0) (olist (reverse pure-irc-dcc-offer-list)))
  1040.     (irchat-insert0 "*** DCC offer list:\n")
  1041.     (irchat-insert0 "*** Date   Time  Type Nickname  Filename\n")
  1042.     ;               "01: Oct 23 12:34 Get  simm00000 /tmp/file (1024 bytes)"
  1043.     (while olist
  1044.       (setq dinfo (car olist))
  1045.       (irchat-insert0
  1046.        (format "%02d: %s %s %9s%s\n"
  1047.            (setq i (1+ i))
  1048.            (substring (or (pure-irc-dcc-info-get-time dinfo) (current-time-string)) 4 16)
  1049.            (if (pure-irc-dcc-info-get-size dinfo) "get " "chat")
  1050.            (substring (concat (pure-irc-dcc-info-get-nick dinfo) "        ") 0 9)
  1051.            (if (pure-irc-dcc-info-chatp dinfo)
  1052.            ""
  1053.          (concat " " (pure-irc-dcc-info-get-file dinfo)
  1054.              "(" (pure-irc-dcc-info-get-size dinfo) " bytes)"))))
  1055.       (setq olist (cdr olist)))))
  1056.  
  1057. (defun irchat-pj-Command-dcc-list-short-status (dinfo)
  1058.   "Short status"
  1059.   (let ((stat (pure-irc-dcc-info-get-status dinfo)))
  1060.     (cond
  1061.      ((eq stat 'set    ) "[set ]")
  1062.      ((eq stat 'wait   ) "[wait]")
  1063.      ((eq stat 'connect) "[conn]")
  1064.      ((eq stat 'resume ) "[resm]")
  1065.      ((eq stat 'server ) "[actv]")
  1066.      ((eq stat 'client ) "[actv]")
  1067.      (t                  "[----]"))))
  1068.  
  1069. (defun irchat-Command-dcc-get (arg &optional resumep)
  1070.   "Get offered file or connect offered chat."
  1071.   (interactive "P")
  1072.   (if (null pure-irc-dcc-offer-list)
  1073.       (irchat-insert0 "*** DCC Warning: no DCC offer\n")
  1074.     (or arg (setq arg 1))
  1075.     (if (<= arg (length pure-irc-dcc-offer-list))
  1076.     (let* ((dinfo (nth (- (length pure-irc-dcc-offer-list) arg) pure-irc-dcc-offer-list))
  1077.            (file (pure-irc-dcc-info-get-file dinfo))
  1078.            (dir  (if (string-match "/$" irchat-pj-dcc-directory)
  1079.              irchat-pj-dcc-directory
  1080.                (concat irchat-pj-dcc-directory "/")))
  1081.            (pure-irc-dcc-dccget-program irchat-pj-dccget-program)
  1082.            (pure-irc-dcc-irchat-program irchat-pj-irchat-dcc-program))
  1083.       (if (pure-irc-dcc-info-chatp dinfo)
  1084.           ;; DCC CHAT request
  1085.           (pure-irc-dcc-info-start
  1086.            dinfo t irchat-pj-dcc-chat-client-method
  1087.            irchat-server-process irchat-pj-cs-encode)
  1088.         ;; DCC SEND request
  1089.         (if (file-directory-p dir) nil
  1090.           (irchat-insert0 "*** Invalid irchat-pj-dcc-directory's value, so use /tmp.")
  1091.           (setq dir "/tmp/"))
  1092.         (with-temp-buffer
  1093.           (insert file)
  1094.           (goto-char (point-min))
  1095.           (while (re-search-forward "[~/]" nil t)
  1096.         (forward-char -1)
  1097.         (insert (if (= ?~ (char-after)) "%7E" "%2F"))
  1098.         (delete-char 1))
  1099.           (setq file (buffer-substring (point-min) (point-max))))
  1100.         (setq file (read-file-name "Filename to get: " (expand-file-name file dir)))
  1101.         (if (file-writable-p file)
  1102.         (let ((doflag nil))
  1103.           (if (file-exists-p file)
  1104.               (if resumep
  1105.               (setq doflag t)
  1106.             (irchat-insert0
  1107.              (format "*** File \"%s\" already exists in %s.\n"
  1108.                  (file-name-nondirectory file) (file-name-directory file)))
  1109.             (irchat-insert0 "*** Overwrite it, or set new file's filename.\n")
  1110.             (setq doflag (yes-or-no-p "Overwrite it? ")))
  1111.             (setq resumep nil doflag t))
  1112.           (if doflag
  1113.               (progn
  1114.             (pure-irc-dcc-info-put-file dinfo (expand-file-name file))
  1115.             (pure-irc-dcc-info-start
  1116.              dinfo (if resumep 'resume 'client) irchat-pj-dcc-file-get-method
  1117.              irchat-server-process irchat-pj-cs-encode))))
  1118.           (irchat-insert0
  1119.            (format "*** DCC ERROR: Cannot write file \"%s\" in %s.\n"
  1120.                (file-name-nondirectory file) (file-name-directory file))))))
  1121.       (irchat-insert0 (format "*** DCC ERROR: No such offered number %d\n" arg)))))
  1122.  
  1123. (defun irchat-Command-dcc-rget (arg)
  1124.   "Get offered file with resume."
  1125.   (interactive "P")
  1126.   (require (intern (format "pure-pr-dcc-%s" irchat-pj-dcc-file-get-method)))
  1127.   (if (funcall (intern (format "pure-pr-dcc-%s-resumep" irchat-pj-dcc-file-get-method)) nil)
  1128.       (irchat-Command-dcc-get arg t)
  1129.     (message "DCC WARNING: not support DCC RESUME")))
  1130.  
  1131. (defun irchat-Command-dcc-kill (arg)
  1132.   "Kill offered file / chat."
  1133.   (interactive "P")
  1134.   (if (null pure-irc-dcc-offer-list)
  1135.       (irchat-insert0 "*** DCC Warning: no DCC offer\n")
  1136.     (or arg (setq arg 1))
  1137.     (or (and (<= arg (length pure-irc-dcc-offer-list))
  1138.          (y-or-n-p (format "Kill DCC offer (No.%d)?" arg))
  1139.          (let ((dinfo (nth (- (length pure-irc-dcc-offer-list) arg)
  1140.                    pure-irc-dcc-offer-list)))
  1141.            (pure-irc-dcc-info-kill dinfo)
  1142.            (irchat-insert0 "*** DCC killed\n")
  1143.            t))
  1144.     (irchat-insert0 (format "*** DCC ERROR: No such offered number %d\n" arg)))))
  1145.  
  1146. (defun irchat-pj-Command-dcc-quit (arg)
  1147.   "Quit DCC process."
  1148.   (interactive "P")
  1149.   (if (null pure-irc-dcc-process-list)
  1150.       (irchat-insert0 "*** DCC Warning: no DCC process\n")
  1151.     (or arg (setq arg 1))
  1152.     (or (and (<= arg (length pure-irc-dcc-process-list))
  1153.          (y-or-n-p (format "Quit DCC process (No.%d)?" arg))
  1154.          (let ((dinfo (nth (- (length pure-irc-dcc-process-list) arg)
  1155.                    pure-irc-dcc-process-list)))
  1156.            (pure-irc-dcc-info-kill dinfo)
  1157.            (irchat-insert0 "*** DCC process quit\n")
  1158.            t))
  1159.     (irchat-insert0 (format "*** DCC ERROR: No such process number %d\n" arg)))))
  1160.  
  1161. ;;;
  1162. ;;; send text in kill-buffer
  1163. ;;;
  1164. (defun irchat-Command-send-yank (&optional howmany)
  1165.   "Yank kill-buffer, and send it to the current channel."
  1166.   (interactive)
  1167.   (let ((beg (point)) end)
  1168.     (insert (car kill-ring-yank-pointer))
  1169.     (setq end (point))
  1170.     (goto-char beg)
  1171.     (while (< (point) end)
  1172.       (progn
  1173.     (irchat-Command-send-line)
  1174.     (set-buffer irchat-Command-buffer)))))
  1175.  
  1176. ;;;
  1177. ;;; send rot-5-13-47-48 encrypted data
  1178. ;;; modified by simm@irc.fan.gr.jp, Sun, 29 Aug 1999 22:27:45 +0900
  1179. ;;;
  1180. (defun irchat-Command-caesar-line ()
  1181.   "*Caesar encrypt current line."
  1182.   (interactive)
  1183.   (let (beg end)
  1184.     (beginning-of-line nil)
  1185.     (setq beg (point))
  1186.     (push-mark (point))
  1187.     (end-of-line)
  1188.     (setq end (point))
  1189.     (irchat-pj-caesar-region beg end)))
  1190.  
  1191.  
  1192. ;;;
  1193. ;;;
  1194. ;;;
  1195. (defun get-word-left ()
  1196.   "Return word left from point."
  1197.   (save-excursion
  1198.     (let (point-now)
  1199.       (setq point-now (point))
  1200.       (backward-word 1)
  1201.       (buffer-substring (point) point-now))))
  1202.  
  1203.  
  1204. (defun irchat-Command-complete ()
  1205.   "Complete word before point from userlist."
  1206.   (interactive)
  1207.   (insert
  1208.    (save-excursion
  1209.      (let ((completion-ignore-case t) point-now word result)
  1210.        (setq point-now (point)
  1211.          word (get-word-left)
  1212.          result (try-completion word irchat-nick-alist))
  1213.        (backward-word 1)
  1214.        (delete-region (point) point-now)
  1215.        (if (or (eq result t) (eq result nil))
  1216.            word
  1217.          result)))))
  1218.  
  1219.  
  1220. (defun irchat-Command-load-vars ()
  1221.   "Load configuration from irchat-variables-file."
  1222.   (interactive)
  1223.   (let ((file (expand-file-name irchat-variables-file)))
  1224.     (if (file-exists-p file)
  1225.     (progn
  1226.       (load-file file)
  1227.       (irchat-Command-reconfigure-windows)))))
  1228.  
  1229.  
  1230. (defun irchat-Command-reconfigure-windows ()
  1231.   (interactive)
  1232.   (let ((command-window (get-buffer-window irchat-Command-buffer))
  1233.     (dialogue-window (get-buffer-window irchat-Dialogue-buffer)))
  1234.     (if (and command-window dialogue-window)
  1235.     (let ((c-height (window-height command-window))
  1236.           (d-height (window-height dialogue-window)))
  1237.       (delete-window command-window)
  1238.       (pop-to-buffer irchat-Dialogue-buffer)
  1239.       (enlarge-window (+ c-height d-height
  1240.                  (- (window-height dialogue-window)))))
  1241.       (pop-to-buffer irchat-Dialogue-buffer))
  1242.     (irchat-configure-windows)
  1243.     (if irchat-one-buffer-mode
  1244.     (pop-to-buffer irchat-Dialogue-buffer)
  1245.       (pop-to-buffer irchat-Command-buffer))))
  1246.  
  1247.  
  1248. ;;;
  1249. ;;; command to get beginning/end of the Dialogue buffer
  1250. ;;;
  1251. (defun irchat-Command-bod-buffer ()
  1252.   (interactive)
  1253.   (pop-to-buffer (irchat-pj-get-message-buffer))
  1254.   (if (pos-visible-in-window-p (point-min))
  1255.       (message "Beginning of buffer")
  1256.     (goto-char (point-min)))
  1257.   (pop-to-buffer irchat-Command-buffer))
  1258.  
  1259. (defun irchat-Command-eod-buffer ()
  1260.   (interactive)
  1261.   (pop-to-buffer (irchat-pj-get-message-buffer))
  1262.   (if (pos-visible-in-window-p (point-max))
  1263.       (message "End of buffer")
  1264.     (goto-char (point-max)))
  1265.   (pop-to-buffer irchat-Command-buffer))
  1266.  
  1267.  
  1268. (defun irchat-Command-toggle-display-mode ()
  1269.   (interactive)
  1270.   (setq irchat-channel-buffer-mode (not irchat-channel-buffer-mode))
  1271.   (irchat-configure-windows))
  1272.  
  1273.  
  1274. (defun irchat-Command-next-channel ()
  1275.   "Select next channel or chat partner."
  1276.   (interactive)
  1277.   (if (numberp current-prefix-arg)
  1278.       (irchat-Channel-jump current-prefix-arg)
  1279.     (irchat-Channel-next)))
  1280.  
  1281.  
  1282. (defun irchat-Command-previous-channel ()
  1283.   "Select previous channel or chat partner."
  1284.   (interactive)
  1285.   (if (numberp current-prefix-arg)
  1286.       (irchat-Channel-jump current-prefix-arg)
  1287.     (irchat-Channel-previous)))
  1288.  
  1289.  
  1290. (defun irchat-Channel-jump (num)
  1291.   (if (or (= 0 num) (nth (1- num) irchat-chanbuf-list))
  1292.       (irchat-Channel-select num)
  1293.     (message (format "No binding at %d" num))))
  1294.  
  1295. (defun irchat-Command-alternative-channel ()
  1296.   (interactive)
  1297.   (if (or (= 0 irchat-chanbuf-alternative-number)
  1298.       (nth (1- irchat-chanbuf-alternative-number) irchat-chanbuf-list))
  1299.       (irchat-Channel-select irchat-chanbuf-alternative-number)))
  1300.  
  1301. (defsubst irchat-channel-key (chan key)
  1302.   (put (intern chan) 'key key))
  1303.  
  1304. (defvar irchat-chanbuf-current-number 0)
  1305. (defvar irchat-chanbuf-alternative-number 0)
  1306.  
  1307. (defun irchat-Channel-buffer-create (chan)
  1308.   (let (nbuf obuf tmp)
  1309.     (setq obuf (current-buffer))
  1310.     (setq nbuf (get-buffer-create  (concat irchat-buffer-base chan)))
  1311.     (set-buffer nbuf)
  1312.     (setq tmp irchat-Channel-buffer)
  1313.     (setq irchat-Channel-buffer nbuf)
  1314.     (irchat-Channel-freeze (get (intern chan) 'freeze))
  1315.     (irchat-Command-beep-on-message (get (intern chan) 'beep))
  1316.     (irchat-Command-suppress-others (get (intern chan) 'suppress))
  1317.     (setq irchat-Channel-buffer tmp)
  1318.     (insert (current-time-string) " Created.\n")
  1319.     (irchat-Channel-mode)
  1320.     (set-buffer obuf)
  1321.     nbuf))
  1322.  
  1323. (defun irchat-Channel-select (num)
  1324.   (if (/= irchat-chanbuf-current-number num)
  1325.       (setq irchat-chanbuf-alternative-number irchat-chanbuf-current-number
  1326.         irchat-chanbuf-current-number num))
  1327.   (let (chan buf win)
  1328.     (if (/= num 0)
  1329.     (setq chan (nth (1- num) irchat-chanbuf-list)
  1330.           buf  (or (get-buffer (concat irchat-buffer-base chan))
  1331.                (irchat-Channel-buffer-create chan)))
  1332.       (setq buf irchat-Private-buffer))
  1333.     (cond ((= 0 num)
  1334.        (setq irchat-chanbuf-indicator    "Private"
  1335.          irchat-current-channel      nil
  1336.          irchat-command-buffer-mode  'chat
  1337.          irchat-current-chat-partner irchat-nickname))
  1338.       ((irchat-ischannel chan)
  1339.        (setq irchat-chanbuf-indicator   (concat "Channel " chan)
  1340.          irchat-command-buffer-mode 'channel
  1341.          irchat-current-channel     chan))
  1342.       (t
  1343.        (setq irchat-chanbuf-indicator   (concat "With " chan)
  1344.          irchat-current-channel     nil
  1345.          irchat-command-buffer-mode 'chat
  1346.          irchat-current-chat-partner chan)))
  1347.     (if (setq win (get-buffer-window irchat-Channel-buffer t))
  1348.     (let (obuf)
  1349.       (setq obuf (current-buffer))
  1350.       (set-window-buffer win buf)
  1351.       (set-buffer buf)
  1352.       (if (not irchat-freeze-local)
  1353.           (set-window-point win (point-max)))
  1354.       (set-buffer obuf)))
  1355.     (setq irchat-Channel-buffer buf)
  1356.     (setq irchat-chanbuf-num num)
  1357.     (set-buffer-modified-p (buffer-modified-p))))
  1358.  
  1359. (defun irchat-Channel-exist (chan)
  1360.   (if (stringp chan)
  1361.       (let ((rest irchat-chanbuf-list) found)
  1362.     (while rest
  1363.       (and (car rest)
  1364.            (string= (downcase chan) (downcase (car rest)))
  1365.            (setq found (car rest)))
  1366.       (setq rest (cdr rest)))
  1367.     (if found
  1368.         (get-buffer (concat irchat-buffer-base found))))))
  1369.  
  1370. (defun irchat-Channel-next ()
  1371.   (let ((rest (nthcdr irchat-chanbuf-num irchat-chanbuf-list))
  1372.     (num (1+ irchat-chanbuf-num))
  1373.     (found nil))
  1374.     (while (and rest (not found))
  1375.       (if (car rest)
  1376.       (setq found t)
  1377.     (setq rest (cdr rest))
  1378.     (setq num (1+ num))))
  1379.     (if found
  1380.     (irchat-Channel-select num)
  1381.       (irchat-Channel-select 0))))
  1382.  
  1383. (defun irchat-Channel-previous ()
  1384.   (let ((num (1- irchat-chanbuf-num)))
  1385.     (if (< num 0)
  1386.     (setq num (length irchat-chanbuf-list)))
  1387.     (while (and (/= num 0)
  1388.         (null (nth (1- num) irchat-chanbuf-list)))
  1389.       (setq num (1- num)))
  1390.     (irchat-Channel-select num)))
  1391.  
  1392. (defun irchat-Channel-join (chan)
  1393.   (let ((rest irchat-chanbuf-list)
  1394.     (num 1)
  1395.     (found nil))
  1396.     (while (and rest (not found))
  1397.       (or (and (car rest)
  1398.            (string= (downcase chan) (downcase (car rest)))
  1399.            (setq found t))
  1400.       (setq num (1+ num) rest (cdr rest))))
  1401.     (unless found
  1402.       (setq num 1 rest irchat-default-channel-binding)
  1403.       (while (and rest (not found))
  1404.     (or (and (car rest)
  1405.          (string= (downcase chan) (downcase (car rest)))
  1406.          (setq found t))
  1407.         (setq num (1+ num) rest (cdr rest))))
  1408.       (when (or (not found)
  1409.         (nth (1- num) irchat-chanbuf-list))
  1410.     (setq num 1 rest irchat-chanbuf-list)
  1411.     (while (and rest (not found))
  1412.       (if (or (car rest)
  1413.           (nth (1- num) irchat-default-channel-binding))
  1414.           (setq num (1+ num) rest (cdr rest))
  1415.         (setq found t)))
  1416.     (unless found
  1417.       (setq num (1+ (length irchat-chanbuf-list)))
  1418.       (while (nth (1- num) irchat-default-channel-binding)
  1419.         (setq num (1+ num))))))
  1420.     (if (> num (length irchat-chanbuf-list))
  1421.     (setq irchat-chanbuf-list
  1422.           (append irchat-chanbuf-list
  1423.               (make-list (- num (length irchat-chanbuf-list)) nil))))
  1424.     (unless (nth (1- num) irchat-chanbuf-list)
  1425.       (setcar (nthcdr (1- num) irchat-chanbuf-list) chan)
  1426.       (irchat-Channel-change))
  1427.     (irchat-Channel-select num)))
  1428.  
  1429. (defun irchat-Channel-part (chan)
  1430.   (if chan
  1431.       (let ((rest irchat-chanbuf-list)
  1432.         (num 1)
  1433.         (found nil))
  1434.     (while (and rest (not found))
  1435.       (or (and (car rest)
  1436.            (string= (downcase chan) (downcase (car rest)))
  1437.            (setq found t))
  1438.           (setq num (1+ num) rest (cdr rest))))
  1439.     (if (not found)
  1440.         (message (format "Not found [%s]" chan))
  1441.       (setcar (nthcdr (1- num) irchat-chanbuf-list) nil)
  1442.       (irchat-Channel-change)
  1443.       (irchat-Channel-select 0)))
  1444.     (setq irchat-chanbuf-list nil)
  1445.     (irchat-Channel-change)
  1446.     (irchat-Channel-select 0)))
  1447.  
  1448. (defun irchat-Channel-change ()
  1449.   (let ((rest irchat-chanbuf-list) (string "") (n 1))
  1450.     (while rest
  1451.       (if (car rest)
  1452.       (setq string (format "%s,%d%s%s" string n 
  1453.                    (if (irchat-ischannel (car rest)) "" ":")
  1454.                    (irchat-chan-virtual (car rest)))))
  1455.       (setq n (1+ n))
  1456.       (setq rest (cdr rest)))
  1457.     (if (string= string "")
  1458.     (setq irchat-chanbufs-indicator "No channel")
  1459.       (setq irchat-chanbufs-indicator (substring string 1 (length string))))))
  1460.  
  1461. (defun irchat-chan-virtual (chan)
  1462.   (if chan
  1463.       (let ((rest irchat-channel-conversion-map) match)
  1464.     (while rest
  1465.       (if (string= (car (car rest)) chan)
  1466.           (setq match (cdr (car rest))))
  1467.       (setq rest (cdr rest)))
  1468.     (or match
  1469.         (and (string-match "^\\([+#]\\)\\(.*\\):\\(.*\\)$" chan)
  1470.          (string= (match-string 3 chan) irchat-channel-conversion-default-mask)
  1471.          (concat (cdr (assoc (match-string 1 chan) '(("#" . "%") ("+" . "-"))))
  1472.              (match-string 2 chan)))
  1473.         chan))))
  1474.  
  1475. (defun irchat-chan-real (chan)
  1476.   (if chan
  1477.       (let ((rest irchat-channel-conversion-map) match)
  1478.     (while rest
  1479.       (if (string= (cdr (car rest)) chan)
  1480.           (setq match (car (car rest))))
  1481.       (setq rest (cdr rest)))
  1482.     (or match
  1483.         (and (string-match "^\\([-%]\\)\\(.*\\)$" chan)
  1484.          (concat (car (rassoc (match-string 1 chan) '(("#" . "%") ("+" . "-"))))
  1485.              (match-string 2 chan) ":" irchat-channel-conversion-default-mask))
  1486.         chan))))
  1487.  
  1488. (defun irchat-Command-jump-channel (num)
  1489.   (interactive "nChannel Number: ")
  1490.   (irchat-Channel-jump num))
  1491.  
  1492. ;; modify implementation by simm@irc.fan.gr.jp, Thu, 24 Aug 2000 20:57:41 +0900
  1493. (defun irchat-pj-generator-Command-jump-channels (max)
  1494.   "Define `irchat-Command-jump-channel*' functions."
  1495.   (let (sym (i 0))
  1496.     (while (< i max)
  1497.       (setq sym (intern (format "irchat-Command-jump-channel%d" i)))
  1498.       (or (fboundp sym)
  1499.       (fset sym ;`(lambda () (interactive) (irchat-Channel-jump ,i)))
  1500.         (list 'lambda '() '(interactive) (list 'irchat-Channel-jump i))))
  1501.       (setq i (1+ i)))))
  1502.  
  1503. ;;;
  1504. ;;; Cannot use completing read, user may want to query many names
  1505. ;;;
  1506. (defun irchat-Command-ison (nick)
  1507.   "IsON user."
  1508.   (interactive "sIsON: ")
  1509.   (irchat-send "ISON %s" nick))
  1510.  
  1511.  
  1512. (defun irchat-Command-userhost (nick)
  1513.   "Ask for userhost."
  1514.   (interactive "sUserhost nick(s): ")
  1515.   (irchat-send "USERHOST %s" nick))
  1516.  
  1517.  
  1518. ;; That's all
  1519. (provide 'irchat-commands)
  1520.  
  1521. ;;;
  1522. ;;; eof
  1523. ;;;
  1524.