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 @@ ...@@ -25,7 +25,7 @@
# $Id$ # $Id$
# #
CLIENTVERSION = 0.39 CLIENTVERSION = 0.39a
GENERIC-CLEAN = *~ *.o core GENERIC-CLEAN = *~ *.o core
GENERIC-DIST-CLEAN = TAGS GENERIC-DIST-CLEAN = TAGS
...@@ -43,7 +43,7 @@ PARTS-EL = komtypes.el clienttypes.el startup.el \ ...@@ -43,7 +43,7 @@ PARTS-EL = komtypes.el clienttypes.el startup.el \
commands1.el commands2.el review.el edit-text.el \ commands1.el commands2.el review.el edit-text.el \
filter.el filter-edit.el lyskom-buttons.el \ filter.el filter-edit.el lyskom-buttons.el \
view-text.el async.el completing-read.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 \ elib-string.el \
lyskom-rest.el lyskom-rest.el
HEADER-EL = macros.el vars.el HEADER-EL = macros.el vars.el
...@@ -58,7 +58,7 @@ SRC-ELC = komtypes.elc clienttypes.elc startup.elc \ ...@@ -58,7 +58,7 @@ SRC-ELC = komtypes.elc clienttypes.elc startup.elc \
commands1.elc commands2.elc review.elc edit-text.elc \ commands1.elc commands2.elc review.elc edit-text.elc \
filter.elc filter-edit.elc lyskom-buttons.elc \ filter.elc filter-edit.elc lyskom-buttons.elc \
view-text.elc async.elc completing-read.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 \ elib-string.elc \
lyskom-rest.elc lyskom-rest.elc
PARTS-ELC = $(SRC-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." ...@@ -164,25 +164,16 @@ this function shall be with current-buffer the BUFFER."
(message (lyskom-parse-string))) (message (lyskom-parse-string)))
(lyskom-save-excursion (lyskom-save-excursion
(set-buffer buffer) (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) (if (zerop recipient)
(initiate-get-conf-stat 'async (initiate-get-conf-stat 'async
'lyskom-show-personal-message 'lyskom-handle-personal-message
sender sender
0 0
message) message)
(lyskom-collect 'async) (lyskom-collect 'async)
(initiate-get-conf-stat 'async nil sender) (initiate-get-conf-stat 'async nil sender)
(initiate-get-conf-stat 'async nil recipient) (initiate-get-conf-stat 'async nil recipient)
(lyskom-use 'async (lyskom-use 'async 'lyskom-handle-personal-message message)))))
'lyskom-show-personal-message
message)))))))
((eq msg-no 13) ; New logout ((eq msg-no 13) ; New logout
(let ((pers-no (lyskom-parse-num)) (let ((pers-no (lyskom-parse-num))
...@@ -264,54 +255,84 @@ this function shall be with current-buffer the BUFFER." ...@@ -264,54 +255,84 @@ this function shall be with current-buffer the BUFFER."
(not (zerop (minibuffer-depth)))) (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. "Insert a personal message into the lyskom buffer.
Args: SENDER: conf-stat for the person issuing the broadcast message or a Args: SENDER: conf-stat for the person issuing the broadcast message or a
string that is the sender. string that is the sender.
RECIPIENT: 0 if this message is for everybody, otherwise the conf-stat RECIPIENT: 0 if this message is for everybody, otherwise the conf-stat
of the recipient. of the recipient.
MESSAGE: A string containing the message." MESSAGE: A string containing the message.
(lyskom-insert-personal-message sender recipient 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 (setq lyskom-last-personal-message-sender
(if (stringp sender) sender (conf-stat->name sender))) (if (stringp sender) sender (conf-stat->name sender)))
(setq lyskom-last-group-message-recipient (setq lyskom-last-group-message-recipient
(if (and recipient (if (and recipient
(/= (conf-stat->conf-no recipient) (not (eq 0 recipient))
lyskom-pers-no)) (not (eq (conf-stat->conf-no recipient)
lyskom-pers-no)))
(conf-stat->name recipient) (conf-stat->name recipient)
nil)) nil))
(run-hooks 'lyskom-personal-message-hook)) (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. "Insert a personal message in the current buffer.
Arguments: SENDER RECIPIENT MESSAGE. Arguments: SENDER RECIPIENT MESSAGE.
SENDER is a conf-stat (possibly nil) or a string. 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. RECIPIENT is 0 if the message is public, otherwise the pers-no of the user.
MESSAGE is a string containing the message. MESSAGE is a string containing the message.
INSERT-FUNCTION is a function that given a string inserts it into the WHEN, if given, is the time when the message arrived. It must be of the same
current buffer." format at (current-time-string)
Non-nil NOBEEP means don't beep."
(lyskom-handle-as-personal-message (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 (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 (lyskom-format 'message-broadcast
(cond (cond
((stringp sender) sender) ((stringp sender) sender)
(sender sender) (sender sender)
(t (lyskom-get-string 'unknown))) (t (lyskom-get-string 'unknown)))
message message
(substring (current-time-string) 11 19))) when))
((= (conf-stat->conf-no recipient) lyskom-pers-no) ; Private ((= (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 (lyskom-format 'message-from
(cond (cond
((stringp sender) sender) ((stringp sender) sender)
(sender sender) (sender sender)
(t (lyskom-get-string 'unknown))) (t (lyskom-get-string 'unknown)))
message message
(substring (current-time-string) 11 19))) when))
(t ; Group message (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 (lyskom-format 'message-from-to
message message
(cond (cond
...@@ -322,15 +343,20 @@ current buffer." ...@@ -322,15 +343,20 @@ current buffer."
((stringp recipient) recipient) ((stringp recipient) recipient)
(recipient (conf-stat->name recipient)) (recipient (conf-stat->name recipient))
(t (lyskom-get-string 'unknown))) (t (lyskom-get-string 'unknown)))
(substring (current-time-string) 11 19)))) when)))))
(conf-stat->conf-no sender)))
(defun lyskom-handle-as-personal-message (string from) (defun lyskom-handle-as-personal-message (string from &optional filter)
"Insert STRING (a format state) as a personal message and beep if "Insert STRING as a personal message and beep if not from me and
not from me and supposed to. The buffer, is chosen according to the supposed to. The buffer, is chosen according to the
kom-show-personal-messages-in-buffer variable value. The text is kom-show-personal-messages-in-buffer variable value. The text is
converted, before insertion." 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 (lyskom-save-excursion
(cond (cond
((eq kom-show-personal-messages-in-buffer t) ((eq kom-show-personal-messages-in-buffer t)
...@@ -343,7 +369,7 @@ converted, before insertion." ...@@ -343,7 +369,7 @@ converted, before insertion."
string string
(iso-8859-1-to-swascii string))))) (iso-8859-1-to-swascii string)))))
(if kom-pop-personal-messages (if kom-pop-personal-messages
(display-buffer (current-buffer))))) (display-buffer (current-buffer))))))
;;; ================================================================ ;;; ================================================================
......
...@@ -119,15 +119,18 @@ ...@@ -119,15 +119,18 @@
;;; Author: Inge Wallin ;;; Author: Inge Wallin
(defun kom-review-presentation () (defun kom-review-presentation (&optional who)
"Review the presentation for a person or a conference." "Review the presentation for a person or a conference."
(interactive) (interactive)
(lyskom-start-of-command 'kom-review-presentation) (lyskom-start-of-command 'kom-review-presentation)
(let ((end-of-command-taken-care-of)) (let ((end-of-command-taken-care-of))
(unwind-protect (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) (lyskom-get-string 'presentation-for-whom)
'all))) 'all))))
(if (null conf-stat) (if (null conf-stat)
(lyskom-insert-string 'somebody-deleted-that-conf) (lyskom-insert-string 'somebody-deleted-that-conf)
(lyskom-format-insert 'review-presentation-of (lyskom-format-insert 'review-presentation-of
...@@ -210,15 +213,17 @@ as TYPE. If no such misc-info, return NIL" ...@@ -210,15 +213,17 @@ as TYPE. If no such misc-info, return NIL"
;;; Author: Inge Wallin ;;; Author: Inge Wallin
;;; Rewritten using read-conf-no by Linus Tolke (4=>1) ;;; 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." "Send a personal letter to a person or a conference."
(interactive) (interactive)
(condition-case error (condition-case error
(progn (progn
(lyskom-start-of-command 'kom-send-letter) (lyskom-start-of-command 'kom-send-letter)
(lyskom-tell-internat 'kom-tell-write-letter) (lyskom-tell-internat 'kom-tell-write-letter)
(let* ((tono (lyskom-read-conf-no (lyskom-get-string 'who-letter-to) (let* ((tono (or pers-no
'all)) (lyskom-read-conf-no
(lyskom-get-string 'who-letter-to)
'all)))
(conf-stat (blocking-do 'get-conf-stat tono))) (conf-stat (blocking-do 'get-conf-stat tono)))
(if (if (zerop (conf-stat->msg-of-day conf-stat)) (if (if (zerop (conf-stat->msg-of-day conf-stat))
t t
...@@ -269,12 +274,13 @@ Ask for the name of the person, the conference to add him/her to." ...@@ -269,12 +274,13 @@ Ask for the name of the person, the conference to add him/her to."
;; Add self ;; 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." "Add this person as a member of a conference."
(interactive) (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) (lyskom-get-string 'where-to-add-self)
'all)) 'all)))
(who (blocking-do 'get-conf-stat lyskom-pers-no)) (who (blocking-do 'get-conf-stat lyskom-pers-no))
(pers-stat (blocking-do 'get-pers-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) (lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat)
...@@ -439,11 +445,12 @@ of the person." ...@@ -439,11 +445,12 @@ of the person."
'all nil ""))) '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." "Subtract this person as a member from a conference."
(interactive) (interactive)
(lyskom-sub-member (lyskom-sub-member
(blocking-do 'get-conf-stat lyskom-pers-no) (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) (lyskom-read-conf-stat (lyskom-get-string 'leave-what-conf)
'all nil 'all nil
(let ((ccn (let ((ccn
...@@ -454,7 +461,7 @@ of the person." ...@@ -454,7 +461,7 @@ of the person."
lyskom-current-conf))))) lyskom-current-conf)))))
(if ccn (if ccn
(cons ccn 0) (cons ccn 0)
""))))) ""))))))
(defun lyskom-sub-member (pers conf) (defun lyskom-sub-member (pers conf)
"Remove the person indicated by PERS as a member of 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." ...@@ -864,9 +871,14 @@ If optional argument is non-nil then dont ask for confirmation."
(not (lyskom-ja-or-nej-p (not (lyskom-ja-or-nej-p
(lyskom-get-string 'quit-in-spite-of-unsent)))) (lyskom-get-string 'quit-in-spite-of-unsent))))
(lyskom-end-of-command)) (lyskom-end-of-command))
((or arg ((or arg (lyskom-ja-or-nej-p (lyskom-get-string 'really-quit)))
(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) (initiate-logout 'main nil)
(setq lyskom-sessions-with-unread (setq lyskom-sessions-with-unread
(delq lyskom-proc 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." ...@@ -879,8 +891,6 @@ If optional argument is non-nil then dont ask for confirmation."
(lyskom-insert-string 'session-ended) (lyskom-insert-string 'session-ended)
(lyskom-scroll) (lyskom-scroll)
(run-hooks 'kom-quit-hook)) (run-hooks 'kom-quit-hook))
(t (lyskom-end-of-command))))