Initial git import
[emchat] / emchat.el
1 ;;; emchat.el --- IM client for (S)XEmacs
2
3 ;; Copyright (C) 2000 - 2008 Steve Youngs
4
5 ;; Maintainer:     Steve Youngs <steve@emchat.org>
6 ;; Created:        Aug 08, 1998
7 ;; Homepage:       http://www.emchat.org/
8 ;; Keywords:       comm ICQ
9
10 ;; This file is part of EMchat.
11
12 ;; Redistribution and use in source and binary forms, with or without
13 ;; modification, are permitted provided that the following conditions
14 ;; are met:
15 ;;
16 ;; 1. Redistributions of source code must retain the above copyright
17 ;;    notice, this list of conditions and the following disclaimer.
18 ;;
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.
22 ;;
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.
26 ;;
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.
38
39 ;;; Commentary:
40 ;;
41 ;; Clone of Mirabilis ICQ communication client.
42 ;;
43 ;; Entry points:
44 ;;   emchat-login
45 ;;   emchat-show-window
46 ;;   emchat-customize
47 ;;
48 ;; See README & INSTALL which come with this package
49 ;;
50 ;; This project is done without the consent of Mirabilis.
51 ;;
52
53 ;;; Code:
54
55 (eval-and-compile
56   (require 'emchat-utils)
57   (require 'timezone)
58   (require 'outline)
59   (require 'emchat-doctor))
60
61 (eval-when-compile
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)
71   (defvar seq-num-bin)
72   (defvar seq-num)
73   (defvar user-bin)
74   (defvar local-year)
75   (defvar emchat-fix-nick)
76   (defvar emchat-wharf-frame-use-p)
77   (require 'ehelp)
78   (require 'cus-edit)
79   (require 'browse-url)
80   (require 'passwd)
81   (require 'regexp-opt)
82   (require 'toolbar-utils)
83   (autoload 'emchat-wharf-dec-messages "emchat-wharf"))
84
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")
96
97 ;; Customize Groups.
98
99 (defgroup emchat nil
100   "Mirabilis ICQ communication client."
101   :group 'comm)
102
103 (defgroup emchat-info nil
104   "Essential account info."
105   :group 'emchat)
106
107 (defgroup emchat-option nil
108   "System settings and general preferences."
109   :group 'emchat)
110
111 (defgroup emchat-sound nil
112   "Sound preferences."
113   :group 'emchat)
114
115 (defgroup emchat-interface nil
116   "Change the look and \"feel\"."
117   :group 'emchat)
118
119 ;; Customize.
120 ;;;###autoload
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."
124   :type 'directory
125   :group 'emchat)
126
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-"
134   :group 'emchat)
135
136 (defcustom emchat-history-enabled-flag nil
137   "*Non-nil means keep \"per-user\" histories."
138   :group 'emchat-history
139   :type 'boolean)
140
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."
144   :type 'directory
145   :group 'emchat-history)
146
147 (defcustom emchat-history-mode-hook nil
148   "*Hooks run in `emchat-history-mode'."
149   :type 'hook
150   :group 'emchat-history)
151
152 ;; This is here and not at the top because some of these libs use
153 ;; emchat-directory
154 (eval-and-compile
155   (require 'emchat-log)
156   (require 'emchat-meta)
157   (require 'emchat-world)
158   (require 'emchat-v8)
159   (require 'emchat-version))
160
161 (defcustom emchat-server "login.icq.com"
162   "*Server host to connect to."
163   :type 'string
164   :group 'emchat)
165
166 (defcustom emchat-port 5401
167   "*Port to connect to."
168   :type 'number
169   :group 'emchat)
170
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)
176       (progn
177         (lwarn 'binding 'warning
178           "%S already bound, reseting `emchat-prefix-key'" value)
179         (set sym nil))
180     (global-set-key value emchat-prefix)
181     (set sym value)))
182
183 (defcustom emchat-prefix-key [(meta ?`)]
184   "*Default global prefix key for EMchat.
185
186 If you change this outside of the customize buffer you _MUST_ use
187 `customize-set-variable', not `setq'."
188   :type 'sexp
189   :set 'emchat-install-bindings
190   :initialize 'custom-initialize-default
191   :group 'emchat)
192
193 (defcustom emchat-use-sound-flag nil
194   "*Whether to use sound or not."
195   :group 'emchat-sound
196   :type 'boolean
197   :tag "Use Sound")
198
199 (defcustom emchat-sound-directory
200   (file-name-as-directory (expand-file-name "sounds" emchat-directory))
201   "*Directory where sound files are kept."
202   :group 'emchat-sound
203   :type 'directory 
204   :tag "emchat-sound-directory")
205
206 (defcustom emchat-sound-alist
207   '((message-sound . nil)
208     (chat-sound . nil)
209     (url-sound . nil)
210     (buddy-sound . nil)
211     (auth-sound . nil)
212     (emailx-sound . nil)
213     (pager-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."
225   :group 'emchat-sound
226   :type '(repeat 
227           (cons (sexp :tag "Sound Event") 
228                 (sexp :tag "Sound File")))
229   :tag "Sounds")
230
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)
243                   (mapcar
244                    #'(lambda (x)
245                        (list 'item x))
246                    (coding-system-list)))))
247
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."
253   :type 'boolean
254   :group 'emchat-option)
255
256 (defcustom emchat-auto-reply-away
257   "I am currently away from the computer.
258
259 If you would like to be notified when I am back online
260 send me a message with \",,notify-me\" in it.
261
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)
267
268 (defcustom emchat-auto-reply-occ
269   "I am currently occupied.
270
271 If you would like to be notified when I am back online
272 send me a message with \",,notify-me\" in it.
273
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)
279
280 (defcustom emchat-auto-reply-dnd
281   "Hey, the sign on the door says \"Do Not Disturb\"!
282
283 Leave me a message, if you feel you must.
284 I might get back to you.
285
286 If you would like to be notified when I am back online
287 send me a message with \",,notify-me\" in it.
288
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)
294
295 (defcustom emchat-auto-reply-na
296   "I am currently not available.
297
298 If you would like to be notified when I am back online
299 send me a message with \",,notify-me\" in it.
300
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)
306
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
311
312 If you would like to be notified when I am back online
313 send me a message with \",,notify-me\" in it.
314
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)
320
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
325
326 If you would like to be notified when I am back online
327 send me a message with \",,notify-me\" in it.
328
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)
334
335 (defcustom emchat-auto-response-never-send-to nil
336   "*This is a list of people that shouldn't get auto-responses.
337
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
340 be sent one."
341   :type '(repeat (string :tag "Alias"))
342   :group 'emchat-option)
343
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."
348   :type 'string
349   :group 'emchat-option)
350
351 (defcustom emchat-start-in-new-frame nil
352   "*If non-NIL, EMchat will start in its own frame."
353   :group 'emchat-interface
354   :type 'boolean)
355
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
360   :type 'hook)
361
362 (defcustom emchat-read-message-hook nil
363   "*Hooks run when a message is marked as \"read\"."
364   :group 'emchat-option
365   :type 'hook)
366
367 (defcustom emchat-system-message-hook nil
368   "*Hooks run when a \"system\" message is received."
369   :group 'emchat-option
370   :type 'hook)
371
372 (defcustom emchat-load-hook nil
373   "*Hooks run after EMchat has loaded everything up."
374   :type 'hook
375   :group 'emchat-option)
376
377 (defcustom emchat-missed-message-hook nil
378   "*Hooks run when SRV_MISSED_ICBM packet comes in.
379
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.
383
384 It is called with 3 arguments:
385
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\)"
390   :type 'hook
391   :group 'emchat-option)
392
393 ;; Some debugging counters.  Do NOT set any of these.
394 (defvar emchat-dropped-packet-counter 0
395   "For debug purpose only.")
396
397 (defvar emchat-resend-packet-counter 0
398   "For debug purpose only.")
399
400 (defvar emchat-recent-packet nil
401   "The most recent incoming packet.
402 For debug only.")
403
404 (defvar emchat-trimmed-packet-counter 0
405   "For debug purpose only.")
406
407 (defvar emchat-error-packets nil
408   "A list of error incoming packets.
409 For debug only.")
410
411 (defcustom emchat-about-fields
412   '((:nick . "Nick Name")
413     (:first-name . "First Name")
414     (:second-name . "Surname")
415     (:email . "Email")
416     (:country . "Country")
417     (:city . "City")
418     (:state . "State")
419     (:zip . "Postal Code")
420     (:phone . "Phone")
421     (:fax . "Fax")
422     (:cellular . "Cellular")
423     (:flags . "Flags")
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")))
443   :group 'emchat)
444
445 (defcustom emchat-about-more-fields
446   '((:age . "Age")
447     (:gender . "Gender")
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")))
476   :group 'emchat)
477
478 (defcustom emchat-auth-accept-reason "You are AUTHORISED!"
479   "*Default reason for rejecting incoming auth requests."
480   :type 'string
481   :group 'emchat)
482
483 (defcustom emchat-auth-reject-reason "Authorisation Rejected!"
484   "*Default reason for rejecting incoming auth requests."
485   :type 'string
486   :group 'emchat)
487
488 (defcustom emchat-auth-request-reason "Please add me to your contact list"
489   "*Message to send with outgoing auth requests."
490   :type 'string
491   :group 'emchat)
492
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)
497     (mapcar
498      #'(lambda (e)
499          (car e))
500      emchat-world)))
501
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
508   :group 'emchat)
509
510 (defcustom emchat-invisible-contacts nil
511   "*List of contacts on your \"invisible\" list."
512   :type '(repeat (string :tag "Contact Alias Name"))
513   :group 'emchat)
514
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."
519  :group 'emchat-info)
520
521 (defvar emchat-ctx nil
522   "Current emchat context in emchat-v8 protocol.
523 Internal variable, do not modify.")
524
525 ;;;###autoload
526 (defun emchat-version (&optional arg)
527   "Return the version of emchat you are currently using.
528 If ARG, insert version string at point."
529   (interactive "P")
530   (if arg
531       (insert (message "EMchat: %s" emchat-version))
532     (message "EMchat: %s" emchat-version)))
533
534 ;;;###autoload
535 (defun emchat-copyright ()
536   "*Display the copyright notice for EMchat."
537   (interactive)
538   (with-electric-help
539    '(lambda ()
540       (insert
541        (with-temp-buffer
542          (erase-buffer)
543          (insert-file-contents (locate-library "emchat.el"))
544          (goto-char (point-min))
545          (re-search-forward ";;; Commentary" nil t)
546          (beginning-of-line)
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*"))
552
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.
560
561 Often the end user doesn't realise that their \"free\" software has
562 come at some considerable cost.  Costs and expenses like...
563
564     Bandwidth and ISP expenses
565     Hardware updates and maintenance expenses
566     Hosting expenses
567     Domain name registrations
568     Electricity and other utility expenses
569     Outrageous amounts of coffee for all-night coding sessions
570
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.
575
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
579 it for you.
580
581 Steve Youngs
582 EMchat Project Lead.
583
584 \t\t [Donate]\t\t\t [Cancel]
585
586 \t\t"
587   "Contents of donation buffer.")
588
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
634 YII="
635   "A base64 encoded paypal donate button.")
636
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.") 
682
683 (defun emchat-make-donation ()
684   "Proceed with making a donation to the EMchat project."
685   (interactive)
686   (browse-url "http://tinyurl.com/2uzel4")
687   (kill-buffer "*emchat-donate*"))
688
689 (defun emchat-no-donation ()
690   "Don't make a donation to the EMchat project."
691   (interactive)
692   (kill-buffer "*emchat-donate*"))
693
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)
700     map)
701   "A keymap for the extents in the EMchat donation buffer.")
702
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)
709     map)
710   "A keymap for the extents in the EMchat donation buffer.")
711
712 (defun emchat-donation ()
713   "Make a donation to the EMchat project via PayPal."
714   (interactive)
715   (let ((buf (get-buffer-create "*emchat-donate*"))
716         (donate-help "Make a donation to the EMchat team.")
717         (cancel-help 
718          "Thank you for considering a donation... maybe another time.")
719         donate-glyph-ext
720         cancel-glyph-ext
721         donate-text-ext
722         cancel-text-ext)
723     (switch-to-buffer buf)
724     (erase-buffer)
725     (insert emchat-donation-notice)
726     (when (and (device-on-window-system-p)
727                (featurep 'png))
728       (setq donate-glyph-ext (make-extent (point-max) (point-max)))
729       (set-extent-begin-glyph
730        donate-glyph-ext
731        (make-glyph
732         (list (vector 'png ':data (with-temp-buffer
733                                      (insert emchat-paypal-glyph)
734                                      (base64-decode-region (point-min)
735                                                            (point-max))
736                                      (buffer-string))))))
737       (insert "\t\t\t")
738       (setq cancel-glyph-ext (make-extent (point-max) (point-max)))
739       (set-extent-begin-glyph
740        cancel-glyph-ext
741        (make-glyph
742         (list (vector 'png ':data (with-temp-buffer
743                                      (insert emchat-maybe-later-glyph)
744                                      (base64-decode-region (point-min)
745                                                            (point-max))
746                                      (buffer-string))))))
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))))
769
770 ;; Load the toolbar
771 (add-hook 'emchat-buddy-mode-hook 'emchat-install-buddy-toolbar)
772 (add-hook 'emchat-log-mode-hook 'emchat-install-log-toolbar)
773
774 ;;; Code - utilities:
775
776 ;;;###autoload
777 (defun emchat-customize ()
778   "Interactively customize settings and preferences."
779   (interactive)
780   (customize-group 'emchat))
781
782 \f
783 ;;;###autoload
784 (defun emchat-browse-homepage ()
785   "Browse emchat homepage for news and files."
786   (interactive)
787   (browse-url "http://www.emchat.org/"))
788
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))
794   :group 'emchat)
795
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))
801   :group 'emchat)
802
803 (defconst emchat-encoding-koi8-r
804   (concat
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"))
813
814 (defconst emchat-encoding-cp1251
815   (concat
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"))
824
825 (defun emchat-translate-string (str from-enc to-enc)
826   "Translate STR from koi8 to cp1251."
827   (let ((fe (ecase from-enc
828               (us-ascii nil)
829               (koi8-r emchat-encoding-koi8-r)
830               (cp1251 emchat-encoding-cp1251)))
831         (te (ecase to-enc
832               (us-ascii nil)
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)))
842                str nil)))
843
844 (defun emchat-encode-string (string)
845   "Return a encoded string from STRING with DOS stuff added.
846 Encode string with `emchat-coding-system'."
847   ;; add DOS stuff
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))))
854
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'."
859   ;; remove DOS stuff
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))))
866
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'.")
870
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."
874   (loop
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))))
883
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.")
887
888 (defvar emchat-frame nil
889   "The frame where EMchat is displayed.")
890
891 (defun emchat-connected-p (ctx)
892   "Return non-nil when EMchat is connected to the ICQ server."
893   (memq ctx emchat-v8-connections))
894
895 (defun emchat-exit ()
896   "Log out of ICQ and close all EMchat buffers."
897   (interactive)
898
899   (emchat-logout)
900   (set-buffer emchat-log-buffer)
901   (save-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 
908                       emchat-buddy-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))
921
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.")
928
929 ;;; Code - client to server packets:
930
931 (defvar emchat-current-seq-num 1
932   "Current sequence number in packet.")
933
934 ;;; FIXME: This needs to be updated for v8
935 ; (defun emchat-pack-register-new-user (password)
936 ;   "Pack register new user packet 03fc."
937 ;   (emchat-pack
938 ;    "\xfc\x03"
939 ;    (emchat-int-bin (length password))
940 ;    password
941 ;    "\xa0\x00\x00\x00"
942 ;    "\x24\x61\x00\x00"
943 ;    "\x00\x00\x00\x00"))
944
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.")
958
959 ;;; FIXME: This needs to be updated for v8
960 ; (defun emchat-pack-set-random-group (group)
961 ;   "Pack set random group 0564."
962 ;   (emchat-pack
963 ;    "\x64\x05"
964 ;    (cdr (assoc group emchat-random-groups))))
965
966 ;;; FIXME: This needs to be updated for v8
967 ; (defun emchat-pack-search-random-user (group)
968 ;   "Pack search random user 056e."
969 ;   (emchat-pack
970 ;    "\x6e\x05"
971 ;    (cdr (assoc group emchat-random-groups))))
972
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"))
977
978 ;;; Code - server to client packets:
979
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)
985 ;   (emchat-log-error
986 ;    "Unknown command: %s"
987 ;    (emchat-bin-hex (substring packet 7 9))))
988
989 ;;; FIXME: How is this handled now?
990 ; (defun emchat-do-wrong-password (packet)
991 ;   ;; not authorized?
992 ;   "Handle server command 0064 in PACKET."
993 ;   (emchat-log-error "Your password is invalid"))
994
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!")
998   (emchat-logout))
999
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.")
1005
1006 (defun emchat-do-disconnect (ectx)
1007   "Handle disconnect from server."
1008   (emchat-log-error "Unexpected disconnection from server")
1009   (emchat-logout)
1010   (if emchat-user-password
1011       (progn
1012         (setq emchat-is-auto-reconnecting t)
1013         (emchat-log-system "Attempting auto-reconnect...")
1014         (emchat-login))
1015     (with-current-buffer emchat-log-buffer
1016       (emchat-log-system 
1017        (substitute-command-keys
1018         "Connection lost, use `\\[emchat-login]' to log back in.")))))
1019
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."))
1024
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)))
1029
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
1036      alias
1037      (format "Server dropped the last %d message%sfrom: %s
1038 Reason: %s"
1039              num (if (> num 1) "s " " ") alias reason) 'missed)
1040     (run-hook-with-args 'emchat-missed-message-hook alias num reason)))
1041
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))
1051          (local-time
1052           (timezone-fix-time
1053            (format "%s %s %s:%s %s"
1054                    monthname day hour min year)
1055            nil nil))
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)))
1062
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))))
1069
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))
1082           (insert uin)
1083           (save-buffer))
1084         (kill-buffer nil))
1085       (add-to-list 'emchat-world-recently-added-by
1086                    (emchat-numeric-uin uin) 'append))))
1087
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)))
1092
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)))
1097
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)))
1102
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)))
1106
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)))
1110
1111 (defvar emchat-auto-reply-p nil
1112   "If non-nil EMchat will not automatically set your state to online.
1113
1114 It is used in `emchat-do-message-helper' and `emchat-send-message-helper'.")
1115
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.")
1119
1120 (eval-when-compile (load "sound"))
1121
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."))
1128
1129 (defun emchat-load-media-streams (&optional force)
1130   "Loads configured sounds into SXEmacs media streams.
1131
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."
1134   (interactive "p")
1135   (emchat-do-in-sxemacs
1136     (let ((sound-lst emchat-sound-alist)
1137           (stub "emchat::"))
1138       (mapcar
1139        #'(lambda (el)
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)
1145                           (or force
1146                               (not (media-stream-p stream))))
1147                  (set streamsym (make-media-stream :file file emchat-media-driver))))))
1148        sound-lst))))
1149
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
1160              (ignore-errors
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))))))
1165
1166 (defvar emchat-online-notifiers nil
1167   "A list of aliases who have requested online notification.")
1168
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)))
1175         (type msg-type))
1176     (add-to-list 'emchat-active-aliases alias)
1177
1178     ;; Doctor
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)))
1186
1187     ;; Notify
1188     (cond
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)))
1204
1205     ;; Auto-response
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
1210           (progn
1211             (setq emchat-auto-reply-p t)
1212             (emchat-idle-reply-maybe alias))
1213         (emchat-auto-reply-maybe alias)))
1214
1215     (run-hooks 'emchat-new-message-hook)
1216     
1217     (case type
1218       (normal
1219        (emchat-log-buddy-message
1220         alias "%s" (emchat-decode-string message))
1221        (emchat-play-sound-maybe 'message-sound))
1222       (chat-request 
1223        (emchat-log-buddy-message 
1224         alias "Request chat")
1225        (emchat-play-sound-maybe 'chat-sound))
1226       (url
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
1233       (auth-accept
1234        (emchat-log-buddy-message 
1235         alias "Authorisation Accepted!")
1236        (emchat-play-sound-maybe 'auth-sound))
1237       (auth-reject
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))
1242       (auth-request
1243        (emchat-log-buddy-message
1244         alias "Authorisation Request\nReason: %s"
1245         (emchat-decode-string message))
1246        (emchat-play-sound-maybe 'auth-sound))
1247       ;; Pager messages
1248       (web-pager
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))
1254       (email-pager
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))
1260       (email-express
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))
1266       (added
1267        (emchat-log-system (format "%s %s" alias message))
1268        (emchat-play-sound-maybe 'system-sound))
1269       (contact-list
1270        (emchat-log-buddy-message
1271         alias "Contact list = %s"
1272         (emchat-decode-string
1273          (replace-in-string message "\xfe" "\n"))))
1274       (get-away
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)"
1278                                   alias
1279                                   (if visible "sent" "not sent")))
1280          (when visible
1281            (emchat-send-message-helper
1282             emchat-auto-reply-away
1283             (list alias) 'automatic "away msg sent"))))
1284       (get-occ
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)"
1288                                   alias
1289                                   (if visible "sent" "not sent")))
1290          (when visible
1291            (emchat-send-message-helper
1292             emchat-auto-reply-occ
1293             (list alias) 'automatic "occ msg sent"))))
1294       (get-na
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)"
1298                                   alias
1299                                   (if visible "sent" "not sent")))
1300          (when visible
1301            (emchat-send-message-helper
1302             emchat-auto-reply-na
1303             (list alias) 'automatic "na msg sent"))))
1304       (get-dnd
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)"
1308                                   alias
1309                                   (if visible "sent" "not sent")))
1310          (when visible
1311            (emchat-send-message-helper
1312             emchat-auto-reply-dnd
1313             (list alias) 'automatic "dnd msg sent"))))
1314       (get-ffc
1315        ;; TODO: send our free-for-chat message
1316        )
1317       ;; SRV_MISSED_ICBM
1318       (missed
1319        (emchat-log-system (format "%s" message))
1320        (emchat-play-sound-maybe 'system-sound))
1321       (automatic
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)))))
1330
1331 (defvar emchat-auto-reply-never emchat-auto-response-never-send-to
1332   "List of people to never send auto-responses to.")
1333
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))))
1338     (when message
1339       (add-to-list 'emchat-active-aliases alias)
1340       (emchat-send-message-helper
1341        message (list alias) 'automatic "Auto reply sent"))))
1342
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)))
1351
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))))
1356     (when message
1357       (add-to-list 'emchat-active-aliases alias)
1358       (emchat-send-message-helper
1359        message (list alias) 'automatic "Idle reply sent"))))
1360
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))
1370
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)))
1388
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)))
1403
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))
1408
1409 (defun emchat-format-field (field field-var &optional format)
1410   "Format FIELD.
1411 FORMAT specifies format to use for FIELD (default is \"%15s: %s\").
1412
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)
1418           ((stringp fi-val)
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)))))
1422
1423 (defun emchat-add-user-ssi (uin nick ssi-grp id)
1424   "Send a request to add UIN to your server side contact list.
1425
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
1429 nick name.
1430
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.
1435
1436 Argument, ID, is the server side contact ID for this contact.  It is
1437 simply the highest ID from world incremented by 1.
1438
1439 This might change in the future when EMchat has better SSI handling."
1440   (let* ((uin (emchat-stringular-uin uin)))
1441     (progn
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))))
1445
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))
1453              emchat-add-user-p)
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: "
1458                                   nick))
1459                          nick
1460                        (read-string "New nick name: " nil nil alias)))
1461           ;; ensure we have a valid nick name
1462           (loop until (string-match "^[^:]" nick)
1463             do (setq nick
1464                      (read-string "Invalid Alias (can't begin with \":\"): "
1465                                   nil nil alias)))
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)
1472           (puthash :egrps
1473                    (read-string 
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
1478       (emchat-log-info
1479        (emchat-decode-string
1480         (concat
1481          "GENERAL about result =\n"
1482          (format "%15s: %d\n" "UIN" uin)
1483          (format "%15s: %s\n" "Local alias" alias)
1484          (apply 'concat
1485                 (mapcar #'(lambda (field)
1486                             (emchat-format-field (car field) emchat-about-fields))
1487                         emchat-about-fields))
1488          "--- END ---"))))))
1489
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))))
1494     (emchat-log-info
1495      (emchat-decode-string
1496       (concat
1497        "MORE about result =\n"
1498        (format "%15s: %d\n" "UIN" uin)
1499        (format "%15s: %s\n" "Local alias" alias)
1500        (apply 'concat
1501               (mapcar #'(lambda (field)
1502                           (emchat-format-field (car field) emchat-about-more-fields))
1503                       emchat-about-more-fields))
1504        "--- END ---")))))
1505
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))))
1510     (emchat-log-info
1511      (emchat-decode-string
1512       (concat
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"
1517        "--- END ---")))))
1518
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))
1522
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)
1526
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"))))
1533
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"))
1538
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"))
1543
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"))
1548
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"))
1553
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"))
1558
1559 ;;; FIXME: This needs to be updated for v8
1560 ; (defun emchat-do-new-account-uin (packet)
1561 ;   "Handle server command 0046 in PACKET."
1562 ;   (emchat-log-info
1563 ;    "New uin: %s"
1564 ;    (emchat-bin-uin packet 13)))
1565
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))))
1572
1573 ;;; Code - alias and uin:
1574
1575 (defvar emchat-alias-history nil
1576   "History of aliases in `emchat-completing-aliases'.")
1577
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.")
1584
1585 (defvar emchat-connected-aliases nil
1586   "Aliases that are in any statuses except 'invisible'.")
1587
1588 (defvar emchat-active-aliases nil
1589   "Aliases which we have exchanged messages with.")
1590
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.
1594
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.
1601
1602 See `emchat-completing-aliases'."
1603   (or (symbol-value symbol)
1604       (set symbol
1605            (if (eq '- current-prefix-arg)
1606                (emchat-buddy-selected-in-view)
1607              (emchat-completing-aliases "to: " (not current-prefix-arg))))))
1608
1609 ;;; Code - system main:
1610
1611 (defvar emchat-blurb 
1612   "As succinctly as possible, tell us:-\n
1613 \tWhat happened.
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.")
1619
1620 ;;;###autoload
1621 (defun emchat-login ()
1622   "Login to ICQ server.
1623 Make connection to server and network if necessary."
1624   (interactive)
1625   (let* ((uin (progn
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)))))
1631
1632     (when (equal emchat-user-status "offline")
1633       (or (emchat-valid-uin-p uin)
1634           (error "Invalid user uin"))
1635
1636       (setq emchat-trimmed-packet nil)  ; hack
1637       (setq emchat-current-seq-num 0)
1638       (emchat-log-show-buffer nil 'no-select)
1639
1640       ;; Create emchat v8 context
1641       (setq emchat-ctx (emchat-v8-create-ctx uin password
1642                       'connect-tries 10
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
1668                   ))
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))))
1674
1675 (autoload 'emchat-wharf-change-messages "emchat-wharf")
1676
1677 (defun emchat-logout ()
1678   "Logout ICQ server.
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."
1682   (interactive)
1683
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))
1691       (progn
1692         (emchat-wharf-change-messages "New" -9999)
1693         (emchat-wharf-change-messages "Sys" -9999)))
1694   (when emchat-history-enabled-flag
1695     (mapcar
1696      #'(lambda (alias)
1697          (let* ((histf (emchat-world-getf alias 'history))
1698                 (histb (and histf (find-buffer-visiting histf))))
1699            (when histb
1700              (with-current-buffer histb
1701                (save-buffer)
1702                (kill-buffer nil)))))
1703      emchat-all-aliases))
1704   (when (emchat-connected-p emchat-ctx)
1705     (emchat-v8-close emchat-ctx)))
1706
1707 (defvar emchat-contact-list-packets nil
1708   "Lists of remaining contact list packets to be sent.
1709 For experimental purpose only.")
1710
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'."
1716 ;;  (interactive)
1717
1718 ;;  (setq emchat-connected-aliases nil)
1719 ;;  (emchat-buddy-show-buffer 'new 'no-select)
1720
1721 ;;  (emchat-world-update)
1722 ;;  ;; Visible
1723 ;;  (when emchat-visible-contacts
1724 ;;    (emchat-v8-ctx-put-prop emchat-ctx 'visible-list
1725 ;;      (mapcar
1726 ;;       #'(lambda (v)
1727 ;;         (emchat-numeric-uin (emchat-alias-uin v)))
1728 ;;       emchat-visible-contacts))
1729 ;;    (emchat-v8-snac-cli-addvisible emchat-ctx))
1730 ;;  ;; Invisible
1731 ;;  (when emchat-invisible-contacts
1732 ;;    (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list
1733 ;;      (mapcar
1734 ;;       #'(lambda (i)
1735 ;;         (emchat-numeric-uin (emchat-alias-uin i)))
1736 ;;       emchat-invisible-contacts))
1737 ;;    (emchat-v8-snac-cli-addinvisible emchat-ctx))
1738 ;;  ;; All
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))
1742
1743 (defun emchat-check-contact-list ()
1744   "Checks to ensure local copy of SSI list is up to date."
1745   (interactive)
1746   (emchat-v8-snac-cli-ssi-checkout emchat-ctx))
1747
1748 (defun emchat-activate-contact-list ()
1749   "Activate the server-side contact list."
1750   (interactive)
1751   (setq emchat-connected-aliases nil)
1752   (emchat-buddy-show-buffer 'new 'no-select)
1753   (emchat-world-update)
1754   ;; Visible
1755   (when emchat-visible-contacts
1756     (emchat-v8-ctx-put-prop emchat-ctx 'visible-list
1757       (mapcar
1758        #'(lambda (v)
1759            (emchat-numeric-uin (emchat-alias-uin v)))
1760        emchat-visible-contacts))
1761     ; (emchat-v8-snac-cli-addvisible emchat-ctx)
1762     )
1763   ;; Invisible
1764   (when emchat-invisible-contacts
1765     (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list
1766       (mapcar
1767        #'(lambda (i)
1768            (emchat-numeric-uin (emchat-alias-uin i)))
1769        emchat-invisible-contacts))
1770     ; (emchat-v8-snac-cli-addinvisible emchat-ctx)
1771     )
1772   ;; All
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))
1776
1777 (defun emchat-keep-alive-start ()
1778   "Start keeping alive."
1779   (emchat-keep-alive-stop)
1780   (start-itimer
1781    "emchat keep-alive"
1782    (lambda ()
1783      (emchat-v8-snac-cli-keepalive emchat-ctx))
1784    ;; sending faster won't hurt
1785    60 60))
1786
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))))
1792
1793 (defun emchat-add-user (uin)
1794   (interactive "sUIN: ")
1795   (setq emchat-add-user-p t)
1796   (emchat-search-by-uin uin))
1797
1798 (defun emchat-change-user (alias password)
1799   "Change user to ALIAS with PASSWORD.
1800 Need to relogin afterwards."
1801   (interactive
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))
1807        nil
1808      password)))
1809
1810 (defun emchat-auto-away-timeout-set (&optional symbol value)
1811   "Set timer for auto-away.  See `emchat-auto-away-timeout'."
1812   (when (itimerp (get-itimer "emchat auto-away"))
1813     (delete-itimer (get-itimer "emchat auto-away")))      ; delete previous
1814   (start-itimer
1815    "emchat auto-away"
1816    (lambda ()
1817      ;; auto away for first idle
1818      (when (member emchat-user-status '("online" "ffc"))
1819        (emchat-log-system "Auto away.")
1820        (emchat-change-status "away")
1821        (setq emchat-user-auto-away-p t)))
1822    value value
1823    'is-idle)
1824   (when (itimerp (get-itimer "emchat auto-na"))
1825     (delete-itimer (get-itimer "emchat auto-na")))
1826   (start-itimer
1827    "emchat auto-na"
1828    (lambda ()
1829      ;; auto na for second idle
1830      (when (and emchat-user-auto-away-p 
1831                 (equal emchat-user-status "away"))
1832        (emchat-log-system "Auto na.")
1833        (emchat-change-status "na")
1834        ;; emchat-change-status resets this flag
1835        (setq emchat-user-auto-away-p t)))
1836    (* 2 value) (* 2 value)
1837    nil))
1838
1839 (defcustom emchat-auto-away-timeout 300
1840   "*Seconds of inactivity in Emacs before auto-away.
1841
1842 After two times the seconds of auto-away, it goes auto-na.
1843 See `emchat-auto-away'.
1844
1845 If you set this outside of the custom buffer you _MUST_ use
1846 `customize-set-variable' and _NOT_ `setq'."
1847   :type 'number
1848   :set 'emchat-auto-away-timeout-set
1849   :initialize 'custom-initialize-default
1850   :group 'emchat-option)
1851
1852 (defun emchat-change-idle-timeout (&optional seconds)
1853   "Change the number of SECONDS before EMchat will idle to \"away\".
1854
1855 Setting the timeout here does not save the value across emacs sessions.
1856 To do that, customise the variable, `emchat-auto-away-timeout'."
1857   (interactive)
1858   (let ((timeout (or seconds
1859                      (read-number
1860                       "New idle timeout in seconds [RET for no change]: "
1861                       nil "0"))))
1862     (unless (zerop timeout)
1863       (emchat-auto-away-timeout-set nil timeout))))
1864
1865 (defun emchat-send-message-helper (message aliases type log-message)
1866   "Send message, url, authorization or others.
1867 MESSAGE is the message to send.
1868 ALIASES is a list of aliases/uin to send to.
1869 TYPE is the type of message in `emchat-v8-message-types'.
1870 LOG-MESSAGE is a message to put in log.
1871
1872 See `emchat-send-message', `emchat-send-url' and `emchat-authorize'."
1873   (when (and emchat-user-auto-away-p
1874              (not emchat-auto-reply-p))
1875     (emchat-change-status "online"))
1876   (add-to-list 'emchat-alias-list-history aliases)
1877   (loop for alias in aliases
1878     do (add-to-list 'emchat-active-aliases alias)
1879     do (if (eq type 'normal)
1880            (emchat-v8-send-simple-message
1881             emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) message)
1882          (emchat-v8-send-typed-message
1883           emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) type message))
1884     do (emchat-log-outgoing alias ">>> %s" log-message))
1885   (setq emchat-auto-reply-p nil))
1886
1887 (defvar emchat-message-history nil
1888   "History of `emchat-send-message' for `completing-read'.")
1889
1890 (defun emchat-send-message (&optional message &rest aliases)
1891   "Send an instant message.
1892 MESSAGE is the message to send.
1893 ALIASES is a list of aliases/uin to send to.
1894
1895 See `emchat-process-alias-input'."
1896   (interactive "P")
1897   (let ((prompt
1898          (concat "Message"
1899                  ;; display alias if given
1900                  (if (car aliases)
1901                      (concat " to "
1902                              (substring (format "%s" aliases) 1 -1)))
1903                  ": ")))
1904     (or (stringp message)
1905         (setq message
1906               (read-from-minibuffer prompt
1907                nil nil nil 'emchat-message-history)))
1908
1909     ;; idea from Erik Arneson <erik@starseed.com>
1910     ;; confirm sending a blank message
1911     (unless (and (or (zerop (length message))
1912                      ;; \\W fails with "=)" or "..."
1913                      (string-match "^[ \t]+$" message))
1914                  (not (y-or-n-p "Send a blank message? ")))
1915       (emchat-process-alias-input 'aliases)
1916
1917       ;; apply encode only TEXT portion of packet
1918       (let ((msg (emchat-splitter message)))
1919         (loop for x in msg
1920           do (emchat-send-message-helper
1921               ;; encoding outgoing but not that to be insert in log buffer
1922               (emchat-encode-string x) aliases 'normal x)
1923           do (when (and (> (length msg) 1)
1924                       (not (string= x (car (last msg)))))
1925              (sit-for 1)))))))
1926
1927 (defun emchat-send-message-via-mouse (event)
1928   ;; Erik Arneson <erik@starseed.com> (from VM)
1929   "`emchat-send-message' via mouse."
1930   (interactive "e")
1931   (set-buffer (window-buffer (event-window event)))
1932   (and (event-point event) (goto-char (event-point event)))
1933   (if (eq (current-buffer) emchat-buddy-buffer)
1934       (emchat-send-message-alias-here)
1935     ;; fall through
1936     ;; any alias in log-mode format (enclosed by []) can use this
1937     (emchat-send-message-alias-around)))
1938
1939 (defvar emchat-url-history nil
1940   "History of `emchat-send-url' for `completing-read'.")
1941
1942 (defun emchat-send-url (&optional url description &rest aliases)
1943   "Send an url.
1944 URL is any Internet address.
1945 DESCRIPTION is the description of url.
1946 ALIASES is a list of aliases/uin to send to.
1947
1948 See `emchat-process-alias-input'."
1949   (interactive "P")
1950   (let ((prompt
1951          (concat "url"
1952                  ;; display alias if given
1953                  (if (car aliases)
1954                      (concat " to "
1955                              (substring (format "%s" aliases) 1 -1)))
1956                  ": ")))
1957     (or (stringp url)
1958         (setq url
1959               (read-from-minibuffer
1960                prompt nil nil nil 'emchat-url-history)))
1961
1962     ;; idea from Erik Arneson <erik@starseed.com>
1963     ;; confirm sending a blank url
1964     (unless (and (or (zerop (length url))
1965                      ;; \\W fails with "=)" or "..."
1966                      (string-match "^[ \t]+$" url))
1967                  (not (y-or-n-p "Send a blank url? ")))
1968       (or description
1969           (setq description
1970                 (read-from-minibuffer
1971                  "description: " nil nil nil 'emchat-message-history)))
1972       (emchat-process-alias-input 'aliases)
1973
1974       (emchat-send-message-helper
1975        (format "%s\xfe%s"
1976                ;; encode only to TEXT portions of packet, instead of the whole
1977                (emchat-encode-string description)
1978                (emchat-encode-string url))
1979        aliases 'url (format "%s (%s)" url description)))))
1980
1981 (defun emchat-authorize (alias)
1982   "Send authorization to allow adding to contact list.
1983 ALIAS is an alias/uin."
1984   (interactive
1985    (list (car (emchat-completing-aliases "Authorisation for: " 'single))))
1986   (let (reply)
1987     (if (y-or-n-p "Accept the authorisation request? ")
1988         (progn
1989           (setq reply 1)
1990           (emchat-log-buddy-message alias ">>> %s" emchat-auth-accept-reason))
1991       (setq reply 0)
1992       (emchat-log-buddy-message alias ">>> %s" emchat-auth-reject-reason))
1993     (emchat-v8-snac-cli-ssi-auth-reply
1994      emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
1995      reply
1996      (if (zerop reply)
1997          emchat-auth-reject-reason
1998        emchat-auth-accept-reason))))
1999
2000 (defun emchat-auth-request (alias)
2001   "Request authorisation from ALIAS."
2002   (interactive
2003    (list (car (emchat-completing-aliases 
2004                "Request Authorisation from: " 'single))))
2005   (emchat-v8-snac-cli-ssi-send-auth-request
2006    emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
2007    emchat-auth-request-reason)
2008   (emchat-log-info "Authorisation requested from: %s" alias))
2009
2010 (defun emchat-request-away (&optional alias)
2011   "Request away message from ALIAS."
2012   (interactive)
2013   (unless alias
2014     (setq alias (car (emchat-completing-aliases
2015                       "Get Away message from: " 'single))))
2016   (emchat-send-message-helper
2017    "" (list alias) 'get-away "Away message requested"))
2018
2019 (defun emchat-request-na (&optional alias)
2020   "Request Not Avaliable message from ALIAS."
2021   (interactive)
2022   (unless alias
2023     (setq alias (car (emchat-completing-aliases
2024                       "Get Not Available message from: " 'single))))
2025   (emchat-send-message-helper
2026    "" (list alias) 'get-na "Not Available message requested"))
2027
2028 (defun emchat-request-dnd (&optional alias)
2029   "Request Do Not Disturb message from ALIAS."
2030   (interactive)
2031   (unless alias
2032     (setq alias (car (emchat-completing-aliases
2033                       "Get Do Not Disturb message from: " 'single))))
2034   (emchat-send-message-helper
2035    "" (list alias) 'get-dnd "Do Not Disturb message requested"))
2036
2037 (defun emchat-request-occ (&optional alias)
2038   "Request occupied message from ALIAS."
2039   (interactive)
2040   (unless alias
2041     (setq alias (car (emchat-completing-aliases
2042                       "Get Occupied message from: " 'single))))
2043   (emchat-send-message-helper
2044    "" (list alias) 'get-occ "Occupied message requested"))
2045
2046 ;;; FIXME: This needs to be updated for v8
2047 ; (defun emchat-register-new-user (password)
2048 ;   "Register a new uin with PASSWORD."
2049 ;   (interactive (list (read-passwd "Password: " 'confirm)))
2050 ;   (emchat-send (emchat-pack-register-new-user password)))
2051
2052 ;;; FIXME: This needs to be updated for v8
2053 ; (defun emchat-change-password (password)
2054 ;   "Change PASSWORD."
2055 ;   (interactive (list (read-passwd "Password: " 'confirm)))
2056 ;   (emchat-send (emchat-pack-meta-user-change-password password)))
2057
2058 (defun emchat-search (&optional online first last nick email)
2059   "Search for ICQ users.
2060
2061 Optional prefix arg, ONLINE when non-nil means to only return search
2062 results for ICQ users that are currently online.
2063
2064 Argument FIRST - first name to search for
2065 Argument LAST  - last name to search for
2066 Argument NICK  - nick name to search for
2067 Argument EMAIL - email address to search for."
2068   (interactive "P")
2069   (let ((online (if online
2070                     1
2071                   (if current-prefix-arg
2072                       1
2073                     0)))
2074         (first (if (interactive-p)
2075                    (read-string "First Name [RET for null]: ")
2076                  (or first "")))
2077         (last (if (interactive-p)
2078                   (read-string "Last Name [RET for null]: ")
2079                 (or last "")))
2080         (nick (if (interactive-p)
2081                   (read-string "Nick Name [RET for null]: ")
2082                 (or nick "")))
2083         (email (if (interactive-p)
2084                    (read-string "Email Address [RET for null]: ")
2085                  (or email ""))))
2086     (when (string= "" (concat first last nick email))
2087       (error 'invalid-argument "You must provide at least one search term"))
2088     (emchat-v8-snac-cli-searchbypersinf
2089      emchat-ctx first last nick email online)))
2090
2091 (defun emchat-search-by-uin (uin)
2092   "Search user by UIN."
2093   (interactive "sUIN: ")
2094   (emchat-v8-snac-cli-searchbyuin
2095    emchat-ctx (emchat-numeric-uin uin)))
2096
2097 (defun emchat-search-by-email (email)
2098   "Search for a user by their EMAIL address."
2099   (interactive "sEmail address: ")
2100   (emchat-v8-snac-cli-searchbyemail emchat-ctx email))
2101
2102 ;;; FIXME: This needs to be updated for v8
2103 ; (defun emchat-search-random-user (group)
2104 ;   "Search random user in GROUP."
2105 ;   (interactive
2106 ;    (list (emchat-completing-read
2107 ;           "Random group: "
2108 ;           (mapcar 'car emchat-random-groups))))
2109 ;   (emchat-send (emchat-pack-search-random-user group)))
2110
2111 ;;; FIXME: This needs to be updated for v8
2112 ; (defun emchat-set-random-group (group)
2113 ;   "Set random user GROUP."
2114 ;   (interactive
2115 ;    (list (emchat-completing-read
2116 ;           "Random group: "
2117 ;           (mapcar 'car emchat-random-groups))))
2118 ;   (emchat-send (emchat-pack-set-random-group group)))
2119
2120 (defun emchat-query-info (&optional alias)
2121   "Query meta user info.
2122 ALIAS is an alias/uin."
2123   (interactive)
2124   (if alias
2125       ;; display alias if given
2126       (message "Query %s." alias)
2127     (setq alias (car (emchat-completing-aliases "Query: " 'single))))
2128   (let ((local-info (emchat-world-info alias)))
2129     (if local-info
2130         (emchat-log-info "Local info:\n%s" local-info)))
2131
2132   (emchat-v8-snac-cli-metareqinfo
2133    emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))))
2134
2135 (defun emchat-add-to-visible-list (aliases)
2136   "Add ALIASES, a list of alias names/UINs, to your visible list."
2137   (interactive
2138    (list (emchat-completing-aliases "Visible to alias/UIN (RET to send): ")))
2139   (let ((uins (mapcar
2140                #'(lambda (alias)
2141                    (emchat-numeric-uin (emchat-alias-uin alias)))
2142                aliases)))
2143     (emchat-v8-snac-cli-addvisible emchat-ctx uins)
2144     (mapcar
2145      #'(lambda (alias)
2146          (add-to-list 'emchat-visible-contacts alias 'append))
2147      aliases)
2148     (emchat-log-info "You are now visible to: %s" aliases)
2149     (when (y-or-n-p "Do you want this change saved for future sessions ")
2150       (customize-save-variable 'emchat-visible-contacts 
2151                                (symbol-value 'emchat-visible-contacts)))))
2152     
2153 (defun emchat-add-to-invisible-list (aliases)
2154   "Add ALIASES, a list of alias names/UINs, to your invisible list."
2155   (interactive
2156    (list (emchat-completing-aliases "Invisible to alias/UIN (RET to send): ")))
2157   (let ((uins (mapcar
2158                #'(lambda (alias)
2159                    (emchat-numeric-uin (emchat-alias-uin alias)))
2160                aliases)))
2161     (emchat-v8-snac-cli-addinvisible emchat-ctx uins)
2162     (mapcar
2163      #'(lambda (alias)
2164          (add-to-list 'emchat-invisible-contacts alias 'append))
2165      aliases)
2166     (emchat-log-info "You are now invisible to: %s" aliases)
2167     (when (y-or-n-p "Do you want this change saved for future sessions ")
2168       (customize-save-variable 'emchat-invisible-contacts 
2169                                (symbol-value 'emchat-invisible-contacts)))))
2170
2171 (defun emchat-remove-from-visible-list (aliases)
2172   "Remove ALIASES, a list of alias names/UINs, from your visible list."
2173   (interactive
2174    (list (emchat-completing-aliases "Not visible to alias/UIN (RET to send): ")))
2175   (let ((uins (mapcar #'(lambda (alias)
2176                           (emchat-numeric-uin (emchat-alias-uin alias)))
2177                       aliases))
2178         nvis)
2179     (mapcar
2180      #'(lambda (alias)
2181          (setq emchat-visible-contacts
2182                (remove alias emchat-visible-contacts)))
2183      aliases)
2184     (setq nvis
2185           (mapcar #'(lambda (alias)
2186                       (emchat-numeric-uin (emchat-alias-uin alias)))
2187                   emchat-visible-contacts))
2188     (emchat-v8-ctx-put-prop emchat-ctx 'visible-list nvis)
2189     (emchat-v8-snac-cli-remvisible emchat-ctx uins)
2190     (emchat-log-info "You are no longer visible to: %s" aliases)
2191     (when (y-or-n-p "Do you want this change saved for future sessions ")
2192       (customize-save-variable 'emchat-visible-contacts
2193                                (symbol-value 'emchat-visible-contacts)))))
2194
2195 (defun emchat-remove-from-invisible-list (aliases)
2196   "Remove ALIASES, a list of alias names/UINs, from your invisible list."
2197   (interactive
2198    (list (emchat-completing-aliases "Not invisible to alias/UIN (RET to send): ")))
2199   (let ((uins (mapcar #'(lambda (alias)
2200                           (emchat-numeric-uin (emchat-alias-uin alias)))
2201                       aliases))
2202         nvis)
2203     (mapcar
2204      #'(lambda (alias)
2205          (setq emchat-invisible-contacts
2206                (remove alias emchat-invisible-contacts)))
2207      aliases)
2208     (setq nvis
2209           (mapcar #'(lambda (alias)
2210                       (emchat-numeric-uin (emchat-alias-uin alias)))
2211                   emchat-invisible-contacts))
2212     (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list nvis)
2213     (emchat-v8-snac-cli-reminvisible emchat-ctx uins)
2214     (emchat-log-info "You are no longer invisible to: %s" aliases)
2215     (when (y-or-n-p "Do you want this change saved for future sessions ")
2216       (customize-save-variable 'emchat-invisible-contacts
2217                                (symbol-value 'emchat-invisible-contacts)))))
2218
2219 (defun emchat-remove-yourself-from-buddy (alias)
2220   "Removes your entry from ALIAS' server side contact list."
2221   (interactive
2222    (list (emchat-completing-read
2223           "UIN: "
2224           (mapcar #'number-to-string emchat-world-recently-added-by)
2225           #'(lambda (match)
2226               (not (or (member match emchat-all-uin)
2227                        emchat-world-track-all-adds))))))
2228   (let ((uin (emchat-numeric-uin (emchat-alias-uin alias))))
2229     (emchat-v8-snac-cli-ssi-del-yourself emchat-ctx uin)
2230     (emchat-log-info "You have removed yourself from %s's server-side
2231 contact list.  When %1$s cycles their ICQ connection you should
2232 disappear from their local list as well."
2233                      alias)
2234     (setq emchat-world-recently-added-by
2235           (delete (emchat-numeric-uin uin) emchat-world-recently-added-by))
2236     (with-current-buffer (find-file-noselect
2237                           emchat-recently-added-by-filename)
2238       (erase-buffer)
2239       (mapcar
2240        #'(lambda (el)
2241            (insert (emchat-stringular-uin el)))
2242        emchat-world-recently-added-by)
2243       (save-buffer)
2244       (kill-buffer nil))))
2245
2246 (autoload 'emchat-wharf-new-frame "emchat-wharf")
2247
2248 (defun emchat-switch-to-buddy-buffer ()
2249   "Switches from the log buffer to the buddy buffer."
2250   (interactive)
2251   (emchat-switch-buffer emchat-buddy-buffer))
2252
2253 (defun emchat-switch-to-log-buffer ()
2254   "Switches from the buddy buffer to the log buffer."
2255   (interactive)
2256   (emchat-switch-buffer emchat-log-buffer))
2257
2258 ;;;###autoload
2259 (defun emchat-show-window ()
2260   "Show windows of emchat buffers.
2261 Make them if not yet done.
2262 See `emchat-buddy-buffer' and `emchat-log-buffer'."
2263   (interactive)
2264   (unless (frame-live-p emchat-frame)
2265     (setq emchat-frame
2266           (if (and emchat-start-in-new-frame
2267                    (device-on-window-system-p))
2268               (new-frame '((name . "EMchatLog")))
2269             (last-nonminibuf-frame))))
2270   (when (device-on-window-system-p)
2271     (select-frame emchat-frame))
2272   (emchat-buddy-show-buffer)
2273   (if emchat-status-use-gutter
2274       (progn
2275         (set-specifier top-gutter-visible-p t emchat-frame)
2276         (emchat-update-tab-in-gutter))
2277     (emchat-status-show-buffer))
2278   (emchat-log-show-buffer)
2279   (set-window-buffer nil emchat-buddy-buffer)
2280   (delete-other-windows)
2281   (set-window-buffer
2282    (split-window nil emchat-buddy-window-width t) emchat-log-buffer)
2283   (if emchat-status-use-gutter
2284       (emchat-switch-buffer emchat-log-buffer)
2285     (set-window-buffer nil emchat-status-buffer)
2286     (set-window-buffer
2287      (split-window nil emchat-status-window-height) emchat-buddy-buffer)
2288     (emchat-switch-buffer emchat-log-buffer))
2289   (save-excursion
2290     (if emchat-wharf-frame-use-p
2291         (emchat-wharf-new-frame)))
2292   (focus-frame emchat-frame))
2293
2294 (defun emchat-hide-window ()
2295   "Hide windows of emchat buffers."
2296   (interactive)
2297   (delete-other-windows)
2298   (loop for each in '(emchat-buddy-buffer 
2299                       emchat-log-buffer 
2300                       emchat-status-buffer
2301                       emchat-debug-buffer)
2302     do (when (buffer-live-p (symbol-value each))
2303          (bury-buffer (symbol-value each))))
2304   (bury-buffer)
2305   (when emchat-status-use-gutter
2306     (set-specifier top-gutter-visible-p nil emchat-frame)))
2307
2308 (defun emchat-window-hidden-p ()
2309   "Returns non-nil when the EMchat buffers are hidden."
2310   (if (or (get-buffer-window emchat-log-buffer emchat-frame)
2311           (get-buffer-window emchat-buddy-buffer emchat-frame)
2312           (get-buffer-window emchat-status-buffer emchat-frame))
2313       nil
2314     t))
2315
2316 ;;; Code - log:
2317
2318 ;; message history buffer
2319
2320 (defun emchat-alias-around ()
2321   "Return an alias/uin on current line or lines before.
2322 If called interactively, display and push alias into `kill-ring'."
2323   (interactive)
2324   (save-excursion
2325     (outline-back-to-heading)
2326     (looking-at "^...:.. \\[\\([^]]+\\)\\]")
2327     (let ((alias (match-string 1)))
2328       (cond
2329        ((or (member alias emchat-all-aliases)
2330               (emchat-valid-uin-p alias))
2331         (when (interactive-p)
2332           (message alias)
2333           (kill-new alias))
2334         alias)
2335        (t (error "No valid alias/uin found"))))))
2336
2337 (defun emchat-oops ()
2338   "Oops that message went to the wrong person.
2339
2340 When you accidently send a message to the wrong person, `emchat-oops'
2341 can be used to send the original message to the correct person and
2342 send the wrong person an explanation.  The explanation sent is the
2343 value of `emchat-oops-msg-wrong-recipient'.
2344
2345 You will be prompted for the new contact to send to."
2346   (interactive)
2347   (let ((message (emchat-log-around))
2348         (alias (emchat-alias-around)))
2349     (emchat-send-message emchat-oops-msg-wrong-recipient alias)
2350     (emchat-send-message message)))
2351
2352 (defun emchat-forward-message-around (&optional no-header)
2353   "Forward message around
2354 Non-nil NO-HEADER means avoid prefixing message with original sender's
2355 info.
2356 ALIASES is a list of aliases/uin to send to.
2357
2358 See `emchat-process-alias-input'."
2359   (interactive "P")
2360   (let* ((message (emchat-log-around))
2361          (alias (emchat-alias-around))
2362          (uin (emchat-alias-uin alias)))
2363     (emchat-send-message
2364      (concat
2365       (if (not no-header)
2366           (format "%s (ICQ#%s) Wrote:\n" alias uin))
2367       message))))
2368
2369 (defun emchat-forward-message-around-without-header ()
2370   "See `emchat-forward-message-around'."
2371   (interactive)
2372   (emchat-forward-message-around 'no-header))
2373
2374 (defun emchat-select-alias-around ()
2375   "See `emchat-group-select-aliases' and `emchat-alias-around'."
2376   (interactive)
2377   (emchat-group-select-aliases 'toggle (emchat-alias-around)))
2378
2379 (defun emchat-send-message-alias-around ()
2380   "See `emchat-send-message' and `emchat-alias-around'."
2381   (interactive)
2382   (emchat-log-mark 'read)
2383   (when emchat-wharf-frame-use-p
2384     (emchat-wharf-dec-messages))
2385   (emchat-send-message nil (emchat-alias-around)))
2386
2387 (defun emchat-send-url-alias-around ()
2388   "See `emchat-send-url' and `emchat-alias-around'."
2389   (interactive)
2390   (emchat-log-mark 'read)
2391   (when emchat-wharf-frame-use-p
2392     (emchat-wharf-dec-messages))
2393   (emchat-send-url nil nil (emchat-alias-around)))
2394
2395 (defun emchat-authorize-alias-around ()
2396   "See `emchat-authorize' and `emchat-alias-around'."
2397   (interactive)
2398   (emchat-authorize (emchat-alias-around)))
2399
2400 (defun emchat-query-info-alias-around ()
2401   "See `emchat-query-info' and `emchat-alias-around'."
2402   (interactive)
2403   (emchat-query-info (emchat-alias-around)))
2404
2405 ;;; Code - buddy:
2406
2407 ;; contact list (list of aliases) buffer
2408
2409 (defun emchat-alias-here ()
2410   "Return an alias/uin on current line.
2411 Leading or trailing whitespace are ignored.
2412 If called interactively, display and push alias into `kill-ring'."
2413   (interactive)
2414   (save-excursion
2415     (end-of-line)
2416     (let ((alias
2417            (buffer-substring
2418             (progn
2419               (beginning-of-line)
2420               (skip-chars-forward "[ \t]")
2421               (point))
2422             (progn
2423               (end-of-line)
2424               (skip-chars-backward "[ \t]")
2425               (point)))))
2426       (cond
2427        ((or (member alias emchat-all-aliases)
2428             (emchat-valid-uin-p alias))
2429         (when (interactive-p)
2430           (message alias)
2431           (kill-new alias))
2432           alias)
2433        (t (error "No valid alias/uin found"))))))
2434
2435 (defun emchat-select-alias-here (action)
2436   "See `emchat-group-select-aliases' and `emchat-alias-here'.
2437 Nil or 'toggle ACTION means toggle selection for alias here.
2438 `numberp' action or digit arguments (press \\[digit-argument] before this
2439 command) means select the number of next/previous aliases.
2440 'toggle-all ACTION or prefix argument (press \\[universal-argument] before this command) means
2441 toggle selections for all aliases in view.
2442 'deselect-all or other non-nil ACTION or negative argument (press
2443 \\[negative-argument] before this command) means deselect for all aliases
2444 in view.
2445
2446 See `emchat-buddy-select-all-in-view'."
2447   (interactive
2448    (list (cond
2449           ((not current-prefix-arg) 'toggle)
2450           ((eq '- current-prefix-arg) 'deselect-all)
2451           ((numberp current-prefix-arg) current-prefix-arg)
2452           (t 'toggle-all))))
2453   (cond
2454    ((or (not action) (eq action'toggle))
2455     (emchat-group-select-aliases 'toggle (emchat-alias-here))
2456     (forward-line))
2457    ((and (numberp action) (zerop action))) ; recurrsion done
2458    ((natnump action)
2459     (emchat-group-select-aliases 'select (emchat-alias-here))
2460     (forward-line 1)
2461     (emchat-select-alias-here (1- action)))
2462    ((numberp action)                    ; negative digit
2463     (emchat-group-select-aliases 'select (emchat-alias-here))
2464     (forward-line -1)
2465     (emchat-select-alias-here (1+ action)))
2466    ((eq action 'toggle-all)
2467     (emchat-buddy-select-all-in-view 'toggle))
2468    ((eq action 'deselect-all)
2469     (emchat-buddy-select-all-in-view nil))))
2470
2471 (defun emchat-send-message-alias-here ()
2472   "See `emchat-send-message' and `emchat-alias-here'."
2473   (interactive)
2474   (emchat-send-message nil (emchat-alias-here)))
2475
2476 (defun emchat-send-url-alias-here ()
2477   "See `emchat-send-url' and `emchat-alias-here'."
2478   (interactive)
2479   (emchat-send-url nil nil (emchat-alias-here)))
2480
2481 (defun emchat-authorize-alias-here ()
2482   "See `emchat-authorize' and `emchat-alias-here'."
2483   (interactive)
2484   (emchat-authorize (emchat-alias-here)))
2485
2486 (defun emchat-query-info-alias-here ()
2487   "See `emchat-query-info' and `emchat-alias-here'."
2488   (interactive)
2489   (emchat-query-info (emchat-alias-here)))
2490
2491 ;; Default toolbar button
2492 (defun emchat-toolbar-login ()
2493   "Log into ICQ from the toolbar."
2494   (interactive)
2495   (call-interactively #'emchat-login))
2496
2497 (defvar emchat-toolbar-icon
2498   (toolbar-make-button-list
2499    (expand-file-name "mini-logo.png" emchat-glyph-dir))
2500   "EMchat button for the default toolbar.")
2501
2502 (defvar emchat-toolbar-spec
2503   (vector emchat-toolbar-icon
2504           'emchat-toolbar-login
2505           t
2506           "Waste time with EMchat")
2507   "EMchat default toolbar spec.")
2508
2509 (defun emchat-add-to-toolbar ()
2510   "Adds the EMchat button to the default toolbar."
2511   (let ((origbar (specifier-instance default-toolbar
2512                                      (selected-window)))
2513         (spec emchat-toolbar-spec))
2514     (or (ignore-errors (toolbar-find-button emchat-toolbar-icon))
2515         (set-specifier default-toolbar
2516                        (toolbar-add-item origbar spec 'right)
2517                        'global))))
2518
2519 ;;; Code - footer:
2520
2521 ;; otherwise sending large contact list leads to significant delay
2522 (byte-compile 'emchat-pack-contact-list)
2523
2524 ;; Start the idle timer
2525 (emchat-auto-away-timeout-set nil emchat-auto-away-timeout)
2526 ;; Install bindings
2527 (emchat-install-bindings 'emchat-prefix-key emchat-prefix-key)
2528 ;; Add our button to the default toolbar
2529 (when (and (featurep 'toolbar)
2530            (featurep 'png)
2531            (device-on-window-system-p))
2532   (emchat-add-to-toolbar))
2533 ;; Pre-load the saved recent-adds
2534 (with-current-buffer (find-file-noselect emchat-recently-added-by-filename)
2535   (while (re-search-forward "\\(\\w+\\)" nil t)
2536     (add-to-list 'emchat-world-recently-added-by
2537                  (string-to-number (match-string 1))))
2538   (kill-buffer nil))
2539 ;; Finally, run the load hook
2540 (run-hooks 'emchat-load-hook)
2541
2542 (provide 'emchat)
2543
2544 ;;; emchat.el ends here
2545