completing-read.el 42.2 KB
Newer Older
David Byers's avatar
David Byers committed
1
;;;;; -*-coding: iso-8859-1;-*-
Linus Tolke Y's avatar
Linus Tolke Y committed
2
3
;;;;;
;;;;; $Id$
4
;;;;; Copyright (C) 1991-2002  Lysator Academic Computer Association.
Linus Tolke Y's avatar
Linus Tolke Y committed
5
;;;;;
6
;;;;; This file is part of the LysKOM Emacs LISP client.
Linus Tolke Y's avatar
Linus Tolke Y 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 Y's avatar
Linus Tolke Y 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
125
126
127
128
129
130
131
132
133
134
(defun lyskom-read-from-minibuffer-clear-initial (&rest args)
  (condition-case nil
      (let ((ranges nil)
            (tmp nil)
            (start (point-min)))
        (while (setq tmp (lyskom-next-property-bounds
                          start (point-max) 'lyskom-initial-mbc))
          (setq ranges (cons tmp ranges)
                start (cdr tmp)))
        (lyskom-traverse range ranges
          (delete-region (car range) (cdr range)))
        (when ranges
          (setq before-change-functions 
                (delq 'lyskom-read-from-minibuffer-clear-initial
                      before-change-functions))))
    (error nil)))

135
136
137
138
139
(defsubst lyskom-completing-match-string-regexp (string)
  (concat "^"
          (replace-in-string (regexp-quote (lyskom-unicase (lyskom-completing-strip-name string)))
                             "\\s-+" "\\\\S-*\\\\s-+")
          "\\s-*"))
140

141
142
143
144
(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))))
145
146


David Byers's avatar
David Byers committed
147
(defun lyskom-read-conf-no (prompt type &optional empty initial mustmatch)
148
149
150
151
  "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."
152
153
154
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) 0)
          ((stringp conf-z-info) 0)
155
	  ((lyskom-conf-stat-p conf-z-info) (conf-stat->conf-no conf-z-info))
David Byers's avatar
David Byers committed
156
	  ((lyskom-uconf-stat-p conf-z-info) (uconf-stat->conf-no conf-z-info))
157
          (t (conf-z-info->conf-no conf-z-info)))))
158
159
160
161
162
163

(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."
164
165
166
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) nil)
          ((stringp conf-z-info) nil)
167
	  ((lyskom-conf-stat-p conf-z-info) conf-z-info)
David Byers's avatar
David Byers committed
168
169
          ((lyskom-uconf-stat-p conf-z-info) 
           (blocking-do 'get-conf-stat (uconf-stat->conf-no conf-z-info)))
170
171
          (t (blocking-do 'get-conf-stat 
                          (conf-z-info->conf-no conf-z-info))))))
172

David Byers's avatar
David Byers committed
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
(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))))))

188
189
190
191
192
(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."
193
194
195
  (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
196
	  ((lyskom-conf-stat-p conf-z-info) (conf-stat->name conf-z-info))
David Byers's avatar
David Byers committed
197
	  ((lyskom-uconf-stat-p conf-z-info) (uconf-stat->name conf-z-info))
David Kågedal's avatar
David Kågedal committed
198
	  (t (conf-z-info->name conf-z-info)))))
199

200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216

(defun lyskom-read-conf-guess-initial (predicate)
  "Return a guess for the initial value for lyskom-read-conf."
  (let* ((pos (or lyskom-command-point (point)))
         (type (and pos (get-text-property pos 'lyskom-button-type)))
         (conf-nos (delq nil
                         (list (and (memq type '(conf pers))
                                    (get-text-property pos 'lyskom-button-arg))
                               lyskom-current-conf
                               lyskom-pers-no))))
    (lyskom-traverse conf-no conf-nos
      (let ((uc (blocking-do 'get-uconf-stat conf-no)))
        (when (lyskom-read-conf-internal-verify-type 
               conf-no (uconf-stat->conf-type uc)
               predicate nil nil)
          (lyskom-traverse-break (uconf-stat->name uc)))))))

217
218
219
220
221
222
(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:
223
224
225
226
    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
227
228
    membership Return only conferences and letterboxes lyskom-pers-no
            is a member of.
229
    none    Return names that do not match anything in the database.
230
231
232
    (restrict c1 c2 ...) Restrict matching to conference numbers c1, 
            c2 etc. The implementation is inefficient for long lists.

233
234
Optional arguments
EMPTY     allow nothing to be entered.
David Byers's avatar
David Byers committed
235
236
INITIAL   initial contents of the minibuffer. If an integer, use the
          name of that conference.
237
238
239
MUSTMATCH if non-nil, the user must enter a valid name.

The return value may be one of
240
A conf-z-info: The conf-z-info associated with the name entered,
241
242
nil:         Nothing was entered, or
A string:    A name that matched nothing in the database."
243

David Byers's avatar
David Byers committed
244
  (lyskom-completing-clear-cache)
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
  (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))
              ((and lyskom-current-conf
                    (not (eq lyskom-current-conf 0)))
               (uconf-stat->name
                (blocking-do 'get-uconf-stat lyskom-current-conf)))
              (t nil)))

263
264
265
266
267
268
269
270
271
272
  (cond ((stringp initial)
         (setq initial (copy-sequence initial))
         (add-text-properties 0 (length initial) 
                              '(lyskom-initial-mbc t) initial))
        (initial
	 (setq initial (cons (copy-sequence (car initial)) (cdr initial)))
	 (add-text-properties 0 (length (car initial)) 
			      '(lyskom-initial-mbc t) (car initial))))


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

    (while keep-going
David Byers's avatar
X    
David Byers committed
283
      (lyskom-with-lyskom-minibuffer
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
       (let ((before-change-functions before-change-functions)
             (minibuffer-setup-hook 
              (cons (lambda ()
                      (setq before-change-functions
                            (cons 'lyskom-read-from-minibuffer-clear-initial
                                  before-change-functions)))
                    minibuffer-setup-hook)))
         (setq read-string (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))))
301
302
303
304
305
306
307
      (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))
308
309


310
311
312
(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
313
314
315
316
  (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)))
317
318


319
320
321
322
323
(defun lyskom-read-conf-expand-specials (string
                                         predicate
                                         login-list
                                         x-list
                                         &optional return-cs)
324
325
326
327
  "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
328
                (cs (blocking-do 'get-uconf-stat no)))
329
330
           (if (and cs
                    (lyskom-read-conf-internal-verify-type
David Byers's avatar
David Byers committed
331
332
                     (uconf-stat->conf-no cs)
                     (uconf-stat->conf-type cs)
333
334
335
                     predicate 
                     login-list
                     x-list))
336
337
338
339
340
341
342
               (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
343
                         (blocking-do 'get-uconf-stat
344
345
346
                                      (session-info->pers-no si)))))
           (if (and cs
                    (lyskom-read-conf-internal-verify-type
David Byers's avatar
David Byers committed
347
348
                     (uconf-stat->conf-no cs)
                     (uconf-stat->conf-type cs)
349
350
351
352
353
354
                     predicate 
                     login-list
                     x-list))
               (if return-cs
                   cs
                 (list string)))))))
355
356
357
358

(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
359
360
361
362
363
364
365
366
  (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))))
367
368

(defun lyskom-lookup-conf-by-name (string predicate)
369
  "Return the conf-z-info associated with STRING that also satisfies
370
371
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
372
373
374
  (if (string= string "")
      nil
    (lyskom-read-conf-internal string predicate 'lyskom-lookup)))
375
376
377
378
379
380


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

STRING is a string to complete.
381
382
PREDICATE is a list of name types to return. See lyskom-read-conf for
details.
383
384
385
386
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."

387
388
389
390
391
392
393
394
  ;;
  ;;  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)
395
         (string-match "^\\s-*$" string)) "")
396
   ((and (eq all 'lyskom-lookup)
David Byers's avatar
David Byers committed
397
         (string-match "^\\s-*$" string)) nil)
398
   ((and (eq all 'lambda)
David Byers's avatar
David Byers committed
399
         (string-match "^\\s-*$" string)) nil)
400
401
402
403
   (t

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

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

444
445
446
447
448
449
450
      (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))))
451
      
452

453
      ;;
454
      ;;  Now the matching conf-z-infos are in result-list
455
      ;;
456

457
458
      (cond 
       ((eq all 'lyskom-lookup)
459
        (let ((names (mapcar 'conf-z-info->name 
460
461
                             result-list))
              (specials (lyskom-read-conf-expand-specials string
462
463
                                                          predicate
                                                          login-list
464
                                                          candidate-list)))
465

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

474
475
476
477
478
479
480
481
482
                ((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
483
                                                            candidate-list))
484
485
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
486
487
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
488
                ((lyskom-read-conf-internal-verify-type nil
489
490
491
                                                        nil
                                                        predicate
                                                        login-list
492
                                                        candidate-list)
493
494
495
496
497
498
499
500
501
502
503
504
                 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
505
                                                          candidate-list)))
506
          (cond ((= (length result-list) 1) t)
David Byers's avatar
David Byers committed
507
508
509
510
511
                ((and (> (length result-list) 1)
                      (let ((names (mapcar 'conf-z-info->name
                                           result-list)))
                        (and (lyskom-completing-member string names)
                             t))))
512
513
514
515
516
                (result-list nil)
                ((= (length specials) 1) t)
                (specials nil)
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
517
518
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
David Byers's avatar
David Byers committed
519

520
521
522
523
                (t (lyskom-read-conf-internal-verify-type nil
                                                          nil
                                                          predicate
                                                          login-list
524
                                                          candidate-list)))))
525
526


527
528
529
530
531
532
533
534
       ;;
       ;;  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.
       ;;
535
          
536
       (all
537
        (let ((names (mapcar 'conf-z-info->name result-list))
538
539
540
              (specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
541
                                                          candidate-list)))
542
543
544
545
          (cond (specials (append specials names))
                (names names)
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
546
547
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
548
549
                ((lyskom-read-conf-internal-verify-type nil
                                                        nil
550
551
                                                        predicate
                                                        login-list
552
                                                        candidate-list)
553
554
555
556
557
558
559
560
561
562
563
564
565
566
                 (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
567
                                                          candidate-list)))
568
          (cond (specials (car specials))
569
570
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
571
572
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
573
574
                ((lyskom-read-conf-internal-verify-type nil
                                                        nil
575
576
                                                        predicate
                                                        login-list
577
                                                        candidate-list)
578
                 t)
579
580
581
582
583
584
585
586
587
588
                (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
589
        (let ((name-list (mapcar 'conf-z-info->name result-list))
590
591
592
              (specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
David Kågedal's avatar
David Kågedal committed
593
                                                          candidate-list)))
594
          (if specials (setq name-list (nconc specials name-list)))
595

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

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

628

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

641
642
643
644
645
646

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

David Byers's avatar
David Byers committed
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
;;; 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)))
683

684

685
686
687
688
689
690
691
692
693
694
695
(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)
696
697
        (have-here nil)
        (last-event-worth-noting nil)
698
699
700
701
702
        (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)
703
;      (lyskom-complete-show-data-list next-char-state data-list)
704
705
706
707
708
709
710
711
      (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
712
713
        (if (eq (aref next-char-state 1) ?\ )
            (progn
714
              (cond ((memq (symbol-value current-state)
715
			     '(start-of-word start-of-string))
David Byers's avatar
David Byers committed
716
717
718
719
720
721
722
723
724
                     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))
725
          (progn
David Byers's avatar
David Byers committed
726
            (set current-state 'in-a-word)
727
            (lyskom-complete-string-accumulate current-accumulator
David Byers's avatar
David Byers committed
728
729
730
                                               (aref next-char-state 1))
            (lyskom-complete-string-advance data-list)))
        (setq last-event-worth-noting 'match))
731
732
733
734
735
736
737
738
739
       
       ;;
       ;; 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)
740
        (setq last-event-worth-noting 'match)
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
        (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)
761
        (setq last-event-worth-noting 'match)
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
        (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)
781
             (memq (aref next-char-state 0)
782
		     '(mismatch space-mismatch open-paren-mismatch)))
783
        (setq last-event-worth-noting 'mismatch)
784
785
786
787
788
789
790
791
792
793
794
795
796
        (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)
797
             (memq (symbol-value current-state)
798
		     '(start-of-string start-of-word)))
David Byers's avatar
David Byers committed
799
        (setq last-event-worth-noting nil)
800
801
802
803
804
805
        (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
       ;;
806

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

822
823
824
       ;;
       ;; Case four, a mistmatch where one character is an open-paren
       ;;
825

826
       ((eq (aref next-char-state 0) 'open-paren-mismatch)
827
        (setq last-event-worth-noting 'mismatch)
828
        (lyskom-complete-string-skip-parens data-list))
829
830


831
832
833
       ;;
       ;; Case five, eof
       ;;
834

835
836
       ((eq (aref next-char-state 0) 'eof)
        (setq done t))
837

838
839
840
841
842
843
844
845
846
847
848
       ;;
       ;; 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
849
850
    (if (eq (car main-accumulator) 'SPC)
        (setq main-accumulator (cdr main-accumulator)))
851
852
853

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

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

865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881

(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
882
   (string-match "\\([ \t]+\\|[^ \t]\\|$\\)"
883
884
885
886
887
888
889
                 (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
890
   (string-match "[ \t]*" (aref el 2) (aref el 0))
891
892
893
894
895
896
897
898
899
   (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
900
   (aset el 0 (string-match "\\([ \t]\\|$\\)" 
901
902
903
904
905
906
                            (aref el 2)
                            (aref el 0)))))

;;;
;;; Unwind a number of parens
;;;
907

908
909
910
911
912
913
914
915
916
917
918
919
920
921
(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
922
  (let ((string (aref el 2))
David Byers's avatar
David Byers committed
923
        (pos (aref el 0)))
924
    (while (> depth 0)
David Byers's avatar
David Byers committed
925
926
      (cond ((>= pos (length string)) 
             (setq depth 0))
David Byers's avatar
David Byers committed
927
            ((eq (aref string pos) ?\))
David Byers's avatar
David Byers committed
928
             (setq depth (1- depth)))
David Byers's avatar
David Byers committed
929
            ((eq (aref string pos) ?\))
David Byers's avatar
David Byers committed
930
931
932
933
             (setq depth (1+ depth))))
      (setq pos (1+ pos)))
    (aset el 0 pos)))

934
935
936
937
938
939
940
941
942
943
944
945
946
947

;;;
;;; 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))

948
    (lyskom-save-excursion
David Byers's avatar
X    
David Byers committed
949
     (set-buffer lyskom-buffer)
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
     (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))
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989

    (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)

990
991
992
993
994
995
996
997
998
999
1000
1001
1002







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

Per Cederqvist's avatar
.    
Per Cederqvist committed
1003
1004


1005
(defun lyskom-read-session-no (prompt &optional empty initial only-one)
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
  (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
1024
    (if (lyskom-have-feature dynamic-session-info)
1025
	(while who-list
David Byers's avatar
David Byers committed
1026
	  (if (eq (dynamic-session-info->person (car who-list)) conf-no)
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
	      (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))))
1037
1038
    (cond ((and (null sessions) kom-permissive-completion) (list (- conf-no)))
          (t sessions))))
1039
1040
1041
1042


(defun lyskom-read-session-resolve-ambiguity (sessions)
  (lyskom-insert "\n")
David Kågedal's avatar
David Kågedal committed
1043
1044
  (let* ((s-width (1+ (apply 'max (mapcar (function
					   (lambda (x)
David Byers's avatar
David Byers committed
1045
					     (string-width (int-to-string x))))
David Kågedal's avatar
David Kågedal committed
1046
1047
1048
					  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")))
1049
    (lyskom-format-insert format-string-s
David Kågedal's avatar
David Kågedal committed
1050
			  ""
1051
1052
1053
			  (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
1054
			  ""
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
			  (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
1066
			      (blocking-do 'get-uconf-stat
1067
1068
1069
					   (session-info->working-conf info))))
			(lyskom-format-insert
			 format-string-p
David Kågedal's avatar
David Kågedal committed
1070
1071
1072
1073
1074
1075
			 (format "%d%s"
				 (session-info->connection info)
				 (if (eq (session-info->connection info)
					 lyskom-session-no)
				     "*" " "))
			 (session-info->pers-no info)
1076
1077
			 (or confconfstat
                             (lyskom-get-string 'not-present-anywhere)))
1078
1079
			(lyskom-format-insert
			 format-string-p
David Kågedal's avatar
David Kågedal committed
1080
			 ""
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
			 (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"))
1091
      (lyskom-insert (lyskom-format 'total-users-sans-date (length who-info)))
1092
1093
      (lyskom-scroll)
      (while (string= ""
David Byers's avatar
X    
David Byers committed
1094
                      (lyskom-with-lyskom-minibuffer
David Byers's avatar
David Byers committed
1095
                       (setq result (lyskom-completing-read
1096
				    (lyskom-get-string 'resolve-session)
David Byers's avatar
David Byers committed
1097
1098
				    (lyskom-maybe-frob-completion-table 
				     who-info)
1099
1100
1101
				    nil
				    t
				    (car (car who-info))
David Byers's avatar
X    
David Byers committed
1102
				    nil)))))
1103
      (list (session-info->connection (cdr (assoc result who-info)))))))
1104
1105
1106