1 ;;; emchat.el --- IM client for (S)XEmacs
3 ;; Copyright (C) 2000 - 2011 Steve Youngs
5 ;; Maintainer: Steve Youngs <steve@emchat.org>
6 ;; Created: Aug 08, 1998
7 ;; Homepage: http://www.emchat.org/
10 ;; This file is part of EMchat.
12 ;; Redistribution and use in source and binary forms, with or without
13 ;; modification, are permitted provided that the following conditions
16 ;; 1. Redistributions of source code must retain the above copyright
17 ;; notice, this list of conditions and the following disclaimer.
19 ;; 2. Redistributions in binary form must reproduce the above copyright
20 ;; notice, this list of conditions and the following disclaimer in the
21 ;; documentation and/or other materials provided with the distribution.
23 ;; 3. Neither the name of the author nor the names of any contributors
24 ;; may be used to endorse or promote products derived from this
25 ;; software without specific prior written permission.
27 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
28 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
29 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
30 ;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
31 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
32 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
33 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
34 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
35 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
36 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
37 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
41 ;; Clone of Mirabilis ICQ communication client.
48 ;; See README & INSTALL which come with this package
50 ;; This project is done without the consent of Mirabilis.
56 (require 'emchat-utils)
59 (require 'emchat-doctor))
62 (defvar emchat-add-user-success)
63 (defvar emchat-user-status)
64 (defvar emchat-user-initial-status)
65 (defvar emchat-buddy-buffer)
66 (defvar emchat-buddy-window-width)
67 (defvar emchat-status-buffer)
68 (defvar emchat-status-use-gutter)
69 (defvar emchat-status-window-height)
70 (defvar emchat-wharf-frame)
75 (defvar emchat-fix-nick)
76 (defvar emchat-wharf-frame-use-p)
82 (require 'toolbar-utils)
83 (autoload 'emchat-wharf-dec-messages "emchat-wharf"))
85 (autoload 'emchat-status-auto-reply "emchat-status")
86 (autoload 'emchat-status-idle-reply "emchat-status")
87 (autoload 'emchat-status-name "emchat-status")
88 (autoload 'emchat-change-status "emchat-status" nil t)
89 (autoload 'emchat-status-show-buffer "emchat-status" nil t)
90 (autoload 'emchat-update-tab-in-gutter "emchat-status")
91 (autoload 'emchat-status-v8 "emchat-status")
92 (autoload 'emchat-buddy-update-status "emchat-status")
93 (autoload 'emchat-buddy-selected-in-view "emchat-buddy")
94 (autoload 'emchat-buddy-show-buffer "emchat-buddy" nil t)
95 (autoload 'emchat-buddy-select-all-in-view "emchat-buddy")
100 "Mirabilis ICQ communication client."
103 (defgroup emchat-info nil
104 "Essential account info."
107 (defgroup emchat-option nil
108 "System settings and general preferences."
111 (defgroup emchat-sound nil
115 (defgroup emchat-interface nil
116 "Change the look and \"feel\"."
121 (defcustom emchat-directory (file-name-as-directory
122 (expand-file-name ".emchat" (user-home-directory)))
123 "*All EMchat support files and directories hang off this."
127 ;; Because of the incredibly complex and hairy twisted maze of
128 ;; inter-connections between the different EMchat libs, these
129 ;; emchat-history defcustoms are here instead of in
130 ;; emchat-history.el. --SY.
131 (defgroup emchat-history nil
132 "History preferences."
133 :prefix "emchat-history-"
136 (defcustom emchat-history-enabled-flag nil
137 "*Non-nil means keep \"per-user\" histories."
138 :group 'emchat-history
141 (defcustom emchat-history-directory
142 (file-name-as-directory (expand-file-name "history" emchat-directory))
143 "*Directory path for storing \"per-user\" history files."
145 :group 'emchat-history)
147 (defcustom emchat-history-mode-hook nil
148 "*Hooks run in `emchat-history-mode'."
150 :group 'emchat-history)
152 ;; This is here and not at the top because some of these libs use
155 (require 'emchat-log)
156 (require 'emchat-meta)
157 (require 'emchat-world)
159 (require 'emchat-version))
161 (defcustom emchat-server "login.icq.com"
162 "*Server host to connect to."
166 (defcustom emchat-port 5401
167 "*Port to connect to."
171 ;;;###autoload(autoload 'emchat-prefix "emchat-menu" nil nil 'keymap)
172 (defun emchat-install-bindings (&optional sym value)
173 (when (eq (key-binding (symbol-value sym)) emchat-prefix)
174 (global-set-key (symbol-value sym) nil)) ; unbind old
175 (if (key-binding value)
177 (lwarn 'binding 'warning
178 "%S already bound, reseting `emchat-prefix-key'" value)
180 (global-set-key value emchat-prefix)
183 (defcustom emchat-prefix-key [(meta ?`)]
184 "*Default global prefix key for EMchat.
186 If you change this outside of the customize buffer you _MUST_ use
187 `customize-set-variable', not `setq'."
189 :set 'emchat-install-bindings
190 :initialize 'custom-initialize-default
193 (defcustom emchat-use-sound-flag nil
194 "*Whether to use sound or not."
199 (defcustom emchat-sound-directory
200 (file-name-as-directory (expand-file-name "sounds" emchat-directory))
201 "*Directory where sound files are kept."
204 :tag "emchat-sound-directory")
206 (defcustom emchat-sound-alist
207 '((message-sound . nil)
214 (system-sound . nil))
215 "*Sound event to sound file alist.
216 The possible sound events are:
217 \"message-sound\" - Incoming message sound.
218 \"chat-sound\" - Incoming chat request sound.
219 \"url-sound\" - Incoming url sound.
220 \"buddy-sound\" - Online notify sound.
221 \"auth-sound\" - Authorise sound.
222 \"emailx-sound\" - Email express sound.
223 \"pager-sound\" - Pager sound.
224 \"system-sound\" - System message sound."
227 (cons (sexp :tag "Sound Event")
228 (sexp :tag "Sound File")))
231 (defcustom emchat-coding-system
232 (when (featurep '(or mule file-coding))
233 (if (eq default-buffer-file-coding-system 'cyrillic)
234 (find-coding-system 'windows-1251)
235 default-buffer-file-coding-system))
236 "*Coding for incoming and outgoing messages.
237 This feature is supported only in Emacs with MULE
238 Nil means not to use any codings.
239 See `list-coding-systems'."
240 :group 'emchat-option
241 :type (append '(choice (item nil))
242 (when (fboundp 'coding-system-list)
246 (coding-system-list)))))
248 (defcustom emchat-auto-response-messages-p t
249 "Set this to non-NIL to send automatic messages.
250 The automatic messages are those that are sent when somebody
251 sends you a message while you are 'away', 'na', 'dnd', or 'occ'."
252 :tag "Send auto-response messages."
254 :group 'emchat-option)
256 (defcustom emchat-auto-reply-away
257 "I am currently away from the computer.
259 If you would like to be notified when I am back online
260 send me a message with \",,notify-me\" in it.
262 This message has been automatically sent to you
263 by the (S)XEmacs IM client \"EMchat\".
264 <http://www.emchat.org/>"
265 "Auto reply with this when you are away."
266 :group 'emchat-option)
268 (defcustom emchat-auto-reply-occ
269 "I am currently occupied.
271 If you would like to be notified when I am back online
272 send me a message with \",,notify-me\" in it.
274 This message has been automatically sent to you
275 by the (S)XEmacs IM client \"EMchat\".
276 <http://www.emchat.org/>"
277 "Auto reply with this when you are occupied."
278 :group 'emchat-option)
280 (defcustom emchat-auto-reply-dnd
281 "Hey, the sign on the door says \"Do Not Disturb\"!
283 Leave me a message, if you feel you must.
284 I might get back to you.
286 If you would like to be notified when I am back online
287 send me a message with \",,notify-me\" in it.
289 This message has been automatically sent to you
290 by the (S)XEmacs IM client \"EMchat\".
291 <http://www.emchat.org/>"
292 "Auto reply with this when you want to leave alone."
293 :group 'emchat-option)
295 (defcustom emchat-auto-reply-na
296 "I am currently not available.
298 If you would like to be notified when I am back online
299 send me a message with \",,notify-me\" in it.
301 This message has been automatically sent to you
302 by the (S)XEmacs IM client \"EMchat\".
303 <http://www.emchat.org/>"
304 "Auto reply with this when you are not available."
305 :group 'emchat-option)
307 ;; FIXME: How can I make this display how long we've been away
308 (defcustom emchat-idle-reply-away
309 "I must be too busy to talk because I have
310 been idle now for at least...seconds
312 If you would like to be notified when I am back online
313 send me a message with \",,notify-me\" in it.
315 This message has been automatically sent to you
316 by the (S)XEmacs IM client \"EMchat\".
317 <http://www.emchat.org/>"
318 "Auto reply with this when you have idled away."
319 :group 'emchat-option)
321 ;; FIXME: How can I make this display how long we've been away
322 (defcustom emchat-idle-reply-na
323 "I must be too busy to talk because I have
324 been idle now for at least...seconds
326 If you would like to be notified when I am back online
327 send me a message with \",,notify-me\" in it.
329 This message has been automatically sent to you
330 by the (S)XEmacs IM client \"EMchat\".
331 <http://www.emchat.org/>"
332 "Auto reply with this when you have idled to na."
333 :group 'emchat-option)
335 (defcustom emchat-auto-response-never-send-to nil
336 "*This is a list of people that shouldn't get auto-responses.
338 When you add someone's alias here and they send you a message while
339 your status would cause an automatic response to be sent, they won't
341 :type '(repeat (string :tag "Alias"))
342 :group 'emchat-option)
344 (defcustom emchat-oops-msg-wrong-recipient
345 "That last message was meant for somebody else.
346 Sorry about that. :-)"
347 "*The \"apology\" sent when you send to the wrong person."
349 :group 'emchat-option)
351 (defcustom emchat-start-in-new-frame nil
352 "*If non-NIL, EMchat will start in its own frame."
353 :group 'emchat-interface
356 (defcustom emchat-new-message-hook nil
357 "*Hooks to run when there is an incoming message.
358 Dynamically ALIAS and MESSAGE are binded to be used in hooks."
359 :group 'emchat-option
362 (defcustom emchat-read-message-hook nil
363 "*Hooks run when a message is marked as \"read\"."
364 :group 'emchat-option
367 (defcustom emchat-system-message-hook nil
368 "*Hooks run when a \"system\" message is received."
369 :group 'emchat-option
372 (defcustom emchat-load-hook nil
373 "*Hooks run after EMchat has loaded everything up."
375 :group 'emchat-option)
377 (defcustom emchat-missed-message-hook nil
378 "*Hooks run when SRV_MISSED_ICBM packet comes in.
380 This is usually when you are getting too many incoming messages at
381 once. You can use this hook, for example to send back a \"please
382 resend\" message to the original sender.
384 It is called with 3 arguments:
386 ALIAS -- The alias/UIN of the person who sent the message that
387 caused the SRV_MISSED_ICBM packet to be sent. \(string\)
388 NUM -- The number of missed messages. \(integer\)
389 REASON -- The reason that the messages were dropped. \(string\)"
391 :group 'emchat-option)
393 ;; Some debugging counters. Do NOT set any of these.
394 (defvar emchat-dropped-packet-counter 0
395 "For debug purpose only.")
397 (defvar emchat-resend-packet-counter 0
398 "For debug purpose only.")
400 (defvar emchat-recent-packet nil
401 "The most recent incoming packet.
404 (defvar emchat-trimmed-packet-counter 0
405 "For debug purpose only.")
407 (defvar emchat-error-packets nil
408 "A list of error incoming packets.
411 (defcustom emchat-about-fields
412 '((:nick . "Nick Name")
413 (:first-name . "First Name")
414 (:second-name . "Surname")
416 (:country . "Country")
419 (:zip . "Postal Code")
422 (:cellular . "Cellular")
424 (:web-indicator . "Web Indicator"))
425 "*Alist of field . field-name for basic info queries."
426 :type '(repeat (cons :tag "Field"
427 (choice :tag "Field Keyword"
428 (const :tag "Nick Name" :value :nick)
429 (const :tag "First Name" :value :first-name)
430 (const :tag "Second Name" :value :second-name)
431 (const :tag "Email" :value :email)
432 (const :tag "Country" :value :country)
433 (const :tag "City" :value :city)
434 (const :tag "State" :value :state)
435 (const :tag "Phone" :value :phone)
436 (const :tag "Fax" :value :fax)
437 (const :tag "Street" :value :street)
438 (const :tag "Cellular" :value :cellular)
439 (const :tag "ZIP Code" :value :zip)
440 (const :tag "Flags" :value :flags)
441 (const :tag "Web Indicator" :value :web-indicator))
442 (string :tag "Field Name")))
445 (defcustom emchat-about-more-fields
448 (:homepage . "Homepage")
449 (:birth-year . "Birth Year")
450 (:birth-month . "Birth Month")
451 (:birth-day . "Birth Day")
452 (:lang1 . "Language")
453 (:lang2 . "Second Language")
454 (:lang3 . "Third Language")
455 (:ocity . "Old City")
456 (:ostate . "Old State")
457 (:ocountry . "Old Country")
458 (:marital . "Marital Status"))
459 "*Alist of field . fieldname for extended info queries."
460 :type '(repeat (cons :tag "Field"
461 (choice :tag "Field Keyword"
462 (const :tag "Age" :value :age)
463 (const :tag "Gender" :value :gender)
464 (const :tag "Homepage" :value :homepage)
465 (const :tag "Birth Year" :value :birth-year)
466 (const :tag "Birth Month" :value :birth-month)
467 (const :tag "Birth Day" :value :birth-day)
468 (const :tag "Language" :value :lang1)
469 (const :tag "Second Language" :value :lang2)
470 (const :tag "Third Language" :value :lang3)
471 (const :tag "Originate City" :value :ocity)
472 (const :tag "Originate State" :value :ostate)
473 (const :tag "Originate Country" :value :ocountry)
474 (const :tag "Marital" :value :marital))
475 (string :tag "Documentation")))
478 (defcustom emchat-auth-accept-reason "You are AUTHORISED!"
479 "*Default reason for rejecting incoming auth requests."
483 (defcustom emchat-auth-reject-reason "Authorisation Rejected!"
484 "*Default reason for rejecting incoming auth requests."
488 (defcustom emchat-auth-request-reason "Please add me to your contact list"
489 "*Message to send with outgoing auth requests."
493 (defun emchat-init-visible-list (&rest args)
494 "Initialises the default value for `emchat-visible-contacts'."
495 (when (file-readable-p emchat-world-rc-filename)
496 (emchat-world-update)
502 (defcustom emchat-visible-contacts (emchat-init-visible-list)
503 "*List of contacts on your \"visible\" list."
504 :type '(repeat (string :tag "Contact Alias Name"))
505 :initialize #'custom-initialize-reset
506 :get #'emchat-init-visible-list
507 :set #'custom-set-default
510 (defcustom emchat-invisible-contacts nil
511 "*List of contacts on your \"invisible\" list."
512 :type '(repeat (string :tag "Contact Alias Name"))
515 ;;; Internal variables
516 (defcustom emchat-user-password nil
517 "*Password for your ICQ account.
518 Nil means prompt for entering password every time you login."
521 (defvar emchat-ctx nil
522 "Current emchat context in emchat-v8 protocol.
523 Internal variable, do not modify.")
526 (defun emchat-version (&optional arg)
527 "Return the version of emchat you are currently using.
528 If ARG, insert version string at point."
531 (insert (message "EMchat: %s" emchat-version))
532 (message "EMchat: %s" emchat-version)))
535 (defun emchat-copyright ()
536 "*Display the copyright notice for EMchat."
543 (insert-file-contents (locate-library "emchat.el"))
544 (goto-char (point-min))
545 (re-search-forward ";;; Commentary" nil t)
547 (narrow-to-region (point-min) (point))
548 (while (re-search-backward "^;+ ?" nil t)
549 (replace-match "" nil nil))
550 (buffer-string (current-buffer)))))
551 "*EMchat Copyright Notice*"))
553 (defconst emchat-donation-notice
554 "EMchat is an Open Source project and we have had a lot of fun in
555 getting it into your hands. But this project is NOT a \"for profit\"
556 organisation. We do not receive any funding, Government grants, or
557 subsidies of any kind. None of us who are involved with the project
558 are remunerated in any fashion for what we do with EMchat. We are all
559 just volunteers, coding in our spare time.
561 Often the end user doesn't realise that their \"free\" software has
562 come at some considerable cost. Costs and expenses like...
564 Bandwidth and ISP expenses
565 Hardware updates and maintenance expenses
567 Domain name registrations
568 Electricity and other utility expenses
569 Outrageous amounts of coffee for all-night coding sessions
571 If you have found this software useful/cool/entertaining please
572 consider dipping into your hard earned and making a donation. Doing
573 so will give you the eternal gratitude and thanks from the EMchat
574 team, and think of the warm fuzzies you'll get.
576 Seriously, even if you decide against making a donation at this time,
577 I would like to sincerely thank you for at least taking the time to
578 consider it. I hope you enjoy EMchat as much as we have enjoyed writing
584 \t\t [Donate]\t\t\t [Cancel]
587 "Contents of donation buffer.")
589 (defconst emchat-paypal-glyph
590 "iVBORw0KGgoAAAANSUhEUgAAAG4AAAAXCAIAAABlFO2lAAAACXBIWXMAAAsTAAALEwEAmpwY
591 AAAAB3RJTUUH1wsQEBYNmimKowAACOlJREFUWMPtmWtwVdUVx3/ncV/n3pubBAIhQF4QkgtJ
592 6gMBrVhfUxSstkjHjlZ8jLUdxk5HRztTqzLUdsaCEsfx0arVqY7TUqfWajWlIqPQiGOLYIE8
593 CI8QyDtc7vu8z+mHewMhxDGg0w+drDkf9pyz9//813+vtfY+ZwvtnLLapgiTdjbWcW/iZFto
594 PylicYK5V1I0H6TxRgngfg7gmEcC8PmdvxDtHGw02ue1J/5eYWLkHVJH6HqL3khOUKE9p2Pd
595 NBrXUFyPHJyMtYmarZHp5T/PsLu1496EDBBJUP8g0y/54sHuSMz9f9iXdEcOEqmh4YccvR2Q
596 a5siyAmmXoiV/XKZ9ZWk5/+sJnx1gKEKps6sbUrLAFNnYqUR5AmME8H5PwrLr8Id12JKA+yQ
597 AQQPRhrJc1oPXx3+RnBJvolrIsiErkUMYHaT/XgExUUYlSGemShfR92Nsf8sJ/ZqpGKsPjLb
598 xz7K0wAcnAzGIfSOM5w5ncb4Do/0yTXEAN5qrGGsAQDPLJRL0Haj7z8XKR0XkAFcAzONM0rK
599 QKP+YrH6yxZEIh3fEqzXXe/1qQv2OP2Gd2WJ0nQhqQ/HInrLzW3RzO0tgbWVvtUG6t6JUila
600 lbrusL2rzXN1UfCli0m+Nw4NwCuKs32+W6b77ioiueXLxaLiJBcYm2T5fK+8UEP0mFtrM3e1
601 BNZV+b6vo+47OzTHwtFHpDQz2BnsUQkeDNtt2Vwo2LvS8qIl+hMDTr8BiFEFoxtfA8F6RD+O
602 TmY3qU/wh+19GUBqDCEEmHonmc9IbUcIEVmKrxxcsq0ktiEKuWkE8FebWyx7VxqwO1WkWRhp
603 IN9nhIb/5xWCIunP9Ki/6MJf7Vs1B+0IBUvxzca1ye4j+U9EgaLr8VWQ3oUyH9cg9hZ2jOCS
604 sVSLLrbeD2mPdyqPz6Xgmwz/QaxpUH5TK583jHqU8JV4Z+Vh0y04LlNuOA32xNsYw6dIujZG
605 IlcsIJVA7cdKnrrkIrs1IyiSONNn7Uw6/aXab3uleQogRYNIhdrTUxONe+JlHyUWfKa9MJPQ
606 hYgRuzUDSPVB/ffF8Rkt6q/ChC539FWZNUZi7s7EvE/VxyIUXoORwErlXxReqq3vFqd75SsK
607 naMaVhA7i5XESJykAfhum+G7qV9pmguYfxkiEHXSKzM/0BLV/0pEd6sbiym8hsLlmTsy8dIW
608 dUNhIro7uajDHlxB6NKxVIuv0zcVZn/cCWTvPxAv30Hh97R1Q9k1HcK0Gid5TeYu9RRswTKK
609 V4yFHViO4D9FUhsg3jYiZQa6m1EH0WPocYw07hT7gCrWKfKisP3vtLq2S74gJNYEACmqoA8K
610 paL/gfLAI1VCoayt73bdxXim2/syYoU/FzuBhysDD8uuVZle2e4c0Pz3zZYviegv9JoflSCX
611 ocfRY3gqzWbT3pfx/WSWND+Ig31Aw/WiJ9ATGKk8jVKvoGQZbharA4CbtN1sUfrGNuvTlH9t
612 pdQY0p/tMbcU4y2z2zKA4BM9N0x1enSzOYkUHktVL5cXeqS5ASRBeW5e8MVaRN1uy4gVfkxn
613 orC+SvQ4egJ1kO53iWkjCQ4M7OXEXsKVBEoJzrUP6piuVKdIDUH1kcPYbnjzeZkfdQgFkljq
614 OEfnm81DVksPtpvfVHgF1wg7RzREQXvqmPLcPO+lu+hrN7asco7pgPpoV75Gx0zSvQzuQOvj
615 0ge1Dd3CFI/nqiLzneO5HJeicYZaAIJzcjTEWoV0G6k+J6kBYpXfeG3Q6TOUDXO83x4SQqXW
616 9rh9QJVThU6fIS8p8D9QZL5rGK/0CxHZGSowm3vGUJXqfE7CEiv93hUiHevc9Eanz/Asn3IK
617 9vpeITT7DNiI+a6VgyXeysDHAIMtGCO7zFP10YDjXdBFRbV9OJMLQHlhAabrvWW6WON3Dqvy
618 wgLsrPpozNoWDzxaJc4JZO9oF2Z4BQas1jAuYqXfOag6B1W+dgwhnEtP5ckascybq7yS8jJ7
619 mzBiVN1hvOXYnSqQXLwzX8E7s9TIHNsBUFGVpzFPQe+nZq1+dy/gXVlibj0BSAuCWD35qlKn
620 5BryxRHie+zWWbkO6rq+sVSdY26izB0y5YsKSB/ieLudzjtr78/mYR13PNh9J2Hp+iuDLWdu
621 rM6wwka7NZsri1Jkc+ChisA9utOh4iBFFRzb6dVzRdf885CrO9KCIPpgbs0J/KxCvqxQazpm
622 Da8CSSz3A+aWmNNvWNuOG6+0CjPKMWIIMvWPaRuPiqXe4KvR4KvR4It1gL1fpSA6hoabtIz3
623 FqRvHTD/EfOsmOK5ShXnBAD9d336phnGy33SgqDncnILlDRfQfLZ7XlRxqGaPuj0Grn8MD6s
624 YMYt+YHR4MRhiX827h4VJPCMuooanLb8nLDnHt/lTwvJ53OIYlRh4G++u0uFiKw/1yNM8+YX
625 ItfKT2NUUZ6sEkJSdk2Hq1zmuznpuWGqtTWevf+guTUpLyuj/008UHOn8YbjdGneW0s9dc2e
626 4G2eawNCgeR0ZohEx9Aw/jSoru1yY2ZgXVVwg8GWet93h703lpjNx7WN3Z4VU0KvzWK4ecTn
627 IIFSuy0tzvAKSmocqrEd4rQD8kVh65Oket9B5p6UUvHdlJwQrG8Q98RpikkAgtsUIZKgpPi0
628 Xe5Ff2Ta1bxXl1/1gdk30/gUe3/KkZco+w71G7BS9L1N9Rr2r6dzPQ1PUH4bHyzGVrlsO1aS
629 bd8Am4Ynmb4MQSbdyaGn6Xk9D1i+moaN7P81nRvyd5YdQu1h29KxNHCxsmQPc2wTXc/j2kgB
630 GpooXY5rMbCZ1ocwjtOwkfLVfLCEzAGu2Ino4f3G8alKfha/QeFCHJ3NFdQ/TvlqPliM1jtR
631 2DFf8okYgxHBbYpQkqCsHkGa/NdzTh+ODrE9HI3I+QQPVUxKea5S2iS7R1ZwFQqqJqU8d+t+
632 ByJyx72J2mfB0Cg5f1KTc7HUYRKM/PrVI3S8Q2gm4XI8BYjipD4T+IvhYqXRhtj/d5IRSIw6
633 2wknKJnJtEXI/kmhJlQih3cx2MmJUWc7J23yxPFsbfSJ438BQx3Q9K+c09sAAAAASUVORK5C
635 "A base64 encoded paypal donate button.")
637 (defconst emchat-maybe-later-glyph
638 "iVBORw0KGgoAAAANSUhEUgAAAG4AAAAXCAIAAABlFO2lAAAACXBIWXMAAAsTAAALEwEAmpwY
639 AAAAB3RJTUUH1wsQEBEgkLdAEQAACKJJREFUWMPtmVuMXVUZx39r7X32PpeZc6YznXYudKa1
640 lHZ6IdzaEGs0IL6CqPGFGKomQDAaagoYAtUEagwF2phSJQYURZEHCCLIRTAojJSCFux12qlz
641 a2emc9ozs+dc9tm3tXw4ZzplOqUzxb40/bIfVr59vv9/rf/51rfXRRxg0pZuyXDRZmNd652T
642 bXHgpIj1Dpdez5zlYEwXJUCfAXDKKwGc+cdnRTsHOxXtTO2Z84qZdV6R76P3JQYzFUHFgYqO
643 y+Zx+Z3Ur8RMXcy1mVpUpjjIfx7no31d6x0TIOOw8j7mf/7swXoi5y4M+4zDMVNklrDqdgbW
644 AebSLRlMh7lXE5ZmiWQg4ggbIrSH9hAWwgYT7aM9CGaMY4FZxSGawbwzEHEwIDxbiIGQADoE
645 dV6KTE07c1uXbimYAHNbCQsIcwZxstohYSLrkA3IWnSIHkUXEDWIeoSBKqCyqCI6OLuOMo2R
646 RsTRPvoEqoQOP7VSmcg6RB3SQrno3BlCBDKOSIENASqPck9TU57mOYfUDmlYBe+ZACKGX8CI
647 zSJeJjFqMVsRNkBkQQKjDmMOgKxDldEu2AgTHaJKaB8RQ5joaCKFLYSBSGO2IDOoEqEgClHj
648 KA8RQyYQcbRCu2i3+sdUqS9BJlB5vDxBCQEigUxM0gkgjdmKrEN7BANoH+Ui4sgEaLSLKoFE
649 JhAWSLQPimhs1lIqDZgA2icooGYjpZnAbPUez7oP9SHJdF0rUnHtxvNrP1DDvvW1xuS2dpRG
650 xpFx0ITjRA5CIBPoEOVj2BAHTaw5eCMqrutM/HihfXsb2ibMQhGZwGxA2KBRBYJhwmGUW6Xe
651 fsJ9qC+x6XP2t5pQfcgk5jyMugm6PLqE2aSyc/zfj5ira80vLEBpZISRnsQMT4DArMdIoxWq
652 RJhDlwhzs5BChShvQsqgSFQkOmWCS1FRerIxxSnqEXa0/xiAItqVN7+Y8bb2q2EfkB1JdIDV
653 jpGsFnZjLsEQwsZqJsoTFZAJzDpUCSGjvVnAuLwGGcduw8ig8sgazAxUKl2AloQOQQ6pT1Ib
654 y5MEPQRF4o3YSzBqqnSmR5DFaAzfHS0/MpB85FKM+ZguMolZO4kpkiCwWqq5LAyK/ahj+IWZ
655 6qA0OsJ3qILmHdxhwvHJx3emNqY4ARGL9hVF0pCtdvivvOr1yk8MGpclAaMjhYiXNx93Vn4w
656 1tLpdLxf3jpCrCX8KDXW1Ok9UyQ2L/xAjDV1lu4dAivaVwSC13LO4h3ja3dFPTaxJjWULH7n
657 oLN4h7Nkh7vxCNZCSKICtECYlRCjI0V5AGIkVpQ35ybptowQa/J+e7z0/UNAaUP32IJ/IprU
658 UPwTmLFWrJbiLQfHWjrdB/qdy94P3kxg1M9Ch3Cc8jHG9k9kZRH6X6XlOqQJ8pNrbAHRNM6k
659 SSijbtdYVWO0x6MP8+5HBfOqGtEQiw6WjI4kIJqs+N1tuMp7eqj8cL/93WbzihSWjPYWEU3l
660 x46IlJG4pw2I9hYBLGHd2uRtP+o9NpB4eHHh5o9F0oj/cEG4c9z71aD5pbrY6hqCMvEYoRF1
661 u7LJEhnB8RBzHiIumoKpdGvSxqWJqKec3LZEpAxdjgo3756KeUNdtL+IQheixE8WGqtGGduJ
662 n5upDspj8G1yZbAnJvWxPYzuoXYhiaZT1loSwD06jbNmbdTtEmhjWdJYlXI39hDp2tevKN7R
663 JdKGbLXUUS/4Sy7sdIh0tSeWxCibl6ei3YXww3z4zlj87jaRPqFLjaqvbK7NJB5o107kbT+q
664 Rnz/2WPqiAe4D/ZWi3suoDjIiY9JXV2hlh1JdESslViDOmaeTmd0JJUTyoVx66sNhHnv1yOn
665 Y2onUkO+cWVNcssihp5n+M+Ueqcf8rTOkU78ic/HZH304UQv9E5XWk9zLt8a7a9MsaR5TZpA
666 W7fMl0sSqsc1r0mjtbuxN/zHWOLBRXJxovTtA6LZEpaPO2isSftPDZU398smy75jPk5n1JdC
667 Y6xIoXUlPY2lycr8TW5dIlusSjk22rvZv41wjDZ7gjqFMKnpQNruD/47lc6OdA6dDczVaXSE
668 CqbBXKEqzth1c8j9mw83UDpyxiGf0XmqtOe0Z4r2lSrjMS4ZSNzfntiQUV0lFEZHEh2pQa9S
669 mIPns9pTxooUXpZg3Fxdq8sq/PtY/J42MfoyQaEiX/DWqP9s1r33MJa01jXJtjgQvJlTw374
670 zpj/7BFRJyn1EhQQZoU62ld0Nw24P8sFr45PQ+fn1KBfST3/JQe3PB2mEe0vAcbyFLmdBOOf
671 ZX0pK8tkYrN8DEtVUmNZkr132V/5nSg9V+mW7Eji7LJvaxYZ0/vFUTHPmvg+DGKmjKtqK1HW
672 11N0P4qU1by4YY67sUd7OvXUMiPxon2riN00N/zbWGnD4eCtUfPLcxh+mSgLzknq8O0xb9sR
673 b9uRqLts394ylS63Qy4YNVfXhjvH3fWHqJlv32p8ErMeL1uVsiNJ9nVEadY6VNUAEHpLhoxD
674 Yz1iltvRtW9QdxXvXs/4HrTCSLLoNpbez6HN9D5J6ze47EdELrn3aL6Ro88RFiLnm/4Lx71f
675 Dtb8cYXZ8gSHf46RYNWjNN/E8Ms0fplwnK6fMvgC1lxWPUrDWoTEPUrvk/T/hsgFsBq4+mnq
676 r53sSd9TlAdZfNckXd+THNhELMM1z5BejvJ5+1pgKubQiyzfRPON7LiZ3Htn2WV9yk7eyTGS
677 EXpLhkaHlpUI4zweHNiNrPmTs2I3Stt3XhJfN8TeewlyXACmFbndDGTM6gSvaT+/UgJ7vpfZ
678 +zhCkv0rPX/ArsWuvSCkjBjvn/iCu5BedN6lBA7fV22k5l9QB5f9r0DG7FrvLN0OfpnGKy8e
679 5p6L5XtwmDj69TJ0vUJNK7VtxNJIeVGfGZxiaMIC5SwHX2M8A84pdzu1Do2tzFuDGb8o1IxK
680 5PFdjBxi9JS7nYs3jv+XG8f/AUQDon1o6NymAAAAAElFTkSuQmCC"
681 "A base64 encoded png \"Maybe Later\" button.")
683 (defun emchat-make-donation ()
684 "Proceed with making a donation to the EMchat project."
686 (browse-url "http://tinyurl.com/2uzel4")
687 (kill-buffer "*emchat-donate*"))
689 (defun emchat-no-donation ()
690 "Don't make a donation to the EMchat project."
692 (kill-buffer "*emchat-donate*"))
694 (defconst emchat-donation-map
695 (let* ((map (make-sparse-keymap 'emchat-donation-map)))
696 (define-key map [button1] 'emchat-make-donation)
697 (define-key map [button2] 'emchat-make-donation)
698 (define-key map [button3] 'emchat-make-donation)
699 (define-key map [return] 'emchat-make-donation)
701 "A keymap for the extents in the EMchat donation buffer.")
703 (defconst emchat-nodonation-map
704 (let* ((map (make-sparse-keymap 'emchat-nodonation-map)))
705 (define-key map [button1] 'emchat-no-donation)
706 (define-key map [button2] 'emchat-no-donation)
707 (define-key map [button3] 'emchat-no-donation)
708 (define-key map [return] 'emchat-no-donation)
710 "A keymap for the extents in the EMchat donation buffer.")
712 (defun emchat-donation ()
713 "Make a donation to the EMchat project via PayPal."
715 (let ((buf (get-buffer-create "*emchat-donate*"))
716 (donate-help "Make a donation to the EMchat team.")
718 "Thank you for considering a donation... maybe another time.")
723 (switch-to-buffer buf)
725 (insert emchat-donation-notice)
726 (when (and (device-on-window-system-p)
728 (setq donate-glyph-ext (make-extent (point-max) (point-max)))
729 (set-extent-begin-glyph
732 (list (vector 'png ':data (with-temp-buffer
733 (insert emchat-paypal-glyph)
734 (base64-decode-region (point-min)
738 (setq cancel-glyph-ext (make-extent (point-max) (point-max)))
739 (set-extent-begin-glyph
742 (list (vector 'png ':data (with-temp-buffer
743 (insert emchat-maybe-later-glyph)
744 (base64-decode-region (point-min)
747 (set-extent-property donate-glyph-ext 'keymap emchat-donation-map)
748 (set-extent-property donate-glyph-ext 'help-echo donate-help)
749 (set-extent-property donate-glyph-ext 'balloon-help donate-help)
750 (set-extent-property cancel-glyph-ext 'keymap emchat-nodonation-map)
751 (set-extent-property cancel-glyph-ext 'help-echo cancel-help)
752 (set-extent-property cancel-glyph-ext 'balloon-help cancel-help))
753 (goto-char (point-min))
754 (re-search-forward "\\[Donate\\]" nil t)
755 (setq donate-text-ext (make-extent (match-beginning 0) (match-end 0)))
756 (re-search-forward "\\[Cancel\\]" nil t)
757 (setq cancel-text-ext (make-extent (match-beginning 0) (match-end 0)))
758 (set-extent-property donate-text-ext 'face 'bold)
759 (set-extent-property donate-text-ext 'mouse-face 'highlight)
760 (set-extent-property donate-text-ext 'keymap emchat-donation-map)
761 (set-extent-property donate-text-ext 'help-echo donate-help)
762 (set-extent-property donate-text-ext 'balloon-help donate-help)
763 (set-extent-property cancel-text-ext 'face 'bold)
764 (set-extent-property cancel-text-ext 'mouse-face 'highlight)
765 (set-extent-property cancel-text-ext 'keymap emchat-nodonation-map)
766 (set-extent-property cancel-text-ext 'help-echo cancel-help)
767 (set-extent-property cancel-text-ext 'balloon-help cancel-help)
768 (goto-char (point-min))))
771 (add-hook 'emchat-buddy-mode-hook 'emchat-install-buddy-toolbar)
772 (add-hook 'emchat-log-mode-hook 'emchat-install-log-toolbar)
774 ;;; Code - utilities:
777 (defun emchat-customize ()
778 "Interactively customize settings and preferences."
780 (customize-group 'emchat))
784 (defun emchat-browse-homepage ()
785 "Browse emchat homepage for news and files."
787 (browse-url "http://www.emchat.org/"))
789 (defcustom emchat-encoding-local 'koi8-r
790 "*Local hosts encoding."
791 :type '(choice (item :tag "ASCII" us-ascii)
792 (item :tag "Russian KOI8-R" koi8-r)
793 (item :tag "Russian CP1251" cp1251))
796 (defcustom emchat-encoding-remote 'cp1251
797 "Remote server encoding."
798 :type '(choice (item :tag "ASCII" us-ascii)
799 (item :tag "Russian KOI8-R" koi8-r)
800 (item :tag "Russian CP1251" cp1251))
803 (defconst emchat-encoding-koi8-r
805 "\301\302\327\307\304\305\243\326\332"
806 "\311\312\313\314\315\316\317\320"
807 "\322\323\324\325\306\310\303\336"
808 "\333\335\337\331\330\334\300\321"
809 "\341\342\367\347\344\345\263\366\372"
810 "\351\352\353\354\355\356\357\360"
811 "\362\363\364\365\346\350\343\376"
812 "\373\375\377\371\370\374\340\361"))
814 (defconst emchat-encoding-cp1251
816 "\340\341\342\343\344\345\270\346\347"
817 "\350\351\352\353\354\355\356\357"
818 "\360\361\362\363\364\365\366\367"
819 "\370\371\372\373\374\375\376\377"
820 "\300\301\302\303\304\305\250\306\307"
821 "\310\311\312\313\314\315\316\317"
822 "\320\321\322\323\324\325\326\327"
823 "\330\331\332\333\334\335\336\337"))
825 (defun emchat-translate-string (str from-enc to-enc)
826 "Translate STR from koi8 to cp1251."
827 (let ((fe (ecase from-enc
829 (koi8-r emchat-encoding-koi8-r)
830 (cp1251 emchat-encoding-cp1251)))
833 (koi8-r emchat-encoding-koi8-r)
834 (cp1251 emchat-encoding-cp1251)))
835 (tt (make-vector 256 nil)))
836 (dotimes (idx (min (length fe) (length te)))
837 (aset tt (char-to-int (aref fe idx))
838 (char-to-string (aref te idx))))
839 (mapconcat #'(lambda (chr)
840 (or (aref tt (char-to-int chr))
841 (char-to-string chr)))
844 (defun emchat-encode-string (string)
845 "Return a encoded string from STRING with DOS stuff added.
846 Encode string with `emchat-coding-system'."
848 ;; "0d" instead to avoid use of ^M
849 ;; which messes up with outline mode
850 (let ((estr (replace-in-string string "\x0a" "\x0d\x0a")))
851 (if (fboundp 'encode-coding-string)
852 (encode-coding-string estr emchat-coding-system)
853 (emchat-translate-string estr emchat-encoding-local emchat-encoding-remote))))
855 (defun emchat-decode-string (string)
856 "Return a decoded string from STRING with DOS stuff removed.
857 It also quote character % to make `format' happy in `emchat-log'.
858 Decode string with `emchat-coding-system'."
860 ;; "0d0a" instead to avoid use of ^M
861 ;; which messes up with outline mode
862 (let ((dstr (replace-in-string string "\x0d\x0a" "\x0a")))
863 (if (fboundp 'decode-coding-string)
864 (decode-coding-string dstr emchat-coding-system)
865 (emchat-translate-string dstr emchat-encoding-remote emchat-encoding-local))))
867 (defconst emchat-message-max-size 500
868 "Maximum size of message that ICQ will accept.
869 Set it to small because size expands after `emchat-encode-string'.")
871 (defun emchat-splitter (x)
872 "Split a long message X into parts of maximum length `emchat-message-max-size'.
873 Only split at whitespace."
875 with i = emchat-message-max-size
876 while (> (length x) i)
877 do (while (and (not (memq (aref x (incf i -1)) '(? ?\t)))
878 ;; at least half, to safe guard
879 (> i (/ emchat-message-max-size 2))))
880 collect (substring x 0 i) into parts
881 do (setq x (substring x i))
882 finally return (nconc parts (list x))))
884 (defvar emchat-outgoing-queue nil
885 "Lists of outgoing queue to be sent.
886 Each queue consists of the binary string and the resend counter.")
888 (defvar emchat-frame nil
889 "The frame where EMchat is displayed.")
891 (defun emchat-connected-p (ctx)
892 "Return non-nil when EMchat is connected to the ICQ server."
893 (memq ctx emchat-v8-connections))
895 (defun emchat-exit ()
896 "Log out of ICQ and close all EMchat buffers."
900 (set-buffer emchat-log-buffer)
902 (if emchat-save-log-on-exit-p
903 (rename-file emchat-log-filename
904 (concat emchat-log-filename
905 (format-time-string "-%Y-%b%d-%H%M-%S")))
906 (delete-file emchat-log-filename))
907 (loop for each in '(emchat-log-buffer
909 emchat-status-buffer)
910 do (when (buffer-live-p (symbol-value each))
911 (kill-buffer (symbol-value each))))
912 (delete-other-windows)
913 (when (and emchat-start-in-new-frame
914 (frame-live-p emchat-frame))
915 (delete-frame emchat-frame))
916 (setq emchat-frame nil)
917 (when (and (featurep 'emchat-wharf)
918 (frame-live-p emchat-wharf-frame))
919 (delete-frame emchat-wharf-frame))
920 (setq emchat-wharf-frame nil))
922 (defvar emchat-trimmed-packet nil
923 "*Last incomplete packet.
924 Due to limited buffer size of Emacs network buffer, packets can be trimmed
925 and attached at the beginning of next callback. Use this in
926 `emchat-network-separator' to concatenate a packet across two callbacks.
927 Usually only one per 1000 packets needs this.")
929 ;;; Code - client to server packets:
931 (defvar emchat-current-seq-num 1
932 "Current sequence number in packet.")
934 ;;; FIXME: This needs to be updated for v8
935 ; (defun emchat-pack-register-new-user (password)
936 ; "Pack register new user packet 03fc."
939 ; (emchat-int-bin (length password))
943 ; "\x00\x00\x00\x00"))
945 ;;; FIXME: This needs to be updated for v8
946 ; (defvar emchat-random-groups
947 ; '(("general" . "\x01\x00\x00\x00")
948 ; ("romance" . "\x02\x00\x00\x00")
949 ; ("games" . "\x03\x00\x00\x00")
950 ; ("students" . "\x04\x00\x00\x00")
951 ; ("age-20" . "\x06\x00\x00\x00")
952 ; ("age-30" . "\x07\x00\x00\x00")
953 ; ("age-40" . "\x08\x00\x00\x00")
954 ; ("age-50+" . "\x09\x00\x00\x00")
955 ; ("women-wanted" . "\x0a\x00\x00\x00")
956 ; ("man-wanted" . "\x0b\x00\x00\x00"))
957 ; "Random user groups.")
959 ;;; FIXME: This needs to be updated for v8
960 ; (defun emchat-pack-set-random-group (group)
961 ; "Pack set random group 0564."
964 ; (cdr (assoc group emchat-random-groups))))
966 ;;; FIXME: This needs to be updated for v8
967 ; (defun emchat-pack-search-random-user (group)
968 ; "Pack search random user 056e."
971 ; (cdr (assoc group emchat-random-groups))))
973 ;;; FIXME: This needs to be updated for v8
974 ; (defun emchat-pack-request-authorization ()
975 ; "Pack request authorization packet 0456."
976 ; (emchat-pack "\x56\x04"))
978 ;;; Code - server to client packets:
980 ;;; FIXME: Do we have an unknown packet handler for v8?
981 ; (defun emchat-do-unknown (packet)
982 ; "Handle any unknown PACKET."
983 ; (push (cons 'unknown-command emchat-recent-packet)
984 ; emchat-error-packets)
986 ; "Unknown command: %s"
987 ; (emchat-bin-hex (substring packet 7 9))))
989 ;;; FIXME: How is this handled now?
990 ; (defun emchat-do-wrong-password (packet)
992 ; "Handle server command 0064 in PACKET."
993 ; (emchat-log-error "Your password is invalid"))
995 (defun emchat-do-forced-logoff (ectx)
996 "Called when another user with same UIN is logged in."
997 (emchat-log-error "Another user with same UIN is logged in!")
1000 ;; Automatically reconnect when connection unexpectadly closes.
1001 ;; WARNING!! This can cause problems, we should have maximum
1002 ;; reconnections and reconnection rate custom variables.
1003 (defvar emchat-is-auto-reconnecting nil
1004 "Internal variable. Do not set.")
1006 (defun emchat-do-disconnect (ectx)
1007 "Handle disconnect from server."
1008 (emchat-log-error "Unexpected disconnection from server")
1010 (if emchat-user-password
1012 (setq emchat-is-auto-reconnecting t)
1013 (emchat-log-system "Attempting auto-reconnect...")
1015 (with-current-buffer emchat-log-buffer
1017 (substitute-command-keys
1018 "Connection lost, use `\\[emchat-login]' to log back in.")))))
1020 ;;; FIXME: How is this handled now?
1021 ; (defun emchat-do-already-logged-in (packet)
1022 ; "Handle server command 00fa PACKET."
1023 ; (emchat-log-error "You are already logged in."))
1025 (defun emchat-do-instant-message (ectx &rest ih-arguments)
1026 "Handle incoming instant message."
1027 (emchat-do-message-helper
1028 (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type)))
1030 (defun emchat-do-missed-message (ectx &rest ih-arguments)
1031 "Handle incoming notice about missed messages."
1032 (let ((alias (emchat-uin-alias (emchat-stringular-uin (emchat-get-arg :uin))))
1033 (num (emchat-get-arg :missed-messages))
1034 (reason (emchat-get-arg :reason)))
1035 (emchat-do-message-helper
1037 (format "Server dropped the last %d message%sfrom: %s
1039 num (if (> num 1) "s " " ") alias reason) 'missed)
1040 (run-hook-with-args 'emchat-missed-message-hook alias num reason)))
1042 (defun emchat-do-offline-message (ectx &rest ih-arguments)
1043 "Handle incoming offline message."
1044 (let* ((time-stamp (emchat-get-arg :time-stamp))
1045 (year (nth 0 time-stamp))
1046 (month (nth 1 time-stamp))
1047 (day (nth 2 time-stamp))
1048 (hour (1- (nth 3 time-stamp)))
1049 (min (nth 4 time-stamp))
1050 (monthname (aref emchat-monthnames month))
1053 (format "%s %s %s:%s %s"
1054 monthname day hour min year)
1056 (local-year (aref local-time 0))
1057 (local-monthname (aref emchat-monthnames
1058 (aref local-time 1)))
1059 (local-day (aref local-time 2))
1060 (local-hour (aref local-time 3))
1061 (local-min (aref local-time 4)))
1063 (emchat-do-message-helper
1064 (emchat-get-arg :uin)
1065 (format "(%s %02s) %02s:%02s\n%s"
1066 local-monthname local-day local-hour local-min
1067 (emchat-get-arg :msg))
1068 (emchat-get-arg :msg-type))))
1070 (defun emchat-do-added-you (ectx &rest ih-arguments)
1071 "Handle incoming SVR_ADDEDYOU packets."
1072 (let ((file emchat-recently-added-by-filename)
1073 (uin (emchat-stringular-uin (emchat-get-arg :uin)))
1074 (msg (emchat-get-arg :msg))
1075 (type (emchat-get-arg :msg-type)))
1076 (emchat-do-message-helper uin msg type)
1077 (when (or (not (member uin emchat-all-uin))
1078 emchat-world-track-all-adds)
1079 (with-current-buffer (find-file-noselect file)
1080 (unless (search-forward uin nil t)
1081 (goto-char (point-max))
1085 (add-to-list 'emchat-world-recently-added-by
1086 (emchat-numeric-uin uin) 'append))))
1088 (defun emchat-do-auth-request (ectx &rest ih-arguments)
1089 "Handle incoming SRV_AUTHREQ."
1090 (emchat-do-message-helper
1091 (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type)))
1093 (defun emchat-do-auth-accept (ectx &rest ih-arguments)
1094 "Handle incoming SRV_AUTHREPLY (accepted)."
1095 (emchat-do-message-helper
1096 (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type)))
1098 (defun emchat-do-auth-reject (ectx &rest ih-arguments)
1099 "Handle incoming SRV_AUTHREPLY (rejected)."
1100 (emchat-do-message-helper
1101 (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type)))
1103 (defun emchat-do-srv-contact-err (ectx &rest ih-arguments)
1104 "Handle incoming SRV_CONTACTERR."
1105 (emchat-log-error "Contacts Error: %s" (emchat-get-arg :reason)))
1107 (defun emchat-do-srv-general-err (ectx &rest ih-arguments)
1108 "Handle incoming SRV_GEN_ERR."
1109 (emchat-log-error "Server Error: %s" (emchat-get-arg :reason)))
1111 (defvar emchat-auto-reply-p nil
1112 "If non-nil EMchat will not automatically set your state to online.
1114 It is used in `emchat-do-message-helper' and `emchat-send-message-helper'.")
1116 (defvar emchat-user-auto-away-p nil
1117 "This variable is set when the auto-away timer expires,
1118 and it is reset in emchat-send-message-helper and emchat-change-status.")
1120 (eval-when-compile (load "sound"))
1122 (when (featurep 'sxemacs)
1123 (defvar emchat-audio-device default-audio-device
1124 "The audio device to play sounds on.")
1125 (defvar emchat-media-driver nil
1126 "Optional driver to use with `emchat-load-media-streams'.
1127 See `make-media-stream' for what can be used here."))
1129 (defun emchat-load-media-streams (&optional force)
1130 "Loads configured sounds into SXEmacs media streams.
1132 With optional prefix arg, FORCE, make the streams even if they already
1133 exist. This is useful when you want to replace existing sounds."
1135 (emchat-do-in-sxemacs
1136 (let ((sound-lst emchat-sound-alist)
1140 (when (stringp (cdr el))
1141 (let* ((file (expand-file-name (cdr el) emchat-sound-directory))
1142 (streamsym (intern (concat stub (symbol-name (car el)))))
1143 (stream (ignore-errors (symbol-value streamsym))))
1144 (when (and (file-readable-p file)
1146 (not (media-stream-p stream))))
1147 (set streamsym (make-media-stream :file file emchat-media-driver))))))
1150 (defun emchat-play-sound-maybe (type)
1151 "Play sound TYPE if it exists."
1152 (when emchat-use-sound-flag
1153 (emchat-do-in-xemacs
1154 (when (cdr (assq type emchat-sound-alist))
1155 (let ((file (expand-file-name (cdr (assq type emchat-sound-alist))
1156 emchat-sound-directory)))
1157 (play-sound-file file))))
1158 (emchat-do-in-sxemacs
1159 (when (media-stream-p
1161 (symbol-value (intern-soft (concat "emchat::" (symbol-name type))))))
1162 (let ((stream (symbol-value (intern-soft
1163 (concat "emchat::" (symbol-name type))))))
1164 (play-media-stream stream emchat-audio-device))))))
1166 (defvar emchat-online-notifiers nil
1167 "A list of aliases who have requested online notification.")
1169 (defun emchat-do-message-helper (uin message &optional msg-type)
1170 "Helper for handling offline and online messages.
1171 UIN is uin of message sender.
1172 MSG-TYPE is type of message. Possible type: `emchat-v8-message-types'.
1173 MESSAGE is message body of any type."
1174 (let ((alias (emchat-uin-alias (emchat-stringular-uin uin)))
1176 (add-to-list 'emchat-active-aliases alias)
1179 (if (and emchat-doctor-enabled-flag
1180 (member alias emchat-doctor-patients))
1181 (emchat-doctor message alias)
1182 (when (and emchat-doctor-enabled-flag
1183 (equal message emchat-doctor-begin-string))
1184 (add-to-list 'emchat-doctor-patients alias)
1185 (emchat-doctor-reply emchat-doctor-hello-string alias)))
1189 ((string-match ",,notify-me\\(\\s-\\|$\\)" message)
1190 (add-to-list 'emchat-online-notifiers alias)
1191 (emchat-v8-send-simple-message
1192 emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
1193 "Online notification request set.
1194 Send \",,cancel-notify\" to cancel.")
1195 (emchat-log-system (format "Online notify requested by: %s" alias))
1196 (emchat-play-sound-maybe 'system-sound))
1197 ((string-match ",,cancel-notify\\(\\s-\\|$\\)" message)
1198 (setq emchat-online-notifiers (remove alias emchat-online-notifiers))
1199 (emchat-v8-send-simple-message
1200 emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
1201 "Online notification request cancelled.")
1202 (emchat-log-system (format "Online notify cancellation: %s" alias))
1203 (emchat-play-sound-maybe 'system-sound)))
1206 (when (and emchat-auto-response-messages-p
1207 (member emchat-user-status
1208 '("away" "na" "dnd" "occ")))
1209 (if emchat-user-auto-away-p
1211 (setq emchat-auto-reply-p t)
1212 (emchat-idle-reply-maybe alias))
1213 (emchat-auto-reply-maybe alias)))
1215 (run-hooks 'emchat-new-message-hook)
1219 (emchat-log-buddy-message
1220 alias "%s" (emchat-decode-string message))
1221 (emchat-play-sound-maybe 'message-sound))
1223 (emchat-log-buddy-message
1224 alias "Request chat")
1225 (emchat-play-sound-maybe 'chat-sound))
1227 (multiple-value-bind (message url)
1228 (values-list (split-string message "\xfe"))
1229 (emchat-log-buddy-url
1230 alias (emchat-decode-string message) (emchat-decode-string url))
1231 (emchat-play-sound-maybe 'url-sound)))
1232 ;; Athorization messages
1234 (emchat-log-buddy-message
1235 alias "Authorisation Accepted!")
1236 (emchat-play-sound-maybe 'auth-sound))
1238 (emchat-log-buddy-message
1239 alias "Authorisation Rejected!\nReason: %s"
1240 (substring (emchat-decode-string message) 0 -1))
1241 (emchat-play-sound-maybe 'auth-sound))
1243 (emchat-log-buddy-message
1244 alias "Authorisation Request\nReason: %s"
1245 (emchat-decode-string message))
1246 (emchat-play-sound-maybe 'auth-sound))
1249 (emchat-log-buddy-message
1250 alias "Web Pager = %s"
1251 (emchat-decode-string
1252 (replace-in-string message "[\xfe]+" "\n")))
1253 (emchat-play-sound-maybe 'pager-sound))
1255 (emchat-log-buddy-message
1256 alias "Email Pager = %s"
1257 (emchat-decode-string
1258 (replace-in-string message "[\xfe]+" "\n")))
1259 (emchat-play-sound-maybe 'pager-sound))
1261 (emchat-log-buddy-message
1262 alias "Email express = %s"
1263 (emchat-decode-string
1264 (replace-in-string message "[\xfe]+" "\n")))
1265 (emchat-play-sound-maybe 'emailx-sound))
1267 (emchat-log-system (format "%s %s" alias message))
1268 (emchat-play-sound-maybe 'system-sound))
1270 (emchat-log-buddy-message
1271 alias "Contact list = %s"
1272 (emchat-decode-string
1273 (replace-in-string message "\xfe" "\n"))))
1275 (let ((visible (or (member alias emchat-visible-contacts)
1276 (not (member alias emchat-invisible-contacts)))))
1277 (emchat-log-system (format "%s requested our away msg (%s)"
1279 (if visible "sent" "not sent")))
1281 (emchat-send-message-helper
1282 emchat-auto-reply-away
1283 (list alias) 'automatic "away msg sent"))))
1285 (let ((visible (or (member alias emchat-visible-contacts)
1286 (not (member alias emchat-invisible-contacts)))))
1287 (emchat-log-system (format "%s requested our occupied msg (%s)"
1289 (if visible "sent" "not sent")))
1291 (emchat-send-message-helper
1292 emchat-auto-reply-occ
1293 (list alias) 'automatic "occ msg sent"))))
1295 (let ((visible (or (member alias emchat-visible-contacts)
1296 (not (member alias emchat-invisible-contacts)))))
1297 (emchat-log-system (format "%s requested our not available msg (%s)"
1299 (if visible "sent" "not sent")))
1301 (emchat-send-message-helper
1302 emchat-auto-reply-na
1303 (list alias) 'automatic "na msg sent"))))
1305 (let ((visible (or (member alias emchat-visible-contacts)
1306 (not (member alias emchat-invisible-contacts)))))
1307 (emchat-log-system (format "%s requested our dnd msg (%s)"
1309 (if visible "sent" "not sent")))
1311 (emchat-send-message-helper
1312 emchat-auto-reply-dnd
1313 (list alias) 'automatic "dnd msg sent"))))
1315 ;; TODO: send our free-for-chat message
1319 (emchat-log-system (format "%s" message))
1320 (emchat-play-sound-maybe 'system-sound))
1322 (emchat-log-buddy-message
1323 alias "-=[Automatic Response]=-\n%s"
1324 (emchat-decode-string message))
1325 (emchat-play-sound-maybe 'system-sound))
1326 (otherwise (push (cons 'unknown-message-types
1327 emchat-recent-packet)
1328 emchat-error-packets)
1329 (emchat-log-error "Unknown message type: %S" msg-type)))))
1331 (defvar emchat-auto-reply-never emchat-auto-response-never-send-to
1332 "List of people to never send auto-responses to.")
1334 (defun emchat-auto-reply (alias)
1335 "Auto-reply to ALIAS/uin depending on `emchat-user-status'.
1336 Called by `emchat-do-message-helper'."
1337 (let ((message (symbol-value (emchat-status-auto-reply emchat-user-status))))
1339 (add-to-list 'emchat-active-aliases alias)
1340 (emchat-send-message-helper
1341 message (list alias) 'automatic "Auto reply sent"))))
1343 (defun emchat-auto-reply-maybe (alias)
1344 "Possibly send an auto-response to ALIAS."
1345 (unless (or (member alias emchat-auto-reply-never)
1346 (member alias emchat-auto-response-never-send-to)
1347 (member alias emchat-invisible-contacts)
1348 (not (member alias emchat-visible-contacts)))
1349 (emchat-auto-reply alias)
1350 (add-to-list 'emchat-auto-reply-never alias)))
1352 (defun emchat-idle-reply (alias)
1353 "Auto-reply to ALIAS/uin depending on `emchat-user-status'.
1354 Called by `emchat-do-message-helper'."
1355 (let ((message (symbol-value (emchat-status-idle-reply emchat-user-status))))
1357 (add-to-list 'emchat-active-aliases alias)
1358 (emchat-send-message-helper
1359 message (list alias) 'automatic "Idle reply sent"))))
1361 (defun emchat-idle-reply-maybe (alias)
1362 "Possibly send an auto-response to ALIAS."
1363 (unless (or (member alias emchat-auto-reply-never)
1364 (member alias emchat-auto-response-never-send-to)
1365 (member alias emchat-invisible-contacts)
1366 (not (member alias emchat-visible-contacts)))
1367 (emchat-idle-reply alias)
1368 (add-to-list 'emchat-auto-reply-never alias))
1369 (setq emchat-auto-reply-p nil))
1371 ;;; FIXME: this isn't used, but having IP and port info in emchat-world
1372 ;;; would be nice to have again.
1373 ; (defun emchat-do-online (packet)
1374 ; "Handle server command 006e in PACKET."
1375 ; (let ((alias (emchat-bin-alias packet 21))
1376 ; (status (emchat-status-name (substring packet 38 39)))
1377 ; (ip (emchat-bin-ip packet 25))
1378 ; (port (emchat-bin-uin packet 29))
1379 ; (real-ip (emchat-bin-ip packet 33)))
1380 ; (if (emchat-valid-uin-p alias)
1381 ; (push (cons 'unknown-alias emchat-recent-packet)
1382 ; emchat-error-packets))
1383 ; (emchat-buddy-update-status alias status)
1384 ; (emchat-play-sound-maybe 'buddy-sound)
1385 ; (emchat-world-putf alias 'ip ip)
1386 ; (emchat-world-putf alias 'port port)
1387 ; (emchat-world-putf alias 'real-ip real-ip)))
1389 (defun emchat-do-login-confirm (ectx)
1390 "Called when emchat successfully connected to icq server."
1391 (emchat-log-debug "Successfully logged in to ICQ server")
1392 (emchat-log-system "Connected to %s:%d"
1393 (emchat-v8-ctx-host ectx)
1394 (emchat-v8-ctx-port ectx))
1395 (emchat-change-status emchat-user-initial-status 'no-network)
1396 (emchat-keep-alive-start)
1397 (emchat-check-contact-list)
1398 (emchat-activate-contact-list)
1399 (message "Welcome to EMchat...")
1400 (if emchat-is-auto-reconnecting
1401 (setq emchat-is-auto-reconnecting nil)
1402 (emchat-show-window)))
1404 ;;; FIXME: What to do with this in v8?
1405 ; (defun emchat-do-system-message (packet) ; TODO
1406 ; "Handle server command 01c2 in PACKET."
1407 ; (run-hooks 'emchat-system-message-hook))
1409 (defun emchat-format-field (field field-var &optional format)
1411 FORMAT specifies format to use for FIELD (default is \"%15s: %s\").
1413 Note: USE THIS FUNCTION VERY CAREFULY."
1414 (let ((fi-name (cdr (assq field field-var)))
1415 (fi-val (emchat-get-arg field)))
1416 ;; NOTE: Do not format empty strings
1417 (cond ((null fi-val) nil)
1419 (unless (string= fi-val "")
1420 (format (or format "%15s: %s\n") fi-name fi-val)))
1421 (t (format (or format "%15s: %S\n") fi-name fi-val)))))
1423 (defun emchat-add-user-ssi (uin nick ssi-grp id)
1424 "Send a request to add UIN to your server side contact list.
1426 NICK is the name that will appear in the buddy buffer. It defaults to
1427 whatever UIN has set their nick name to. It can be overridden, in
1428 fact, you'll be asked if you want to keep the default or choose another
1431 Argument, SSI-GRP is the server side group ID this contact
1432 should be added to. EMchat has its own notion of contact groups so
1433 SSI-GRP will rarely, if ever, be need to be set by hand. A value for
1434 it is obtained from existing group IDs in world.
1436 Argument, ID, is the server side contact ID for this contact. It is
1437 simply the highest ID from world incremented by 1.
1439 This might change in the future when EMchat has better SSI handling."
1440 (let* ((uin (emchat-stringular-uin uin)))
1442 (emchat-v8-snac-cli-ssi-edit-begin emchat-ctx)
1443 (emchat-v8-snac-cli-ssi-add emchat-ctx uin ssi-grp id nick)
1444 (emchat-v8-snac-cli-ssi-edit-end emchat-ctx))))
1446 (defun emchat-do-about-general (ectx &rest ih-arguments)
1447 "Handle incoming general about info."
1448 (let* ((uin (emchat-get-arg :uin))
1449 (alias (emchat-uin-alias (emchat-stringular-uin uin)))
1450 (nick (emchat-get-arg :nick)))
1451 ;; Dynamically add a new user to your contact list.
1452 (if (and (not (member (emchat-stringular-uin uin) emchat-all-uin))
1454 (let ((ssi-grp (emchat-world-ssi-grp))
1455 (id (emchat-world-next-ssi-id)))
1456 (setq nick (if (y-or-n-p
1457 (format "Default nick is set to: \"%s\", accept: "
1460 (read-string "New nick name: " nil nil alias)))
1461 ;; ensure we have a valid nick name
1462 (loop until (string-match "^[^:]" nick)
1464 (read-string "Invalid Alias (can't begin with \":\"): "
1466 ;; load up a hash table to carry new user info over to world
1467 (setq emchat-world-new-user-hash (make-hash-table :test #'equal :size 6))
1468 (puthash :uin uin emchat-world-new-user-hash)
1469 (puthash :nick nick emchat-world-new-user-hash)
1470 (puthash :ssi-grp ssi-grp emchat-world-new-user-hash)
1471 (puthash :id id emchat-world-new-user-hash)
1474 "Add user to group[s] (fmt: :group1 :group2 or RET for none): ")
1475 emchat-world-new-user-hash)
1476 (emchat-add-user-ssi uin nick ssi-grp id))
1477 ;; Not adding new user, output about info
1479 (emchat-decode-string
1481 "GENERAL about result =\n"
1482 (format "%15s: %d\n" "UIN" uin)
1483 (format "%15s: %s\n" "Local alias" alias)
1485 (mapcar #'(lambda (field)
1486 (emchat-format-field (car field) emchat-about-fields))
1487 emchat-about-fields))
1490 (defun emchat-do-about-more (ectx &rest ih-arguments)
1491 "Handle incoming more about info."
1492 (let* ((uin (emchat-get-arg :uin))
1493 (alias (emchat-uin-alias (emchat-stringular-uin uin))))
1495 (emchat-decode-string
1497 "MORE about result =\n"
1498 (format "%15s: %d\n" "UIN" uin)
1499 (format "%15s: %s\n" "Local alias" alias)
1501 (mapcar #'(lambda (field)
1502 (emchat-format-field (car field) emchat-about-more-fields))
1503 emchat-about-more-fields))
1506 (defun emchat-do-about-about (ectx &rest ih-arguments)
1507 "Handle incoming user notes info."
1508 (let* ((uin (emchat-get-arg :uin))
1509 (alias (emchat-uin-alias (emchat-stringular-uin uin))))
1511 (emchat-decode-string
1513 "ABOUT about result =\n"
1514 (format "%15s: %d\n" "UIN" uin)
1515 (format "%15s: %s\n" "Local alias" alias)
1516 (emchat-get-arg :about) "\n"
1519 (defun emchat-do-search-found (ecxt &rest ih-arguments)
1520 "A user we were looking for is found."
1521 (apply 'emchat-do-about-general ecxt ih-arguments))
1523 (defun emchat-do-search-found-last (ecxt &rest ih-arguments)
1524 "The last user in the search has been found."
1525 (apply 'emchat-do-about-general ecxt ih-arguments)
1527 (let ((status (if (= (emchat-get-arg :status) 1) 'online 'offline)))
1528 (if (zerop (emchat-get-arg :missed))
1529 (if emchat-add-user-p
1530 (puthash :status status emchat-world-new-user-hash)
1531 (emchat-log-info "All search results returned"))
1532 (emchat-log-info "Too many seach results"))))
1534 ;;; FIXME: This needs to be updated for v8
1535 ; (defun emchat-do-update-info-confirm (packet)
1536 ; "Handle server command 01e0 in PACKET."
1537 ; (emchat-log-info "Update info succeeded"))
1539 ;;; FIXME: This needs to be updated for v8
1540 ; (defun emchat-do-update-info-fail (packet)
1541 ; "Handle server command 01ea in PACKET."
1542 ; (emchat-log-info "Update info failed"))
1544 ;;; FIXME: This needs to be updated for v8
1545 ; (defun emchat-do-update-authorization-confirm (packet)
1546 ; "Handle server command 01f4 in PACKET."
1547 ; (emchat-log-info "Update authorization succeeded"))
1549 ;;; FIXME: This needs to be updated for v8
1550 ; (defun emchat-do-update-authorization-fail (packet)
1551 ; "Handle server command 01fe in PACKET."
1552 ; (emchat-log-info "Update authorization failed"))
1554 ;;; FIXME: This needs to be updated for v8
1555 ; (defun emchat-do-update-info-ext-confirm (packet)
1556 ; "Handle server command 01c8 in PACKET."
1557 ; (emchat-log-info "Update extended info succeeded"))
1559 ;;; FIXME: This needs to be updated for v8
1560 ; (defun emchat-do-new-account-uin (packet)
1561 ; "Handle server command 0046 in PACKET."
1564 ; (emchat-bin-uin packet 13)))
1566 ;;; FIXME: This needs to be updated for v8
1567 ; (defun emchat-do-search-random-user-found (packet)
1568 ; "Handle server command 0258 in PACKET."
1569 ; (if (< (length packet) 30)
1570 ; (emchat-log-info "Random user search failed")
1571 ; (emchat-query-info (emchat-bin-uin packet 21))))
1573 ;;; Code - alias and uin:
1575 (defvar emchat-alias-history nil
1576 "History of aliases in `emchat-completing-aliases'.")
1578 (defvar emchat-alias-list-history nil
1579 "History of aliases in `emchat-send-message-helper'.
1580 For sending messages of any kind to a single alias, it records the same
1581 thing as `emchat-alias-history' does, while sending to multiple aliases, this
1582 records a list of aliases instead of one by one. This faciliates
1583 re-sending to a list of aliases in future version.")
1585 (defvar emchat-connected-aliases nil
1586 "Aliases that are in any statuses except 'invisible'.")
1588 (defvar emchat-active-aliases nil
1589 "Aliases which we have exchanged messages with.")
1591 (defun emchat-process-alias-input (symbol)
1592 "Input alias as selected or from completing.
1593 SYMBOL is the symbol of variable (`alias') to be processed.
1595 Non-nil SYMBOL means no processing.
1596 Negative argument (press \\[negative-argument] before this command) means
1597 taking all selected alias in buddy buffer as input.
1598 Prefix argument (press \\[universal-argument] before this command) means
1599 completing-read multi aliases from minibuffer.
1600 Otherwise, completing-read one alias from minibuffer.
1602 See `emchat-completing-aliases'."
1603 (or (symbol-value symbol)
1605 (if (eq '- current-prefix-arg)
1606 (emchat-buddy-selected-in-view)
1607 (emchat-completing-aliases "to: " (not current-prefix-arg))))))
1609 ;;; Code - system main:
1611 (defvar emchat-blurb
1612 "As succinctly as possible, tell us:-\n
1614 \tWhat you thought should happen.
1615 \tAnything else that you think is relevant.\n
1616 *** Please delete these instructions before submitting the report. ***
1617 ======================================================================\n"
1618 "Preamble to the bug report.")
1621 (defun emchat-login ()
1622 "Login to ICQ server.
1623 Make connection to server and network if necessary."
1626 (emchat-world-update)
1627 (emchat-numeric-uin (emchat-alias-uin emchat-user-alias))))
1628 (password (or emchat-user-password
1629 (read-passwd (format "Password for %s (%d): "
1630 emchat-user-alias uin)))))
1632 (when (equal emchat-user-status "offline")
1633 (or (emchat-valid-uin-p uin)
1634 (error "Invalid user uin"))
1636 (setq emchat-trimmed-packet nil) ; hack
1637 (setq emchat-current-seq-num 0)
1638 (emchat-log-show-buffer nil 'no-select)
1640 ;; Create emchat v8 context
1641 (setq emchat-ctx (emchat-v8-create-ctx uin password
1643 'initial-status (append (and emchat-user-meta-web-aware '(web-aware))
1644 (and emchat-user-meta-invisible '(invisible))
1645 (list (emchat-status-v8
1646 emchat-user-initial-status)))))
1647 ;; Install incoming handlers
1648 (setf (emchat-v8-ctx-incoming-handlers emchat-ctx)
1649 (list 'instant-message 'emchat-do-instant-message
1650 'missed-message 'emchat-do-missed-message
1651 'offline-message 'emchat-do-offline-message
1652 'connected 'emchat-do-login-confirm
1653 'status-update 'emchat-do-status-update
1654 'about-general 'emchat-do-about-general
1655 'about-more 'emchat-do-about-more
1656 'about-about 'emchat-do-about-about
1657 'logoff 'emchat-do-forced-logoff
1658 'disconnect 'emchat-do-disconnect
1659 'search-found 'emchat-do-search-found
1660 'search-found-last 'emchat-do-search-found-last
1661 'added-you 'emchat-do-added-you
1662 'auth-request 'emchat-do-auth-request
1663 'auth-accept 'emchat-do-auth-accept
1664 'auth-reject 'emchat-do-auth-reject
1665 'srv-contacterr 'emchat-do-srv-contact-err
1666 'srv-error 'emchat-do-srv-general-err
1667 'new-user 'emchat-world-add-new-user
1669 ;; Load SXEmacs media streams
1670 (when (and emchat-use-sound-flag
1671 (featurep 'sxemacs))
1672 (emchat-load-media-streams))
1673 (emchat-v8-connect emchat-ctx emchat-server emchat-port))))
1675 (autoload 'emchat-wharf-change-messages "emchat-wharf")
1677 (defun emchat-logout ()
1679 Remain connected to network and server.
1680 Don't send logout packet if KILL is non-nil,
1681 useful for emergency logout when being kicked out by server."
1684 (emchat-log-debug "Logging out ICQ server.")
1685 (setq emchat-connected-aliases nil)
1686 (emchat-buddy-show-buffer 'new 'no-select)
1687 (emchat-change-status "offline" 'no-network)
1688 (emchat-keep-alive-stop)
1689 (if (and (featurep 'emchat-wharf)
1690 (frame-live-p emchat-wharf-frame))
1692 (emchat-wharf-change-messages "New" -9999)
1693 (emchat-wharf-change-messages "Sys" -9999)))
1694 (when emchat-history-enabled-flag
1697 (let* ((histf (emchat-world-getf alias 'history))
1698 (histb (and histf (find-buffer-visiting histf))))
1700 (with-current-buffer histb
1702 (kill-buffer nil)))))
1703 emchat-all-aliases))
1704 (when (emchat-connected-p emchat-ctx)
1705 (emchat-v8-close emchat-ctx)))
1707 (defvar emchat-contact-list-packets nil
1708 "Lists of remaining contact list packets to be sent.
1709 For experimental purpose only.")
1711 ;; Now broken because local contact lists are no longer
1712 ;; supported. `emchat-activate-contact-list' replaces this.
1713 ;;(defun emchat-send-contact-list ()
1714 ;; "Send the whole contact list.
1715 ;;You can resend contact list after `emchat-world-update'."
1718 ;; (setq emchat-connected-aliases nil)
1719 ;; (emchat-buddy-show-buffer 'new 'no-select)
1721 ;; (emchat-world-update)
1723 ;; (when emchat-visible-contacts
1724 ;; (emchat-v8-ctx-put-prop emchat-ctx 'visible-list
1727 ;; (emchat-numeric-uin (emchat-alias-uin v)))
1728 ;; emchat-visible-contacts))
1729 ;; (emchat-v8-snac-cli-addvisible emchat-ctx))
1731 ;; (when emchat-invisible-contacts
1732 ;; (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list
1735 ;; (emchat-numeric-uin (emchat-alias-uin i)))
1736 ;; emchat-invisible-contacts))
1737 ;; (emchat-v8-snac-cli-addinvisible emchat-ctx))
1739 ;; (emchat-v8-ctx-put-prop emchat-ctx 'contacts
1740 ;; (mapcar 'emchat-numeric-uin (mapcar 'cadr emchat-world)))
1741 ;; (emchat-v8-snac-cli-add-contact emchat-ctx))
1743 (defun emchat-check-contact-list ()
1744 "Checks to ensure local copy of SSI list is up to date."
1746 (emchat-v8-snac-cli-ssi-checkout emchat-ctx))
1748 (defun emchat-activate-contact-list ()
1749 "Activate the server-side contact list."
1751 (setq emchat-connected-aliases nil)
1752 (emchat-buddy-show-buffer 'new 'no-select)
1753 (emchat-world-update)
1755 (when emchat-visible-contacts
1756 (emchat-v8-ctx-put-prop emchat-ctx 'visible-list
1759 (emchat-numeric-uin (emchat-alias-uin v)))
1760 emchat-visible-contacts))
1761 ; (emchat-v8-snac-cli-addvisible emchat-ctx)
1764 (when emchat-invisible-contacts
1765 (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list
1768 (emchat-numeric-uin (emchat-alias-uin i)))
1769 emchat-invisible-contacts))
1770 ; (emchat-v8-snac-cli-addinvisible emchat-ctx)
1773 (emchat-v8-ctx-put-prop emchat-ctx 'contacts
1774 (mapcar 'emchat-numeric-uin (mapcar 'cadr emchat-world)))
1775 (emchat-v8-snac-cli-ssi-activate emchat-ctx))
1777 (defun emchat-keep-alive-start ()
1778 "Start keeping alive."
1779 (emchat-keep-alive-stop)
1783 (emchat-v8-snac-cli-keepalive emchat-ctx))
1784 ;; sending faster won't hurt
1787 (defun emchat-keep-alive-stop ()
1788 "Stop keeping alive."
1789 (let ((itimer (get-itimer "emchat keep-alive")))
1790 (when (itimerp itimer)
1791 (delete-itimer itimer))))
1793 (defun emchat-add-user (uin)
1794 (interactive "sUIN: ")
1795 (setq emchat-add-user-p t)
1796 (emchat-search-by-uin uin))
1798 (defun emchat-change-user (alias password)
1799 "Change user to ALIAS with PASSWORD.
1800 Need to relogin afterwards."
1802 (append (emchat-completing-aliases "Change to: " 'single)
1803 (list (read-passwd "Password: "))))
1804 (setq emchat-user-alias alias)
1805 (setq emchat-user-password
1806 (if (zerop (length password))
1810 (defun emchat-auto-away-timeout-set (symbol value)
1811 "Set timer for auto-away. See `emchat-auto-away-timeout'."
1812 ;; delete the previous itimers
1813 (when (itimerp (get-itimer "emchat auto-away"))
1814 (delete-itimer (get-itimer "emchat auto-away")))
1815 (when (itimerp (get-itimer "emchat auto-na"))
1816 (delete-itimer (get-itimer "emchat auto-na")))
1817 (unless (zerop value)
1818 (start-itimer "emchat auto-away"
1820 ;; auto away for first idle
1821 (when (member emchat-user-status '("online" "ffc"))
1822 (emchat-log-system "Auto away.")
1823 (emchat-change-status "away")
1824 (setq emchat-user-auto-away-p t)))
1826 (start-itimer "emchat auto-na"
1828 ;; auto na for second idle
1829 (when (and emchat-user-auto-away-p
1830 (equal emchat-user-status "away"))
1831 (emchat-log-system "Auto na.")
1832 (emchat-change-status "na")
1833 ;; emchat-change-status resets this flag
1834 (setq emchat-user-auto-away-p t)))
1835 (* 2 value) (* 2 value)))
1836 (set (intern (symbol-name symbol)) value))
1838 (defcustom emchat-auto-away-timeout 300
1839 "*Seconds of inactivity in Emacs before auto-away.
1841 After two times the seconds of auto-away, it goes auto-na.
1842 See `emchat-auto-away'.
1844 Setting this to zero disables the timeout.
1846 If you set this outside of the custom buffer you _MUST_ use
1847 `customize-set-variable' and _NOT_ `setq'."
1849 :set 'emchat-auto-away-timeout-set
1850 :initialize 'custom-initialize-default
1851 :group 'emchat-option)
1853 (defun emchat-change-idle-timeout (seconds)
1854 "Change the number of SECONDS before EMchat will idle to \"away\".
1856 If SECONDS is 0 \(zero\) the timeout will be disabled and EMchat will
1857 not automatically idle to \"away\" or \"na\".
1859 Setting the timeout here does not save the value across emacs sessions.
1860 To do that, customise the variable, `emchat-auto-away-timeout'."
1862 (list (read-number "Idle timeout in seconds (0 to disable): "
1863 nil (number-to-string emchat-auto-away-timeout))))
1864 (emchat-auto-away-timeout-set 'emchat-auto-away-timeout seconds)
1866 (emchat-log-system "Auto-away disabled.")
1867 (emchat-log-system "Auto-away timeout set to: %d seconds." seconds)))
1869 (defun emchat-send-message-helper (message aliases type log-message)
1870 "Send message, url, authorization or others.
1871 MESSAGE is the message to send.
1872 ALIASES is a list of aliases/uin to send to.
1873 TYPE is the type of message in `emchat-v8-message-types'.
1874 LOG-MESSAGE is a message to put in log.
1876 See `emchat-send-message', `emchat-send-url' and `emchat-authorize'."
1877 (when (and emchat-user-auto-away-p
1878 (not emchat-auto-reply-p))
1879 (emchat-change-status "online"))
1880 (add-to-list 'emchat-alias-list-history aliases)
1881 (loop for alias in aliases
1882 do (add-to-list 'emchat-active-aliases alias)
1883 do (if (eq type 'normal)
1884 (emchat-v8-send-simple-message
1885 emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) message)
1886 (emchat-v8-send-typed-message
1887 emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) type message))
1888 do (emchat-log-outgoing alias ">>> %s" log-message))
1889 (setq emchat-auto-reply-p nil))
1891 (defvar emchat-message-history nil
1892 "History of `emchat-send-message' for `completing-read'.")
1894 (defun emchat-send-message (&optional message &rest aliases)
1895 "Send an instant message.
1896 MESSAGE is the message to send.
1897 ALIASES is a list of aliases/uin to send to.
1899 See `emchat-process-alias-input'."
1903 ;; display alias if given
1906 (substring (format "%s" aliases) 1 -1)))
1908 (or (stringp message)
1910 (read-from-minibuffer prompt
1911 nil nil nil 'emchat-message-history)))
1913 ;; idea from Erik Arneson <erik@starseed.com>
1914 ;; confirm sending a blank message
1915 (unless (and (or (zerop (length message))
1916 ;; \\W fails with "=)" or "..."
1917 (string-match "^[ \t]+$" message))
1918 (not (y-or-n-p "Send a blank message? ")))
1919 (emchat-process-alias-input 'aliases)
1921 ;; apply encode only TEXT portion of packet
1922 (let ((msg (emchat-splitter message)))
1924 do (emchat-send-message-helper
1925 ;; encoding outgoing but not that to be insert in log buffer
1926 (emchat-encode-string x) aliases 'normal x)
1927 do (when (and (> (length msg) 1)
1928 (not (string= x (car (last msg)))))
1931 (defun emchat-send-message-via-mouse (event)
1932 ;; Erik Arneson <erik@starseed.com> (from VM)
1933 "`emchat-send-message' via mouse."
1935 (set-buffer (window-buffer (event-window event)))
1936 (and (event-point event) (goto-char (event-point event)))
1937 (if (eq (current-buffer) emchat-buddy-buffer)
1938 (emchat-send-message-alias-here)
1940 ;; any alias in log-mode format (enclosed by []) can use this
1941 (emchat-send-message-alias-around)))
1943 (defvar emchat-url-history nil
1944 "History of `emchat-send-url' for `completing-read'.")
1946 (defun emchat-send-url (&optional url description &rest aliases)
1948 URL is any Internet address.
1949 DESCRIPTION is the description of url.
1950 ALIASES is a list of aliases/uin to send to.
1952 See `emchat-process-alias-input'."
1956 ;; display alias if given
1959 (substring (format "%s" aliases) 1 -1)))
1963 (read-from-minibuffer
1964 prompt nil nil nil 'emchat-url-history)))
1966 ;; idea from Erik Arneson <erik@starseed.com>
1967 ;; confirm sending a blank url
1968 (unless (and (or (zerop (length url))
1969 ;; \\W fails with "=)" or "..."
1970 (string-match "^[ \t]+$" url))
1971 (not (y-or-n-p "Send a blank url? ")))
1974 (read-from-minibuffer
1975 "description: " nil nil nil 'emchat-message-history)))
1976 (emchat-process-alias-input 'aliases)
1978 (emchat-send-message-helper
1980 ;; encode only to TEXT portions of packet, instead of the whole
1981 (emchat-encode-string description)
1982 (emchat-encode-string url))
1983 aliases 'url (format "%s (%s)" url description)))))
1985 (defun emchat-authorize (alias)
1986 "Send authorization to allow adding to contact list.
1987 ALIAS is an alias/uin."
1989 (list (car (emchat-completing-aliases "Authorisation for: " 'single))))
1991 (if (y-or-n-p "Accept the authorisation request? ")
1994 (emchat-log-buddy-message alias ">>> %s" emchat-auth-accept-reason))
1996 (emchat-log-buddy-message alias ">>> %s" emchat-auth-reject-reason))
1997 (emchat-v8-snac-cli-ssi-auth-reply
1998 emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
2001 emchat-auth-reject-reason
2002 emchat-auth-accept-reason))))
2004 (defun emchat-auth-request (alias)
2005 "Request authorisation from ALIAS."
2007 (list (car (emchat-completing-aliases
2008 "Request Authorisation from: " 'single))))
2009 (emchat-v8-snac-cli-ssi-send-auth-request
2010 emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
2011 emchat-auth-request-reason)
2012 (emchat-log-info "Authorisation requested from: %s" alias))
2014 (defun emchat-request-away (&optional alias)
2015 "Request away message from ALIAS."
2018 (setq alias (car (emchat-completing-aliases
2019 "Get Away message from: " 'single))))
2020 (emchat-send-message-helper
2021 "" (list alias) 'get-away "Away message requested"))
2023 (defun emchat-request-na (&optional alias)
2024 "Request Not Avaliable message from ALIAS."
2027 (setq alias (car (emchat-completing-aliases
2028 "Get Not Available message from: " 'single))))
2029 (emchat-send-message-helper
2030 "" (list alias) 'get-na "Not Available message requested"))
2032 (defun emchat-request-dnd (&optional alias)
2033 "Request Do Not Disturb message from ALIAS."
2036 (setq alias (car (emchat-completing-aliases
2037 "Get Do Not Disturb message from: " 'single))))
2038 (emchat-send-message-helper
2039 "" (list alias) 'get-dnd "Do Not Disturb message requested"))
2041 (defun emchat-request-occ (&optional alias)
2042 "Request occupied message from ALIAS."
2045 (setq alias (car (emchat-completing-aliases
2046 "Get Occupied message from: " 'single))))
2047 (emchat-send-message-helper
2048 "" (list alias) 'get-occ "Occupied message requested"))
2050 ;;; FIXME: This needs to be updated for v8
2051 ; (defun emchat-register-new-user (password)
2052 ; "Register a new uin with PASSWORD."
2053 ; (interactive (list (read-passwd "Password: " 'confirm)))
2054 ; (emchat-send (emchat-pack-register-new-user password)))
2056 ;;; FIXME: This needs to be updated for v8
2057 ; (defun emchat-change-password (password)
2058 ; "Change PASSWORD."
2059 ; (interactive (list (read-passwd "Password: " 'confirm)))
2060 ; (emchat-send (emchat-pack-meta-user-change-password password)))
2062 (defun emchat-search (&optional online first last nick email)
2063 "Search for ICQ users.
2065 Optional prefix arg, ONLINE when non-nil means to only return search
2066 results for ICQ users that are currently online.
2068 Argument FIRST - first name to search for
2069 Argument LAST - last name to search for
2070 Argument NICK - nick name to search for
2071 Argument EMAIL - email address to search for."
2073 (let ((online (if online
2075 (if current-prefix-arg
2078 (first (if (interactive-p)
2079 (read-string "First Name [RET for null]: ")
2081 (last (if (interactive-p)
2082 (read-string "Last Name [RET for null]: ")
2084 (nick (if (interactive-p)
2085 (read-string "Nick Name [RET for null]: ")
2087 (email (if (interactive-p)
2088 (read-string "Email Address [RET for null]: ")
2090 (when (string= "" (concat first last nick email))
2091 (error 'invalid-argument "You must provide at least one search term"))
2092 (emchat-v8-snac-cli-searchbypersinf
2093 emchat-ctx first last nick email online)))
2095 (defun emchat-search-by-uin (uin)
2096 "Search user by UIN."
2097 (interactive "sUIN: ")
2098 (emchat-v8-snac-cli-searchbyuin
2099 emchat-ctx (emchat-numeric-uin uin)))
2101 (defun emchat-search-by-email (email)
2102 "Search for a user by their EMAIL address."
2103 (interactive "sEmail address: ")
2104 (emchat-v8-snac-cli-searchbyemail emchat-ctx email))
2106 ;;; FIXME: This needs to be updated for v8
2107 ; (defun emchat-search-random-user (group)
2108 ; "Search random user in GROUP."
2110 ; (list (emchat-completing-read
2112 ; (mapcar 'car emchat-random-groups))))
2113 ; (emchat-send (emchat-pack-search-random-user group)))
2115 ;;; FIXME: This needs to be updated for v8
2116 ; (defun emchat-set-random-group (group)
2117 ; "Set random user GROUP."
2119 ; (list (emchat-completing-read
2121 ; (mapcar 'car emchat-random-groups))))
2122 ; (emchat-send (emchat-pack-set-random-group group)))
2124 (defun emchat-query-info (&optional alias)
2125 "Query meta user info.
2126 ALIAS is an alias/uin."
2129 ;; display alias if given
2130 (message "Query %s." alias)
2131 (setq alias (car (emchat-completing-aliases "Query: " 'single))))
2132 (let ((local-info (emchat-world-info alias)))
2134 (emchat-log-info "Local info:\n%s" local-info)))
2136 (emchat-v8-snac-cli-metareqinfo
2137 emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))))
2139 (defun emchat-add-to-visible-list (aliases)
2140 "Add ALIASES, a list of alias names/UINs, to your visible list."
2142 (list (emchat-completing-aliases "Visible to alias/UIN (RET to send): ")))
2145 (emchat-numeric-uin (emchat-alias-uin alias)))
2147 (emchat-v8-snac-cli-addvisible emchat-ctx uins)
2150 (add-to-list 'emchat-visible-contacts alias 'append))
2152 (emchat-log-info "You are now visible to: %s" aliases)
2153 (when (y-or-n-p "Do you want this change saved for future sessions ")
2154 (customize-save-variable 'emchat-visible-contacts
2155 (symbol-value 'emchat-visible-contacts)))))
2157 (defun emchat-add-to-invisible-list (aliases)
2158 "Add ALIASES, a list of alias names/UINs, to your invisible list."
2160 (list (emchat-completing-aliases "Invisible to alias/UIN (RET to send): ")))
2163 (emchat-numeric-uin (emchat-alias-uin alias)))
2165 (emchat-v8-snac-cli-addinvisible emchat-ctx uins)
2168 (add-to-list 'emchat-invisible-contacts alias 'append))
2170 (emchat-log-info "You are now invisible to: %s" aliases)
2171 (when (y-or-n-p "Do you want this change saved for future sessions ")
2172 (customize-save-variable 'emchat-invisible-contacts
2173 (symbol-value 'emchat-invisible-contacts)))))
2175 (defun emchat-remove-from-visible-list (aliases)
2176 "Remove ALIASES, a list of alias names/UINs, from your visible list."
2178 (list (emchat-completing-aliases "Not visible to alias/UIN (RET to send): ")))
2179 (let ((uins (mapcar #'(lambda (alias)
2180 (emchat-numeric-uin (emchat-alias-uin alias)))
2185 (setq emchat-visible-contacts
2186 (remove alias emchat-visible-contacts)))
2189 (mapcar #'(lambda (alias)
2190 (emchat-numeric-uin (emchat-alias-uin alias)))
2191 emchat-visible-contacts))
2192 (emchat-v8-ctx-put-prop emchat-ctx 'visible-list nvis)
2193 (emchat-v8-snac-cli-remvisible emchat-ctx uins)
2194 (emchat-log-info "You are no longer visible to: %s" aliases)
2195 (when (y-or-n-p "Do you want this change saved for future sessions ")
2196 (customize-save-variable 'emchat-visible-contacts
2197 (symbol-value 'emchat-visible-contacts)))))
2199 (defun emchat-remove-from-invisible-list (aliases)
2200 "Remove ALIASES, a list of alias names/UINs, from your invisible list."
2202 (list (emchat-completing-aliases "Not invisible to alias/UIN (RET to send): ")))
2203 (let ((uins (mapcar #'(lambda (alias)
2204 (emchat-numeric-uin (emchat-alias-uin alias)))
2209 (setq emchat-invisible-contacts
2210 (remove alias emchat-invisible-contacts)))
2213 (mapcar #'(lambda (alias)
2214 (emchat-numeric-uin (emchat-alias-uin alias)))
2215 emchat-invisible-contacts))
2216 (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list nvis)
2217 (emchat-v8-snac-cli-reminvisible emchat-ctx uins)
2218 (emchat-log-info "You are no longer invisible to: %s" aliases)
2219 (when (y-or-n-p "Do you want this change saved for future sessions ")
2220 (customize-save-variable 'emchat-invisible-contacts
2221 (symbol-value 'emchat-invisible-contacts)))))
2223 (defun emchat-remove-yourself-from-buddy (alias)
2224 "Removes your entry from ALIAS' server side contact list."
2226 (list (emchat-completing-read
2228 (mapcar #'number-to-string emchat-world-recently-added-by)
2230 (not (or (member match emchat-all-uin)
2231 emchat-world-track-all-adds))))))
2232 (let ((uin (emchat-numeric-uin (emchat-alias-uin alias))))
2233 (emchat-v8-snac-cli-ssi-del-yourself emchat-ctx uin)
2234 (emchat-log-info "You have removed yourself from %s's server-side
2235 contact list. When %1$s cycles their ICQ connection you should
2236 disappear from their local list as well."
2238 (setq emchat-world-recently-added-by
2239 (delete (emchat-numeric-uin uin) emchat-world-recently-added-by))
2240 (with-current-buffer (find-file-noselect
2241 emchat-recently-added-by-filename)
2245 (insert (emchat-stringular-uin el)))
2246 emchat-world-recently-added-by)
2248 (kill-buffer nil))))
2250 (autoload 'emchat-wharf-new-frame "emchat-wharf")
2252 (defun emchat-switch-to-buddy-buffer ()
2253 "Switches from the log buffer to the buddy buffer."
2255 (emchat-switch-buffer emchat-buddy-buffer))
2257 (defun emchat-switch-to-log-buffer ()
2258 "Switches from the buddy buffer to the log buffer."
2260 (emchat-switch-buffer emchat-log-buffer))
2263 (defun emchat-show-window ()
2264 "Show windows of emchat buffers.
2265 Make them if not yet done.
2266 See `emchat-buddy-buffer' and `emchat-log-buffer'."
2268 (unless (frame-live-p emchat-frame)
2270 (if (and emchat-start-in-new-frame
2271 (device-on-window-system-p))
2272 (new-frame '((name . "EMchatLog")))
2273 (last-nonminibuf-frame))))
2274 (when (device-on-window-system-p)
2275 (select-frame emchat-frame))
2276 (emchat-buddy-show-buffer)
2277 (if emchat-status-use-gutter
2279 (set-specifier top-gutter-visible-p t emchat-frame)
2280 (emchat-update-tab-in-gutter))
2281 (emchat-status-show-buffer))
2282 (emchat-log-show-buffer)
2283 (set-window-buffer nil emchat-buddy-buffer)
2284 (delete-other-windows)
2286 (split-window nil emchat-buddy-window-width t) emchat-log-buffer)
2287 (if emchat-status-use-gutter
2288 (emchat-switch-buffer emchat-log-buffer)
2289 (set-window-buffer nil emchat-status-buffer)
2291 (split-window nil emchat-status-window-height) emchat-buddy-buffer)
2292 (emchat-switch-buffer emchat-log-buffer))
2294 (if emchat-wharf-frame-use-p
2295 (emchat-wharf-new-frame)))
2296 (focus-frame emchat-frame))
2298 (defun emchat-hide-window ()
2299 "Hide windows of emchat buffers."
2301 (delete-other-windows)
2302 (loop for each in '(emchat-buddy-buffer
2304 emchat-status-buffer
2305 emchat-debug-buffer)
2306 do (when (buffer-live-p (symbol-value each))
2307 (bury-buffer (symbol-value each))))
2309 (when emchat-status-use-gutter
2310 (set-specifier top-gutter-visible-p nil emchat-frame)))
2312 (defun emchat-window-hidden-p ()
2313 "Returns non-nil when the EMchat buffers are hidden."
2314 (if (or (get-buffer-window emchat-log-buffer emchat-frame)
2315 (get-buffer-window emchat-buddy-buffer emchat-frame)
2316 (get-buffer-window emchat-status-buffer emchat-frame))
2322 ;; message history buffer
2324 (defun emchat-alias-around ()
2325 "Return an alias/uin on current line or lines before.
2326 If called interactively, display and push alias into `kill-ring'."
2329 (outline-back-to-heading)
2330 (looking-at "^...:.. \\[\\([^]]+\\)\\]")
2331 (let ((alias (match-string 1)))
2333 ((or (member alias emchat-all-aliases)
2334 (emchat-valid-uin-p alias))
2335 (when (interactive-p)
2339 (t (error "No valid alias/uin found"))))))
2341 (defun emchat-oops ()
2342 "Oops that message went to the wrong person.
2344 When you accidently send a message to the wrong person, `emchat-oops'
2345 can be used to send the original message to the correct person and
2346 send the wrong person an explanation. The explanation sent is the
2347 value of `emchat-oops-msg-wrong-recipient'.
2349 You will be prompted for the new contact to send to."
2351 (let ((message (emchat-log-around))
2352 (alias (emchat-alias-around)))
2353 (emchat-send-message emchat-oops-msg-wrong-recipient alias)
2354 (emchat-send-message message)))
2356 (defun emchat-forward-message-around (&optional no-header)
2357 "Forward message around
2358 Non-nil NO-HEADER means avoid prefixing message with original sender's
2360 ALIASES is a list of aliases/uin to send to.
2362 See `emchat-process-alias-input'."
2364 (let* ((message (emchat-log-around))
2365 (alias (emchat-alias-around))
2366 (uin (emchat-alias-uin alias)))
2367 (emchat-send-message
2370 (format "%s (ICQ#%s) Wrote:\n" alias uin))
2373 (defun emchat-forward-message-around-without-header ()
2374 "See `emchat-forward-message-around'."
2376 (emchat-forward-message-around 'no-header))
2378 (defun emchat-select-alias-around ()
2379 "See `emchat-group-select-aliases' and `emchat-alias-around'."
2381 (emchat-group-select-aliases 'toggle (emchat-alias-around)))
2383 (defun emchat-send-message-alias-around ()
2384 "See `emchat-send-message' and `emchat-alias-around'."
2386 (emchat-log-mark 'read)
2387 (when emchat-wharf-frame-use-p
2388 (emchat-wharf-dec-messages))
2389 (emchat-send-message nil (emchat-alias-around)))
2391 (defun emchat-send-url-alias-around ()
2392 "See `emchat-send-url' and `emchat-alias-around'."
2394 (emchat-log-mark 'read)
2395 (when emchat-wharf-frame-use-p
2396 (emchat-wharf-dec-messages))
2397 (emchat-send-url nil nil (emchat-alias-around)))
2399 (defun emchat-authorize-alias-around ()
2400 "See `emchat-authorize' and `emchat-alias-around'."
2402 (emchat-authorize (emchat-alias-around)))
2404 (defun emchat-query-info-alias-around ()
2405 "See `emchat-query-info' and `emchat-alias-around'."
2407 (emchat-query-info (emchat-alias-around)))
2411 ;; contact list (list of aliases) buffer
2413 (defun emchat-alias-here ()
2414 "Return an alias/uin on current line.
2415 Leading or trailing whitespace are ignored.
2416 If called interactively, display and push alias into `kill-ring'."
2424 (skip-chars-forward "[ \t]")
2428 (skip-chars-backward "[ \t]")
2431 ((or (member alias emchat-all-aliases)
2432 (emchat-valid-uin-p alias))
2433 (when (interactive-p)
2437 (t (error "No valid alias/uin found"))))))
2439 (defun emchat-select-alias-here (action)
2440 "See `emchat-group-select-aliases' and `emchat-alias-here'.
2441 Nil or 'toggle ACTION means toggle selection for alias here.
2442 `numberp' action or digit arguments (press \\[digit-argument] before this
2443 command) means select the number of next/previous aliases.
2444 'toggle-all ACTION or prefix argument (press \\[universal-argument] before this command) means
2445 toggle selections for all aliases in view.
2446 'deselect-all or other non-nil ACTION or negative argument (press
2447 \\[negative-argument] before this command) means deselect for all aliases
2450 See `emchat-buddy-select-all-in-view'."
2453 ((not current-prefix-arg) 'toggle)
2454 ((eq '- current-prefix-arg) 'deselect-all)
2455 ((numberp current-prefix-arg) current-prefix-arg)
2458 ((or (not action) (eq action'toggle))
2459 (emchat-group-select-aliases 'toggle (emchat-alias-here))
2461 ((and (numberp action) (zerop action))) ; recurrsion done
2463 (emchat-group-select-aliases 'select (emchat-alias-here))
2465 (emchat-select-alias-here (1- action)))
2466 ((numberp action) ; negative digit
2467 (emchat-group-select-aliases 'select (emchat-alias-here))
2469 (emchat-select-alias-here (1+ action)))
2470 ((eq action 'toggle-all)
2471 (emchat-buddy-select-all-in-view 'toggle))
2472 ((eq action 'deselect-all)
2473 (emchat-buddy-select-all-in-view nil))))
2475 (defun emchat-send-message-alias-here ()
2476 "See `emchat-send-message' and `emchat-alias-here'."
2478 (emchat-send-message nil (emchat-alias-here)))
2480 (defun emchat-send-url-alias-here ()
2481 "See `emchat-send-url' and `emchat-alias-here'."
2483 (emchat-send-url nil nil (emchat-alias-here)))
2485 (defun emchat-authorize-alias-here ()
2486 "See `emchat-authorize' and `emchat-alias-here'."
2488 (emchat-authorize (emchat-alias-here)))
2490 (defun emchat-query-info-alias-here ()
2491 "See `emchat-query-info' and `emchat-alias-here'."
2493 (emchat-query-info (emchat-alias-here)))
2495 ;; Default toolbar button
2496 (defun emchat-toolbar-login ()
2497 "Log into ICQ from the toolbar."
2499 (call-interactively #'emchat-login))
2501 (defvar emchat-toolbar-icon
2502 (toolbar-make-button-list
2503 (expand-file-name "mini-logo.png" emchat-glyph-dir))
2504 "EMchat button for the default toolbar.")
2506 (defvar emchat-toolbar-spec
2507 (vector emchat-toolbar-icon
2508 'emchat-toolbar-login
2510 "Waste time with EMchat")
2511 "EMchat default toolbar spec.")
2513 (defun emchat-add-to-toolbar ()
2514 "Adds the EMchat button to the default toolbar."
2515 (let ((origbar (specifier-instance default-toolbar
2517 (spec emchat-toolbar-spec))
2518 (or (ignore-errors (toolbar-find-button emchat-toolbar-icon))
2519 (set-specifier default-toolbar
2520 (toolbar-add-item origbar spec 'right)
2525 ;; otherwise sending large contact list leads to significant delay
2526 (byte-compile 'emchat-pack-contact-list)
2528 ;; Start the idle timer
2529 (emchat-auto-away-timeout-set
2530 'emchat-auto-away-timeout emchat-auto-away-timeout)
2532 (emchat-install-bindings 'emchat-prefix-key emchat-prefix-key)
2533 ;; Add our button to the default toolbar
2534 (when (and (featurep 'toolbar)
2536 (device-on-window-system-p))
2537 (emchat-add-to-toolbar))
2538 ;; Pre-load the saved recent-adds
2539 (with-current-buffer (find-file-noselect emchat-recently-added-by-filename)
2540 (while (re-search-forward "\\(\\w+\\)" nil t)
2541 (add-to-list 'emchat-world-recently-added-by
2542 (string-to-number (match-string 1))))
2544 ;; Finally, run the load hook
2545 (run-hooks 'emchat-load-hook)
2549 ;;; emchat.el ends here