;;; emchat.el --- IM client for (S)XEmacs ;; Copyright (C) 2000 - 2011 Steve Youngs ;; Maintainer: Steve Youngs ;; Created: Aug 08, 1998 ;; Homepage: http://www.emchat.org/ ;; Keywords: comm ICQ ;; This file is part of EMchat. ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions ;; are met: ;; ;; 1. Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; ;; 2. Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in the ;; documentation and/or other materials provided with the distribution. ;; ;; 3. Neither the name of the author nor the names of any contributors ;; may be used to endorse or promote products derived from this ;; software without specific prior written permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE ;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;;; Commentary: ;; ;; Clone of Mirabilis ICQ communication client. ;; ;; Entry points: ;; emchat-login ;; emchat-show-window ;; emchat-customize ;; ;; See README & INSTALL which come with this package ;; ;; This project is done without the consent of Mirabilis. ;; ;;; Code: (eval-and-compile (require 'emchat-utils) (require 'timezone) (require 'outline) (require 'emchat-doctor)) (eval-when-compile (defvar emchat-add-user-success) (defvar emchat-user-status) (defvar emchat-user-initial-status) (defvar emchat-buddy-buffer) (defvar emchat-buddy-window-width) (defvar emchat-status-buffer) (defvar emchat-status-use-gutter) (defvar emchat-status-window-height) (defvar emchat-wharf-frame) (defvar seq-num-bin) (defvar seq-num) (defvar user-bin) (defvar local-year) (defvar emchat-fix-nick) (defvar emchat-wharf-frame-use-p) (require 'ehelp) (require 'cus-edit) (require 'browse-url) (require 'passwd) (require 'regexp-opt) (require 'toolbar-utils) (autoload 'emchat-wharf-dec-messages "emchat-wharf")) (autoload 'emchat-status-auto-reply "emchat-status") (autoload 'emchat-status-idle-reply "emchat-status") (autoload 'emchat-status-name "emchat-status") (autoload 'emchat-change-status "emchat-status" nil t) (autoload 'emchat-status-show-buffer "emchat-status" nil t) (autoload 'emchat-update-tab-in-gutter "emchat-status") (autoload 'emchat-status-v8 "emchat-status") (autoload 'emchat-buddy-update-status "emchat-status") (autoload 'emchat-buddy-selected-in-view "emchat-buddy") (autoload 'emchat-buddy-show-buffer "emchat-buddy" nil t) (autoload 'emchat-buddy-select-all-in-view "emchat-buddy") ;; Customize Groups. (defgroup emchat nil "Mirabilis ICQ communication client." :group 'comm) (defgroup emchat-info nil "Essential account info." :group 'emchat) (defgroup emchat-option nil "System settings and general preferences." :group 'emchat) (defgroup emchat-sound nil "Sound preferences." :group 'emchat) (defgroup emchat-interface nil "Change the look and \"feel\"." :group 'emchat) ;; Customize. ;;;###autoload (defcustom emchat-directory (file-name-as-directory (expand-file-name ".emchat" (user-home-directory))) "*All EMchat support files and directories hang off this." :type 'directory :group 'emchat) ;; Because of the incredibly complex and hairy twisted maze of ;; inter-connections between the different EMchat libs, these ;; emchat-history defcustoms are here instead of in ;; emchat-history.el. --SY. (defgroup emchat-history nil "History preferences." :prefix "emchat-history-" :group 'emchat) (defcustom emchat-history-enabled-flag nil "*Non-nil means keep \"per-user\" histories." :group 'emchat-history :type 'boolean) (defcustom emchat-history-directory (file-name-as-directory (expand-file-name "history" emchat-directory)) "*Directory path for storing \"per-user\" history files." :type 'directory :group 'emchat-history) (defcustom emchat-history-mode-hook nil "*Hooks run in `emchat-history-mode'." :type 'hook :group 'emchat-history) ;; This is here and not at the top because some of these libs use ;; emchat-directory (eval-and-compile (require 'emchat-log) (require 'emchat-meta) (require 'emchat-world) (require 'emchat-v8) (require 'emchat-version)) (defcustom emchat-server "login.icq.com" "*Server host to connect to." :type 'string :group 'emchat) (defcustom emchat-port 5401 "*Port to connect to." :type 'number :group 'emchat) ;;;###autoload(autoload 'emchat-prefix "emchat-menu" nil nil 'keymap) (defun emchat-install-bindings (&optional sym value) (when (eq (key-binding (symbol-value sym)) emchat-prefix) (global-set-key (symbol-value sym) nil)) ; unbind old (if (key-binding value) (progn (lwarn 'binding 'warning "%S already bound, reseting `emchat-prefix-key'" value) (set sym nil)) (global-set-key value emchat-prefix) (set sym value))) (defcustom emchat-prefix-key [(meta ?`)] "*Default global prefix key for EMchat. If you change this outside of the customize buffer you _MUST_ use `customize-set-variable', not `setq'." :type 'sexp :set 'emchat-install-bindings :initialize 'custom-initialize-default :group 'emchat) (defcustom emchat-use-sound-flag nil "*Whether to use sound or not." :group 'emchat-sound :type 'boolean :tag "Use Sound") (defcustom emchat-sound-directory (file-name-as-directory (expand-file-name "sounds" emchat-directory)) "*Directory where sound files are kept." :group 'emchat-sound :type 'directory :tag "emchat-sound-directory") (defcustom emchat-sound-alist '((message-sound . nil) (chat-sound . nil) (url-sound . nil) (buddy-sound . nil) (auth-sound . nil) (emailx-sound . nil) (pager-sound . nil) (system-sound . nil)) "*Sound event to sound file alist. The possible sound events are: \"message-sound\" - Incoming message sound. \"chat-sound\" - Incoming chat request sound. \"url-sound\" - Incoming url sound. \"buddy-sound\" - Online notify sound. \"auth-sound\" - Authorise sound. \"emailx-sound\" - Email express sound. \"pager-sound\" - Pager sound. \"system-sound\" - System message sound." :group 'emchat-sound :type '(repeat (cons (sexp :tag "Sound Event") (sexp :tag "Sound File"))) :tag "Sounds") (defcustom emchat-coding-system (when (featurep '(or mule file-coding)) (if (eq default-buffer-file-coding-system 'cyrillic) (find-coding-system 'windows-1251) default-buffer-file-coding-system)) "*Coding for incoming and outgoing messages. This feature is supported only in Emacs with MULE Nil means not to use any codings. See `list-coding-systems'." :group 'emchat-option :type (append '(choice (item nil)) (when (fboundp 'coding-system-list) (mapcar #'(lambda (x) (list 'item x)) (coding-system-list))))) (defcustom emchat-auto-response-messages-p t "Set this to non-NIL to send automatic messages. The automatic messages are those that are sent when somebody sends you a message while you are 'away', 'na', 'dnd', or 'occ'." :tag "Send auto-response messages." :type 'boolean :group 'emchat-option) (defcustom emchat-auto-reply-away "I am currently away from the computer. If you would like to be notified when I am back online send me a message with \",,notify-me\" in it. This message has been automatically sent to you by the (S)XEmacs IM client \"EMchat\". " "Auto reply with this when you are away." :group 'emchat-option) (defcustom emchat-auto-reply-occ "I am currently occupied. If you would like to be notified when I am back online send me a message with \",,notify-me\" in it. This message has been automatically sent to you by the (S)XEmacs IM client \"EMchat\". " "Auto reply with this when you are occupied." :group 'emchat-option) (defcustom emchat-auto-reply-dnd "Hey, the sign on the door says \"Do Not Disturb\"! Leave me a message, if you feel you must. I might get back to you. If you would like to be notified when I am back online send me a message with \",,notify-me\" in it. This message has been automatically sent to you by the (S)XEmacs IM client \"EMchat\". " "Auto reply with this when you want to leave alone." :group 'emchat-option) (defcustom emchat-auto-reply-na "I am currently not available. If you would like to be notified when I am back online send me a message with \",,notify-me\" in it. This message has been automatically sent to you by the (S)XEmacs IM client \"EMchat\". " "Auto reply with this when you are not available." :group 'emchat-option) ;; FIXME: How can I make this display how long we've been away (defcustom emchat-idle-reply-away "I must be too busy to talk because I have been idle now for at least...seconds If you would like to be notified when I am back online send me a message with \",,notify-me\" in it. This message has been automatically sent to you by the (S)XEmacs IM client \"EMchat\". " "Auto reply with this when you have idled away." :group 'emchat-option) ;; FIXME: How can I make this display how long we've been away (defcustom emchat-idle-reply-na "I must be too busy to talk because I have been idle now for at least...seconds If you would like to be notified when I am back online send me a message with \",,notify-me\" in it. This message has been automatically sent to you by the (S)XEmacs IM client \"EMchat\". " "Auto reply with this when you have idled to na." :group 'emchat-option) (defcustom emchat-auto-response-never-send-to nil "*This is a list of people that shouldn't get auto-responses. When you add someone's alias here and they send you a message while your status would cause an automatic response to be sent, they won't be sent one." :type '(repeat (string :tag "Alias")) :group 'emchat-option) (defcustom emchat-oops-msg-wrong-recipient "That last message was meant for somebody else. Sorry about that. :-)" "*The \"apology\" sent when you send to the wrong person." :type 'string :group 'emchat-option) (defcustom emchat-start-in-new-frame nil "*If non-NIL, EMchat will start in its own frame." :group 'emchat-interface :type 'boolean) (defcustom emchat-new-message-hook nil "*Hooks to run when there is an incoming message. Dynamically ALIAS and MESSAGE are binded to be used in hooks." :group 'emchat-option :type 'hook) (defcustom emchat-read-message-hook nil "*Hooks run when a message is marked as \"read\"." :group 'emchat-option :type 'hook) (defcustom emchat-system-message-hook nil "*Hooks run when a \"system\" message is received." :group 'emchat-option :type 'hook) (defcustom emchat-load-hook nil "*Hooks run after EMchat has loaded everything up." :type 'hook :group 'emchat-option) (defcustom emchat-missed-message-hook nil "*Hooks run when SRV_MISSED_ICBM packet comes in. This is usually when you are getting too many incoming messages at once. You can use this hook, for example to send back a \"please resend\" message to the original sender. It is called with 3 arguments: ALIAS -- The alias/UIN of the person who sent the message that caused the SRV_MISSED_ICBM packet to be sent. \(string\) NUM -- The number of missed messages. \(integer\) REASON -- The reason that the messages were dropped. \(string\)" :type 'hook :group 'emchat-option) ;; Some debugging counters. Do NOT set any of these. (defvar emchat-dropped-packet-counter 0 "For debug purpose only.") (defvar emchat-resend-packet-counter 0 "For debug purpose only.") (defvar emchat-recent-packet nil "The most recent incoming packet. For debug only.") (defvar emchat-trimmed-packet-counter 0 "For debug purpose only.") (defvar emchat-error-packets nil "A list of error incoming packets. For debug only.") (defcustom emchat-about-fields '((:nick . "Nick Name") (:first-name . "First Name") (:second-name . "Surname") (:email . "Email") (:country . "Country") (:city . "City") (:state . "State") (:zip . "Postal Code") (:phone . "Phone") (:fax . "Fax") (:cellular . "Cellular") (:flags . "Flags") (:web-indicator . "Web Indicator")) "*Alist of field . field-name for basic info queries." :type '(repeat (cons :tag "Field" (choice :tag "Field Keyword" (const :tag "Nick Name" :value :nick) (const :tag "First Name" :value :first-name) (const :tag "Second Name" :value :second-name) (const :tag "Email" :value :email) (const :tag "Country" :value :country) (const :tag "City" :value :city) (const :tag "State" :value :state) (const :tag "Phone" :value :phone) (const :tag "Fax" :value :fax) (const :tag "Street" :value :street) (const :tag "Cellular" :value :cellular) (const :tag "ZIP Code" :value :zip) (const :tag "Flags" :value :flags) (const :tag "Web Indicator" :value :web-indicator)) (string :tag "Field Name"))) :group 'emchat) (defcustom emchat-about-more-fields '((:age . "Age") (:gender . "Gender") (:homepage . "Homepage") (:birth-year . "Birth Year") (:birth-month . "Birth Month") (:birth-day . "Birth Day") (:lang1 . "Language") (:lang2 . "Second Language") (:lang3 . "Third Language") (:ocity . "Old City") (:ostate . "Old State") (:ocountry . "Old Country") (:marital . "Marital Status")) "*Alist of field . fieldname for extended info queries." :type '(repeat (cons :tag "Field" (choice :tag "Field Keyword" (const :tag "Age" :value :age) (const :tag "Gender" :value :gender) (const :tag "Homepage" :value :homepage) (const :tag "Birth Year" :value :birth-year) (const :tag "Birth Month" :value :birth-month) (const :tag "Birth Day" :value :birth-day) (const :tag "Language" :value :lang1) (const :tag "Second Language" :value :lang2) (const :tag "Third Language" :value :lang3) (const :tag "Originate City" :value :ocity) (const :tag "Originate State" :value :ostate) (const :tag "Originate Country" :value :ocountry) (const :tag "Marital" :value :marital)) (string :tag "Documentation"))) :group 'emchat) (defcustom emchat-auth-accept-reason "You are AUTHORISED!" "*Default reason for rejecting incoming auth requests." :type 'string :group 'emchat) (defcustom emchat-auth-reject-reason "Authorisation Rejected!" "*Default reason for rejecting incoming auth requests." :type 'string :group 'emchat) (defcustom emchat-auth-request-reason "Please add me to your contact list" "*Message to send with outgoing auth requests." :type 'string :group 'emchat) (defun emchat-init-visible-list (&rest args) "Initialises the default value for `emchat-visible-contacts'." (when (file-readable-p emchat-world-rc-filename) (emchat-world-update) (mapcar #'(lambda (e) (car e)) emchat-world))) (defcustom emchat-visible-contacts (emchat-init-visible-list) "*List of contacts on your \"visible\" list." :type '(repeat (string :tag "Contact Alias Name")) :initialize #'custom-initialize-reset :get #'emchat-init-visible-list :set #'custom-set-default :group 'emchat) (defcustom emchat-invisible-contacts nil "*List of contacts on your \"invisible\" list." :type '(repeat (string :tag "Contact Alias Name")) :group 'emchat) ;;; Internal variables (defcustom emchat-user-password nil "*Password for your ICQ account. Nil means prompt for entering password every time you login." :group 'emchat-info) (defvar emchat-ctx nil "Current emchat context in emchat-v8 protocol. Internal variable, do not modify.") ;;;###autoload (defun emchat-version (&optional arg) "Return the version of emchat you are currently using. If ARG, insert version string at point." (interactive "P") (if arg (insert (message "EMchat: %s" emchat-version)) (message "EMchat: %s" emchat-version))) ;;;###autoload (defun emchat-copyright () "*Display the copyright notice for EMchat." (interactive) (with-electric-help '(lambda () (insert (with-temp-buffer (erase-buffer) (insert-file-contents (locate-library "emchat.el")) (goto-char (point-min)) (re-search-forward ";;; Commentary" nil t) (beginning-of-line) (narrow-to-region (point-min) (point)) (while (re-search-backward "^;+ ?" nil t) (replace-match "" nil nil)) (buffer-string (current-buffer))))) "*EMchat Copyright Notice*")) (defconst emchat-donation-notice "EMchat is an Open Source project and we have had a lot of fun in getting it into your hands. But this project is NOT a \"for profit\" organisation. We do not receive any funding, Government grants, or subsidies of any kind. None of us who are involved with the project are remunerated in any fashion for what we do with EMchat. We are all just volunteers, coding in our spare time. Often the end user doesn't realise that their \"free\" software has come at some considerable cost. Costs and expenses like... Bandwidth and ISP expenses Hardware updates and maintenance expenses Hosting expenses Domain name registrations Electricity and other utility expenses Outrageous amounts of coffee for all-night coding sessions If you have found this software useful/cool/entertaining please consider dipping into your hard earned and making a donation. Doing so will give you the eternal gratitude and thanks from the EMchat team, and think of the warm fuzzies you'll get. Seriously, even if you decide against making a donation at this time, I would like to sincerely thank you for at least taking the time to consider it. I hope you enjoy EMchat as much as we have enjoyed writing it for you. Steve Youngs EMchat Project Lead. \t\t [Donate]\t\t\t [Cancel] \t\t" "Contents of donation buffer.") (defconst emchat-paypal-glyph "iVBORw0KGgoAAAANSUhEUgAAAG4AAAAXCAIAAABlFO2lAAAACXBIWXMAAAsTAAALEwEAmpwY AAAAB3RJTUUH1wsQEBYNmimKowAACOlJREFUWMPtmWtwVdUVx3/ncV/n3pubBAIhQF4QkgtJ 6gMBrVhfUxSstkjHjlZ8jLUdxk5HRztTqzLUdsaCEsfx0arVqY7TUqfWajWlIqPQiGOLYIE8 CI8QyDtc7vu8z+mHewMhxDGg0w+drDkf9pyz9//813+vtfY+ZwvtnLLapgiTdjbWcW/iZFto PylicYK5V1I0H6TxRgngfg7gmEcC8PmdvxDtHGw02ue1J/5eYWLkHVJH6HqL3khOUKE9p2Pd NBrXUFyPHJyMtYmarZHp5T/PsLu1496EDBBJUP8g0y/54sHuSMz9f9iXdEcOEqmh4YccvR2Q a5siyAmmXoiV/XKZ9ZWk5/+sJnx1gKEKps6sbUrLAFNnYqUR5AmME8H5PwrLr8Id12JKA+yQ AQQPRhrJc1oPXx3+RnBJvolrIsiErkUMYHaT/XgExUUYlSGemShfR92Nsf8sJ/ZqpGKsPjLb xz7K0wAcnAzGIfSOM5w5ncb4Do/0yTXEAN5qrGGsAQDPLJRL0Haj7z8XKR0XkAFcAzONM0rK QKP+YrH6yxZEIh3fEqzXXe/1qQv2OP2Gd2WJ0nQhqQ/HInrLzW3RzO0tgbWVvtUG6t6JUila lbrusL2rzXN1UfCli0m+Nw4NwCuKs32+W6b77ioiueXLxaLiJBcYm2T5fK+8UEP0mFtrM3e1 BNZV+b6vo+47OzTHwtFHpDQz2BnsUQkeDNtt2Vwo2LvS8qIl+hMDTr8BiFEFoxtfA8F6RD+O TmY3qU/wh+19GUBqDCEEmHonmc9IbUcIEVmKrxxcsq0ktiEKuWkE8FebWyx7VxqwO1WkWRhp IN9nhIb/5xWCIunP9Ki/6MJf7Vs1B+0IBUvxzca1ye4j+U9EgaLr8VWQ3oUyH9cg9hZ2jOCS sVSLLrbeD2mPdyqPz6Xgmwz/QaxpUH5TK583jHqU8JV4Z+Vh0y04LlNuOA32xNsYw6dIujZG IlcsIJVA7cdKnrrkIrs1IyiSONNn7Uw6/aXab3uleQogRYNIhdrTUxONe+JlHyUWfKa9MJPQ hYgRuzUDSPVB/ffF8Rkt6q/ChC539FWZNUZi7s7EvE/VxyIUXoORwErlXxReqq3vFqd75SsK naMaVhA7i5XESJykAfhum+G7qV9pmguYfxkiEHXSKzM/0BLV/0pEd6sbiym8hsLlmTsy8dIW dUNhIro7uajDHlxB6NKxVIuv0zcVZn/cCWTvPxAv30Hh97R1Q9k1HcK0Gid5TeYu9RRswTKK V4yFHViO4D9FUhsg3jYiZQa6m1EH0WPocYw07hT7gCrWKfKisP3vtLq2S74gJNYEACmqoA8K paL/gfLAI1VCoayt73bdxXim2/syYoU/FzuBhysDD8uuVZle2e4c0Pz3zZYviegv9JoflSCX ocfRY3gqzWbT3pfx/WSWND+Ig31Aw/WiJ9ATGKk8jVKvoGQZbharA4CbtN1sUfrGNuvTlH9t pdQY0p/tMbcU4y2z2zKA4BM9N0x1enSzOYkUHktVL5cXeqS5ASRBeW5e8MVaRN1uy4gVfkxn orC+SvQ4egJ1kO53iWkjCQ4M7OXEXsKVBEoJzrUP6piuVKdIDUH1kcPYbnjzeZkfdQgFkljq OEfnm81DVksPtpvfVHgF1wg7RzREQXvqmPLcPO+lu+hrN7asco7pgPpoV75Gx0zSvQzuQOvj 0ge1Dd3CFI/nqiLzneO5HJeicYZaAIJzcjTEWoV0G6k+J6kBYpXfeG3Q6TOUDXO83x4SQqXW 9rh9QJVThU6fIS8p8D9QZL5rGK/0CxHZGSowm3vGUJXqfE7CEiv93hUiHevc9Eanz/Asn3IK 9vpeITT7DNiI+a6VgyXeysDHAIMtGCO7zFP10YDjXdBFRbV9OJMLQHlhAabrvWW6WON3Dqvy wgLsrPpozNoWDzxaJc4JZO9oF2Z4BQas1jAuYqXfOag6B1W+dgwhnEtP5ckascybq7yS8jJ7 mzBiVN1hvOXYnSqQXLwzX8E7s9TIHNsBUFGVpzFPQe+nZq1+dy/gXVlibj0BSAuCWD35qlKn 5BryxRHie+zWWbkO6rq+sVSdY26izB0y5YsKSB/ieLudzjtr78/mYR13PNh9J2Hp+iuDLWdu rM6wwka7NZsri1Jkc+ChisA9utOh4iBFFRzb6dVzRdf885CrO9KCIPpgbs0J/KxCvqxQazpm Da8CSSz3A+aWmNNvWNuOG6+0CjPKMWIIMvWPaRuPiqXe4KvR4KvR4It1gL1fpSA6hoabtIz3 FqRvHTD/EfOsmOK5ShXnBAD9d336phnGy33SgqDncnILlDRfQfLZ7XlRxqGaPuj0Grn8MD6s YMYt+YHR4MRhiX827h4VJPCMuooanLb8nLDnHt/lTwvJ53OIYlRh4G++u0uFiKw/1yNM8+YX ItfKT2NUUZ6sEkJSdk2Hq1zmuznpuWGqtTWevf+guTUpLyuj/008UHOn8YbjdGneW0s9dc2e 4G2eawNCgeR0ZohEx9Aw/jSoru1yY2ZgXVVwg8GWet93h703lpjNx7WN3Z4VU0KvzWK4ecTn IIFSuy0tzvAKSmocqrEd4rQD8kVh65Oket9B5p6UUvHdlJwQrG8Q98RpikkAgtsUIZKgpPi0 Xe5Ff2Ta1bxXl1/1gdk30/gUe3/KkZco+w71G7BS9L1N9Rr2r6dzPQ1PUH4bHyzGVrlsO1aS bd8Am4Ynmb4MQSbdyaGn6Xk9D1i+moaN7P81nRvyd5YdQu1h29KxNHCxsmQPc2wTXc/j2kgB GpooXY5rMbCZ1ocwjtOwkfLVfLCEzAGu2Ino4f3G8alKfha/QeFCHJ3NFdQ/TvlqPliM1jtR 2DFf8okYgxHBbYpQkqCsHkGa/NdzTh+ODrE9HI3I+QQPVUxKea5S2iS7R1ZwFQqqJqU8d+t+ ByJyx72J2mfB0Cg5f1KTc7HUYRKM/PrVI3S8Q2gm4XI8BYjipD4T+IvhYqXRhtj/d5IRSIw6 2wknKJnJtEXI/kmhJlQih3cx2MmJUWc7J23yxPFsbfSJ438BQx3Q9K+c09sAAAAASUVORK5C YII=" "A base64 encoded paypal donate button.") (defconst emchat-maybe-later-glyph "iVBORw0KGgoAAAANSUhEUgAAAG4AAAAXCAIAAABlFO2lAAAACXBIWXMAAAsTAAALEwEAmpwY AAAAB3RJTUUH1wsQEBEgkLdAEQAACKJJREFUWMPtmVuMXVUZx39r7X32PpeZc6YznXYudKa1 lHZ6IdzaEGs0IL6CqPGFGKomQDAaagoYAtUEagwF2phSJQYURZEHCCLIRTAojJSCFux12qlz a2emc9ozs+dc9tm3tXw4ZzplOqUzxb40/bIfVr59vv9/rf/51rfXRRxg0pZuyXDRZmNd652T bXHgpIj1Dpdez5zlYEwXJUCfAXDKKwGc+cdnRTsHOxXtTO2Z84qZdV6R76P3JQYzFUHFgYqO y+Zx+Z3Ur8RMXcy1mVpUpjjIfx7no31d6x0TIOOw8j7mf/7swXoi5y4M+4zDMVNklrDqdgbW AebSLRlMh7lXE5ZmiWQg4ggbIrSH9hAWwgYT7aM9CGaMY4FZxSGawbwzEHEwIDxbiIGQADoE dV6KTE07c1uXbimYAHNbCQsIcwZxstohYSLrkA3IWnSIHkUXEDWIeoSBKqCyqCI6OLuOMo2R RsTRPvoEqoQOP7VSmcg6RB3SQrno3BlCBDKOSIENASqPck9TU57mOYfUDmlYBe+ZACKGX8CI zSJeJjFqMVsRNkBkQQKjDmMOgKxDldEu2AgTHaJKaB8RQ5joaCKFLYSBSGO2IDOoEqEgClHj KA8RQyYQcbRCu2i3+sdUqS9BJlB5vDxBCQEigUxM0gkgjdmKrEN7BANoH+Ui4sgEaLSLKoFE JhAWSLQPimhs1lIqDZgA2icooGYjpZnAbPUez7oP9SHJdF0rUnHtxvNrP1DDvvW1xuS2dpRG xpFx0ITjRA5CIBPoEOVj2BAHTaw5eCMqrutM/HihfXsb2ibMQhGZwGxA2KBRBYJhwmGUW6Xe fsJ9qC+x6XP2t5pQfcgk5jyMugm6PLqE2aSyc/zfj5ira80vLEBpZISRnsQMT4DArMdIoxWq RJhDlwhzs5BChShvQsqgSFQkOmWCS1FRerIxxSnqEXa0/xiAItqVN7+Y8bb2q2EfkB1JdIDV jpGsFnZjLsEQwsZqJsoTFZAJzDpUCSGjvVnAuLwGGcduw8ig8sgazAxUKl2AloQOQQ6pT1Ib y5MEPQRF4o3YSzBqqnSmR5DFaAzfHS0/MpB85FKM+ZguMolZO4kpkiCwWqq5LAyK/ahj+IWZ 6qA0OsJ3qILmHdxhwvHJx3emNqY4ARGL9hVF0pCtdvivvOr1yk8MGpclAaMjhYiXNx93Vn4w 1tLpdLxf3jpCrCX8KDXW1Ok9UyQ2L/xAjDV1lu4dAivaVwSC13LO4h3ja3dFPTaxJjWULH7n oLN4h7Nkh7vxCNZCSKICtECYlRCjI0V5AGIkVpQ35ybptowQa/J+e7z0/UNAaUP32IJ/IprU UPwTmLFWrJbiLQfHWjrdB/qdy94P3kxg1M9Ch3Cc8jHG9k9kZRH6X6XlOqQJ8pNrbAHRNM6k SSijbtdYVWO0x6MP8+5HBfOqGtEQiw6WjI4kIJqs+N1tuMp7eqj8cL/93WbzihSWjPYWEU3l x46IlJG4pw2I9hYBLGHd2uRtP+o9NpB4eHHh5o9F0oj/cEG4c9z71aD5pbrY6hqCMvEYoRF1 u7LJEhnB8RBzHiIumoKpdGvSxqWJqKec3LZEpAxdjgo3756KeUNdtL+IQheixE8WGqtGGduJ n5upDspj8G1yZbAnJvWxPYzuoXYhiaZT1loSwD06jbNmbdTtEmhjWdJYlXI39hDp2tevKN7R JdKGbLXUUS/4Sy7sdIh0tSeWxCibl6ei3YXww3z4zlj87jaRPqFLjaqvbK7NJB5o107kbT+q Rnz/2WPqiAe4D/ZWi3suoDjIiY9JXV2hlh1JdESslViDOmaeTmd0JJUTyoVx66sNhHnv1yOn Y2onUkO+cWVNcssihp5n+M+Ueqcf8rTOkU78ic/HZH304UQv9E5XWk9zLt8a7a9MsaR5TZpA W7fMl0sSqsc1r0mjtbuxN/zHWOLBRXJxovTtA6LZEpaPO2isSftPDZU398smy75jPk5n1JdC Y6xIoXUlPY2lycr8TW5dIlusSjk22rvZv41wjDZ7gjqFMKnpQNruD/47lc6OdA6dDczVaXSE CqbBXKEqzth1c8j9mw83UDpyxiGf0XmqtOe0Z4r2lSrjMS4ZSNzfntiQUV0lFEZHEh2pQa9S mIPns9pTxooUXpZg3Fxdq8sq/PtY/J42MfoyQaEiX/DWqP9s1r33MJa01jXJtjgQvJlTw374 zpj/7BFRJyn1EhQQZoU62ld0Nw24P8sFr45PQ+fn1KBfST3/JQe3PB2mEe0vAcbyFLmdBOOf ZX0pK8tkYrN8DEtVUmNZkr132V/5nSg9V+mW7Eji7LJvaxYZ0/vFUTHPmvg+DGKmjKtqK1HW 11N0P4qU1by4YY67sUd7OvXUMiPxon2riN00N/zbWGnD4eCtUfPLcxh+mSgLzknq8O0xb9sR b9uRqLts394ylS63Qy4YNVfXhjvH3fWHqJlv32p8ErMeL1uVsiNJ9nVEadY6VNUAEHpLhoxD Yz1iltvRtW9QdxXvXs/4HrTCSLLoNpbez6HN9D5J6ze47EdELrn3aL6Ro88RFiLnm/4Lx71f Dtb8cYXZ8gSHf46RYNWjNN/E8Ms0fplwnK6fMvgC1lxWPUrDWoTEPUrvk/T/hsgFsBq4+mnq r53sSd9TlAdZfNckXd+THNhELMM1z5BejvJ5+1pgKubQiyzfRPON7LiZ3Htn2WV9yk7eyTGS EXpLhkaHlpUI4zweHNiNrPmTs2I3Stt3XhJfN8TeewlyXACmFbndDGTM6gSvaT+/UgJ7vpfZ +zhCkv0rPX/ArsWuvSCkjBjvn/iCu5BedN6lBA7fV22k5l9QB5f9r0DG7FrvLN0OfpnGKy8e 5p6L5XtwmDj69TJ0vUJNK7VtxNJIeVGfGZxiaMIC5SwHX2M8A84pdzu1Do2tzFuDGb8o1IxK 5PFdjBxi9JS7nYs3jv+XG8f/AUQDon1o6NymAAAAAElFTkSuQmCC" "A base64 encoded png \"Maybe Later\" button.") (defun emchat-make-donation () "Proceed with making a donation to the EMchat project." (interactive) (browse-url "http://tinyurl.com/2uzel4") (kill-buffer "*emchat-donate*")) (defun emchat-no-donation () "Don't make a donation to the EMchat project." (interactive) (kill-buffer "*emchat-donate*")) (defconst emchat-donation-map (let* ((map (make-sparse-keymap 'emchat-donation-map))) (define-key map [button1] 'emchat-make-donation) (define-key map [button2] 'emchat-make-donation) (define-key map [button3] 'emchat-make-donation) (define-key map [return] 'emchat-make-donation) map) "A keymap for the extents in the EMchat donation buffer.") (defconst emchat-nodonation-map (let* ((map (make-sparse-keymap 'emchat-nodonation-map))) (define-key map [button1] 'emchat-no-donation) (define-key map [button2] 'emchat-no-donation) (define-key map [button3] 'emchat-no-donation) (define-key map [return] 'emchat-no-donation) map) "A keymap for the extents in the EMchat donation buffer.") (defun emchat-donation () "Make a donation to the EMchat project via PayPal." (interactive) (let ((buf (get-buffer-create "*emchat-donate*")) (donate-help "Make a donation to the EMchat team.") (cancel-help "Thank you for considering a donation... maybe another time.") (donate-glyph (base64-decode-string emchat-paypal-glyph)) (cancel-glyph (base64-decode-string emchat-maybe-later-glyph)) donate-glyph-ext cancel-glyph-ext donate-text-ext cancel-text-ext) (switch-to-buffer buf) (erase-buffer) (insert emchat-donation-notice) (when (and (device-on-window-system-p) (featurep 'png)) (setq donate-glyph-ext (make-extent (point-max) (point-max))) (set-extent-begin-glyph donate-glyph-ext (make-glyph `([png :data ,donate-glyph]))) (insert "\t\t\t") (setq cancel-glyph-ext (make-extent (point-max) (point-max))) (set-extent-begin-glyph cancel-glyph-ext (make-glyph `([png :data ,cancel-glyph]))) (set-extent-property donate-glyph-ext 'keymap emchat-donation-map) (set-extent-property donate-glyph-ext 'help-echo donate-help) (set-extent-property donate-glyph-ext 'balloon-help donate-help) (set-extent-property cancel-glyph-ext 'keymap emchat-nodonation-map) (set-extent-property cancel-glyph-ext 'help-echo cancel-help) (set-extent-property cancel-glyph-ext 'balloon-help cancel-help)) (goto-char (point-min)) (re-search-forward "\\[Donate\\]" nil t) (setq donate-text-ext (make-extent (match-beginning 0) (match-end 0))) (re-search-forward "\\[Cancel\\]" nil t) (setq cancel-text-ext (make-extent (match-beginning 0) (match-end 0))) (set-extent-property donate-text-ext 'face 'bold) (set-extent-property donate-text-ext 'mouse-face 'highlight) (set-extent-property donate-text-ext 'keymap emchat-donation-map) (set-extent-property donate-text-ext 'help-echo donate-help) (set-extent-property donate-text-ext 'balloon-help donate-help) (set-extent-property cancel-text-ext 'face 'bold) (set-extent-property cancel-text-ext 'mouse-face 'highlight) (set-extent-property cancel-text-ext 'keymap emchat-nodonation-map) (set-extent-property cancel-text-ext 'help-echo cancel-help) (set-extent-property cancel-text-ext 'balloon-help cancel-help) (goto-char (point-min)))) ;; Load the toolbar (add-hook 'emchat-buddy-mode-hook 'emchat-install-buddy-toolbar) (add-hook 'emchat-log-mode-hook 'emchat-install-log-toolbar) ;;; Code - utilities: ;;;###autoload (defun emchat-customize () "Interactively customize settings and preferences." (interactive) (customize-group 'emchat)) ;;;###autoload (defun emchat-browse-homepage () "Browse emchat homepage for news and files." (interactive) (browse-url "http://www.emchat.org/")) (defcustom emchat-encoding-local 'koi8-r "*Local hosts encoding." :type '(choice (item :tag "ASCII" us-ascii) (item :tag "Russian KOI8-R" koi8-r) (item :tag "Russian CP1251" cp1251)) :group 'emchat) (defcustom emchat-encoding-remote 'cp1251 "Remote server encoding." :type '(choice (item :tag "ASCII" us-ascii) (item :tag "Russian KOI8-R" koi8-r) (item :tag "Russian CP1251" cp1251)) :group 'emchat) (defconst emchat-encoding-koi8-r (concat "\301\302\327\307\304\305\243\326\332" "\311\312\313\314\315\316\317\320" "\322\323\324\325\306\310\303\336" "\333\335\337\331\330\334\300\321" "\341\342\367\347\344\345\263\366\372" "\351\352\353\354\355\356\357\360" "\362\363\364\365\346\350\343\376" "\373\375\377\371\370\374\340\361")) (defconst emchat-encoding-cp1251 (concat "\340\341\342\343\344\345\270\346\347" "\350\351\352\353\354\355\356\357" "\360\361\362\363\364\365\366\367" "\370\371\372\373\374\375\376\377" "\300\301\302\303\304\305\250\306\307" "\310\311\312\313\314\315\316\317" "\320\321\322\323\324\325\326\327" "\330\331\332\333\334\335\336\337")) (defun emchat-translate-string (str from-enc to-enc) "Translate STR from koi8 to cp1251." (let ((fe (ecase from-enc (us-ascii nil) (koi8-r emchat-encoding-koi8-r) (cp1251 emchat-encoding-cp1251))) (te (ecase to-enc (us-ascii nil) (koi8-r emchat-encoding-koi8-r) (cp1251 emchat-encoding-cp1251))) (tt (make-vector 256 nil))) (dotimes (idx (min (length fe) (length te))) (aset tt (char-to-int (aref fe idx)) (char-to-string (aref te idx)))) (mapconcat #'(lambda (chr) (or (aref tt (char-to-int chr)) (char-to-string chr))) str nil))) (defun emchat-encode-string (string) "Return a encoded string from STRING with DOS stuff added. Encode string with `emchat-coding-system'." ;; add DOS stuff ;; "0d" instead to avoid use of ^M ;; which messes up with outline mode (let ((estr (replace-in-string string "\x0a" "\x0d\x0a"))) (if (fboundp 'encode-coding-string) (encode-coding-string estr emchat-coding-system) (emchat-translate-string estr emchat-encoding-local emchat-encoding-remote)))) (defun emchat-decode-string (string) "Return a decoded string from STRING with DOS stuff removed. It also quote character % to make `format' happy in `emchat-log'. Decode string with `emchat-coding-system'." ;; remove DOS stuff ;; "0d0a" instead to avoid use of ^M ;; which messes up with outline mode (let ((dstr (replace-in-string string "\x0d\x0a" "\x0a"))) (if (fboundp 'decode-coding-string) (decode-coding-string dstr emchat-coding-system) (emchat-translate-string dstr emchat-encoding-remote emchat-encoding-local)))) (defconst emchat-message-max-size 500 "Maximum size of message that ICQ will accept. Set it to small because size expands after `emchat-encode-string'.") (defun emchat-splitter (x) "Split a long message X into parts of maximum length `emchat-message-max-size'. Only split at whitespace." (loop with i = emchat-message-max-size while (> (length x) i) do (while (and (not (memq (aref x (incf i -1)) '(? ?\t))) ;; at least half, to safe guard (> i (/ emchat-message-max-size 2)))) collect (substring x 0 i) into parts do (setq x (substring x i)) finally return (nconc parts (list x)))) (defvar emchat-outgoing-queue nil "Lists of outgoing queue to be sent. Each queue consists of the binary string and the resend counter.") (defvar emchat-frame nil "The frame where EMchat is displayed.") (defun emchat-connected-p (ctx) "Return non-nil when EMchat is connected to the ICQ server." (memq ctx emchat-v8-connections)) (defun emchat-exit () "Log out of ICQ and close all EMchat buffers." (interactive) (emchat-logout) (set-buffer emchat-log-buffer) (save-buffer) (if emchat-save-log-on-exit-p (rename-file emchat-log-filename (concat emchat-log-filename (format-time-string "-%Y-%b%d-%H%M-%S"))) (delete-file emchat-log-filename)) (loop for each in '(emchat-log-buffer emchat-buddy-buffer emchat-status-buffer) do (when (buffer-live-p (symbol-value each)) (kill-buffer (symbol-value each)))) (delete-other-windows) (when (and emchat-start-in-new-frame (frame-live-p emchat-frame)) (delete-frame emchat-frame)) (setq emchat-frame nil) (when (and (featurep 'emchat-wharf) (frame-live-p emchat-wharf-frame)) (delete-frame emchat-wharf-frame)) (setq emchat-wharf-frame nil)) (defvar emchat-trimmed-packet nil "*Last incomplete packet. Due to limited buffer size of Emacs network buffer, packets can be trimmed and attached at the beginning of next callback. Use this in `emchat-network-separator' to concatenate a packet across two callbacks. Usually only one per 1000 packets needs this.") ;;; Code - client to server packets: (defvar emchat-current-seq-num 1 "Current sequence number in packet.") ;;; FIXME: This needs to be updated for v8 ; (defun emchat-pack-register-new-user (password) ; "Pack register new user packet 03fc." ; (emchat-pack ; "\xfc\x03" ; (emchat-int-bin (length password)) ; password ; "\xa0\x00\x00\x00" ; "\x24\x61\x00\x00" ; "\x00\x00\x00\x00")) ;;; FIXME: This needs to be updated for v8 ; (defvar emchat-random-groups ; '(("general" . "\x01\x00\x00\x00") ; ("romance" . "\x02\x00\x00\x00") ; ("games" . "\x03\x00\x00\x00") ; ("students" . "\x04\x00\x00\x00") ; ("age-20" . "\x06\x00\x00\x00") ; ("age-30" . "\x07\x00\x00\x00") ; ("age-40" . "\x08\x00\x00\x00") ; ("age-50+" . "\x09\x00\x00\x00") ; ("women-wanted" . "\x0a\x00\x00\x00") ; ("man-wanted" . "\x0b\x00\x00\x00")) ; "Random user groups.") ;;; FIXME: This needs to be updated for v8 ; (defun emchat-pack-set-random-group (group) ; "Pack set random group 0564." ; (emchat-pack ; "\x64\x05" ; (cdr (assoc group emchat-random-groups)))) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-pack-search-random-user (group) ; "Pack search random user 056e." ; (emchat-pack ; "\x6e\x05" ; (cdr (assoc group emchat-random-groups)))) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-pack-request-authorization () ; "Pack request authorization packet 0456." ; (emchat-pack "\x56\x04")) ;;; Code - server to client packets: ;;; FIXME: Do we have an unknown packet handler for v8? ; (defun emchat-do-unknown (packet) ; "Handle any unknown PACKET." ; (push (cons 'unknown-command emchat-recent-packet) ; emchat-error-packets) ; (emchat-log-error ; "Unknown command: %s" ; (emchat-bin-hex (substring packet 7 9)))) ;;; FIXME: How is this handled now? ; (defun emchat-do-wrong-password (packet) ; ;; not authorized? ; "Handle server command 0064 in PACKET." ; (emchat-log-error "Your password is invalid")) (defun emchat-do-forced-logoff (ectx) "Called when another user with same UIN is logged in." (emchat-log-error "Another user with same UIN is logged in!") (emchat-logout)) ;; Automatically reconnect when connection unexpectadly closes. ;; WARNING!! This can cause problems, we should have maximum ;; reconnections and reconnection rate custom variables. (defvar emchat-is-auto-reconnecting nil "Internal variable. Do not set.") (defun emchat-do-disconnect (ectx) "Handle disconnect from server." (emchat-log-error "Unexpected disconnection from server") (emchat-logout) (if emchat-user-password (progn (setq emchat-is-auto-reconnecting t) (emchat-log-system "Attempting auto-reconnect...") (emchat-login)) (with-current-buffer emchat-log-buffer (emchat-log-system (substitute-command-keys "Connection lost, use `\\[emchat-login]' to log back in."))))) ;;; FIXME: How is this handled now? ; (defun emchat-do-already-logged-in (packet) ; "Handle server command 00fa PACKET." ; (emchat-log-error "You are already logged in.")) (defun emchat-do-instant-message (ectx &rest ih-arguments) "Handle incoming instant message." (emchat-do-message-helper (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type))) (defun emchat-do-missed-message (ectx &rest ih-arguments) "Handle incoming notice about missed messages." (let ((alias (emchat-uin-alias (emchat-stringular-uin (emchat-get-arg :uin)))) (num (emchat-get-arg :missed-messages)) (reason (emchat-get-arg :reason))) (emchat-do-message-helper alias (format "Server dropped the last %d message%sfrom: %s Reason: %s" num (if (> num 1) "s " " ") alias reason) 'missed) (run-hook-with-args 'emchat-missed-message-hook alias num reason))) (defun emchat-do-offline-message (ectx &rest ih-arguments) "Handle incoming offline message." (let* ((time-stamp (emchat-get-arg :time-stamp)) (year (nth 0 time-stamp)) (month (nth 1 time-stamp)) (day (nth 2 time-stamp)) (hour (1- (nth 3 time-stamp))) (min (nth 4 time-stamp)) (monthname (aref emchat-monthnames month)) (local-time (timezone-fix-time (format "%s %s %s:%s %s" monthname day hour min year) nil nil)) (local-year (aref local-time 0)) (local-monthname (aref emchat-monthnames (aref local-time 1))) (local-day (aref local-time 2)) (local-hour (aref local-time 3)) (local-min (aref local-time 4))) (emchat-do-message-helper (emchat-get-arg :uin) (format "(%s %02s) %02s:%02s\n%s" local-monthname local-day local-hour local-min (emchat-get-arg :msg)) (emchat-get-arg :msg-type)))) (defun emchat-do-added-you (ectx &rest ih-arguments) "Handle incoming SVR_ADDEDYOU packets." (let ((file emchat-recently-added-by-filename) (uin (emchat-stringular-uin (emchat-get-arg :uin))) (msg (emchat-get-arg :msg)) (type (emchat-get-arg :msg-type))) (emchat-do-message-helper uin msg type) (when (or (not (member uin emchat-all-uin)) emchat-world-track-all-adds) (with-current-buffer (find-file-noselect file) (unless (search-forward uin nil t) (goto-char (point-max)) (insert uin) (save-buffer)) (kill-buffer nil)) (add-to-list 'emchat-world-recently-added-by (emchat-numeric-uin uin) 'append)))) (defun emchat-do-auth-request (ectx &rest ih-arguments) "Handle incoming SRV_AUTHREQ." (emchat-do-message-helper (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type))) (defun emchat-do-auth-accept (ectx &rest ih-arguments) "Handle incoming SRV_AUTHREPLY (accepted)." (emchat-do-message-helper (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type))) (defun emchat-do-auth-reject (ectx &rest ih-arguments) "Handle incoming SRV_AUTHREPLY (rejected)." (emchat-do-message-helper (emchat-get-arg :uin) (emchat-get-arg :msg) (emchat-get-arg :msg-type))) (defun emchat-do-srv-contact-err (ectx &rest ih-arguments) "Handle incoming SRV_CONTACTERR." (emchat-log-error "Contacts Error: %s" (emchat-get-arg :reason))) (defun emchat-do-srv-general-err (ectx &rest ih-arguments) "Handle incoming SRV_GEN_ERR." (emchat-log-error "Server Error: %s" (emchat-get-arg :reason))) (defvar emchat-auto-reply-p nil "If non-nil EMchat will not automatically set your state to online. It is used in `emchat-do-message-helper' and `emchat-send-message-helper'.") (defvar emchat-user-auto-away-p nil "This variable is set when the auto-away timer expires, and it is reset in emchat-send-message-helper and emchat-change-status.") (eval-when-compile (load "sound")) (when (featurep 'sxemacs) (defvar emchat-audio-device default-audio-device "The audio device to play sounds on.") (defvar emchat-media-driver nil "Optional driver to use with `emchat-load-media-streams'. See `make-media-stream' for what can be used here.")) (defun emchat-load-media-streams (&optional force) "Loads configured sounds into SXEmacs media streams. With optional prefix arg, FORCE, make the streams even if they already exist. This is useful when you want to replace existing sounds." (interactive "p") (emchat-do-in-sxemacs (let ((sound-lst emchat-sound-alist) (stub "emchat::")) (mapcar #'(lambda (el) (when (stringp (cdr el)) (let* ((file (expand-file-name (cdr el) emchat-sound-directory)) (streamsym (intern (concat stub (symbol-name (car el))))) (stream (ignore-errors (symbol-value streamsym)))) (when (and (file-readable-p file) (or force (not (media-stream-p stream)))) (set streamsym (make-media-stream :file file emchat-media-driver)))))) sound-lst)))) (defun emchat-play-sound-maybe (type) "Play sound TYPE if it exists." (when emchat-use-sound-flag (emchat-do-in-xemacs (when (cdr (assq type emchat-sound-alist)) (let ((file (expand-file-name (cdr (assq type emchat-sound-alist)) emchat-sound-directory))) (play-sound-file file)))) (emchat-do-in-sxemacs (when (media-stream-p (ignore-errors (symbol-value (intern-soft (concat "emchat::" (symbol-name type)))))) (let ((stream (symbol-value (intern-soft (concat "emchat::" (symbol-name type)))))) (play-media-stream stream emchat-audio-device)))))) (defvar emchat-online-notifiers nil "A list of aliases who have requested online notification.") (defun emchat-do-message-helper (uin message &optional msg-type) "Helper for handling offline and online messages. UIN is uin of message sender. MSG-TYPE is type of message. Possible type: `emchat-v8-message-types'. MESSAGE is message body of any type." (let ((alias (emchat-uin-alias (emchat-stringular-uin uin))) (type msg-type)) (add-to-list 'emchat-active-aliases alias) ;; Doctor (if (and emchat-doctor-enabled-flag (member alias emchat-doctor-patients)) (emchat-doctor message alias) (when (and emchat-doctor-enabled-flag (equal message emchat-doctor-begin-string)) (add-to-list 'emchat-doctor-patients alias) (emchat-doctor-reply emchat-doctor-hello-string alias))) ;; Notify (cond ((string-match ",,notify-me\\(\\s-\\|$\\)" message) (add-to-list 'emchat-online-notifiers alias) (emchat-v8-send-simple-message emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) "Online notification request set. Send \",,cancel-notify\" to cancel.") (emchat-log-system (format "Online notify requested by: %s" alias)) (emchat-play-sound-maybe 'system-sound)) ((string-match ",,cancel-notify\\(\\s-\\|$\\)" message) (setq emchat-online-notifiers (remove alias emchat-online-notifiers)) (emchat-v8-send-simple-message emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) "Online notification request cancelled.") (emchat-log-system (format "Online notify cancellation: %s" alias)) (emchat-play-sound-maybe 'system-sound))) ;; Auto-response (when (and emchat-auto-response-messages-p (member emchat-user-status '("away" "na" "dnd" "occ"))) (if emchat-user-auto-away-p (progn (setq emchat-auto-reply-p t) (emchat-idle-reply-maybe alias)) (emchat-auto-reply-maybe alias))) (run-hooks 'emchat-new-message-hook) (case type (normal (emchat-log-buddy-message alias "%s" (emchat-decode-string message)) (emchat-play-sound-maybe 'message-sound)) (chat-request (emchat-log-buddy-message alias "Request chat") (emchat-play-sound-maybe 'chat-sound)) (url (multiple-value-bind (message url) (values-list (split-string message "\xfe")) (emchat-log-buddy-url alias (emchat-decode-string message) (emchat-decode-string url)) (emchat-play-sound-maybe 'url-sound))) ;; Athorization messages (auth-accept (emchat-log-buddy-message alias "Authorisation Accepted!") (emchat-play-sound-maybe 'auth-sound)) (auth-reject (emchat-log-buddy-message alias "Authorisation Rejected!\nReason: %s" (substring (emchat-decode-string message) 0 -1)) (emchat-play-sound-maybe 'auth-sound)) (auth-request (emchat-log-buddy-message alias "Authorisation Request\nReason: %s" (emchat-decode-string message)) (emchat-play-sound-maybe 'auth-sound)) ;; Pager messages (web-pager (emchat-log-buddy-message alias "Web Pager = %s" (emchat-decode-string (replace-in-string message "[\xfe]+" "\n"))) (emchat-play-sound-maybe 'pager-sound)) (email-pager (emchat-log-buddy-message alias "Email Pager = %s" (emchat-decode-string (replace-in-string message "[\xfe]+" "\n"))) (emchat-play-sound-maybe 'pager-sound)) (email-express (emchat-log-buddy-message alias "Email express = %s" (emchat-decode-string (replace-in-string message "[\xfe]+" "\n"))) (emchat-play-sound-maybe 'emailx-sound)) (added (emchat-log-system (format "%s %s" alias message)) (emchat-play-sound-maybe 'system-sound)) (contact-list (emchat-log-buddy-message alias "Contact list = %s" (emchat-decode-string (replace-in-string message "\xfe" "\n")))) (get-away (let ((visible (or (member alias emchat-visible-contacts) (not (member alias emchat-invisible-contacts))))) (emchat-log-system (format "%s requested our away msg (%s)" alias (if visible "sent" "not sent"))) (when visible (emchat-send-message-helper emchat-auto-reply-away (list alias) 'automatic "away msg sent")))) (get-occ (let ((visible (or (member alias emchat-visible-contacts) (not (member alias emchat-invisible-contacts))))) (emchat-log-system (format "%s requested our occupied msg (%s)" alias (if visible "sent" "not sent"))) (when visible (emchat-send-message-helper emchat-auto-reply-occ (list alias) 'automatic "occ msg sent")))) (get-na (let ((visible (or (member alias emchat-visible-contacts) (not (member alias emchat-invisible-contacts))))) (emchat-log-system (format "%s requested our not available msg (%s)" alias (if visible "sent" "not sent"))) (when visible (emchat-send-message-helper emchat-auto-reply-na (list alias) 'automatic "na msg sent")))) (get-dnd (let ((visible (or (member alias emchat-visible-contacts) (not (member alias emchat-invisible-contacts))))) (emchat-log-system (format "%s requested our dnd msg (%s)" alias (if visible "sent" "not sent"))) (when visible (emchat-send-message-helper emchat-auto-reply-dnd (list alias) 'automatic "dnd msg sent")))) (get-ffc ;; TODO: send our free-for-chat message ) ;; SRV_MISSED_ICBM (missed (emchat-log-system (format "%s" message)) (emchat-play-sound-maybe 'system-sound)) (automatic (emchat-log-buddy-message alias "-=[Automatic Response]=-\n%s" (emchat-decode-string message)) (emchat-play-sound-maybe 'system-sound)) (otherwise (push (cons 'unknown-message-types emchat-recent-packet) emchat-error-packets) (emchat-log-error "Unknown message type: %S" msg-type))))) (defvar emchat-auto-reply-never emchat-auto-response-never-send-to "List of people to never send auto-responses to.") (defun emchat-auto-reply (alias) "Auto-reply to ALIAS/uin depending on `emchat-user-status'. Called by `emchat-do-message-helper'." (let ((message (symbol-value (emchat-status-auto-reply emchat-user-status)))) (when message (add-to-list 'emchat-active-aliases alias) (emchat-send-message-helper message (list alias) 'automatic "Auto reply sent")))) (defun emchat-auto-reply-maybe (alias) "Possibly send an auto-response to ALIAS." (unless (or (member alias emchat-auto-reply-never) (member alias emchat-auto-response-never-send-to) (member alias emchat-invisible-contacts) (not (member alias emchat-visible-contacts))) (emchat-auto-reply alias) (add-to-list 'emchat-auto-reply-never alias))) (defun emchat-idle-reply (alias) "Auto-reply to ALIAS/uin depending on `emchat-user-status'. Called by `emchat-do-message-helper'." (let ((message (symbol-value (emchat-status-idle-reply emchat-user-status)))) (when message (add-to-list 'emchat-active-aliases alias) (emchat-send-message-helper message (list alias) 'automatic "Idle reply sent")))) (defun emchat-idle-reply-maybe (alias) "Possibly send an auto-response to ALIAS." (unless (or (member alias emchat-auto-reply-never) (member alias emchat-auto-response-never-send-to) (member alias emchat-invisible-contacts) (not (member alias emchat-visible-contacts))) (emchat-idle-reply alias) (add-to-list 'emchat-auto-reply-never alias)) (setq emchat-auto-reply-p nil)) ;;; FIXME: this isn't used, but having IP and port info in emchat-world ;;; would be nice to have again. ; (defun emchat-do-online (packet) ; "Handle server command 006e in PACKET." ; (let ((alias (emchat-bin-alias packet 21)) ; (status (emchat-status-name (substring packet 38 39))) ; (ip (emchat-bin-ip packet 25)) ; (port (emchat-bin-uin packet 29)) ; (real-ip (emchat-bin-ip packet 33))) ; (if (emchat-valid-uin-p alias) ; (push (cons 'unknown-alias emchat-recent-packet) ; emchat-error-packets)) ; (emchat-buddy-update-status alias status) ; (emchat-play-sound-maybe 'buddy-sound) ; (emchat-world-putf alias 'ip ip) ; (emchat-world-putf alias 'port port) ; (emchat-world-putf alias 'real-ip real-ip))) (defun emchat-do-login-confirm (ectx) "Called when emchat successfully connected to icq server." (emchat-log-debug "Successfully logged in to ICQ server") (emchat-log-system "Connected to %s:%d" (emchat-v8-ctx-host ectx) (emchat-v8-ctx-port ectx)) (emchat-change-status emchat-user-initial-status 'no-network) (emchat-keep-alive-start) (emchat-check-contact-list) (emchat-activate-contact-list) (message "Welcome to EMchat...") (if emchat-is-auto-reconnecting (setq emchat-is-auto-reconnecting nil) (emchat-show-window))) ;;; FIXME: What to do with this in v8? ; (defun emchat-do-system-message (packet) ; TODO ; "Handle server command 01c2 in PACKET." ; (run-hooks 'emchat-system-message-hook)) (defun emchat-format-field (field field-var &optional format) "Format FIELD. FORMAT specifies format to use for FIELD (default is \"%15s: %s\"). Note: USE THIS FUNCTION VERY CAREFULY." (let ((fi-name (cdr (assq field field-var))) (fi-val (emchat-get-arg field))) ;; NOTE: Do not format empty strings (cond ((null fi-val) nil) ((stringp fi-val) (unless (string= fi-val "") (format (or format "%15s: %s\n") fi-name fi-val))) (t (format (or format "%15s: %S\n") fi-name fi-val))))) (defun emchat-add-user-ssi (uin nick ssi-grp id) "Send a request to add UIN to your server side contact list. NICK is the name that will appear in the buddy buffer. It defaults to whatever UIN has set their nick name to. It can be overridden, in fact, you'll be asked if you want to keep the default or choose another nick name. Argument, SSI-GRP is the server side group ID this contact should be added to. EMchat has its own notion of contact groups so SSI-GRP will rarely, if ever, be need to be set by hand. A value for it is obtained from existing group IDs in world. Argument, ID, is the server side contact ID for this contact. It is simply the highest ID from world incremented by 1. This might change in the future when EMchat has better SSI handling." (let* ((uin (emchat-stringular-uin uin))) (progn (emchat-v8-snac-cli-ssi-edit-begin emchat-ctx) (emchat-v8-snac-cli-ssi-add emchat-ctx uin ssi-grp id nick) (emchat-v8-snac-cli-ssi-edit-end emchat-ctx)))) (defun emchat-do-about-general (ectx &rest ih-arguments) "Handle incoming general about info." (let* ((uin (emchat-get-arg :uin)) (alias (emchat-uin-alias (emchat-stringular-uin uin))) (nick (emchat-get-arg :nick))) ;; Dynamically add a new user to your contact list. (if (and (not (member (emchat-stringular-uin uin) emchat-all-uin)) emchat-add-user-p) (let ((ssi-grp (emchat-world-ssi-grp)) (id (emchat-world-next-ssi-id))) (setq nick (if (y-or-n-p (format "Default nick is set to: \"%s\", accept: " nick)) nick (read-string "New nick name: " nil nil alias))) ;; ensure we have a valid nick name (loop until (string-match "^[^:]" nick) do (setq nick (read-string "Invalid Alias (can't begin with \":\"): " nil nil alias))) ;; load up a hash table to carry new user info over to world (setq emchat-world-new-user-hash (make-hash-table :test #'equal :size 6)) (puthash :uin uin emchat-world-new-user-hash) (puthash :nick nick emchat-world-new-user-hash) (puthash :ssi-grp ssi-grp emchat-world-new-user-hash) (puthash :id id emchat-world-new-user-hash) (puthash :egrps (read-string "Add user to group[s] (fmt: :group1 :group2 or RET for none): ") emchat-world-new-user-hash) (emchat-add-user-ssi uin nick ssi-grp id)) ;; Not adding new user, output about info (emchat-log-info (emchat-decode-string (concat "GENERAL about result =\n" (format "%15s: %d\n" "UIN" uin) (format "%15s: %s\n" "Local alias" alias) (apply 'concat (mapcar #'(lambda (field) (emchat-format-field (car field) emchat-about-fields)) emchat-about-fields)) "--- END ---")))))) (defun emchat-do-about-more (ectx &rest ih-arguments) "Handle incoming more about info." (let* ((uin (emchat-get-arg :uin)) (alias (emchat-uin-alias (emchat-stringular-uin uin)))) (emchat-log-info (emchat-decode-string (concat "MORE about result =\n" (format "%15s: %d\n" "UIN" uin) (format "%15s: %s\n" "Local alias" alias) (apply 'concat (mapcar #'(lambda (field) (emchat-format-field (car field) emchat-about-more-fields)) emchat-about-more-fields)) "--- END ---"))))) (defun emchat-do-about-about (ectx &rest ih-arguments) "Handle incoming user notes info." (let* ((uin (emchat-get-arg :uin)) (alias (emchat-uin-alias (emchat-stringular-uin uin)))) (emchat-log-info (emchat-decode-string (concat "ABOUT about result =\n" (format "%15s: %d\n" "UIN" uin) (format "%15s: %s\n" "Local alias" alias) (emchat-get-arg :about) "\n" "--- END ---"))))) (defun emchat-do-search-found (ecxt &rest ih-arguments) "A user we were looking for is found." (apply 'emchat-do-about-general ecxt ih-arguments)) (defun emchat-do-search-found-last (ecxt &rest ih-arguments) "The last user in the search has been found." (apply 'emchat-do-about-general ecxt ih-arguments) (let ((status (if (= (emchat-get-arg :status) 1) 'online 'offline))) (if (zerop (emchat-get-arg :missed)) (if emchat-add-user-p (puthash :status status emchat-world-new-user-hash) (emchat-log-info "All search results returned")) (emchat-log-info "Too many seach results")))) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-do-update-info-confirm (packet) ; "Handle server command 01e0 in PACKET." ; (emchat-log-info "Update info succeeded")) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-do-update-info-fail (packet) ; "Handle server command 01ea in PACKET." ; (emchat-log-info "Update info failed")) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-do-update-authorization-confirm (packet) ; "Handle server command 01f4 in PACKET." ; (emchat-log-info "Update authorization succeeded")) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-do-update-authorization-fail (packet) ; "Handle server command 01fe in PACKET." ; (emchat-log-info "Update authorization failed")) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-do-update-info-ext-confirm (packet) ; "Handle server command 01c8 in PACKET." ; (emchat-log-info "Update extended info succeeded")) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-do-new-account-uin (packet) ; "Handle server command 0046 in PACKET." ; (emchat-log-info ; "New uin: %s" ; (emchat-bin-uin packet 13))) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-do-search-random-user-found (packet) ; "Handle server command 0258 in PACKET." ; (if (< (length packet) 30) ; (emchat-log-info "Random user search failed") ; (emchat-query-info (emchat-bin-uin packet 21)))) ;;; Code - alias and uin: (defvar emchat-alias-history nil "History of aliases in `emchat-completing-aliases'.") (defvar emchat-alias-list-history nil "History of aliases in `emchat-send-message-helper'. For sending messages of any kind to a single alias, it records the same thing as `emchat-alias-history' does, while sending to multiple aliases, this records a list of aliases instead of one by one. This faciliates re-sending to a list of aliases in future version.") (defvar emchat-connected-aliases nil "Aliases that are in any statuses except 'invisible'.") (defvar emchat-active-aliases nil "Aliases which we have exchanged messages with.") (defun emchat-process-alias-input (symbol) "Input alias as selected or from completing. SYMBOL is the symbol of variable (`alias') to be processed. Non-nil SYMBOL means no processing. Negative argument (press \\[negative-argument] before this command) means taking all selected alias in buddy buffer as input. Prefix argument (press \\[universal-argument] before this command) means completing-read multi aliases from minibuffer. Otherwise, completing-read one alias from minibuffer. See `emchat-completing-aliases'." (or (symbol-value symbol) (set symbol (if (eq '- current-prefix-arg) (emchat-buddy-selected-in-view) (emchat-completing-aliases "to: " (not current-prefix-arg)))))) ;;; Code - system main: (defvar emchat-blurb "As succinctly as possible, tell us:-\n \tWhat happened. \tWhat you thought should happen. \tAnything else that you think is relevant.\n *** Please delete these instructions before submitting the report. *** ======================================================================\n" "Preamble to the bug report.") ;;;###autoload (defun emchat-login () "Login to ICQ server. Make connection to server and network if necessary." (interactive) (let* ((uin (progn (emchat-world-update) (emchat-numeric-uin (emchat-alias-uin emchat-user-alias)))) (password (or emchat-user-password (read-passwd (format "Password for %s (%d): " emchat-user-alias uin))))) (when (equal emchat-user-status "offline") (or (emchat-valid-uin-p uin) (error "Invalid user uin")) (setq emchat-trimmed-packet nil) ; hack (setq emchat-current-seq-num 0) (emchat-log-show-buffer nil 'no-select) ;; Create emchat v8 context (setq emchat-ctx (emchat-v8-create-ctx uin password 'connect-tries 10 'initial-status (append (and emchat-user-meta-web-aware '(web-aware)) (and emchat-user-meta-invisible '(invisible)) (list (emchat-status-v8 emchat-user-initial-status))))) ;; Install incoming handlers (setf (emchat-v8-ctx-incoming-handlers emchat-ctx) (list 'instant-message 'emchat-do-instant-message 'missed-message 'emchat-do-missed-message 'offline-message 'emchat-do-offline-message 'connected 'emchat-do-login-confirm 'status-update 'emchat-do-status-update 'about-general 'emchat-do-about-general 'about-more 'emchat-do-about-more 'about-about 'emchat-do-about-about 'logoff 'emchat-do-forced-logoff 'disconnect 'emchat-do-disconnect 'search-found 'emchat-do-search-found 'search-found-last 'emchat-do-search-found-last 'added-you 'emchat-do-added-you 'auth-request 'emchat-do-auth-request 'auth-accept 'emchat-do-auth-accept 'auth-reject 'emchat-do-auth-reject 'srv-contacterr 'emchat-do-srv-contact-err 'srv-error 'emchat-do-srv-general-err 'new-user 'emchat-world-add-new-user )) ;; Load SXEmacs media streams (when (and emchat-use-sound-flag (featurep 'sxemacs)) (emchat-load-media-streams)) (emchat-v8-connect emchat-ctx emchat-server emchat-port)))) (autoload 'emchat-wharf-change-messages "emchat-wharf") (defun emchat-logout () "Logout ICQ server. Remain connected to network and server. Don't send logout packet if KILL is non-nil, useful for emergency logout when being kicked out by server." (interactive) (emchat-log-debug "Logging out ICQ server.") (setq emchat-connected-aliases nil) (emchat-buddy-show-buffer 'new 'no-select) (emchat-change-status "offline" 'no-network) (emchat-keep-alive-stop) (if (and (featurep 'emchat-wharf) (frame-live-p emchat-wharf-frame)) (progn (emchat-wharf-change-messages "New" -9999) (emchat-wharf-change-messages "Sys" -9999))) (when emchat-history-enabled-flag (mapcar #'(lambda (alias) (let* ((histf (emchat-world-getf alias 'history)) (histb (and histf (find-buffer-visiting histf)))) (when histb (with-current-buffer histb (save-buffer) (kill-buffer nil))))) emchat-all-aliases)) (when (emchat-connected-p emchat-ctx) (emchat-v8-close emchat-ctx))) (defvar emchat-contact-list-packets nil "Lists of remaining contact list packets to be sent. For experimental purpose only.") ;; Now broken because local contact lists are no longer ;; supported. `emchat-activate-contact-list' replaces this. ;;(defun emchat-send-contact-list () ;; "Send the whole contact list. ;;You can resend contact list after `emchat-world-update'." ;; (interactive) ;; (setq emchat-connected-aliases nil) ;; (emchat-buddy-show-buffer 'new 'no-select) ;; (emchat-world-update) ;; ;; Visible ;; (when emchat-visible-contacts ;; (emchat-v8-ctx-put-prop emchat-ctx 'visible-list ;; (mapcar ;; #'(lambda (v) ;; (emchat-numeric-uin (emchat-alias-uin v))) ;; emchat-visible-contacts)) ;; (emchat-v8-snac-cli-addvisible emchat-ctx)) ;; ;; Invisible ;; (when emchat-invisible-contacts ;; (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list ;; (mapcar ;; #'(lambda (i) ;; (emchat-numeric-uin (emchat-alias-uin i))) ;; emchat-invisible-contacts)) ;; (emchat-v8-snac-cli-addinvisible emchat-ctx)) ;; ;; All ;; (emchat-v8-ctx-put-prop emchat-ctx 'contacts ;; (mapcar 'emchat-numeric-uin (mapcar 'cadr emchat-world))) ;; (emchat-v8-snac-cli-add-contact emchat-ctx)) (defun emchat-check-contact-list () "Checks to ensure local copy of SSI list is up to date." (interactive) (emchat-v8-snac-cli-ssi-checkout emchat-ctx)) (defun emchat-activate-contact-list () "Activate the server-side contact list." (interactive) (setq emchat-connected-aliases nil) (emchat-buddy-show-buffer 'new 'no-select) (emchat-world-update) ;; Visible (when emchat-visible-contacts (emchat-v8-ctx-put-prop emchat-ctx 'visible-list (mapcar #'(lambda (v) (emchat-numeric-uin (emchat-alias-uin v))) emchat-visible-contacts)) ; (emchat-v8-snac-cli-addvisible emchat-ctx) ) ;; Invisible (when emchat-invisible-contacts (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list (mapcar #'(lambda (i) (emchat-numeric-uin (emchat-alias-uin i))) emchat-invisible-contacts)) ; (emchat-v8-snac-cli-addinvisible emchat-ctx) ) ;; All (emchat-v8-ctx-put-prop emchat-ctx 'contacts (mapcar 'emchat-numeric-uin (mapcar 'cadr emchat-world))) (emchat-v8-snac-cli-ssi-activate emchat-ctx)) (defun emchat-keep-alive-start () "Start keeping alive." (emchat-keep-alive-stop) (start-itimer "emchat keep-alive" (lambda () (emchat-v8-snac-cli-keepalive emchat-ctx)) ;; sending faster won't hurt 60 60)) (defun emchat-keep-alive-stop () "Stop keeping alive." (let ((itimer (get-itimer "emchat keep-alive"))) (when (itimerp itimer) (delete-itimer itimer)))) (defun emchat-add-user (uin) (interactive "sUIN: ") (setq emchat-add-user-p t) (emchat-search-by-uin uin)) (defun emchat-change-user (alias password) "Change user to ALIAS with PASSWORD. Need to relogin afterwards." (interactive (append (emchat-completing-aliases "Change to: " 'single) (list (read-passwd "Password: ")))) (setq emchat-user-alias alias) (setq emchat-user-password (if (zerop (length password)) nil password))) (defun emchat-auto-away-timeout-set (symbol value) "Set timer for auto-away. See `emchat-auto-away-timeout'." ;; delete the previous itimers (when (itimerp (get-itimer "emchat auto-away")) (delete-itimer (get-itimer "emchat auto-away"))) (when (itimerp (get-itimer "emchat auto-na")) (delete-itimer (get-itimer "emchat auto-na"))) (unless (zerop value) (start-itimer "emchat auto-away" #'(lambda () ;; auto away for first idle (when (member emchat-user-status '("online" "ffc")) (emchat-log-system "Auto away.") (emchat-change-status "away") (setq emchat-user-auto-away-p t))) value value 'idle) (start-itimer "emchat auto-na" #'(lambda () ;; auto na for second idle (when (and emchat-user-auto-away-p (equal emchat-user-status "away")) (emchat-log-system "Auto na.") (emchat-change-status "na") ;; emchat-change-status resets this flag (setq emchat-user-auto-away-p t))) (* 2 value) (* 2 value))) (set (intern (symbol-name symbol)) value)) (defcustom emchat-auto-away-timeout 300 "*Seconds of inactivity in Emacs before auto-away. After two times the seconds of auto-away, it goes auto-na. See `emchat-auto-away'. Setting this to zero disables the timeout. If you set this outside of the custom buffer you _MUST_ use `customize-set-variable' and _NOT_ `setq'." :type 'number :set 'emchat-auto-away-timeout-set :initialize 'custom-initialize-default :group 'emchat-option) (defun emchat-change-idle-timeout (seconds) "Change the number of SECONDS before EMchat will idle to \"away\". If SECONDS is 0 \(zero\) the timeout will be disabled and EMchat will not automatically idle to \"away\" or \"na\". Setting the timeout here does not save the value across emacs sessions. To do that, customise the variable, `emchat-auto-away-timeout'." (interactive (list (read-number "Idle timeout in seconds (0 to disable): " nil (number-to-string emchat-auto-away-timeout)))) (emchat-auto-away-timeout-set 'emchat-auto-away-timeout seconds) (if (zerop seconds) (emchat-log-system "Auto-away disabled.") (emchat-log-system "Auto-away timeout set to: %d seconds." seconds))) (defun emchat-send-message-helper (message aliases type log-message) "Send message, url, authorization or others. MESSAGE is the message to send. ALIASES is a list of aliases/uin to send to. TYPE is the type of message in `emchat-v8-message-types'. LOG-MESSAGE is a message to put in log. See `emchat-send-message', `emchat-send-url' and `emchat-authorize'." (when (and emchat-user-auto-away-p (not emchat-auto-reply-p)) (emchat-change-status "online")) (add-to-list 'emchat-alias-list-history aliases) (loop for alias in aliases do (add-to-list 'emchat-active-aliases alias) do (if (eq type 'normal) (emchat-v8-send-simple-message emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) message) (emchat-v8-send-typed-message emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) type message)) do (emchat-log-outgoing alias ">>> %s" log-message)) (setq emchat-auto-reply-p nil)) (defvar emchat-message-history nil "History of `emchat-send-message' for `completing-read'.") (defun emchat-send-message (&optional message &rest aliases) "Send an instant message. MESSAGE is the message to send. ALIASES is a list of aliases/uin to send to. See `emchat-process-alias-input'." (interactive "P") (let ((prompt (concat "Message" ;; display alias if given (if (car aliases) (concat " to " (substring (format "%s" aliases) 1 -1))) ": "))) (or (stringp message) (setq message (read-from-minibuffer prompt nil nil nil 'emchat-message-history))) ;; idea from Erik Arneson ;; confirm sending a blank message (unless (and (or (zerop (length message)) ;; \\W fails with "=)" or "..." (string-match "^[ \t]+$" message)) (not (y-or-n-p "Send a blank message? "))) (emchat-process-alias-input 'aliases) ;; apply encode only TEXT portion of packet (let ((msg (emchat-splitter message))) (loop for x in msg do (emchat-send-message-helper ;; encoding outgoing but not that to be insert in log buffer (emchat-encode-string x) aliases 'normal x) do (when (and (> (length msg) 1) (not (string= x (car (last msg))))) (sit-for 1))))))) (defun emchat-send-message-via-mouse (event) ;; Erik Arneson (from VM) "`emchat-send-message' via mouse." (interactive "e") (set-buffer (window-buffer (event-window event))) (and (event-point event) (goto-char (event-point event))) (if (eq (current-buffer) emchat-buddy-buffer) (emchat-send-message-alias-here) ;; fall through ;; any alias in log-mode format (enclosed by []) can use this (emchat-send-message-alias-around))) (defvar emchat-url-history nil "History of `emchat-send-url' for `completing-read'.") (defun emchat-send-url (&optional url description &rest aliases) "Send an url. URL is any Internet address. DESCRIPTION is the description of url. ALIASES is a list of aliases/uin to send to. See `emchat-process-alias-input'." (interactive "P") (let ((prompt (concat "url" ;; display alias if given (if (car aliases) (concat " to " (substring (format "%s" aliases) 1 -1))) ": "))) (or (stringp url) (setq url (read-from-minibuffer prompt nil nil nil 'emchat-url-history))) ;; idea from Erik Arneson ;; confirm sending a blank url (unless (and (or (zerop (length url)) ;; \\W fails with "=)" or "..." (string-match "^[ \t]+$" url)) (not (y-or-n-p "Send a blank url? "))) (or description (setq description (read-from-minibuffer "description: " nil nil nil 'emchat-message-history))) (emchat-process-alias-input 'aliases) (emchat-send-message-helper (format "%s\xfe%s" ;; encode only to TEXT portions of packet, instead of the whole (emchat-encode-string description) (emchat-encode-string url)) aliases 'url (format "%s (%s)" url description))))) (defun emchat-authorize (alias) "Send authorization to allow adding to contact list. ALIAS is an alias/uin." (interactive (list (car (emchat-completing-aliases "Authorisation for: " 'single)))) (let (reply) (if (y-or-n-p "Accept the authorisation request? ") (progn (setq reply 1) (emchat-log-buddy-message alias ">>> %s" emchat-auth-accept-reason)) (setq reply 0) (emchat-log-buddy-message alias ">>> %s" emchat-auth-reject-reason)) (emchat-v8-snac-cli-ssi-auth-reply emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) reply (if (zerop reply) emchat-auth-reject-reason emchat-auth-accept-reason)))) (defun emchat-auth-request (alias) "Request authorisation from ALIAS." (interactive (list (car (emchat-completing-aliases "Request Authorisation from: " 'single)))) (emchat-v8-snac-cli-ssi-send-auth-request emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)) emchat-auth-request-reason) (emchat-log-info "Authorisation requested from: %s" alias)) (defun emchat-request-away (&optional alias) "Request away message from ALIAS." (interactive) (unless alias (setq alias (car (emchat-completing-aliases "Get Away message from: " 'single)))) (emchat-send-message-helper "" (list alias) 'get-away "Away message requested")) (defun emchat-request-na (&optional alias) "Request Not Avaliable message from ALIAS." (interactive) (unless alias (setq alias (car (emchat-completing-aliases "Get Not Available message from: " 'single)))) (emchat-send-message-helper "" (list alias) 'get-na "Not Available message requested")) (defun emchat-request-dnd (&optional alias) "Request Do Not Disturb message from ALIAS." (interactive) (unless alias (setq alias (car (emchat-completing-aliases "Get Do Not Disturb message from: " 'single)))) (emchat-send-message-helper "" (list alias) 'get-dnd "Do Not Disturb message requested")) (defun emchat-request-occ (&optional alias) "Request occupied message from ALIAS." (interactive) (unless alias (setq alias (car (emchat-completing-aliases "Get Occupied message from: " 'single)))) (emchat-send-message-helper "" (list alias) 'get-occ "Occupied message requested")) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-register-new-user (password) ; "Register a new uin with PASSWORD." ; (interactive (list (read-passwd "Password: " 'confirm))) ; (emchat-send (emchat-pack-register-new-user password))) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-change-password (password) ; "Change PASSWORD." ; (interactive (list (read-passwd "Password: " 'confirm))) ; (emchat-send (emchat-pack-meta-user-change-password password))) (defun emchat-search (&optional online first last nick email) "Search for ICQ users. Optional prefix arg, ONLINE when non-nil means to only return search results for ICQ users that are currently online. Argument FIRST - first name to search for Argument LAST - last name to search for Argument NICK - nick name to search for Argument EMAIL - email address to search for." (interactive "P") (let ((online (if online 1 (if current-prefix-arg 1 0))) (first (if (interactive-p) (read-string "First Name [RET for null]: ") (or first ""))) (last (if (interactive-p) (read-string "Last Name [RET for null]: ") (or last ""))) (nick (if (interactive-p) (read-string "Nick Name [RET for null]: ") (or nick ""))) (email (if (interactive-p) (read-string "Email Address [RET for null]: ") (or email "")))) (when (string= "" (concat first last nick email)) (error 'invalid-argument "You must provide at least one search term")) (emchat-v8-snac-cli-searchbypersinf emchat-ctx first last nick email online))) (defun emchat-search-by-uin (uin) "Search user by UIN." (interactive "sUIN: ") (emchat-v8-snac-cli-searchbyuin emchat-ctx (emchat-numeric-uin uin))) (defun emchat-search-by-email (email) "Search for a user by their EMAIL address." (interactive "sEmail address: ") (emchat-v8-snac-cli-searchbyemail emchat-ctx email)) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-search-random-user (group) ; "Search random user in GROUP." ; (interactive ; (list (emchat-completing-read ; "Random group: " ; (mapcar 'car emchat-random-groups)))) ; (emchat-send (emchat-pack-search-random-user group))) ;;; FIXME: This needs to be updated for v8 ; (defun emchat-set-random-group (group) ; "Set random user GROUP." ; (interactive ; (list (emchat-completing-read ; "Random group: " ; (mapcar 'car emchat-random-groups)))) ; (emchat-send (emchat-pack-set-random-group group))) (defun emchat-query-info (&optional alias) "Query meta user info. ALIAS is an alias/uin." (interactive) (if alias ;; display alias if given (message "Query %s." alias) (setq alias (car (emchat-completing-aliases "Query: " 'single)))) (let ((local-info (emchat-world-info alias))) (if local-info (emchat-log-info "Local info:\n%s" local-info))) (emchat-v8-snac-cli-metareqinfo emchat-ctx (emchat-numeric-uin (emchat-alias-uin alias)))) (defun emchat-add-to-visible-list (aliases) "Add ALIASES, a list of alias names/UINs, to your visible list." (interactive (list (emchat-completing-aliases "Visible to alias/UIN (RET to send): "))) (let ((uins (mapcar #'(lambda (alias) (emchat-numeric-uin (emchat-alias-uin alias))) aliases))) (emchat-v8-snac-cli-addvisible emchat-ctx uins) (mapcar #'(lambda (alias) (add-to-list 'emchat-visible-contacts alias 'append)) aliases) (emchat-log-info "You are now visible to: %s" aliases) (when (y-or-n-p "Do you want this change saved for future sessions ") (customize-save-variable 'emchat-visible-contacts (symbol-value 'emchat-visible-contacts))))) (defun emchat-add-to-invisible-list (aliases) "Add ALIASES, a list of alias names/UINs, to your invisible list." (interactive (list (emchat-completing-aliases "Invisible to alias/UIN (RET to send): "))) (let ((uins (mapcar #'(lambda (alias) (emchat-numeric-uin (emchat-alias-uin alias))) aliases))) (emchat-v8-snac-cli-addinvisible emchat-ctx uins) (mapcar #'(lambda (alias) (add-to-list 'emchat-invisible-contacts alias 'append)) aliases) (emchat-log-info "You are now invisible to: %s" aliases) (when (y-or-n-p "Do you want this change saved for future sessions ") (customize-save-variable 'emchat-invisible-contacts (symbol-value 'emchat-invisible-contacts))))) (defun emchat-remove-from-visible-list (aliases) "Remove ALIASES, a list of alias names/UINs, from your visible list." (interactive (list (emchat-completing-aliases "Not visible to alias/UIN (RET to send): "))) (let ((uins (mapcar #'(lambda (alias) (emchat-numeric-uin (emchat-alias-uin alias))) aliases)) nvis) (mapcar #'(lambda (alias) (setq emchat-visible-contacts (remove alias emchat-visible-contacts))) aliases) (setq nvis (mapcar #'(lambda (alias) (emchat-numeric-uin (emchat-alias-uin alias))) emchat-visible-contacts)) (emchat-v8-ctx-put-prop emchat-ctx 'visible-list nvis) (emchat-v8-snac-cli-remvisible emchat-ctx uins) (emchat-log-info "You are no longer visible to: %s" aliases) (when (y-or-n-p "Do you want this change saved for future sessions ") (customize-save-variable 'emchat-visible-contacts (symbol-value 'emchat-visible-contacts))))) (defun emchat-remove-from-invisible-list (aliases) "Remove ALIASES, a list of alias names/UINs, from your invisible list." (interactive (list (emchat-completing-aliases "Not invisible to alias/UIN (RET to send): "))) (let ((uins (mapcar #'(lambda (alias) (emchat-numeric-uin (emchat-alias-uin alias))) aliases)) nvis) (mapcar #'(lambda (alias) (setq emchat-invisible-contacts (remove alias emchat-invisible-contacts))) aliases) (setq nvis (mapcar #'(lambda (alias) (emchat-numeric-uin (emchat-alias-uin alias))) emchat-invisible-contacts)) (emchat-v8-ctx-put-prop emchat-ctx 'invisible-list nvis) (emchat-v8-snac-cli-reminvisible emchat-ctx uins) (emchat-log-info "You are no longer invisible to: %s" aliases) (when (y-or-n-p "Do you want this change saved for future sessions ") (customize-save-variable 'emchat-invisible-contacts (symbol-value 'emchat-invisible-contacts))))) (defun emchat-remove-yourself-from-buddy (alias) "Removes your entry from ALIAS' server side contact list." (interactive (list (emchat-completing-read "UIN: " (mapcar #'number-to-string emchat-world-recently-added-by) #'(lambda (match) (not (or (member match emchat-all-uin) emchat-world-track-all-adds)))))) (let ((uin (emchat-numeric-uin (emchat-alias-uin alias)))) (emchat-v8-snac-cli-ssi-del-yourself emchat-ctx uin) (emchat-log-info "You have removed yourself from %s's server-side contact list. When %1$s cycles their ICQ connection you should disappear from their local list as well." alias) (setq emchat-world-recently-added-by (delete (emchat-numeric-uin uin) emchat-world-recently-added-by)) (with-current-buffer (find-file-noselect emchat-recently-added-by-filename) (erase-buffer) (mapcar #'(lambda (el) (insert (emchat-stringular-uin el))) emchat-world-recently-added-by) (save-buffer) (kill-buffer nil)))) (autoload 'emchat-wharf-new-frame "emchat-wharf") (defun emchat-switch-to-buddy-buffer () "Switches from the log buffer to the buddy buffer." (interactive) (emchat-switch-buffer emchat-buddy-buffer)) (defun emchat-switch-to-log-buffer () "Switches from the buddy buffer to the log buffer." (interactive) (emchat-switch-buffer emchat-log-buffer)) ;;;###autoload (defun emchat-show-window () "Show windows of emchat buffers. Make them if not yet done. See `emchat-buddy-buffer' and `emchat-log-buffer'." (interactive) (unless (frame-live-p emchat-frame) (setq emchat-frame (if (and emchat-start-in-new-frame (device-on-window-system-p)) (new-frame '((name . "EMchatLog"))) (last-nonminibuf-frame)))) (when (device-on-window-system-p) (select-frame emchat-frame)) (emchat-buddy-show-buffer) (if emchat-status-use-gutter (progn (set-specifier top-gutter-visible-p t emchat-frame) (emchat-update-tab-in-gutter)) (emchat-status-show-buffer)) (emchat-log-show-buffer) (set-window-buffer nil emchat-buddy-buffer) (delete-other-windows) (set-window-buffer (split-window nil emchat-buddy-window-width t) emchat-log-buffer) (if emchat-status-use-gutter (emchat-switch-buffer emchat-log-buffer) (set-window-buffer nil emchat-status-buffer) (set-window-buffer (split-window nil emchat-status-window-height) emchat-buddy-buffer) (emchat-switch-buffer emchat-log-buffer)) (save-excursion (if emchat-wharf-frame-use-p (emchat-wharf-new-frame))) (focus-frame emchat-frame)) (defun emchat-hide-window () "Hide windows of emchat buffers." (interactive) (delete-other-windows) (loop for each in '(emchat-buddy-buffer emchat-log-buffer emchat-status-buffer emchat-debug-buffer) do (when (buffer-live-p (symbol-value each)) (bury-buffer (symbol-value each)))) (bury-buffer) (when emchat-status-use-gutter (set-specifier top-gutter-visible-p nil emchat-frame))) (defun emchat-window-hidden-p () "Returns non-nil when the EMchat buffers are hidden." (if (or (get-buffer-window emchat-log-buffer emchat-frame) (get-buffer-window emchat-buddy-buffer emchat-frame) (get-buffer-window emchat-status-buffer emchat-frame)) nil t)) ;;; Code - log: ;; message history buffer (defun emchat-alias-around () "Return an alias/uin on current line or lines before. If called interactively, display and push alias into `kill-ring'." (interactive) (save-excursion (outline-back-to-heading) (looking-at "^...:.. \\[\\([^]]+\\)\\]") (let ((alias (match-string 1))) (cond ((or (member alias emchat-all-aliases) (emchat-valid-uin-p alias)) (when (interactive-p) (message alias) (kill-new alias)) alias) (t (error "No valid alias/uin found")))))) (defun emchat-oops () "Oops that message went to the wrong person. When you accidently send a message to the wrong person, `emchat-oops' can be used to send the original message to the correct person and send the wrong person an explanation. The explanation sent is the value of `emchat-oops-msg-wrong-recipient'. You will be prompted for the new contact to send to." (interactive) (let ((message (emchat-log-around)) (alias (emchat-alias-around))) (emchat-send-message emchat-oops-msg-wrong-recipient alias) (emchat-send-message message))) (defun emchat-forward-message-around (&optional no-header) "Forward message around Non-nil NO-HEADER means avoid prefixing message with original sender's info. ALIASES is a list of aliases/uin to send to. See `emchat-process-alias-input'." (interactive "P") (let* ((message (emchat-log-around)) (alias (emchat-alias-around)) (uin (emchat-alias-uin alias))) (emchat-send-message (concat (if (not no-header) (format "%s (ICQ#%s) Wrote:\n" alias uin)) message)))) (defun emchat-forward-message-around-without-header () "See `emchat-forward-message-around'." (interactive) (emchat-forward-message-around 'no-header)) (defun emchat-select-alias-around () "See `emchat-group-select-aliases' and `emchat-alias-around'." (interactive) (emchat-group-select-aliases 'toggle (emchat-alias-around))) (defun emchat-send-message-alias-around () "See `emchat-send-message' and `emchat-alias-around'." (interactive) (emchat-log-mark 'read) (when emchat-wharf-frame-use-p (emchat-wharf-dec-messages)) (emchat-send-message nil (emchat-alias-around))) (defun emchat-send-url-alias-around () "See `emchat-send-url' and `emchat-alias-around'." (interactive) (emchat-log-mark 'read) (when emchat-wharf-frame-use-p (emchat-wharf-dec-messages)) (emchat-send-url nil nil (emchat-alias-around))) (defun emchat-authorize-alias-around () "See `emchat-authorize' and `emchat-alias-around'." (interactive) (emchat-authorize (emchat-alias-around))) (defun emchat-query-info-alias-around () "See `emchat-query-info' and `emchat-alias-around'." (interactive) (emchat-query-info (emchat-alias-around))) ;;; Code - buddy: ;; contact list (list of aliases) buffer (defun emchat-alias-here () "Return an alias/uin on current line. Leading or trailing whitespace are ignored. If called interactively, display and push alias into `kill-ring'." (interactive) (save-excursion (end-of-line) (let ((alias (buffer-substring (progn (beginning-of-line) (skip-chars-forward "[ \t]") (point)) (progn (end-of-line) (skip-chars-backward "[ \t]") (point))))) (cond ((or (member alias emchat-all-aliases) (emchat-valid-uin-p alias)) (when (interactive-p) (message alias) (kill-new alias)) alias) (t (error "No valid alias/uin found")))))) (defun emchat-select-alias-here (action) "See `emchat-group-select-aliases' and `emchat-alias-here'. Nil or 'toggle ACTION means toggle selection for alias here. `numberp' action or digit arguments (press \\[digit-argument] before this command) means select the number of next/previous aliases. 'toggle-all ACTION or prefix argument (press \\[universal-argument] before this command) means toggle selections for all aliases in view. 'deselect-all or other non-nil ACTION or negative argument (press \\[negative-argument] before this command) means deselect for all aliases in view. See `emchat-buddy-select-all-in-view'." (interactive (list (cond ((not current-prefix-arg) 'toggle) ((eq '- current-prefix-arg) 'deselect-all) ((numberp current-prefix-arg) current-prefix-arg) (t 'toggle-all)))) (cond ((or (not action) (eq action'toggle)) (emchat-group-select-aliases 'toggle (emchat-alias-here)) (forward-line)) ((and (numberp action) (zerop action))) ; recurrsion done ((natnump action) (emchat-group-select-aliases 'select (emchat-alias-here)) (forward-line 1) (emchat-select-alias-here (1- action))) ((numberp action) ; negative digit (emchat-group-select-aliases 'select (emchat-alias-here)) (forward-line -1) (emchat-select-alias-here (1+ action))) ((eq action 'toggle-all) (emchat-buddy-select-all-in-view 'toggle)) ((eq action 'deselect-all) (emchat-buddy-select-all-in-view nil)))) (defun emchat-send-message-alias-here () "See `emchat-send-message' and `emchat-alias-here'." (interactive) (emchat-send-message nil (emchat-alias-here))) (defun emchat-send-url-alias-here () "See `emchat-send-url' and `emchat-alias-here'." (interactive) (emchat-send-url nil nil (emchat-alias-here))) (defun emchat-authorize-alias-here () "See `emchat-authorize' and `emchat-alias-here'." (interactive) (emchat-authorize (emchat-alias-here))) (defun emchat-query-info-alias-here () "See `emchat-query-info' and `emchat-alias-here'." (interactive) (emchat-query-info (emchat-alias-here))) ;; Default toolbar button (defun emchat-toolbar-login () "Log into ICQ from the toolbar." (interactive) (call-interactively #'emchat-login)) (defvar emchat-toolbar-icon (toolbar-make-button-list (expand-file-name "mini-logo.png" emchat-glyph-dir)) "EMchat button for the default toolbar.") (defvar emchat-toolbar-spec (vector emchat-toolbar-icon 'emchat-toolbar-login t "Waste time with EMchat") "EMchat default toolbar spec.") (defun emchat-add-to-toolbar () "Adds the EMchat button to the default toolbar." (let ((origbar (specifier-instance default-toolbar (selected-window))) (spec emchat-toolbar-spec)) (or (ignore-errors (toolbar-find-button emchat-toolbar-icon)) (set-specifier default-toolbar (toolbar-add-item origbar spec 'right) 'global)))) ;;; Code - footer: ;; otherwise sending large contact list leads to significant delay (byte-compile 'emchat-pack-contact-list) ;; Start the idle timer (emchat-auto-away-timeout-set 'emchat-auto-away-timeout emchat-auto-away-timeout) ;; Install bindings (emchat-install-bindings 'emchat-prefix-key emchat-prefix-key) ;; Add our button to the default toolbar (when (and (featurep 'toolbar) (featurep 'png) (device-on-window-system-p)) (emchat-add-to-toolbar)) ;; Pre-load the saved recent-adds (with-current-buffer (find-file-noselect emchat-recently-added-by-filename) (while (re-search-forward "\\(\\w+\\)" nil t) (add-to-list 'emchat-world-recently-added-by (string-to-number (match-string 1)))) (kill-buffer nil)) ;; Finally, run the load hook (run-hooks 'emchat-load-hook) (provide 'emchat) ;;; emchat.el ends here