Commit 1cc6151a authored by David Byers's avatar David Byers
Browse files

Lots of changes. Mostly features. New message handling. Ansaphone. Remote...

Lots of changes. Mostly features. New message handling. Ansaphone. Remote control and more. See the ChangeLog.
parent 54a8f419
No preview for this file type
......@@ -25,7 +25,7 @@
# $Id$
#
CLIENTVERSION = 0.39
CLIENTVERSION = 0.39a
GENERIC-CLEAN = *~ *.o core
GENERIC-DIST-CLEAN = TAGS
......@@ -43,7 +43,7 @@ PARTS-EL = komtypes.el clienttypes.el startup.el \
commands1.el commands2.el review.el edit-text.el \
filter.el filter-edit.el lyskom-buttons.el \
view-text.el async.el completing-read.el \
prioritize.el flags.el \
prioritize.el flags.el messages.el ansaphone.el remote-control.el \
elib-string.el \
lyskom-rest.el
HEADER-EL = macros.el vars.el
......@@ -58,7 +58,7 @@ SRC-ELC = komtypes.elc clienttypes.elc startup.elc \
commands1.elc commands2.elc review.elc edit-text.elc \
filter.elc filter-edit.elc lyskom-buttons.elc \
view-text.elc async.elc completing-read.elc \
prioritize.elc flags.elc \
prioritize.elc flags.elc messages.elc ansaphone.elc remote-control.elc \
elib-string.elc \
lyskom-rest.elc
PARTS-ELC = $(SRC-ELC)
......
;;;;;
;;;;; $Id$
;;;;; Copyright (C) 1991 Lysator Academic Computer Association.
;;;;;
;;;;; This file is part of the LysKOM server.
;;;;;
;;;;; LysKOM is free software; you can redistribute it and/or modify it
;;;;; under the terms of the GNU General Public License as published by
;;;;; the Free Software Foundation; either version 1, or (at your option)
;;;;; any later version.
;;;;;
;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT
;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;;;;; for more details.
;;;;;
;;;;; You should have received a copy of the GNU General Public License
;;;;; along with LysKOM; see the file COPYING. If not, write to
;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
;;;;; MA 02139, USA.
;;;;;
;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se.
;;;;;
;;;; ================================================================
;;;; ================================================================
;;;;
;;;; File: ansaphone.el
;;;; Author: David Byers
;;;;
;;;; This file implements the auto-reply facility.
;;;; It must be loaded after messages.el
;;;;
(setq lyskom-clientversion-long
(concat lyskom-clientversion-long
"$Id$\n"))
(defvar kom-ansaphone-replies
'((group nil nil nil nil)
(common nil nil nil nil))
"*List of automatic replies to various messages.
A list of (MESSAGE-TYPE SENDER RECIPIENT TEXT REPLY)
MESSAGE-TYPE is one of personal, group or common or nil
SENDER is a list of integers or a single integer or nil
RECIPIENT is a list of integers or a single integer or nil
TEXT is a regular expression or nil
REPLY is a string or nil
When an incoming message arrives and the auto-reply facility is on,
this list is checked for automatic replies. The message type, sender,
recipient and text of the incoming messages is matched against the
elements of this list. If a match is found, the corresponding reply is
send. A nil in one of the message-type, sender, recipient or text
components in the list is taken to mean a wildcard. A null reply means
don't send a reply.
If none of the elements match, KOM-ANSAPHONE-DEFAULT-REPLY is sent.")
(defvar lyskom-ansaphone-messages nil
"Messages collected by the automatic reply facility.")
(defvar lyskom-ansaphone-when-set (current-time-string)
"Time when the auto-reply facility was enabled.")
(defconst lyskom-ansaphone-tag "Auto-reply:\n")
;;;============================================================
;;;
;;; User functions
;;;
(def-kom-command kom-change-auto-reply (&optional message)
"Change the default automatic reply message."
(interactive)
(let ((message (or message
(read-from-minibuffer
(lyskom-get-string 'ansaphone-new-message)))))
(setq kom-ansaphone-default-reply message)
(lyskom-format-insert (lyskom-get-string 'ansaphone-message)
kom-ansaphone-default-reply)))
(def-kom-command kom-toggle-auto-reply ()
"Toggle automatic replies to personal messages."
(interactive)
(setq kom-ansaphone-on (not kom-ansaphone-on))
(lyskom-format-insert (lyskom-get-string 'ansaphone-state-r)
(lyskom-get-string (if kom-ansaphone-on
'state-on
'state-off)))
(if kom-ansaphone-on
(progn
(setq lyskom-ansaphone-when-set (current-time-string))
(lyskom-format-insert (lyskom-get-string 'ansaphone-message)
kom-ansaphone-default-reply))))
(def-kom-command kom-list-messages ()
"List collected messages"
(interactive)
(if (null lyskom-ansaphone-messages)
(lyskom-format-insert (lyskom-get-string 'ansaphone-no-messages))
(progn
(lyskom-format-insert (lyskom-get-string 'ansaphone-message-list-start))
(mapcar (function
(lambda (msg)
(lyskom-show-personal-message
(blocking-do 'get-conf-stat (elt msg 0))
(blocking-do 'get-conf-stat (elt msg 1))
(elt msg 2)
(elt msg 3)
'nobeep)))
lyskom-ansaphone-messages)
(lyskom-format-insert (lyskom-get-string 'ansaphone-message-list-end)))))
(def-kom-command kom-erase-messages ()
"Erase collected messages"
(interactive)
(lyskom-message (lyskom-get-string 'ansaphone-messages-gone))
(setq lyskom-ansaphone-messages nil))
(defun lyskom-ansaphone-send-message (recipient message)
(initiate-send-message 'async
nil
(if (numberp recipient)
recipient
(conf-stat->conf-no recipient))
(concat lyskom-ansaphone-tag
message)))
(defun lyskom-ansaphone-message-handler (message-type sender recipient text)
"Personal message handler.
Automatically reply to certain personal messages and strip auto-reply
identification from messages.
See kom-ansaphone-on"
(let ((is-automatic (eq 0 (string-match lyskom-ansaphone-tag text))))
(if is-automatic
(progn
(string-match (concat "^"
lyskom-ansaphone-tag
"\\(\\(.\\|\n\\)*\\)") text)
(lyskom-set-current-message-text (substring text
(match-beginning 1)
(match-end 1)))))
(if (and kom-ansaphone-on
sender
(not (eq sender 0))
(not is-automatic))
(let ((reply (lyskom-ansaphone-find-reply
message-type
(conf-stat->conf-no sender)
(conf-stat->conf-no recipient)
text)))
(if (and reply (elt reply 4))
(progn
(setq reply
(concat
(lyskom-format
(lyskom-get-string 'ansaphone-message-header)
lyskom-ansaphone-when-set)
(elt reply 4)))
(lyskom-ansaphone-send-message sender reply)))))
(if (and kom-ansaphone-on sender)
(lyskom-ansaphone-record-message sender
recipient
lyskom-message-current-text)))
nil)
(defun lyskom-ansaphone-find-reply (message-type sender recipient text)
"Find an automatic reply suitable for messages of type MESSAGE-TYPE from
SENDER to RECIPIENT consisting of TEXT. See the documentation for
kom-ansaphone-default-reply and kom-ansaphone-replies."
(let ((exprs kom-ansaphone-replies)
(result nil))
(while exprs
(if (and (or (null (elt (car exprs) 0))
(eq (elt (car exprs) 0) message-type))
(or (null (elt (car exprs) 1))
(eq (elt (car exprs) 1) sender)
(and (listp (elt (car exprs) 1))
(memq sender (elt (car exprs) 1))))
(or (null (elt (car exprs) 2))
(eq (elt (car exprs) 2) recipient)
(and (listp (elt (car exprs) 2))
(memq recipient (elt (car exprs) 2))))
(or (null (elt (car exprs) 3))
(string-match (elt (car exprs) 3) text)))
(progn
(setq result (car exprs))
(setq exprs nil)))
(setq exprs (cdr-safe exprs)))
(or result (and (eq message-type 'personal)
(list nil nil nil nil kom-ansaphone-default-reply)))))
(defun lyskom-ansaphone-record-message (sender recipient text)
(if (not (numberp sender))
(setq sender (conf-stat->conf-no sender)))
(if (not (numberp recipient))
(setq recipient (conf-stat->conf-no recipient)))
(setq lyskom-ansaphone-messages (cons (list sender recipient text
(current-time-string))
lyskom-ansaphone-messages)))
(lyskom-add-personal-message-handler 'lyskom-ansaphone-message-handler
'before
nil
t)
......@@ -164,25 +164,16 @@ this function shall be with current-buffer the BUFFER."
(message (lyskom-parse-string)))
(lyskom-save-excursion
(set-buffer buffer)
(cond
((string= message " ")
(initiate-send-message 'follow nil sender
(format "emacs-version: %s\nclient-version: %s"
(emacs-version)
lyskom-clientversion)))
(t
(if (zerop recipient)
(initiate-get-conf-stat 'async
'lyskom-show-personal-message
'lyskom-handle-personal-message
sender
0
message)
(lyskom-collect 'async)
(initiate-get-conf-stat 'async nil sender)
(initiate-get-conf-stat 'async nil recipient)
(lyskom-use 'async
'lyskom-show-personal-message
message)))))))
(lyskom-use 'async 'lyskom-handle-personal-message message)))))
((eq msg-no 13) ; New logout
(let ((pers-no (lyskom-parse-num))
......@@ -264,54 +255,84 @@ this function shall be with current-buffer the BUFFER."
(not (zerop (minibuffer-depth))))
(defun lyskom-show-personal-message (sender recipient message)
(defun lyskom-show-personal-message (sender recipient message
&optional when nobeep)
"Insert a personal message into the lyskom buffer.
Args: SENDER: conf-stat for the person issuing the broadcast message or a
string that is the sender.
RECIPIENT: 0 if this message is for everybody, otherwise the conf-stat
of the recipient.
MESSAGE: A string containing the message."
(lyskom-insert-personal-message sender recipient message)
MESSAGE: A string containing the message.
WHEN: Optional time of arrival. Same format as (current-time-string)
NOBEEP: True means don't beep. No matter what."
(lyskom-insert-personal-message sender recipient message when nobeep)
(setq lyskom-last-personal-message-sender
(if (stringp sender) sender (conf-stat->name sender)))
(setq lyskom-last-group-message-recipient
(if (and recipient
(/= (conf-stat->conf-no recipient)
lyskom-pers-no))
(not (eq 0 recipient))
(not (eq (conf-stat->conf-no recipient)
lyskom-pers-no)))
(conf-stat->name recipient)
nil))
(run-hooks 'lyskom-personal-message-hook))
(defun lyskom-insert-personal-message (sender recipient message)
(defun lyskom-insert-personal-message (sender recipient message
&optional when nobeep)
"Insert a personal message in the current buffer.
Arguments: SENDER RECIPIENT MESSAGE.
SENDER is a conf-stat (possibly nil) or a string.
RECIPIENT is 0 if the message is public, otherwise the pers-no of the user.
MESSAGE is a string containing the message.
INSERT-FUNCTION is a function that given a string inserts it into the
current buffer."
WHEN, if given, is the time when the message arrived. It must be of the same
format at (current-time-string)
Non-nil NOBEEP means don't beep."
(lyskom-handle-as-personal-message
(lyskom-format-as-personal-message sender recipient message when nobeep)
(conf-stat->conf-no sender)
nil))
(defun lyskom-format-as-personal-message (sender
recipient
message
&optional when nobeep)
"Formats a personal message, returning it as a string.
Arguments: SENDER RECIPIENT MESSAGE.
SENDER is a conf-stat (possibly nil) or a string.
RECIPIENT is 0 if the message is public, otherwise the pers-no of the user.
MESSAGE is a string containing the message.
WHEN, if given, is the time when the message arrived. It must be of the same
format at (current-time-string)
Non-nil NOBEEP means don't beep."
(progn
(if (null when)
(setq when (current-time-string)))
(if (not (string= (substring when 0 10)
(substring (current-time-string) 0 10)))
(setq when (substring when 4 19))
(setq when (substring when 11 19)))
(cond ((eq recipient 0) ; Public message
(if (eq t kom-ding-on-personal-messages) (beep))
(lyskom-beep (if (not nobeep) kom-ding-on-common-messages 0))
(lyskom-format 'message-broadcast
(cond
((stringp sender) sender)
(sender sender)
(t (lyskom-get-string 'unknown)))
message
(substring (current-time-string) 11 19)))
when))
((= (conf-stat->conf-no recipient) lyskom-pers-no) ; Private
(if (memq kom-ding-on-personal-messages '(t personal)) (beep))
(lyskom-beep (if (not nobeep) kom-ding-on-personal-messages 0))
(lyskom-format 'message-from
(cond
((stringp sender) sender)
(sender sender)
(t (lyskom-get-string 'unknown)))
message
(substring (current-time-string) 11 19)))
when))
(t ; Group message
(if (memq kom-ding-on-personal-messages '(t group)) (beep))
(lyskom-beep (if (not nobeep) kom-ding-on-group-messages 0))
(lyskom-format 'message-from-to
message
(cond
......@@ -322,15 +343,20 @@ current buffer."
((stringp recipient) recipient)
(recipient (conf-stat->name recipient))
(t (lyskom-get-string 'unknown)))
(substring (current-time-string) 11 19))))
(conf-stat->conf-no sender)))
when)))))
(defun lyskom-handle-as-personal-message (string from)
"Insert STRING (a format state) as a personal message and beep if
not from me and supposed to. The buffer, is chosen according to the
(defun lyskom-handle-as-personal-message (string from &optional filter)
"Insert STRING as a personal message and beep if not from me and
supposed to. The buffer, is chosen according to the
kom-show-personal-messages-in-buffer variable value. The text is
converted, before insertion."
(if (and filter
(or
(eq 0 (string-match "^Remote-command: [0-9]+ [0-9]+\n" string))
(eq 0 (string-match "^Auto-reply:\n" string))))
nil
(lyskom-save-excursion
(cond
((eq kom-show-personal-messages-in-buffer t)
......@@ -343,7 +369,7 @@ converted, before insertion."
string
(iso-8859-1-to-swascii string)))))
(if kom-pop-personal-messages
(display-buffer (current-buffer)))))
(display-buffer (current-buffer))))))
;;; ================================================================
......
......@@ -119,15 +119,18 @@
;;; Author: Inge Wallin
(defun kom-review-presentation ()
(defun kom-review-presentation (&optional who)
"Review the presentation for a person or a conference."
(interactive)
(lyskom-start-of-command 'kom-review-presentation)
(let ((end-of-command-taken-care-of))
(unwind-protect
(let ((conf-stat (lyskom-read-conf-stat
(let ((conf-stat
(if who
(blocking-do 'get-conf-stat who)
(lyskom-read-conf-stat
(lyskom-get-string 'presentation-for-whom)
'all)))
'all))))
(if (null conf-stat)
(lyskom-insert-string 'somebody-deleted-that-conf)
(lyskom-format-insert 'review-presentation-of
......@@ -210,15 +213,17 @@ as TYPE. If no such misc-info, return NIL"
;;; Author: Inge Wallin
;;; Rewritten using read-conf-no by Linus Tolke (4=>1)
(defun kom-send-letter ()
(defun kom-send-letter (&optional pers-no)
"Send a personal letter to a person or a conference."
(interactive)
(condition-case error
(progn
(lyskom-start-of-command 'kom-send-letter)
(lyskom-tell-internat 'kom-tell-write-letter)
(let* ((tono (lyskom-read-conf-no (lyskom-get-string 'who-letter-to)
'all))
(let* ((tono (or pers-no
(lyskom-read-conf-no
(lyskom-get-string 'who-letter-to)
'all)))
(conf-stat (blocking-do 'get-conf-stat tono)))
(if (if (zerop (conf-stat->msg-of-day conf-stat))
t
......@@ -269,12 +274,13 @@ Ask for the name of the person, the conference to add him/her to."
;; Add self
(def-kom-command kom-add-self ()
(def-kom-command kom-add-self (&optional conf)
"Add this person as a member of a conference."
(interactive)
(let ((whereto (lyskom-read-conf-stat
(let ((whereto (if conf (blocking-do 'get-conf-stat conf)
(lyskom-read-conf-stat
(lyskom-get-string 'where-to-add-self)
'all))
'all)))
(who (blocking-do 'get-conf-stat lyskom-pers-no))
(pers-stat (blocking-do 'get-pers-stat lyskom-pers-no)))
(lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat)
......@@ -439,11 +445,12 @@ of the person."
'all nil "")))
(def-kom-command kom-sub-self ()
(def-kom-command kom-sub-self (&optional conf)
"Subtract this person as a member from a conference."
(interactive)
(lyskom-sub-member
(blocking-do 'get-conf-stat lyskom-pers-no)
(if conf (blocking-do 'get-conf-stat conf)
(lyskom-read-conf-stat (lyskom-get-string 'leave-what-conf)
'all nil
(let ((ccn
......@@ -454,7 +461,7 @@ of the person."
lyskom-current-conf)))))
(if ccn
(cons ccn 0)
"")))))
""))))))
(defun lyskom-sub-member (pers conf)
"Remove the person indicated by PERS as a member of CONF."
......@@ -864,9 +871,14 @@ If optional argument is non-nil then dont ask for confirmation."
(not (lyskom-ja-or-nej-p
(lyskom-get-string 'quit-in-spite-of-unsent))))
(lyskom-end-of-command))
((or arg
(lyskom-ja-or-nej-p (lyskom-get-string 'really-quit))
)
((or arg (lyskom-ja-or-nej-p (lyskom-get-string 'really-quit)))
(lyskom-quit))
(t (lyskom-end-of-command))))
(defun lyskom-quit ()
"Quit a session. Kill process and buffer-local variables.
Don't ask for confirmation."
(initiate-logout 'main nil)
(setq lyskom-sessions-with-unread
(delq lyskom-proc lyskom-sessions-with-unread))
......@@ -879,8 +891,6 @@ If optional argument is non-nil then dont ask for confirmation."
(lyskom-insert-string 'session-ended)
(lyskom-scroll)
(run-hooks 'kom-quit-hook))
(t (lyskom-end-of-command))))
;;; ================================================================
......@@ -993,15 +1003,17 @@ TYPE is either 'pres or 'motd, depending on what should be changed."
;;; Author: ???
(def-kom-command kom-go-to-conf ()
(def-kom-command kom-go-to-conf (&optional conf-no)
"Select a certain conference.
The user is prompted for the name of the conference.
If s/he was already reading a conference that conference will be put
back on lyskom-to-do-list."
(interactive)
(let ((conf (lyskom-read-conf-stat
(let ((conf (if conf-no
(blocking-do 'get-conf-stat conf-no)
(lyskom-read-conf-stat
(lyskom-get-string 'go-to-conf-p)
'all "")))
'all ""))))
(lyskom-go-to-conf conf)))
......@@ -1269,7 +1281,8 @@ MARK: A number that is used as the mark."
(listp text-no-arg))
(car text-no-arg))
(t lyskom-current-text))))
(setq text-no (lyskom-read-number prompt text-no))
(if prompt
(setq text-no (lyskom-read-number prompt text-no)))
(if (not (eq mark 0))
(setq mark
(or kom-default-mark
......@@ -1529,7 +1542,9 @@ the window width."
(defun lyskom-return-username (who-info)
"Takes the username from the WHO-INFO and returns it on a better format."
(let* ((username (who-info->username who-info))
(let* ((username (if (eq 'SESSION-INFO who-info)
(session-info->username who-info)
(who-info->username who-info)))
(type (or
(string-match "\\([^%@.]+\\)%\\(.+\\)@\\([^%@.]+\\)" username)
(string-match "\\([^%@.]+\\)@\\([^%@.]+\\)" username))))
......
......@@ -456,10 +456,11 @@ otherwise: the conference is read with lyskom-completing-read."
;;; Modified to use default recipient by David Byers
(def-kom-command kom-send-message ()
(def-kom-command kom-send-message (&optional who message)
"Send a message to one of the users in KOM right now."
(interactive)
(lyskom-send-message
(or who
(lyskom-read-conf-no
(format (lyskom-get-string 'who-to-send-message-to)
(lyskom-get-string 'everybody))
......@@ -467,28 +468,29 @@ otherwise: the conference is read with lyskom-completing-read."
;; Initial string:
(cond
((null kom-send-message-to-last-sender) nil)
((and (not (eq kom-send-message-to-last-sender 'always))
((and (eq kom-send-message-to-last-sender 'group)
lyskom-last-group-message-recipient)
(if (string-match "^19" emacs-version)
(cons lyskom-last-group-message-recipient 0)
lyskom-last-group-message-recipient))
(cons lyskom-last-group-message-recipient 0)))
(lyskom-last-personal-message-sender
(if (string-match "^19" emacs-version)
(cons lyskom-last-personal-message-sender 0)
lyskom-last-personal-message-sender))
(t "")))))
(t ""))))
message))
(def-kom-command kom-send-alarm ()
"Send a message to all of the users in KOM right now."
(interactive)
(lyskom-send-message 0))
(lyskom-send-message 0 nil))
(defun lyskom-send-message (pers-no)
(defun lyskom-send-message (pers-no message)
"Send a message to the person with the number CONF-NO. CONF-NO == 0
means send the message to everybody."
(let* ((string (lyskom-read-string (lyskom-get-string 'message-prompt)))
(let* ((string (or message
(lyskom-read-string (lyskom-get-string 'message-prompt))))
(reply (blocking-do 'send-message pers-no string))
(to-conf-stat (if (zerop pers-no)
nil
......@@ -499,7 +501,8 @@ means send the message to everybody."
(lyskom-format 'message-sent-to-user
string to-conf-stat)
(lyskom-format 'message-sent-to-all string))
lyskom-pers-no)
lyskom-pers-no
lyskom-filter-outgoing-messages)
(lyskom-format-insert-before-prompt 'message-nope
(or to-conf-stat
(lyskom-get-string 'everybody))
......@@ -1161,10 +1164,14 @@ Use OLD-MOTD-TEXT as the default text if non-nil."
(def-kom-command kom-force-logout ()
"Force another user to log out."
(interactive)
(let ((session (lyskom-read-number (lyskom-get-string 'who-to-throw-out))))
(let ((session (car-safe (lyskom-read-session-no
(lyskom-get-string 'who-to-throw-out)