Commit 19e0fb73 authored by David Byers's avatar David Byers
Browse files

Skrev om addera mottagare och vänner för att bli av med js otäcka hack och

den gamla otäcka koden.
Completion kan nu begränsas till uppräknade möten.
Smartare default och completionalternativ för subtrahera mottagare.
kom-list-created-confs visar om ett möte är hemligt eller slutet
parent 8840beee
2000-08-16 David Byers <davby@ida.liu.se>
* commands1.el (lyskom-list-created-conferences-2): Show if
conference is secret or protected.
* swedish-strings.el (lyskom-message): Skyddat->Hemligt.
* commands1.el (kom-add-recipient): Rewrote.
(kom-add-copy): Rewrote.
(kom-add-bcc): Rewrote.
(lyskom-verify-add-recipient): Rewrote.
(lyskom-add-helper): New function.
(kom-sub-recipient): Rewrote. Only allow completion of actual
recipients.
(kom-move-text): Rewrote. Only complete actual recipients.
(lyskom-move-recipient): New function replaces
lyskom-add-sub-recipients. Better error messages.
* vars.el.in (lyskom-add-recipient-hook): New variable.
(lyskom-add-sub-recipients-hook): Removed.
* completing-read.el (lyskom-read-conf-internal-verify-type):
Added restrict predicate.
(lyskom-read-conf-internal): Changed x-list to candidate-list
since x-list is probably not the right thing to look at.
Implement more efficient matching if the restrict predicate is
used. Get persons or conferences only as needed according to the
predicate.
(lyskom-completing-lookup-z-name): want-pers and want-conf were
swapped in call to lookup-z-name (and it didn't matter since we
always called it with both set to 1).
* utilities.el (lyskom-text-recipients): New function.
2000-08-15 David Byers <davby@ida.liu.se>
* async.el (lyskom-is-in-minibuffer): Check cursor-in-echo-area.
......
......@@ -1499,13 +1499,18 @@ Those that you are not a member in will be marked with an asterisk."
(eq (conf-stat->supervisor cs) pers-no)
(eq (conf-stat->super-conf cs) pers-no)))
(aset counter 3 (1+ (elt counter 3)))
(lyskom-format-insert "%[%#1@%4#2:m %#3c %4#4s %#2M%]\n"
(lyskom-format-insert "%[%#1@%4#2:m %#3c %4#4s %#5s %#2M%]\n"
(lyskom-default-button 'conf (conf-stat->conf-no cs))
cs
(lyskom-list-conf-membership-char (conf-stat->conf-no cs))
(concat (if (eq pers-no (conf-stat->creator cs)) "C" " ")
(if (eq pers-no (conf-stat->supervisor cs)) "O" " ")
(if (eq pers-no (conf-stat->super-conf cs)) "S" " "))))))
(concat (if (eq pers-no (conf-stat->creator cs)) (lyskom-get-string 'created-conf-letter) " ")
(if (eq pers-no (conf-stat->supervisor cs)) (lyskom-get-string 'supervisor-conf-letter) " ")
(if (and (conf-type->original (conf-stat->conf-type cs))
(eq pers-no (conf-stat->super-conf cs)))
(lyskom-get-string 'superconf-conf-letter) " "))
(cond ((conf-type->secret (conf-stat->conf-type cs)) (lyskom-get-string 'secret-conf-letter))
((conf-type->rd_prot (conf-stat->conf-type cs)) (lyskom-get-string 'protected-conf-letter))
(t " "))))))
(defun lyskom-list-conf-print (conf-z)
......@@ -2969,224 +2974,212 @@ footnotes) to it as read in the server."
;;; Addera mottagare - Add recipient
;;; Subtrahera mottagare - Subtract recipient
;;; Author: David Byers, David Kågedal and Johan Sundström
;;; Based on code by Inge Wallin
;(macroexpand '(lyskom-sub-recipient 1 2))
(defmacro lyskom-defmacro-lyskom-add-sub-rcpt (name action description)
"Defines a macro lyskom-NAME (text-no conf) for calling
lyskom-add-sub-recipient in a more readable fashion."
`(defmacro
,(intern (concat "lyskom-" (symbol-name name)))
(text-no conf)
,(concat description " a text TEXT-NO.")
(list 'lyskom-add-sub-recipient text-no ',action conf)))
(lyskom-defmacro-lyskom-add-sub-rcpt add-recipient 'add-rcpt
"Add a recipient CONF to")
(lyskom-defmacro-lyskom-add-sub-rcpt sub-recipient 'sub
"Subtract a recipient (of any type) CONF from")
(lyskom-defmacro-lyskom-add-sub-rcpt add-copy 'add-copy
"Add a cc (carbon copy) recipient CONF to")
(lyskom-defmacro-lyskom-add-sub-rcpt add-bcc 'add-bcc
"Add a bcc (blind carbon copy) recipient CONF to")
;;; Author: David Byers
(def-kom-command kom-add-recipient (text-no)
"Add a recipient to a text."
(interactive (list (lyskom-read-text-no-prefix-arg 'text-to-add-recipient)))
(let ((conf (blocking-do 'get-conf-stat lyskom-last-added-rcpt)))
(lyskom-add-recipient text-no conf)))
(lyskom-add-helper text-no
'lyskom-last-added-rcpt
'who-to-add-q
'adding-name-as-recipient
'recpt))
(def-kom-command kom-add-copy (text-no)
"Add a cc (carbon copy) recipient to a text."
"Add a recipient to a text."
(interactive (list (lyskom-read-text-no-prefix-arg 'text-to-add-copy)))
(let ((conf (blocking-do 'get-conf-stat lyskom-last-added-ccrcpt)))
(lyskom-add-copy text-no conf)))
(lyskom-add-helper text-no
'lyskom-last-added-ccrcpt
'who-to-add-copy-q
'adding-name-as-copy
'cc-recpt))
(def-kom-command kom-add-bcc (text-no)
"Add a bcc (blind carbon copy) recipient to a text."
(interactive (list (lyskom-read-text-no-prefix-arg 'text-to-add-bcc)))
(let ((conf (blocking-do 'get-conf-stat lyskom-last-added-bccrcpt)))
(lyskom-add-bcc text-no conf)))
"Add a recipient to a text."
(interactive (list (lyskom-read-text-no-prefix-arg 'text-to-add-copy)))
(lyskom-add-helper text-no
'lyskom-last-added-bccrcpt
'who-to-add-bcc-q
'adding-name-as-copy
'bcc-recpt))
(defvar lyskom-add-recipient-type)
(defvar lyskom-add-recipient-target)
(defvar lyskom-add-recipient-text)
(defun lyskom-verify-add-recipient ()
"Make sure the user really does mean to add a recipient
conference instead of just adding a carbon copy as he most likely
ought to. Useful as a lyskom-add-recipient-hook only."
(when (eq lyskom-add-recipient-type 'recpt)
(unless (lyskom-j-or-n-p (lyskom-format 'really-add-as-recpt-q
lyskom-add-recipient-target)
t)
(setq lyskom-add-recipient-type 'cc-recpt))))
(defun lyskom-add-helper (text-no last-variable who-prompt doing-prompt type)
(let* ((conf (blocking-do 'get-conf-stat (lyskom-default-value last-variable)))
(target (lyskom-read-conf-stat
(lyskom-get-string who-prompt)
'(all)
nil
(cons (if conf (conf-stat->name conf) "") 0)
t)))
(when (and target text-no)
(let ((lyskom-add-recipient-text text-no)
(lyskom-add-recipient-type type)
(lyskom-add-recipient-target target))
(run-hooks 'lyskom-add-recipient-hook)
(when (and target text-no)
(lyskom-set-default last-variable (conf-stat->conf-no target))
(lyskom-format-insert doing-prompt target text-no)
(lyskom-move-recipient text-no nil target type))))))
(def-kom-command kom-sub-recipient (text-no)
"Subtract a recipient from a text."
"Remove a recipient from text TEXT-NO."
(interactive (list (lyskom-read-text-no-prefix-arg 'text-to-delete-recipient)))
(let ((conf (blocking-do 'get-conf-stat lyskom-current-conf)))
(lyskom-sub-recipient text-no conf)))
(let ((text-stat (blocking-do 'get-text-stat text-no)))
(if text-stat
(let ((recipients (lyskom-text-recipients text-stat)))
(if recipients
(let* ((conf (cond ((memq lyskom-current-conf recipients)
(blocking-do 'get-conf-stat lyskom-current-conf))
((car recipients) (blocking-do 'get-conf-stat (car recipients)))))
(source (lyskom-read-conf-stat
(lyskom-get-string 'who-to-sub-q)
(list (cons 'restrict recipients))
nil
(cons (if conf (conf-stat->name conf) "") 0)
t)))
(when source
(lyskom-format-insert 'remove-name-as-recipient source text-no)
(lyskom-move-recipient text-no source nil nil)
))
(lyskom-format-insert 'text-has-no-recipients-r text-no)))
(lyskom-format-insert 'no-such-text-no text-no))))
(def-kom-command kom-move-text (text-no)
"Subtract a recipient from a text and add another."
"Move text TEXT-NO from one conference to another."
(interactive (list (lyskom-read-text-no-prefix-arg 'text-to-move)))
(let* ((text-stat (blocking-do 'get-text-stat text-no))
default-recpt found)
(lyskom-traverse misc-item
(text-stat->misc-info-list text-stat)
(when (memq (misc-info->type misc-item)
'(RECPT CC-RECPT BCC-RECPT))
(when (not found)
(setq default-recpt (misc-info->recipient-no misc-item)
found (eq (misc-info->type misc-item) 'RECPT)))
(when (eq (misc-info->recipient-no misc-item) lyskom-current-conf)
(setq default-recpt lyskom-current-conf found t))))
(cond ((null text-stat)
(lyskom-format-insert 'no-such-text-no text-no))
((null default-recpt)
(lyskom-format-insert 'text-has-no-recipients-r text-no))
(t (blocking-do-multiple
((default-from (get-conf-stat default-recpt))
(default-to (get-conf-stat
(or lyskom-last-added-rcpt
lyskom-current-conf))))
(lyskom-add-sub-recipient text-no
'move
default-to
default-from))))))
(defvar lyskom-add-sub-recipient-action)
(defvar lyskom-add-sub-recipient-source-conf)
(defvar lyskom-add-sub-recipient-target-conf)
(let ((text-stat (blocking-do 'get-text-stat text-no)))
(if text-stat
(let* ((recipients (lyskom-text-recipients text-stat t))
(default-recpt (or (car (assq lyskom-current-conf recipients))
(car (rassq 'RECPT recipients))
(car (car recipients)))))
(if (null default-recpt)
(lyskom-format-insert 'text-has-no-recipients-r text-no)
(blocking-do-multiple ((default-from (get-conf-stat default-recpt))
(default-to (get-conf-stat
(or lyskom-last-added-rcpt
lyskom-current-conf))))
(let ((source (lyskom-read-conf-stat 'who-to-move-from-q
(list
(cons 'restrict
(mapcar 'car
recipients)))
nil
(cons (if default-from
(conf-stat->name default-from)
"") 0)
t))
(target (lyskom-read-conf-stat 'who-to-move-to-q
'(all)
nil
(cons (if default-to
(conf-stat->name default-from)
"") 0)
t)))
(when (and source target)
(lyskom-format-insert 'moving-name source target text-stat)
(lyskom-move-recipient text-no source target 'recpt))))))
(lyskom-format-insert 'no-such-text-no text-no))))
(defun lyskom-move-recipient (text-no source target type)
"Remove TEXT-NO from SOURCE and add it to TARGET as TYPE.
This is the internal function for moving texts around. SOURCE or TARGET
may be nil. TYPE is ignored if TARGET is nil.
Calls lyskom-report-command-answer to report the result, to callers
must have printed something without a newline at the end of the buffer."
(let ((text-stat (blocking-do 'get-text-stat text-no)))
(if text-stat
(let* ((was-read (lyskom-text-read-p text-stat))
(add-result (if target
(blocking-do 'add-recipient
text-no
(conf-stat->conf-no target)
type)
t))
(add-errno lyskom-errno)
(sub-result (if (and source add-result)
(blocking-do 'sub-recipient
text-no
(conf-stat->conf-no source))
t))
(sub-errno lyskom-errno))
(when (null add-result)
;; Can't add to target. Explain why. We have not removed from the
;; source conference, so no need to add it back
(cond ((eq add-errno 27) ; already-recipient
(lyskom-insert-string 'nope)
(lyskom-format-insert 'error-already-recipient text-stat target)
)
((eq add-errno 33) ; recipient-limit
(lyskom-insert-string 'nope)
(lyskom-format-insert 'error-recipient-limit text-stat)
)
((eq add-errno 12) ; permission-denied
(lyskom-insert-string 'nope)
(lyskom-format-insert 'error-permission-denied-add-recpt text-stat target)
)
((eq add-errno 11) ; access-denied
(lyskom-insert-string 'nope)
(lyskom-format-insert 'error-access-denied-add-recpt text-stat target)
)
(t (lyskom-report-command-answer nil add-errno)))
)
(when (null sub-result)
;; Can't sub from souce. Explain why.
(when target
(blocking-do 'sub-recipient text-no (conf-stat->conf-no source)))
(cond ((eq sub-errno 30) ;not-recipient
(lyskom-insert-string 'nope)
(lyskom-format-insert 'error-not-recipient text-stat source)
)
((eq sub-errno 12) ; permission-denied
(lyskom-insert-string 'nope)
(lyskom-format-insert 'error-permission-denied-sub-recpt
text-stat
source)
)
(t (lyskom-report-command-answer nil sub-errno)))
)
(when (and add-result sub-result)
(lyskom-report-command-answer t))
;; If the text was read prior to the move, it is afterwards too.
(cache-del-text-stat text-no)
(when (and add-result target was-read)
(lyskom-mark-as-read (blocking-do 'get-text-stat text-no)))
(defun lyskom-verify-add-recipient ()
"Make sure the user really does mean to add a recipient
conference instead of just adding a carbon copy as he most likely
ought to. Useful as a lyskom-add-sub-recipient-hook only."
(when (and
(eq lyskom-add-sub-recipient-action 'add-rcpt)
lyskom-add-sub-recipient-target-conf
(not
(lyskom-j-or-n-p
(lyskom-format
'really-add-as-recpt-q
lyskom-add-sub-recipient-target-conf)
t)))
(setq lyskom-add-sub-recipient-action 'add-copy)))
;;; NOTE: If you add an action you need to add a foo-action-name
;;; string to the strings files.
(defun lyskom-add-sub-recipient (text-no action conf
&optional conf2)
"Add or remove a recipient.
TEXT-NO is the text being operated on; ACTION is what to do (one of
add-rcpt, add-copy, add-bcc, sub or move), CONF is the conference to
add, remove or move from, CONF2 is the conference to move to (for
move)."
(if text-no
(let* ((text-stat (blocking-do 'get-text-stat text-no))
(was-read (lyskom-text-read-p text-stat))
;; Only for moving
(lyskom-add-sub-recipient-source-conf
(when (eq action 'move)
(lyskom-read-conf-stat
(lyskom-get-string 'who-to-move-from-q)
'(all)
nil
(cons (if conf2 (conf-stat->name conf2) "") 0)
t)))
(lyskom-add-sub-recipient-target-conf
(lyskom-read-conf-stat
(lyskom-get-string
(cond ((eq action 'add-rcpt) 'who-to-add-q)
((eq action 'add-copy) 'who-to-add-copy-q)
((eq action 'add-bcc) 'who-to-add-bcc-q)
((eq action 'sub) 'who-to-sub-q)
((eq action 'move) 'who-to-move-to-q)
(t (lyskom-error "internal error"))))
'(all)
nil
(cons (if conf (conf-stat->name conf) "") 0)
t))
(lyskom-add-sub-recipient-action action)
(result nil))
; hooks for doing nasty questions like "really sure about adding conf?"
(run-hooks 'lyskom-add-sub-recipients-hook)
(setq result
(cond ((eq lyskom-add-sub-recipient-action 'add-rcpt)
(lyskom-format-insert 'adding-name-as-recipient
lyskom-add-sub-recipient-target-conf
text-stat)
(setq lyskom-last-added-rcpt
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf))
(blocking-do 'add-recipient
text-no
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf)
'recpt))
((eq lyskom-add-sub-recipient-action 'add-copy)
(lyskom-format-insert 'adding-name-as-copy
lyskom-add-sub-recipient-target-conf
text-stat)
(setq lyskom-last-added-ccrcpt
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf))
(blocking-do 'add-recipient
text-no
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf)
'cc-recpt))
((eq lyskom-add-sub-recipient-action 'add-bcc)
(lyskom-format-insert 'adding-name-as-copy
lyskom-add-sub-recipient-target-conf
text-stat)
(setq lyskom-last-added-bccrcpt
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf))
(blocking-do 'add-recipient
text-no
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf)
'bcc-recpt))
((eq lyskom-add-sub-recipient-action 'sub)
(lyskom-format-insert 'remove-name-as-recipient
lyskom-add-sub-recipient-target-conf
text-stat)
(blocking-do 'sub-recipient
text-no
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf)))
((eq lyskom-add-sub-recipient-action 'move)
(lyskom-format-insert 'moving-name
lyskom-add-sub-recipient-source-conf
lyskom-add-sub-recipient-target-conf
text-stat)
(setq lyskom-last-added-rcpt
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf))
(blocking-do-multiple
((add (add-recipient
text-no
(conf-stat->conf-no
lyskom-add-sub-recipient-target-conf)
'recpt))
(sub (sub-recipient
text-no
(conf-stat->conf-no
lyskom-add-sub-recipient-source-conf))))
(and add sub)))
(t (lyskom-error "internal error"))))
(cache-del-text-stat text-no)
(if was-read (lyskom-mark-as-read (blocking-do 'get-text-stat text-no)))
(lyskom-report-command-answer result))
(lyskom-format-insert 'confusion-what-to-add-sub-recipient
(lyskom-get-string (intern (concat (symbol-name action)
"-action-name"))))))
(and add-result sub-result))
(lyskom-format-insert 'no-such-text-no text-no)
nil)))
......
......@@ -81,16 +81,19 @@
(defun lyskom-completing-lookup-z-name (string want-conf want-pers)
"Look up STRING as a name. Same as \(blocking-do 'lookup-z-name ...\)
but first checks a cache."
(let* ((downs (lyskom-unicase string))
(tmp (assoc downs lyskom-completing-lookup-name-cache)))
(if tmp
(cdr tmp)
(progn
(setq tmp (blocking-do 'lookup-z-name string want-conf want-pers))
(setq lyskom-completing-lookup-name-cache
(cons (cons downs tmp)
lyskom-completing-lookup-name-cache))
tmp))))
(if (and (eq 0 want-conf)
(eq 0 want-pers))
nil
(let* ((downs (lyskom-unicase string))
(tmp (assoc downs lyskom-completing-lookup-name-cache)))
(if tmp
(cdr tmp)
(progn
(setq tmp (blocking-do 'lookup-z-name string want-pers want-conf))
(setq lyskom-completing-lookup-name-cache
(cons (cons downs tmp)
lyskom-completing-lookup-name-cache))
tmp)))))
;;; ============================================================
;;;
......@@ -180,6 +183,9 @@ more of the following:
pers Return persons (letterboxes),
login Return persons who are also logged-in, and
none Return names that do not match anything in the database.
(restrict c1 c2 ...) Restrict matching to conference numbers c1,
c2 etc. The implementation is inefficient for long lists.
Optional arguments
EMPTY allow nothing to be entered.
INITIAL initial contents of the minibuffer
......@@ -290,12 +296,8 @@ a documentation of PREDICATE."
"Complete the name STRING according to PREDICATE and ALL.
STRING is a string to complete.
PREDICATE is a list of name types to return. Valid types are
all Any existing name may be returned,
pers Names of persons may be returned,
conf Names of conferences may be returned,
login Names of logged-in persons may be returned, and
none Names that match nothing may be returned.
PREDICATE is a list of name types to return. See lyskom-read-conf for
details.
ALL is set by try-completion and all-completions. See the Emacs lisp
manual for a description. Special value 'lyskom-lookup makes the
function work as a name-to-conf-stat translator."
......@@ -318,18 +320,38 @@ function work as a name-to-conf-stat translator."
(let* ((login-list (and (memq 'login predicate)
(lyskom-read-conf-get-logins)))
(x-list (lyskom-completing-lookup-z-name string
1 1))
(if (or (memq 'all predicate)
(memq 'conf predicate)
(memq 'none predicate)) 1 0)
(if (or (memq 'all predicate)
(memq 'pers predicate)
(memq 'none predicate)
(memq 'login predicate)) 1 0)))
(r-list (when (assq 'restrict predicate)
(let ((result (make-collector)))
(lyskom-traverse conf-no (cdr (assq 'restrict predicate))
(initiate-get-uconf-stat 'main 'collector-push
conf-no result))
(lyskom-wait-queue 'main)
(delq nil
(mapcar (lambda (conf-stat)
(when (lyskom-completing-match-string string (conf-stat->name conf-stat))
(lyskom-create-conf-z-info
(conf-stat->name conf-stat)
(conf-stat->conf-type conf-stat)
(conf-stat->conf-no conf-stat))))
(collector->value result))))))
(candidate-list
(and x-list
(listify-vector (conf-z-info-list->conf-z-infos x-list))))
(append r-list
(if x-list
(conf-z-info-list->conf-z-infos x-list))))
(result-list nil))
;;
;; login-list now contains a list of logins, IF the predicate
;; includes 'login
;;
;; candidate-list contains a list of conf-nos, with the
;; corresponding conf-types in candidate-type-list.
;; candidate-list contains a list of conf-z-infos
;;
;; Now set result-list to the conf-z-infos that fulfill the
;; predicate, fetching the conf-stats asynchronously.
......@@ -496,7 +518,10 @@ function work as a name-to-conf-stat translator."
string) nil)
(t (or (lyskom-completing-cache-completion
(lyskom-complete-string name-list)
x-list)
(if r-list
(lyskom-create-conf-z-info-list
(apply 'vector candidate-list))
x-list))
(and (lyskom-read-conf-internal-verify-type
nil
nil
......@@ -505,6 +530,15 @@ function work as a name-to-conf-stat translator."
candidate-list)
(list string))))))))))))
(defun lyskom-completing-match-string (string name)
"Return non-nil if STRING matches NAME using LysKOM completion rules."
(string-match (concat "^"
(replace-in-string (lyskom-unicase (lyskom-completing-strip-name string))
"\\s-+" "\\\\S-*\\\\s-+")
"\\s-*")
(lyskom-completing-strip-name (lyskom-unicase name))))
(defun lyskom-completing-member (string list)
(let ((string (lyskom-unicase (lyskom-completing-strip-name string)))
(result nil))
......@@ -522,6 +556,8 @@ function work as a name-to-conf-stat translator."
(setq string (replace-match " " t t string)))
(while (string-match "\\s-\\s-+" string)
(setq string (replace-match " " t t string)))
(while (string-match "([^()]*$" string)
(setq string (substring string 0 (match-beginning 0))))
(if (string-match "^\\s-*\\(.*\\S-\\)\\s-*$" string)
(match-string 1 string)
string))
......@@ -532,7 +568,8 @@ function work as a name-to-conf-stat translator."
predicate
logins
x-list)
(or (and (memq 'all predicate)
(or (memq conf-no (cdr (assq 'restrict predicate)))
(and (memq 'all predicate)
conf-no)
(and (memq 'conf predicate)
conf-type
......