completing-read.el 41.8 KB
Newer Older
David Byers's avatar
David Byers committed
1
;;;;; -*-coding: iso-8859-1;-*-
Linus Tolke's avatar
Linus Tolke committed
2
3
;;;;;
;;;;; $Id$
4
;;;;; Copyright (C) 1991-2002  Lysator Academic Computer Association.
Linus Tolke's avatar
Linus Tolke committed
5
;;;;;
6
;;;;; This file is part of the LysKOM Emacs LISP client.
Linus Tolke's avatar
Linus Tolke committed
7
8
9
;;;;; 
;;;;; LysKOM is free software; you can redistribute it and/or modify it
;;;;; under the terms of the GNU General Public License as published by 
10
;;;;; the Free Software Foundation; either version 2, or (at your option) 
Linus Tolke's avatar
Linus Tolke committed
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
;;;;; 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. 
;;;;;
Per Cederqvist's avatar
.  
Per Cederqvist committed
26
27
28
29
;;;; ================================================================
;;;; ================================================================
;;;;
;;;; File: completing-read.el
30
;;;; Author: David Byers
Per Cederqvist's avatar
.  
Per Cederqvist committed
31
32
33
34
35
;;;;
;;;; This file implements functions for reading a conference name
;;;; or a person name with completion and other help.
;;;;

36
(setq lyskom-clientversion-long 
37
38
39
      (concat
       lyskom-clientversion-long
       "$Id$\n"))
40

41
(defvar lyskom-name-hist nil)
Per Cederqvist's avatar
.  
Per Cederqvist committed
42
43


44

45
46
47
48
;;; ============================================================
;;;
;;; Name lookup caches
;;;
49

David Byers's avatar
David Byers committed
50
51
52
53
54
55
(defvar lyskom-completing-who-info-cache nil
  "Temporary cache of who-info data")

(defvar lyskom-completing-lookup-name-cache nil
  "Temporary cache of server queries")

56
(defvar lyskom-completing-use-dynamic-info nil)
David Byers's avatar
David Byers committed
57
58
59
60
61
62
63
64
65
66
67

(defun lyskom-completing-clear-cache ()
  (setq lyskom-completing-who-info-cache nil)
  (setq lyskom-completing-lookup-name-cache nil))

(defun lyskom-completing-who-is-on ()
  "Get information about who is on, first checking the cache. Returns what 
\(blocking-do 'who-is-on\) would, but as a list, not a vector"
  (if lyskom-completing-who-info-cache
      lyskom-completing-who-info-cache
    (setq lyskom-completing-who-info-cache
68
          (listify-vector
David Byers's avatar
David Byers committed
69
	   (if (lyskom-have-feature dynamic-session-info)
70
71
	       (blocking-do 'who-is-on-dynamic t t 0)
	     (blocking-do 'who-is-on))))))
David Byers's avatar
David Byers committed
72

73
(defun lyskom-completing-cache-completion (string data)
74
  (let* ((downs (lyskom-unicase string))
75
76
77
78
79
80
81
82
         (tmp (assoc downs lyskom-completing-lookup-name-cache)))
    (if (null tmp)
        (setq lyskom-completing-lookup-name-cache
              (cons (cons downs data) lyskom-completing-lookup-name-cache)))
    string))

(defun lyskom-completing-lookup-z-name (string want-conf want-pers)
  "Look up STRING as a name. Same as \(blocking-do 'lookup-z-name ...\)
David Byers's avatar
David Byers committed
83
but first checks a cache."
84
85
86
87
88
89
90
91
92
93
94
95
96
  (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)))))
David Byers's avatar
David Byers committed
97

98
99
100
101
102
;;; ============================================================
;;;
;;; Keymaps
;;;

David Byers's avatar
David Byers committed
103

104
105
106
107
108
109
110
111
(defvar lyskom-minibuffer-local-completion-map
  (let ((map (copy-keymap minibuffer-local-completion-map)))
    (define-key map " " nil)
    map)
  "Keymap used for reading LysKOM names.")

(defvar lyskom-minibuffer-local-must-match-map
  (let ((map (copy-keymap minibuffer-local-must-match-map)))
David Byers's avatar
X    
David Byers committed
112
113
114
    (lyskom-xemacs-or-gnu 
     (set-keymap-parent map lyskom-minibuffer-local-completion-map)
     (define-key map " " nil))
115
116
117
    map)
  "Keymap used for reading LysKOM names.")

118
119


120
121
122
123
124
(defsubst lyskom-completing-match-string-regexp (string)
  (concat "^"
          (replace-in-string (regexp-quote (lyskom-unicase (lyskom-completing-strip-name string)))
                             "\\s-+" "\\\\S-*\\\\s-+")
          "\\s-*"))
125

126
127
128
129
(defsubst lyskom-completing-match-string (string name)
  "Return non-nil if STRING matches NAME using LysKOM completion rules."
  (string-match (lyskom-completing-match-string-regexp string)
                (lyskom-completing-strip-name (lyskom-unicase name))))
130
131


David Byers's avatar
David Byers committed
132
(defun lyskom-read-conf-no (prompt type &optional empty initial mustmatch)
133
134
135
136
  "Read a conference name from the minibuffer with completion and
return its number or zero if nothing was matched.

See lyskom-read-conf for a description of the parameters."
137
138
139
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) 0)
          ((stringp conf-z-info) 0)
140
	  ((lyskom-conf-stat-p conf-z-info) (conf-stat->conf-no conf-z-info))
David Byers's avatar
David Byers committed
141
	  ((lyskom-uconf-stat-p conf-z-info) (uconf-stat->conf-no conf-z-info))
142
          (t (conf-z-info->conf-no conf-z-info)))))
143
144
145
146
147
148

(defun lyskom-read-conf-stat (prompt type &optional empty initial mustmatch)
  "Read a conference name from the minibuffer with completion and
return its conf-stat or nil if nothing was matched.

See lyskom-read-conf for a description of the parameters."
149
150
151
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) nil)
          ((stringp conf-z-info) nil)
152
	  ((lyskom-conf-stat-p conf-z-info) conf-z-info)
David Byers's avatar
David Byers committed
153
154
          ((lyskom-uconf-stat-p conf-z-info) 
           (blocking-do 'get-conf-stat (uconf-stat->conf-no conf-z-info)))
155
156
          (t (blocking-do 'get-conf-stat 
                          (conf-z-info->conf-no conf-z-info))))))
157

David Byers's avatar
David Byers committed
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
(defun lyskom-read-uconf-stat (prompt type &optional empty initial mustmatch)
  "Read a conference name from the minibuffer with completion and
return its conf-stat or nil if nothing was matched.

See lyskom-read-conf for a description of the parameters."
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) nil)
          ((stringp conf-z-info) nil)
	  ((lyskom-uconf-stat-p conf-z-info) conf-z-info)
	  ((lyskom-conf-stat-p conf-z-info)
           (blocking-do 'get-uconf-stat 
                        (conf-stat->conf-no conf-z-info)))
          (t (blocking-do 'get-uconf-stat 
                          (conf-z-info->conf-no conf-z-info))))))

173
174
175
176
177
(defun lyskom-read-conf-name (prompt type &optional empty initial mustmatch)
  "Read a conference name from the minibuffer with completion and
return its name.

See lyskom-read-conf for a description of the parameters."
178
179
180
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) "")
          ((stringp conf-z-info) conf-z-info)
David Kågedal's avatar
David Kågedal committed
181
	  ((lyskom-conf-stat-p conf-z-info) (conf-stat->name conf-z-info))
David Byers's avatar
David Byers committed
182
	  ((lyskom-uconf-stat-p conf-z-info) (uconf-stat->name conf-z-info))
David Kågedal's avatar
David Kågedal committed
183
	  (t (conf-z-info->name conf-z-info)))))
184

185

186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
;;; ================================================================
;;; Code to guess defaults for initial input
;;;

(defun lyskom-default-conference-at-point ()
  (let* ((pos (or lyskom-command-point (point)))
         (type (and pos (get-text-property pos 'lyskom-button-type))))
    (and (memq type '(conf pers))
         (list (get-text-property pos 'lyskom-button-arg)))))

(defun lyskom-default-conference-current ()
  (list lyskom-current-conf))

(defun lyskom-default-conference-self ()
  (list lyskom-pers-no))

(defun lyskom-default-conference-not-self (uc)
  (not (eq (uconf-stat->conf-no uc) lyskom-pers-no)))

(defun lyskom-default-conference-not-current (uc)
  (not (eq (uconf-stat->conf-no uc) lyskom-current-conf)))

(defun lyskom-get-initial-conf-strategy ()
  (or (cdr (assq lyskom-current-command lyskom-default-conference-strategy))
      (cdr (assq t lyskom-default-conference-strategy))))

212
213
(defun lyskom-read-conf-guess-initial (predicate)
  "Return a guess for the initial value for lyskom-read-conf."
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
  (let* ((strategy (lyskom-get-initial-conf-strategy))
         (default (cdr (assq 'default strategy)))
         (filter (cdr (assq 'filter strategy))))

    (uconf-stat->name
     (car (filter-list (lambda (uconf-stat)
                         (and uconf-stat
                              (not (memq nil (mapcar (lambda (fn)
                                                       (funcall fn uconf-stat)) 
                                                     filter)))
                              (lyskom-read-conf-internal-verify-type
                               (uconf-stat->conf-no uconf-stat)
                               (uconf-stat->conf-type uconf-stat)
                               predicate nil nil)))
                       (mapcar (lambda (conf-no)
                                 (blocking-do 'get-uconf-stat conf-no)) 
                               (apply 'append (mapcar 'funcall default))))))))



234

235
236
237
238
239
240
(defun lyskom-read-conf (prompt type &optional empty initial mustmatch)
  "Completing read a conference or person from the minibuffer. 

PROMPT is the prompt type type.
TYPE   is the type of conferences to return. It is a list of one or
more of the following:
241
242
243
244
    all     Return any conference.
    conf    Return conferences (not letterboxes).
    pers    Return persons (letterboxes).
    login   Return persons who are also logged-in.
David Byers's avatar
David Byers committed
245
246
    membership Return only conferences and letterboxes lyskom-pers-no
            is a member of.
247
    none    Return names that do not match anything in the database.
248
249
250
    (restrict c1 c2 ...) Restrict matching to conference numbers c1, 
            c2 etc. The implementation is inefficient for long lists.

251
252
Optional arguments
EMPTY     allow nothing to be entered.
David Byers's avatar
David Byers committed
253
254
INITIAL   initial contents of the minibuffer. If an integer, use the
          name of that conference.
255
256
257
MUSTMATCH if non-nil, the user must enter a valid name.

The return value may be one of
258
A conf-z-info: The conf-z-info associated with the name entered,
259
260
nil:         Nothing was entered, or
A string:    A name that matched nothing in the database."
261

David Byers's avatar
David Byers committed
262
  (lyskom-completing-clear-cache)
263
264
265
266
267
268
269
270
271
272
273
274
275
276
  (setq initial
        (cond ((integerp initial)
               (uconf-stat->name (blocking-do 'get-uconf-stat initial)))
              ((stringp initial) initial)
              ((lyskom-conf-stat-p initial)
               (conf-stat->name initial))
              ((lyskom-uconf-stat-p initial)
               (uconf-stat->name initial))
              ((lyskom-conf-z-info-p initial)
               (conf-z-info->name initial))
              ((consp initial) initial)
              ((lyskom-read-conf-guess-initial type))
              (t nil)))

277
  (let* ((completion-ignore-case t)
David Byers's avatar
David Byers committed
278
279
280
         (minibuffer-local-completion-map 
          lyskom-minibuffer-local-completion-map)
         (minibuffer-local-must-match-map 
281
282
283
284
285
286
          lyskom-minibuffer-local-must-match-map)
         (read-string nil)
         (result nil)
         (keep-going t))

    (while keep-going
287
288
289
290
291
292
293
294
295
296
      (setq read-string (lyskom-completing-read (cond ((stringp prompt) prompt)
                                                      ((symbolp prompt) (lyskom-get-string prompt))
                                                      (t (lyskom-get-string 'conf-prompt)))
                                                'lyskom-read-conf-internal
                                                type
                                                mustmatch
                                                (if (listp initial)
                                                    initial
                                                  (cons initial 0))
                                                'lyskom-name-hist))
297
298
299
300
301
302
303
      (setq result
            (cond ((null read-string) nil)
                  ((string= "" read-string) nil)
                  (t (lyskom-lookup-conf-by-name read-string type))))
      (setq keep-going (and (not empty)
                            (null result))))
    result))
304
305


306
307
308
(defun lyskom-read-conf-get-logins ()
  "Used internally by lyskom-read-conf-internal to get a list of
persons who are logged on."
David Byers's avatar
David Byers committed
309
310
311
312
  (mapcar (if (lyskom-have-feature dynamic-session-info)
              (function (lambda (el) (dynamic-session-info->person el)))
            (function (lambda (el) (who-info->pers-no el))))
          (lyskom-completing-who-is-on)))
313
314


315
316
317
318
319
(defun lyskom-read-conf-expand-specials (string
                                         predicate
                                         login-list
                                         x-list
                                         &optional return-cs)
320
321
322
323
  "Used internally by lyskom-read-conf-internal to expand person and
conference number specifications to something useful."
  (cond ((string-match (lyskom-get-string 'person-or-conf-no-regexp) string)
         (let* ((no (string-to-int (match-string 1 string)))
David Byers's avatar
David Byers committed
324
                (cs (blocking-do 'get-uconf-stat no)))
325
326
           (if (and cs
                    (lyskom-read-conf-internal-verify-type
David Byers's avatar
David Byers committed
327
328
                     (uconf-stat->conf-no cs)
                     (uconf-stat->conf-type cs)
329
330
331
                     predicate 
                     login-list
                     x-list))
332
333
334
335
336
337
338
               (if return-cs
                   cs
                 (list string)))))
        ((string-match (lyskom-get-string 'session-no-regexp) string)
         (let* ((no (string-to-int (match-string 1 string)))
                (si (blocking-do 'get-session-info no))
                (cs (and si
David Byers's avatar
David Byers committed
339
                         (blocking-do 'get-uconf-stat
340
341
342
                                      (session-info->pers-no si)))))
           (if (and cs
                    (lyskom-read-conf-internal-verify-type
David Byers's avatar
David Byers committed
343
344
                     (uconf-stat->conf-no cs)
                     (uconf-stat->conf-type cs)
345
346
347
348
349
350
                     predicate 
                     login-list
                     x-list))
               (if return-cs
                   cs
                 (list string)))))))
351
352
353
354

(defun lyskom-read-conf-lookup-specials (string predicate login-list x-list)
  "Used internally by lyskom-read-conf-internal to look up conf-stats
from person and conference number specifications."
David Byers's avatar
David Byers committed
355
356
357
358
359
360
361
362
  (let ((cs (lyskom-read-conf-expand-specials string
                                              predicate
                                              login-list
                                              x-list
                                              t)))
    (lyskom-create-conf-z-info (uconf-stat->name cs)
                               (uconf-stat->conf-type cs)
                               (uconf-stat->conf-no cs))))
363
364

(defun lyskom-lookup-conf-by-name (string predicate)
365
  "Return the conf-z-info associated with STRING that also satisfies
366
367
PREDICATE or nil if no name matches. See lyskom-read-conf-internal for
a documentation of PREDICATE."
David Byers's avatar
X    
David Byers committed
368
369
370
  (if (string= string "")
      nil
    (lyskom-read-conf-internal string predicate 'lyskom-lookup)))
371
372
373
374
375
376


(defun lyskom-read-conf-internal (string predicate all)
  "Complete the name STRING according to PREDICATE and ALL.

STRING is a string to complete.
377
378
PREDICATE is a list of name types to return. See lyskom-read-conf for
details.
379
380
381
382
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."

383
384
385
386
387
388
389
390
  ;;
  ;;  Catch some degenerate cases that can cause...problems. This
  ;;  won't solve all the...problems, but should speed things up a
  ;;  little bit.
  ;;

  (cond 
   ((and (null all)
391
         (string-match "^\\s-*$" string)) "")
392
   ((and (eq all 'lyskom-lookup)
David Byers's avatar
David Byers committed
393
         (string-match "^\\s-*$" string)) nil)
394
   ((and (eq all 'lambda)
David Byers's avatar
David Byers committed
395
         (string-match "^\\s-*$" string)) nil)
396
397
398
399
   (t

    (let* ((login-list (and (memq 'login predicate)
                            (lyskom-read-conf-get-logins)))
400
           (x-list (lyskom-completing-lookup-z-name string 
401
                                                    (if (or (memq 'all predicate)
David Byers's avatar
David Byers committed
402
                                                            (memq 'membership predicate)
403
404
405
                                                            (memq 'conf predicate)
                                                            (memq 'none predicate)) 1 0)
                                                    (if (or (memq 'all predicate)
David Byers's avatar
David Byers committed
406
                                                            (memq 'membership predicate)
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
                                                            (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))))))
424
           (candidate-list 
425
426
427
            (append r-list
                   (if x-list
                       (conf-z-info-list->conf-z-infos x-list))))
428
           (result-list nil))
429
430

      ;;
431
432
433
      ;;  login-list now contains a list of logins, IF the predicate
      ;;  includes 'login
      ;;
434
      ;;  candidate-list contains a list of conf-z-infos
435
      ;;
436
      ;;  Now set result-list to the conf-z-infos that fulfill the
437
      ;;  predicate, fetching the conf-stats asynchronously.
438
439
      ;;

440
441
442
443
444
445
446
      (lyskom-traverse el candidate-list
        (if (lyskom-read-conf-internal-verify-type (conf-z-info->conf-no el)
                                                   (conf-z-info->conf-type el)
                                                   predicate
                                                   login-list
                                                   candidate-list)
            (setq result-list (cons el result-list))))
447
      
448

449
      ;;
450
      ;;  Now the matching conf-z-infos are in result-list
451
      ;;
452

453
454
      (cond 
       ((eq all 'lyskom-lookup)
455
        (let ((names (mapcar 'conf-z-info->name 
456
457
                             result-list))
              (specials (lyskom-read-conf-expand-specials string
458
459
                                                          predicate
                                                          login-list
460
                                                          candidate-list)))
461

David Byers's avatar
David Byers committed
462
          (cond ((and kom-complete-numbers-before-names specials)
463
464
465
466
467
                 (lyskom-read-conf-lookup-specials string
                                                   predicate
                                                   login-list
                                                   candidate-list))
                ((= (length result-list) 1)
468
                 (car result-list))
David Byers's avatar
David Byers committed
469

470
471
472
473
474
475
476
477
478
                ((and (> (length result-list) 1)
                      (lyskom-completing-member string names))
                 (elt result-list
                      (- (length result-list)
                         (length (lyskom-completing-member string names)))))

                (specials (lyskom-read-conf-lookup-specials string
                                                            predicate
                                                            login-list
479
                                                            candidate-list))
480
481
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
482
483
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
484
                ((lyskom-read-conf-internal-verify-type nil
485
486
487
                                                        nil
                                                        predicate
                                                        login-list
488
                                                        candidate-list)
489
490
491
492
493
494
495
496
497
498
499
500
                 string))))
     
       ;;
       ;;  Check for exact match. We have an exact match in the server
       ;;  when there was a single match OR when there was no match, and
       ;;  no match is valid according to predicate
       ;;

       ((eq all 'lambda)
        (let ((specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
501
                                                          candidate-list)))
502
          (cond ((= (length result-list) 1) t)
David Byers's avatar
David Byers committed
503
504
505
506
507
                ((and (> (length result-list) 1)
                      (let ((names (mapcar 'conf-z-info->name
                                           result-list)))
                        (and (lyskom-completing-member string names)
                             t))))
508
509
510
511
512
                (result-list nil)
                ((= (length specials) 1) t)
                (specials nil)
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
513
514
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
David Byers's avatar
David Byers committed
515

516
517
518
519
                (t (lyskom-read-conf-internal-verify-type nil
                                                          nil
                                                          predicate
                                                          login-list
520
                                                          candidate-list)))))
521
522


523
524
525
526
527
528
529
530
       ;;
       ;;  Called from all-completions. Return a list of all possible
       ;;  completions, in this case all names in the result list plus,
       ;;  if the input string is a person or conf number specification,
       ;;  the input string, PROVIDED, the requested conference matches
       ;;  the predicate. If there were no matches, return the input
       ;;  string if no matches satisfies the predicate.
       ;;
531
          
532
       (all
533
        (let ((names (mapcar 'conf-z-info->name result-list))
534
535
536
              (specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
537
                                                          candidate-list)))
538
539
540
541
          (cond (specials (append specials names))
                (names names)
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
542
543
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
544
545
                ((lyskom-read-conf-internal-verify-type nil
                                                        nil
546
547
                                                        predicate
                                                        login-list
548
                                                        candidate-list)
549
550
551
552
553
554
555
556
557
558
559
560
561
562
                 (list string))
                (t nil))))

       ;;
       ;;  Called from try-completion, and there were no matches. Try to
       ;;  expand the input string as a person or conf number
       ;;  specification or return something sensible if the predicate
       ;;  is satisfied by no matches.
       ;;

       ((null result-list)
        (let ((specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
563
                                                          candidate-list)))
564
          (cond (specials (car specials))
565
566
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
567
568
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
569
570
                ((lyskom-read-conf-internal-verify-type nil
                                                        nil
571
572
                                                        predicate
                                                        login-list
573
                                                        candidate-list)
574
                 t)
575
576
577
578
579
580
581
582
583
584
                (t nil))))

       ;;
       ;;  Called from try-completion, and there were matches in the
       ;;  server. Return t if the string is an exact match to any
       ;;  string returned from the server. Otherwise, expand the string
       ;;  as far as possible and return that
       ;;

       (t
585
        (let ((name-list (mapcar 'conf-z-info->name result-list))
586
587
588
              (specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
David Kågedal's avatar
David Kågedal committed
589
                                                          candidate-list)))
590
          (if specials (setq name-list (nconc specials name-list)))
591

David Byers's avatar
David Byers committed
592
593
          (cond ((lyskom-completing-member string name-list) 
                 (or (and (= (length name-list) 1) t) string)) ; Exact match
594
595
596
                ((= (length name-list) 1) (car name-list))
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
597
598
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
599
600
                (t (or (lyskom-completing-cache-completion
                        (lyskom-complete-string name-list)
601
602
603
604
                        (if r-list
                            (lyskom-create-conf-z-info-list
                             (apply 'vector candidate-list))
                          x-list))
605
606
607
608
609
610
                       (and (lyskom-read-conf-internal-verify-type 
                             nil
                             nil
                             predicate
                             login-list
                             candidate-list)
611
                            (list string))))))))))))
612
613
        

David Byers's avatar
David Byers committed
614
615
616
617
(defun lyskom-completing-member (string list)
  (let ((string (lyskom-unicase (lyskom-completing-strip-name string)))
        (result nil))
    (while (and list (not result))
618
      (if (lyskom-string= string (lyskom-unicase 
David Byers's avatar
David Byers committed
619
620
621
622
                           (lyskom-completing-strip-name (car list))))
          (setq result list)
        (setq list (cdr list))))
    result))
623

624

625
626
(defun lyskom-completing-strip-name (string)
  "Strip parens and crap from a name."
David Byers's avatar
David Byers committed
627
628
629
630
  (while (string-match "([^()]*)" string)
    (setq string (replace-match " " t t string)))
  (while (string-match "\\s-\\s-+" string)
    (setq string (replace-match " " t t string)))
631
632
  (while (string-match "([^()]*$" string)
    (setq string (substring string 0 (match-beginning 0))))
633
  (if (string-match "^\\s-*\\(.*\\S-\\)\\s-*$" string)
David Byers's avatar
David Byers committed
634
635
      (match-string 1 string)
    string))
636

637
638
639
640
641
642

(defun lyskom-read-conf-internal-verify-type (conf-no
                                              conf-type
                                              predicate
                                              logins
                                              x-list)
643
644
  (or (memq conf-no (cdr (assq 'restrict predicate)))
      (and (memq 'all predicate)
645
646
           conf-no)
      (and (memq 'conf predicate)
647
           conf-type
648
649
           (not (conf-type->letterbox conf-type)))
      (and (memq 'pers predicate) 
650
           conf-type
651
652
           (conf-type->letterbox conf-type))
      (and (memq 'login predicate)
David Byers's avatar
David Byers committed
653
           conf-no
654
           (memq conf-no logins))
David Byers's avatar
David Byers committed
655
656
657
      (and (memq 'membership predicate)
           conf-no
           (lyskom-get-membership conf-no t))
658
659
      (and (memq 'none predicate) 
           (and (null conf-no)
660
                (null x-list)))))
661

David Byers's avatar
David Byers committed
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
;;; FOR DEBUGGING (DON'T DELETE)     /byers
;;;
;;; (defun lyskom-complete-show-data-list (state data)
;;;   (save-excursion
;;;     (pop-to-buffer (get-buffer-create "*kom*-complete"))
;;;     (erase-buffer)
;;;     (set-buffer-multibyte nil)
;;;    (while data
;;;       (insert
;;;        (format "%s\n" (substring (aref (car data) 2)
;;;                                  (aref (car data) 0)
;;;                                  (aref (car data) 1))))
;;;       (setq data (cdr data)))
;;;     (insert (format "%S %S: %S" (symbol-value current-state)
;;;                     (elt state 0)
;;;                     (elt state 1)))
;;;     (sit-for 5)))
679

680

681
682
683
684
685
686
687
688
689
690
691
(defun lyskom-complete-string (string-list)
  "Find the longest common prefix of all strings in STRING-LIST according to
the LysKOM rules of string matching."
  (let ((main-state 'start-of-string)
        (tmp-state nil)
        (current-state 'main-state)
        (main-accumulator nil)
        (tmp-accumulator nil)
        (current-accumulator 'main-accumulator)
        (done nil)
        (paren-depth 0)
692
693
        (have-here nil)
        (last-event-worth-noting nil)
694
695
696
697
698
        (data-list (lyskom-complete-string-munge-input string-list))
        (next-char-state (vector nil nil)))

    (while (not done)
      (lyskom-complete-string-next-char next-char-state data-list)
699
;      (lyskom-complete-show-data-list next-char-state data-list)
700
701
702
703
704
705
706
707
      (cond

       ;;
       ;; Case one, a match of two non-special characters.
       ;; Accumulate one character and advance the lists
       ;;

       ((eq (aref next-char-state 0) 'match)
David Byers's avatar
David Byers committed
708
709
        (if (eq (aref next-char-state 1) ?\ )
            (progn
710
              (cond ((memq (symbol-value current-state)
711
			     '(start-of-word start-of-string))
David Byers's avatar
David Byers committed
712
713
714
715
716
717
718
719
720
                     nil)
                    ((eq last-event-worth-noting 'mismatch)
                     (lyskom-complete-string-accumulate current-accumulator
                                                        'SPC))
                    (t
                     (lyskom-complete-string-accumulate current-accumulator
                                                        ?\ )))
              (set current-state 'start-of-word)
              (lyskom-complete-string-advance data-list))
721
          (progn
David Byers's avatar
David Byers committed
722
            (set current-state 'in-a-word)
723
            (lyskom-complete-string-accumulate current-accumulator
David Byers's avatar
David Byers committed
724
725
726
                                               (aref next-char-state 1))
            (lyskom-complete-string-advance data-list)))
        (setq last-event-worth-noting 'match))
727
728
729
730
731
732
733
734
735
       
       ;;
       ;; Case two, a match of two open-paren expressions Increase
       ;; paren depth and accumulate a character. First set
       ;; current-accumulator to the temporary if paren-depth is zero
       ;; to start with.
       ;;

       ((eq (aref next-char-state 0) 'open-paren-match)
736
        (setq last-event-worth-noting 'match)
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
        (if (zerop paren-depth)
            (progn
              (setq current-accumulator 'tmp-accumulator)
              (setq current-state 'tmp-state)
              (setq tmp-state main-state)
              (setq tmp-accumulator nil)))
        (setq paren-depth (1+ paren-depth))
        (lyskom-complete-string-accumulate current-accumulator
                                    (aref next-char-state 1))
        (lyskom-complete-string-advance data-list))

       ;;
       ;; Case three, a match of two close-paren expressions
       ;; Accumulate a character. If paren-depth is postitive,
       ;; decrease it. If it ends up zero, add the temporary
       ;; accumulator to the main accumulator and set the current
       ;; accumulator to the main accumulator.
       ;;

       ((eq (aref next-char-state 0) 'close-paren-match)
757
        (setq last-event-worth-noting 'match)
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
        (lyskom-complete-string-accumulate current-accumulator
                                    (aref next-char-state 1))
        (if (> paren-depth 0)
            (progn
              (setq paren-depth (1- paren-depth))
              (if (zerop paren-depth)
                  (progn
                    (setq main-accumulator
                          (nconc tmp-accumulator main-accumulator))
                    (setq main-state tmp-state)
                    (setq current-state 'main-state)
                    (setq current-accumulator 'main-accumulator)))))
        (lyskom-complete-string-advance data-list))

       ;;
       ;; Case two, a mismatch of any kind in a paren expression
       ;;

       ((and (> paren-depth 0)
777
             (memq (aref next-char-state 0)
778
		     '(mismatch space-mismatch open-paren-mismatch)))
779
        (setq last-event-worth-noting 'mismatch)
780
781
782
783
784
785
786
787
788
789
790
791
792
        (setq tmp-accumulator nil)
        (setq tmp-state nil)
        (setq current-state 'main-state)
        (setq current-accumulator 'main-accumulator)
        (lyskom-complete-string-close-parens data-list paren-depth)
        (setq paren-depth 0))

       ;;
       ;; Case two and a half or so, a space mismatch. This is ignored
       ;; if we're still at the start of the string
       ;;
       
       ((and (eq (aref next-char-state 0) 'space-mismatch)
793
             (memq (symbol-value current-state)
794
		     '(start-of-string start-of-word)))
David Byers's avatar
David Byers committed
795
        (setq last-event-worth-noting nil)
796
797
798
799
800
801
        (lyskom-complete-string-skip-whitespace data-list))

       ;;
       ;; Case three, a mismatch of regular characters outside a paren
       ;; Advance to the end of the current word
       ;;
802

803
       ((and (memq (aref next-char-state 0) '(mismatch space-mismatch))
804
             (zerop paren-depth))
David Byers's avatar
David Byers committed
805
        (setq last-event-worth-noting 'mismatch)
806
        (if (memq (symbol-value current-state)
807
		    '(start-of-word start-of-string))
808
809
            (setq done t)
          (progn
810
811
812
813
814
            (if (not have-here)
                (progn
                  (lyskom-complete-string-accumulate current-accumulator 
                                                     'HERE)
                  (setq have-here t)))
815
816
            (lyskom-complete-string-advance-to-end-of-word data-list)
            (set current-state 'in-a-word))))
817

818
819
820
       ;;
       ;; Case four, a mistmatch where one character is an open-paren
       ;;
821

822
       ((eq (aref next-char-state 0) 'open-paren-mismatch)
823
        (setq last-event-worth-noting 'mismatch)
824
        (lyskom-complete-string-skip-parens data-list))
825
826


827
828
829
       ;;
       ;; Case five, eof
       ;;
830

831
832
       ((eq (aref next-char-state 0) 'eof)
        (setq done t))
833

834
835
836
837
838
839
840
841
842
843
844
       ;;
       ;; Case six, can't happen
       ;;

       (t (error "This can't happen: %S" next-char-state))))

    ;;
    ;; Build the result by reversing the result list and making a
    ;; string out of it.
    ;;

David Byers's avatar
David Byers committed
845
846
    (if (eq (car main-accumulator) 'SPC)
        (setq main-accumulator (cdr main-accumulator)))
847
848
849

    (setq main-accumulator (nreverse main-accumulator))

David Byers's avatar
David Byers committed
850
851
852
    (if (memq 'HERE main-accumulator)
        (let ((backup (length (memq 'HERE main-accumulator))))
          (if lyskom-experimental-features
853
854
              (setq unread-command-events
                    (append (cons ? (make-list (1- backup) 2))
David Byers's avatar
David Byers committed
855
856
                            unread-command-events)))
          (setq main-accumulator (delq 'HERE main-accumulator))))
857
858
859
    
    (concat (mapcar (lambda (el) (if (eq el 'SPC) ?\  el))
		    main-accumulator))))
860

861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877

(defun lyskom-complete-string-accumulate (accumulator char)
  (set accumulator (cons char (symbol-value accumulator))))

(defun lyskom-complete-string-munge-input (string-list)
  (mapcar (function
           (lambda (x)
             (vector 0 (length x) x)))
          string-list))

;;;
;;; Advance one regular character or multiple whitespaces
;;;

(defun lyskom-complete-string-advance (data-list)
  (lyskom-traverse 
   el data-list
878
   (string-match "\\([ \t]+\\|[^ \t]\\|$\\)"
879
880
881
882
883
884
885
                 (aref el 2)
                 (aref el 0))
   (aset el 0 (match-end 0))))

(defun lyskom-complete-string-skip-whitespace (data-list)
  (lyskom-traverse
   el data-list
886
   (string-match "[ \t]*" (aref el 2) (aref el 0))
887
888
889
890
891
892
893
894
895
   (aset el 0 (match-end 0))))

;;;
;;; Advance to the end of the current word
;;;

(defun lyskom-complete-string-advance-to-end-of-word (data-list)
  (lyskom-traverse
   el data-list
896
   (aset el 0 (string-match "\\([ \t]\\|$\\)" 
897
898
899
900
901
902
                            (aref el 2)
                            (aref el 0)))))

;;;
;;; Unwind a number of parens
;;;
903

904
905
906
907
908
909
910
911
912
913
914
915
916
917
(defun lyskom-complete-string-skip-parens (data-list)
  (lyskom-traverse
   el data-list
   (if (eq ?\( (aref (aref el 2) (aref el 0)))
       (progn
         (aset el 0 (1+ (aref el 0)))
         (lyskom-complete-string-close-parens-2 el 1)))))

(defun lyskom-complete-string-close-parens (data-list depth)
  (lyskom-traverse
   el data-list
   (lyskom-complete-string-close-parens-2 el depth)))

(defun lyskom-complete-string-close-parens-2 (el depth)
David Byers's avatar
David Byers committed
918
  (let ((string (aref el 2))
David Byers's avatar
David Byers committed
919
        (pos (aref el 0)))
920
    (while (> depth 0)
David Byers's avatar
David Byers committed
921
922
      (cond ((>= pos (length string)) 
             (setq depth 0))
David Byers's avatar
David Byers committed
923
            ((eq (aref string pos) ?\))
David Byers's avatar
David Byers committed
924
             (setq depth (1- depth)))
David Byers's avatar
David Byers committed
925
            ((eq (aref string pos) ?\))
David Byers's avatar
David Byers committed
926
927
928
929
             (setq depth (1+ depth))))
      (setq pos (1+ pos)))
    (aset el 0 pos)))

930
931
932
933
934
935
936
937
938
939
940
941
942
943

;;;
;;; Check what's happenin' next
;;;

(defun lyskom-complete-string-next-char (state data-list)
  (let ((eofp nil)
        (open-paren-p nil)
        (close-paren-p nil)
        (matchp t)
        (spacep nil)
        (char nil)
        (xchar nil))

944
    (lyskom-save-excursion
David Byers's avatar
X    
David Byers committed
945
     (set-buffer lyskom-buffer)
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
     (mapcar
      (function 
       (lambda (x)
         (cond ((>= (aref x 0) (aref x 1))
                (setq eofp t)
                (setq matchp nil))
               ((eq (aref (aref x 2) (aref x 0)) ?\()
                (setq open-paren-p t))
               ((eq (aref (aref x 2) (aref x 0)) ?\))
                (setq close-paren-p t))
               ((eq (aref (aref x 2) (aref x 0)) ?\ )
                (setq spacep t)))

         (setq matchp (and matchp
                           (if (null char)
                               (progn
                                 (setq xchar (aref (aref x 2)
                                                   (aref x 0)))
                                 (setq char (lyskom-unicase-char xchar)))
                             (eq char (lyskom-unicase-char
                                       (aref (aref x 2)
                                             (aref x 0)))))))))
      data-list))
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985

    (aset state 1 xchar)
    (cond (eofp (aset state 0 'eof))
          ((and matchp open-paren-p)
           (aset state 0 'open-paren-match))
          ((and matchp close-paren-p)
           (aset state 0 'close-paren-match))
          (matchp
           (aset state 0 'match))
          (spacep
           (aset state 0 'space-mismatch))
          (open-paren-p
           (aset state 0 'open-paren-mismatch))
          (t
           (aset state 0 'mismatch))))
  state)

986
987
988
989
990
991
992
993
994
995
996
997
998







;;; ============================================================
;;;
;;; Session reading
;;;
;;;

Per Cederqvist's avatar
.  
Per Cederqvist committed
999
1000


1001
(defun lyskom-read-session-no (prompt &optional empty initial only-one)
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
  (let ((possible-matches
         (lyskom-session-from-conf
          (lyskom-read-conf-no prompt
                               (if kom-permissive-completion
                                   '(pers)
                                 '(login))
                               empty
                               initial
                               t))))
    (if (and (> (length possible-matches) 1)
             only-one)
        (lyskom-read-session-resolve-ambiguity possible-matches)
      possible-matches)))


(defun lyskom-session-from-conf (conf-no)
  (let ((who-list (lyskom-completing-who-is-on))
        (sessions nil))
David Byers's avatar
David Byers committed
1020
    (if (lyskom-have-feature dynamic-session-info)
1021
	(while who-list
David Byers's avatar
David Byers committed
1022
	  (if (eq (dynamic-session-info->person (car who-list)) conf-no)
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
	      (setq sessions (cons (dynamic-session-info->session
				    (car who-list))
				   sessions)))
	  (setq who-list (cdr who-list)))
      (while who-list
	(if (eq (who-info->pers-no (car who-list))
		conf-no)
	    (setq sessions (cons (who-info->connection (car who-list))
				 sessions)))
	(setq who-list (cdr who-list))))
1033
1034
    (cond ((and (null sessions) kom-permissive-completion) (list (- conf-no)))
          (t sessions))))
1035
1036
1037
1038


(defun lyskom-read-session-resolve-ambiguity (sessions)
  (lyskom-insert "\n")
David Kågedal's avatar
David Kågedal committed
1039
1040
  (let* ((s-width (1+ (apply 'max (mapcar (function
					   (lambda (x)
David Byers's avatar
David Byers committed
1041
					     (string-width (int-to-string x))))
David Kågedal's avatar
David Kågedal committed
1042
1043
1044
					  sessions))))
	 (format-string-s (lyskom-info-line-format-string s-width "s" "s"))
	 (format-string-p (lyskom-info-line-format-string s-width "P" "M")))
1045
    (lyskom-format-insert format-string-s
David Kågedal's avatar
David Kågedal committed
1046
			  ""
1047
1048
1049
			  (lyskom-get-string 'lyskom-name)
			  (lyskom-get-string 'is-in-conf))
    (lyskom-format-insert format-string-s
David Kågedal's avatar
David Kågedal committed
1050
			  ""
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
			  (lyskom-get-string 'from-machine)
			  (lyskom-get-string 'is-doing))
    (lyskom-insert
     (concat (make-string (- (lyskom-window-width) 2) ?-)
	     "\n"))
    (let ((result nil)
	  (who-info
	   (mapcar (function
		    (lambda (el)
		      (let* ((info (blocking-do 'get-session-info el))
			     (confconfstat
David Byers's avatar
David Byers committed
1062
			      (blocking-do 'get-uconf-stat
1063
1064
1065
					   (session-info->working-conf info))))
			(lyskom-format-insert
			 format-string-p
David Kågedal's avatar
David Kågedal committed
1066
1067
1068
1069
1070
1071
			 (format "%d%s"
				 (session-info->connection info)
				 (if (eq (session-info->connection info)
					 lyskom-session-no)
				     "*" " "))
			 (session-info->pers-no info)
1072
1073
			 (or confconfstat
                             (lyskom-get-string 'not-present-anywhere)))
1074
1075
			(lyskom-format-insert
			 format-string-p
David Kågedal's avatar
David Kågedal committed
1076
			 ""
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
			 (lyskom-return-username info)
			 (concat "("
				 (session-info->doing info)
				 ")"))
			(cons (number-to-string
			       (session-info->connection info))
			      info))))
		   (sort sessions '<))))
      (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-)
			     "\n"))
1087
      (lyskom-insert (lyskom-format 'total-users-sans-date (length who-info)))
1088
1089
      (lyskom-scroll)
      (while (string= ""
1090
                      (setq result (lyskom-completing-read
1091
				    (lyskom-get-string 'resolve-session)
David Byers's avatar
David Byers committed
1092
1093
				    (lyskom-maybe-frob-completion-table 
				     who-info)
1094
1095
1096
				    nil
				    t
				    (car (car who-info))
1097
				    nil))))
1098
      (list (session-info->connection (cdr (assoc result who-info)))))))
1099
1100
1101