Allow disabling auto-away/auto-na timeouts.
[emchat] / emchat.el
1 ;;; emchat.el --- IM client for (S)XEmacs
2
3 ;; Copyright (C) 2000 - 2011 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   ;; delete the previous itimers
1813   (when (itimerp (get-itimer "emchat auto-away"))
1814     (delete-itimer (get-itimer "emchat auto-away")))
1815   (when (itimerp (get-itimer "emchat auto-na"))
1816     (delete-itimer (get-itimer "emchat auto-na")))
1817   (unless (zerop value)
1818     (start-itimer
1819      "emchat auto-away"
1820      (lambda ()
1821        ;; auto away for first idle
1822        (when (member emchat-user-status '("online" "ffc"))
1823          (emchat-log-system "Auto away.")
1824          (emchat-change-status "away")
1825          (setq emchat-user-auto-away-p t)))
1826      value value
1827      'is-idle)
1828     (start-itimer
1829      "emchat auto-na"
1830      (lambda ()
1831        ;; auto na for second idle
1832        (when (and emchat-user-auto-away-p
1833                   (equal emchat-user-status "away"))
1834          (emchat-log-system "Auto na.")
1835          (emchat-change-status "na")
1836          ;; emchat-change-status resets this flag
1837          (setq emchat-user-auto-away-p t)))
1838      (* 2 value) (* 2 value)
1839      nil)))
1840
1841 (defcustom emchat-auto-away-timeout 300
1842   "*Seconds of inactivity in Emacs before auto-away.
1843
1844 After two times the seconds of auto-away, it goes auto-na.
1845 See `emchat-auto-away'.
1846
1847 Setting this to zero disables the timeout.
1848
1849 If you set this outside of the custom buffer you _MUST_ use
1850 `customize-set-variable' and _NOT_ `setq'."
1851   :type 'number
1852   :set 'emchat-auto-away-timeout-set
1853   :initialize 'custom-initialize-default
1854   :group 'emchat-option)
1855
1856 (defun emchat-change-idle-timeout (seconds)
1857   "Change the number of SECONDS before EMchat will idle to \"away\".
1858
1859 If SECONDS is 0 \(zero\) the timeout will be disabled and EMchat will
1860 not automatically idle to \"away\" or \"na\".
1861
1862 Setting the timeout here does not save the value across emacs sessions.
1863 To do that, customise the variable, `emchat-auto-away-timeout'."
1864   (interactive
1865    (list (read-number "Idle timeout in seconds (0 to disable): "
1866                       nil (number-to-string emchat-auto-away-timeout))))
1867   (emchat-auto-away-timeout-set nil seconds)
1868   (if (zerop seconds)
1869       (emchat-log-system "Auto-away disabled.")
1870     (emchat-log-system "Auto-away timeout set to: %d seconds." seconds)))
1871
1872 (defun emchat-send-message-helper (message aliases type log-message)
1873   "Send message, url, authorization or others.
1874 MESSAGE is the message to send.
1875 ALIASES is a list of aliases/uin to send to.
1876 TYPE is the type of message in `emchat-v8-message-types'.
1877 LOG-MESSAGE is a message to put in log.
1878
1879 See `emchat-send-message', `emchat-send-url' and `emchat-authorize'."
1880   (when (and emchat-user-auto-away-p
1881              (not emchat-auto-reply-p))
1882     (emchat-change-status "online"))
1883   (add-to-list 'emchat-alias-list-history aliases)
1884   (loop for alias in aliases
1885     do (add-to-list 'emchat-active-aliases alias)
1886     do (if (eq type 'normal)
1887            (emchat-v8-send-simple-message
1888             emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) message)
1889          (emchat-v8-send-typed-message
1890           emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) type message))
1891     do (emchat-log-outgoing alias ">>> %s" log-message))
1892   (setq emchat-auto-reply-p nil))
1893
1894 (defvar emchat-message-history nil
1895   "History of `emchat-send-message' for `completing-read'.")
1896
1897 (defun emchat-send-message (&optional message &rest aliases)
1898   "Send an instant message.
1899 MESSAGE is the message to send.
1900 ALIASES is a list of aliases/uin to send to.
1901
1902 See `emchat-process-alias-input'."
1903   (interactive "P")
1904   (let ((prompt
1905          (concat "Message"
1906                  ;; display alias if given
1907                  (if (car aliases)
1908                      (concat " to "
1909                              (substring (format "%s" aliases) 1 -1)))
1910                  ": ")))
1911     (or (stringp message)
1912         (setq message
1913               (read-from-minibuffer prompt
1914                nil nil nil 'emchat-message-history)))
1915
1916     ;; idea from Erik Arneson <erik@starseed.com>
1917     ;; confirm sending a blank message
1918     (unless (and (or (zerop (length message))
1919                      ;; \\W fails with "=)" or "..."
1920                      (string-match "^[ \t]+$" message))
1921                  (not (y-or-n-p "Send a blank message? ")))
1922       (emchat-process-alias-input 'aliases)
1923
1924       ;; apply encode only TEXT portion of packet
1925       (let ((msg (emchat-splitter message)))
1926         (loop for x in msg
1927           do (emchat-send-message-helper
1928               ;; encoding outgoing but not that to be insert in log buffer
1929               (emchat-encode-string x) aliases 'normal x)
1930           do (when (and (> (length msg) 1)
1931                       (not (string= x (car (last msg)))))
1932              (sit-for 1)))))))
1933
1934 (defun emchat-send-message-via-mouse (event)
1935   ;; Erik Arneson <erik@starseed.com> (from VM)
1936   "`emchat-send-message' via mouse."
1937   (interactive "e")
1938   (set-buffer (window-buffer (event-window event)))
1939   (and (event-point event) (goto-char (event-point event)))
1940   (if (eq (current-buffer) emchat-buddy-buffer)
1941       (emchat-send-message-alias-here)
1942     ;; fall through
1943     ;; any alias in log-mode format (enclosed by []) can use this
1944     (emchat-send-message-alias-around)))
1945
1946 (defvar emchat-url-history nil
1947   "History of `emchat-send-url' for `completing-read'.")
1948
1949 (defun emchat-send-url (&optional url description &rest aliases)
1950   "Send an url.
1951 URL is any Internet address.
1952 DESCRIPTION is the description of url.
1953 ALIASES is a list of aliases/uin to send to.
1954
1955 See `emchat-process-alias-input'."
1956   (interactive "P")
1957   (let ((prompt
1958          (concat "url"
1959                  ;; display alias if given
1960                  (if (car aliases)
1961                      (concat " to "
1962                              (substring (format "%s" aliases) 1 -1)))
1963                  ": ")))
1964     (or (stringp url)
1965         (setq url
1966               (read-from-minibuffer
1967                prompt nil nil nil 'emchat-url-history)))
1968
1969     ;; idea from Erik Arneson <erik@starseed.com>
1970     ;; confirm sending a blank url
1971     (unless (and (or (zerop (length url))
1972                      ;; \\W fails with "=)" or "..."
1973                      (string-match "^[ \t]+$" url))
1974                  (not (y-or-n-p "Send a blank url? ")))
1975       (or description
1976           (setq description
1977                 (read-from-minibuffer
1978                  "description: " nil nil nil 'emchat-message-history)))
1979       (emchat-process-alias-input 'aliases)
1980
1981       (emchat-send-message-helper
1982        (format "%s\xfe%s"
1983                ;; encode only to TEXT portions of packet, instead of the whole
1984                (emchat-encode-string description)
1985                (emchat-encode-string url))
1986        aliases 'url (format "%s (%s)" url description)))))
1987
1988 (defun emchat-authorize (alias)
1989   "Send authorization to allow adding to contact list.
1990 ALIAS is an alias/uin."
1991   (interactive
1992    (list (car (emchat-completing-aliases "Authorisation for: " 'single))))
1993   (let (reply)
1994     (if (y-or-n-p "Accept the authorisation request? ")
1995         (progn
1996           (setq reply 1)
1997           (emchat-log-buddy-message alias ">>> %s" emchat-auth-accept-reason))
1998       (setq reply 0)
1999       (emchat-log-buddy-message alias ">>> %s" emchat-auth-reject-reason))
2000     (emchat-v8-snac-cli-ssi-auth-reply
2001      emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
2002      reply
2003      (if (zerop reply)
2004          emchat-auth-reject-reason
2005        emchat-auth-accept-reason))))
2006
2007 (defun emchat-auth-request (alias)
2008   "Request authorisation from ALIAS."
2009   (interactive
2010    (list (car (emchat-completing-aliases
2011                "Request Authorisation from: " 'single))))
2012   (emchat-v8-snac-cli-ssi-send-auth-request
2013    emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))
2014    emchat-auth-request-reason)
2015   (emchat-log-info "Authorisation requested from: %s" alias))
2016
2017 (defun emchat-request-away (&optional alias)
2018   "Request away message from ALIAS."
2019   (interactive)
2020   (unless alias
2021     (setq alias (car (emchat-completing-aliases
2022                       "Get Away message from: " 'single))))
2023   (emchat-send-message-helper
2024    "" (list alias) 'get-away "Away message requested"))
2025
2026 (defun emchat-request-na (&optional alias)
2027   "Request Not Avaliable message from ALIAS."
2028   (interactive)
2029   (unless alias
2030     (setq alias (car (emchat-completing-aliases
2031                       "Get Not Available message from: " 'single))))
2032   (emchat-send-message-helper
2033    "" (list alias) 'get-na "Not Available message requested"))
2034
2035 (defun emchat-request-dnd (&optional alias)
2036   "Request Do Not Disturb message from ALIAS."
2037   (interactive)
2038   (unless alias
2039     (setq alias (car (emchat-completing-aliases
2040                       "Get Do Not Disturb message from: " 'single))))
2041   (emchat-send-message-helper
2042    "" (list alias) 'get-dnd "Do Not Disturb message requested"))
2043
2044 (defun emchat-request-occ (&optional alias)
2045   "Request occupied message from ALIAS."
2046   (interactive)
2047   (unless alias
2048     (setq alias (car (emchat-completing-aliases
2049                       "Get Occupied message from: " 'single))))
2050   (emchat-send-message-helper
2051    "" (list alias) 'get-occ "Occupied message requested"))
2052
2053 ;;; FIXME: This needs to be updated for v8
2054 ; (defun emchat-register-new-user (password)
2055 ;   "Register a new uin with PASSWORD."
2056 ;   (interactive (list (read-passwd "Password: " 'confirm)))
2057 ;   (emchat-send (emchat-pack-register-new-user password)))
2058
2059 ;;; FIXME: This needs to be updated for v8
2060 ; (defun emchat-change-password (password)
2061 ;   "Change PASSWORD."
2062 ;   (interactive (list (read-passwd "Password: " 'confirm)))
2063 ;   (emchat-send (emchat-pack-meta-user-change-password password)))
2064
2065 (defun emchat-search (&optional online first last nick email)
2066   "Search for ICQ users.
2067
2068 Optional prefix arg, ONLINE when non-nil means to only return search
2069 results for ICQ users that are currently online.
2070
2071 Argument FIRST - first name to search for
2072 Argument LAST  - last name to search for
2073 Argument NICK  - nick name to search for
2074 Argument EMAIL - email address to search for."
2075   (interactive "P")
2076   (let ((online (if online
2077                     1
2078                   (if current-prefix-arg
2079                       1
2080                     0)))
2081         (first (if (interactive-p)
2082                    (read-string "First Name [RET for null]: ")
2083                  (or first "")))
2084         (last (if (interactive-p)
2085                   (read-string "Last Name [RET for null]: ")
2086                 (or last "")))
2087         (nick (if (interactive-p)
2088                   (read-string "Nick Name [RET for null]: ")
2089                 (or nick "")))
2090         (email (if (interactive-p)
2091                    (read-string "Email Address [RET for null]: ")
2092                  (or email ""))))
2093     (when (string= "" (concat first last nick email))
2094       (error 'invalid-argument "You must provide at least one search term"))
2095     (emchat-v8-snac-cli-searchbypersinf
2096      emchat-ctx first last nick email online)))
2097
2098 (defun emchat-search-by-uin (uin)
2099   "Search user by UIN."
2100   (interactive "sUIN: ")
2101   (emchat-v8-snac-cli-searchbyuin
2102    emchat-ctx (emchat-numeric-uin uin)))
2103
2104 (defun emchat-search-by-email (email)
2105   "Search for a user by their EMAIL address."
2106   (interactive "sEmail address: ")
2107   (emchat-v8-snac-cli-searchbyemail emchat-ctx email))
2108
2109 ;;; FIXME: This needs to be updated for v8
2110 ; (defun emchat-search-random-user (group)
2111 ;   "Search random user in GROUP."
2112 ;   (interactive
2113 ;    (list (emchat-completing-read
2114 ;           "Random group: "
2115 ;           (mapcar 'car emchat-random-groups))))
2116 ;   (emchat-send (emchat-pack-search-random-user group)))
2117
2118 ;;; FIXME: This needs to be updated for v8
2119 ; (defun emchat-set-random-group (group)
2120 ;   "Set random user GROUP."
2121 ;   (interactive
2122 ;    (list (emchat-completing-read
2123 ;           "Random group: "
2124 ;           (mapcar 'car emchat-random-groups))))
2125 ;   (emchat-send (emchat-pack-set-random-group group)))
2126
2127 (defun emchat-query-info (&optional alias)
2128   "Query meta user info.
2129 ALIAS is an alias/uin."
2130   (interactive)
2131   (if alias
2132       ;; display alias if given
2133       (message "Query %s." alias)
2134     (setq alias (car (emchat-completing-aliases "Query: " 'single))))
2135   (let ((local-info (emchat-world-info alias)))
2136     (if local-info
2137         (emchat-log-info "Local info:\n%s" local-info)))
2138
2139   (emchat-v8-snac-cli-metareqinfo
2140    emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias))))
2141
2142 (defun emchat-add-to-visible-list (aliases)
2143   "Add ALIASES, a list of alias names/UINs, to your visible list."
2144   (interactive
2145    (list (emchat-completing-aliases "Visible to alias/UIN (RET to send): ")))
2146   (let ((uins (mapcar
2147                #'(lambda (alias)
2148                    (emchat-numeric-uin (emchat-alias-uin alias)))
2149                aliases)))
2150     (emchat-v8-snac-cli-addvisible emchat-ctx uins)
2151     (mapcar
2152      #'(lambda (alias)
2153          (add-to-list 'emchat-visible-contacts alias 'append))
2154      aliases)
2155     (emchat-log-info "You are now visible to: %s" aliases)
2156     (when (y-or-n-p "Do you want this change saved for future sessions ")
2157       (customize-save-variable 'emchat-visible-contacts
2158                                (symbol-value 'emchat-visible-contacts)))))
2159
2160 (defun emchat-add-to-invisible-list (aliases)
2161   "Add ALIASES, a list of alias names/UINs, to your invisible list."
2162   (interactive
2163    (list (emchat-completing-aliases "Invisible to alias/UIN (RET to send): ")))
2164   (let ((uins (mapcar
2165                #'(lambda (alias)
2166                    (emchat-numeric-uin (emchat-alias-uin alias)))
2167                aliases)))
2168     (emchat-v8-snac-cli-addinvisible emchat-ctx uins)
2169     (mapcar
2170      #'(lambda (alias)
2171          (add-to-list 'emchat-invisible-contacts alias 'append))
2172      aliases)
2173     (emchat-log-info "You are now invisible to: %s" aliases)
2174     (when (y-or-n-p "Do you want this change saved for future sessions ")
2175       (customize-save-variable 'emchat-invisible-contacts
2176                                (symbol-value 'emchat-invisible-contacts)))))
2177
2178 (defun emchat-remove-from-visible-list (aliases)
2179   "Remove ALIASES, a list of alias names/UINs, from your visible list."
2180   (interactive
2181    (list (emchat-completing-aliases "Not visible to alias/UIN (RET to send): ")))
2182   (let ((uins (mapcar #'(lambda (alias)
2183                           (emchat-numeric-uin (emchat-alias-uin alias)))
2184                       aliases))
2185         nvis)
2186     (mapcar
2187      #'(lambda (alias)
2188          (setq emchat-visible-contacts
2189                (remove alias emchat-visible-contacts)))
2190      aliases)
2191     (setq nvis
2192           (mapcar #'(lambda (alias)
2193                       (emchat-numeric-uin (emchat-alias-uin alias)))
2194                   emchat-visible-contacts))
2195     (emchat-v8-ctx-put-prop emchat-ctx 'visible-list nvis)
2196     (emchat-v8-snac-cli-remvisible emchat-ctx uins)
2197     (emchat-log-info "You are no longer visible to: %s" aliases)
2198     (when (y-or-n-p "Do you want this change saved for future sessions ")
2199       (customize-save-variable 'emchat-visible-contacts
2200                                (symbol-value 'emchat-visible-contacts)))))
2201
2202 (defun emchat-remove-from-invisible-list (aliases)
2203   "Remove ALIASES, a list of alias names/UINs, from your invisible list."
2204   (interactive
2205    (list (emchat-completing-aliases "Not invisible to alias/UIN (RET to send): ")))
2206   (let ((uins (mapcar #'(lambda (alias)
2207                           (emchat-numeric-uin (emchat-alias-uin alias)))
2208                       aliases))
2209         nvis)
2210     (mapcar
2211      #'(lambda (alias)
2212          (setq emchat-invisible-contacts
2213                (remove alias emchat-invisible-contacts)))
2214      aliases)
2215     (setq nvis
2216           (mapcar #'(lambda (alias)
2217                       (emchat-numeric-uin (emchat-alias-uin alias)))
2218                   emchat-invisible-contacts))
2219     (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list nvis)
2220     (emchat-v8-snac-cli-reminvisible emchat-ctx uins)
2221     (emchat-log-info "You are no longer invisible to: %s" aliases)
2222     (when (y-or-n-p "Do you want this change saved for future sessions ")
2223       (customize-save-variable 'emchat-invisible-contacts
2224                                (symbol-value 'emchat-invisible-contacts)))))
2225
2226 (defun emchat-remove-yourself-from-buddy (alias)
2227   "Removes your entry from ALIAS' server side contact list."
2228   (interactive
2229    (list (emchat-completing-read
2230           "UIN: "
2231           (mapcar #'number-to-string emchat-world-recently-added-by)
2232           #'(lambda (match)
2233               (not (or (member match emchat-all-uin)
2234                        emchat-world-track-all-adds))))))
2235   (let ((uin (emchat-numeric-uin (emchat-alias-uin alias))))
2236     (emchat-v8-snac-cli-ssi-del-yourself emchat-ctx uin)
2237     (emchat-log-info "You have removed yourself from %s's server-side
2238 contact list.  When %1$s cycles their ICQ connection you should
2239 disappear from their local list as well."
2240                      alias)
2241     (setq emchat-world-recently-added-by
2242           (delete (emchat-numeric-uin uin) emchat-world-recently-added-by))
2243     (with-current-buffer (find-file-noselect
2244                           emchat-recently-added-by-filename)
2245       (erase-buffer)
2246       (mapcar
2247        #'(lambda (el)
2248            (insert (emchat-stringular-uin el)))
2249        emchat-world-recently-added-by)
2250       (save-buffer)
2251       (kill-buffer nil))))
2252
2253 (autoload 'emchat-wharf-new-frame "emchat-wharf")
2254
2255 (defun emchat-switch-to-buddy-buffer ()
2256   "Switches from the log buffer to the buddy buffer."
2257   (interactive)
2258   (emchat-switch-buffer emchat-buddy-buffer))
2259
2260 (defun emchat-switch-to-log-buffer ()
2261   "Switches from the buddy buffer to the log buffer."
2262   (interactive)
2263   (emchat-switch-buffer emchat-log-buffer))
2264
2265 ;;;###autoload
2266 (defun emchat-show-window ()
2267   "Show windows of emchat buffers.
2268 Make them if not yet done.
2269 See `emchat-buddy-buffer' and `emchat-log-buffer'."
2270   (interactive)
2271   (unless (frame-live-p emchat-frame)
2272     (setq emchat-frame
2273           (if (and emchat-start-in-new-frame
2274                    (device-on-window-system-p))
2275               (new-frame '((name . "EMchatLog")))
2276             (last-nonminibuf-frame))))
2277   (when (device-on-window-system-p)
2278     (select-frame emchat-frame))
2279   (emchat-buddy-show-buffer)
2280   (if emchat-status-use-gutter
2281       (progn
2282         (set-specifier top-gutter-visible-p t emchat-frame)
2283         (emchat-update-tab-in-gutter))
2284     (emchat-status-show-buffer))
2285   (emchat-log-show-buffer)
2286   (set-window-buffer nil emchat-buddy-buffer)
2287   (delete-other-windows)
2288   (set-window-buffer
2289    (split-window nil emchat-buddy-window-width t) emchat-log-buffer)
2290   (if emchat-status-use-gutter
2291       (emchat-switch-buffer emchat-log-buffer)
2292     (set-window-buffer nil emchat-status-buffer)
2293     (set-window-buffer
2294      (split-window nil emchat-status-window-height) emchat-buddy-buffer)
2295     (emchat-switch-buffer emchat-log-buffer))
2296   (save-excursion
2297     (if emchat-wharf-frame-use-p
2298         (emchat-wharf-new-frame)))
2299   (focus-frame emchat-frame))
2300
2301 (defun emchat-hide-window ()
2302   "Hide windows of emchat buffers."
2303   (interactive)
2304   (delete-other-windows)
2305   (loop for each in '(emchat-buddy-buffer
2306                       emchat-log-buffer
2307                       emchat-status-buffer
2308                       emchat-debug-buffer)
2309     do (when (buffer-live-p (symbol-value each))
2310          (bury-buffer (symbol-value each))))
2311   (bury-buffer)
2312   (when emchat-status-use-gutter
2313     (set-specifier top-gutter-visible-p nil emchat-frame)))
2314
2315 (defun emchat-window-hidden-p ()
2316   "Returns non-nil when the EMchat buffers are hidden."
2317   (if (or (get-buffer-window emchat-log-buffer emchat-frame)
2318           (get-buffer-window emchat-buddy-buffer emchat-frame)
2319           (get-buffer-window emchat-status-buffer emchat-frame))
2320       nil
2321     t))
2322
2323 ;;; Code - log:
2324
2325 ;; message history buffer
2326
2327 (defun emchat-alias-around ()
2328   "Return an alias/uin on current line or lines before.
2329 If called interactively, display and push alias into `kill-ring'."
2330   (interactive)
2331   (save-excursion
2332     (outline-back-to-heading)
2333     (looking-at "^...:.. \\[\\([^]]+\\)\\]")
2334     (let ((alias (match-string 1)))
2335       (cond
2336        ((or (member alias emchat-all-aliases)
2337               (emchat-valid-uin-p alias))
2338         (when (interactive-p)
2339           (message alias)
2340           (kill-new alias))
2341         alias)
2342        (t (error "No valid alias/uin found"))))))
2343
2344 (defun emchat-oops ()
2345   "Oops that message went to the wrong person.
2346
2347 When you accidently send a message to the wrong person, `emchat-oops'
2348 can be used to send the original message to the correct person and
2349 send the wrong person an explanation.  The explanation sent is the
2350 value of `emchat-oops-msg-wrong-recipient'.
2351
2352 You will be prompted for the new contact to send to."
2353   (interactive)
2354   (let ((message (emchat-log-around))
2355         (alias (emchat-alias-around)))
2356     (emchat-send-message emchat-oops-msg-wrong-recipient alias)
2357     (emchat-send-message message)))
2358
2359 (defun emchat-forward-message-around (&optional no-header)
2360   "Forward message around
2361 Non-nil NO-HEADER means avoid prefixing message with original sender's
2362 info.
2363 ALIASES is a list of aliases/uin to send to.
2364
2365 See `emchat-process-alias-input'."
2366   (interactive "P")
2367   (let* ((message (emchat-log-around))
2368          (alias (emchat-alias-around))
2369          (uin (emchat-alias-uin alias)))
2370     (emchat-send-message
2371      (concat
2372       (if (not no-header)
2373           (format "%s (ICQ#%s) Wrote:\n" alias uin))
2374       message))))
2375
2376 (defun emchat-forward-message-around-without-header ()
2377   "See `emchat-forward-message-around'."
2378   (interactive)
2379   (emchat-forward-message-around 'no-header))
2380
2381 (defun emchat-select-alias-around ()
2382   "See `emchat-group-select-aliases' and `emchat-alias-around'."
2383   (interactive)
2384   (emchat-group-select-aliases 'toggle (emchat-alias-around)))
2385
2386 (defun emchat-send-message-alias-around ()
2387   "See `emchat-send-message' and `emchat-alias-around'."
2388   (interactive)
2389   (emchat-log-mark 'read)
2390   (when emchat-wharf-frame-use-p
2391     (emchat-wharf-dec-messages))
2392   (emchat-send-message nil (emchat-alias-around)))
2393
2394 (defun emchat-send-url-alias-around ()
2395   "See `emchat-send-url' and `emchat-alias-around'."
2396   (interactive)
2397   (emchat-log-mark 'read)
2398   (when emchat-wharf-frame-use-p
2399     (emchat-wharf-dec-messages))
2400   (emchat-send-url nil nil (emchat-alias-around)))
2401
2402 (defun emchat-authorize-alias-around ()
2403   "See `emchat-authorize' and `emchat-alias-around'."
2404   (interactive)
2405   (emchat-authorize (emchat-alias-around)))
2406
2407 (defun emchat-query-info-alias-around ()
2408   "See `emchat-query-info' and `emchat-alias-around'."
2409   (interactive)
2410   (emchat-query-info (emchat-alias-around)))
2411
2412 ;;; Code - buddy:
2413
2414 ;; contact list (list of aliases) buffer
2415
2416 (defun emchat-alias-here ()
2417   "Return an alias/uin on current line.
2418 Leading or trailing whitespace are ignored.
2419 If called interactively, display and push alias into `kill-ring'."
2420   (interactive)
2421   (save-excursion
2422     (end-of-line)
2423     (let ((alias
2424            (buffer-substring
2425             (progn
2426               (beginning-of-line)
2427               (skip-chars-forward "[ \t]")
2428               (point))
2429             (progn
2430               (end-of-line)
2431               (skip-chars-backward "[ \t]")
2432               (point)))))
2433       (cond
2434        ((or (member alias emchat-all-aliases)
2435             (emchat-valid-uin-p alias))
2436         (when (interactive-p)
2437           (message alias)
2438           (kill-new alias))
2439           alias)
2440        (t (error "No valid alias/uin found"))))))
2441
2442 (defun emchat-select-alias-here (action)
2443   "See `emchat-group-select-aliases' and `emchat-alias-here'.
2444 Nil or 'toggle ACTION means toggle selection for alias here.
2445 `numberp' action or digit arguments (press \\[digit-argument] before this
2446 command) means select the number of next/previous aliases.
2447 'toggle-all ACTION or prefix argument (press \\[universal-argument] before this command) means
2448 toggle selections for all aliases in view.
2449 'deselect-all or other non-nil ACTION or negative argument (press
2450 \\[negative-argument] before this command) means deselect for all aliases
2451 in view.
2452
2453 See `emchat-buddy-select-all-in-view'."
2454   (interactive
2455    (list (cond
2456           ((not current-prefix-arg) 'toggle)
2457           ((eq '- current-prefix-arg) 'deselect-all)
2458           ((numberp current-prefix-arg) current-prefix-arg)
2459           (t 'toggle-all))))
2460   (cond
2461    ((or (not action) (eq action'toggle))
2462     (emchat-group-select-aliases 'toggle (emchat-alias-here))
2463     (forward-line))
2464    ((and (numberp action) (zerop action))) ; recurrsion done
2465    ((natnump action)
2466     (emchat-group-select-aliases 'select (emchat-alias-here))
2467     (forward-line 1)
2468     (emchat-select-alias-here (1- action)))
2469    ((numberp action)                    ; negative digit
2470     (emchat-group-select-aliases 'select (emchat-alias-here))
2471     (forward-line -1)
2472     (emchat-select-alias-here (1+ action)))
2473    ((eq action 'toggle-all)
2474     (emchat-buddy-select-all-in-view 'toggle))
2475    ((eq action 'deselect-all)
2476     (emchat-buddy-select-all-in-view nil))))
2477
2478 (defun emchat-send-message-alias-here ()
2479   "See `emchat-send-message' and `emchat-alias-here'."
2480   (interactive)
2481   (emchat-send-message nil (emchat-alias-here)))
2482
2483 (defun emchat-send-url-alias-here ()
2484   "See `emchat-send-url' and `emchat-alias-here'."
2485   (interactive)
2486   (emchat-send-url nil nil (emchat-alias-here)))
2487
2488 (defun emchat-authorize-alias-here ()
2489   "See `emchat-authorize' and `emchat-alias-here'."
2490   (interactive)
2491   (emchat-authorize (emchat-alias-here)))
2492
2493 (defun emchat-query-info-alias-here ()
2494   "See `emchat-query-info' and `emchat-alias-here'."
2495   (interactive)
2496   (emchat-query-info (emchat-alias-here)))
2497
2498 ;; Default toolbar button
2499 (defun emchat-toolbar-login ()
2500   "Log into ICQ from the toolbar."
2501   (interactive)
2502   (call-interactively #'emchat-login))
2503
2504 (defvar emchat-toolbar-icon
2505   (toolbar-make-button-list
2506    (expand-file-name "mini-logo.png" emchat-glyph-dir))
2507   "EMchat button for the default toolbar.")
2508
2509 (defvar emchat-toolbar-spec
2510   (vector emchat-toolbar-icon
2511           'emchat-toolbar-login
2512           t
2513           "Waste time with EMchat")
2514   "EMchat default toolbar spec.")
2515
2516 (defun emchat-add-to-toolbar ()
2517   "Adds the EMchat button to the default toolbar."
2518   (let ((origbar (specifier-instance default-toolbar
2519                                      (selected-window)))
2520         (spec emchat-toolbar-spec))
2521     (or (ignore-errors (toolbar-find-button emchat-toolbar-icon))
2522         (set-specifier default-toolbar
2523                        (toolbar-add-item origbar spec 'right)
2524                        'global))))
2525
2526 ;;; Code - footer:
2527
2528 ;; otherwise sending large contact list leads to significant delay
2529 (byte-compile 'emchat-pack-contact-list)
2530
2531 ;; Start the idle timer
2532 (emchat-auto-away-timeout-set nil emchat-auto-away-timeout)
2533 ;; Install bindings
2534 (emchat-install-bindings 'emchat-prefix-key emchat-prefix-key)
2535 ;; Add our button to the default toolbar
2536 (when (and (featurep 'toolbar)
2537            (featurep 'png)
2538            (device-on-window-system-p))
2539   (emchat-add-to-toolbar))
2540 ;; Pre-load the saved recent-adds
2541 (with-current-buffer (find-file-noselect emchat-recently-added-by-filename)
2542   (while (re-search-forward "\\(\\w+\\)" nil t)
2543     (add-to-list 'emchat-world-recently-added-by
2544                  (string-to-number (match-string 1))))
2545   (kill-buffer nil))
2546 ;; Finally, run the load hook
2547 (run-hooks 'emchat-load-hook)
2548
2549 (provide 'emchat)
2550
2551 ;;; emchat.el ends here