completing-read.el 36.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, 1996  Lysator Academic Computer Association.
Linus Tolke's avatar
Linus Tolke committed
5
6
7
8
9
;;;;;
;;;;; This file is part of the LysKOM server.
;;;;; 
;;;;; LysKOM is free software; you can redistribute it and/or modify it
;;;;; under the terms of the GNU General Public License as published by 
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
  (let* ((downs (lyskom-unicase string))
85
         (tmp (assoc downs lyskom-completing-lookup-name-cache)))
David Byers's avatar
David Byers committed
86
87
88
    (if tmp
        (cdr tmp)
      (progn
89
        (setq tmp (blocking-do 'lookup-z-name string want-conf want-pers))
David Byers's avatar
David Byers committed
90
        (setq lyskom-completing-lookup-name-cache
91
              (cons (cons downs tmp)
David Byers's avatar
David Byers committed
92
93
94
                    lyskom-completing-lookup-name-cache))
        tmp))))

95
96
97
98
99
;;; ============================================================
;;;
;;; Keymaps
;;;

David Byers's avatar
David Byers committed
100

101
102
103
104
105
106
107
108
(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
109
110
111
    (lyskom-xemacs-or-gnu 
     (set-keymap-parent map lyskom-minibuffer-local-completion-map)
     (define-key map " " nil))
112
113
114
    map)
  "Keymap used for reading LysKOM names.")

115

116
117
118



David Byers's avatar
David Byers committed
119
(defun lyskom-read-conf-no (prompt type &optional empty initial mustmatch)
120
121
122
123
  "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."
124
125
126
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) 0)
          ((stringp conf-z-info) 0)
127
	  ((lyskom-conf-stat-p conf-z-info) (conf-stat->conf-no conf-z-info))
David Byers's avatar
David Byers committed
128
	  ((lyskom-uconf-stat-p conf-z-info) (uconf-stat->conf-no conf-z-info))
129
          (t (conf-z-info->conf-no conf-z-info)))))
130
131
132
133
134
135

(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."
136
137
138
  (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch)))
    (cond ((null conf-z-info) nil)
          ((stringp conf-z-info) nil)
139
	  ((lyskom-conf-stat-p conf-z-info) conf-z-info)
David Byers's avatar
David Byers committed
140
141
          ((lyskom-uconf-stat-p conf-z-info) 
           (blocking-do 'get-conf-stat (uconf-stat->conf-no conf-z-info)))
142
143
          (t (blocking-do 'get-conf-stat 
                          (conf-z-info->conf-no conf-z-info))))))
144

David Byers's avatar
David Byers committed
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
(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))))))

160
161
162
163
164
(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."
165
166
167
  (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
168
	  ((lyskom-conf-stat-p conf-z-info) (conf-stat->name conf-z-info))
David Byers's avatar
David Byers committed
169
	  ((lyskom-uconf-stat-p conf-z-info) (uconf-stat->name conf-z-info))
David Kågedal's avatar
David Kågedal committed
170
	  (t (conf-z-info->name conf-z-info)))))
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

(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:
    all     Return any conference,
    conf    Return conferences (not letterboxes),
    pers    Return persons (letterboxes),
    login   Return persons who are also logged-in, and
    none    Return names that do not match anything in the database.
Optional arguments
EMPTY     allow nothing to be entered.
INITIAL   initial contents of the minibuffer
MUSTMATCH if non-nil, the user must enter a valid name.

The return value may be one of
189
A conf-z-info: The conf-z-info associated with the name entered,
190
191
nil:         Nothing was entered, or
A string:    A name that matched nothing in the database."
192

David Byers's avatar
David Byers committed
193
  (lyskom-completing-clear-cache)
194
  (let* ((completion-ignore-case t)
David Byers's avatar
David Byers committed
195
196
197
         (minibuffer-local-completion-map 
          lyskom-minibuffer-local-completion-map)
         (minibuffer-local-must-match-map 
198
199
200
201
202
203
          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
204
      (lyskom-with-lyskom-minibuffer
David Byers's avatar
David Byers committed
205
206
207
       (setq read-string (completing-read (cond ((stringp prompt) prompt)
                                                ((symbolp prompt) (lyskom-get-string prompt))
                                                (t (lyskom-get-string 'conf-prompt)))
David Byers's avatar
X    
David Byers committed
208
209
210
211
212
                                          'lyskom-read-conf-internal
                                          type
                                          mustmatch
                                          initial
                                          'lyskom-name-hist)))
213
214
215
216
217
218
219
      (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))
220
221


222
223
224
(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
225
226
227
228
  (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)))
229
230


231
232
233
234
235
(defun lyskom-read-conf-expand-specials (string
                                         predicate
                                         login-list
                                         x-list
                                         &optional return-cs)
236
237
238
239
  "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
240
                (cs (blocking-do 'get-uconf-stat no)))
241
242
           (if (and cs
                    (lyskom-read-conf-internal-verify-type
David Byers's avatar
David Byers committed
243
244
                     (uconf-stat->conf-no cs)
                     (uconf-stat->conf-type cs)
245
246
247
                     predicate 
                     login-list
                     x-list))
248
249
250
251
252
253
254
               (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
255
                         (blocking-do 'get-uconf-stat
256
257
258
                                      (session-info->pers-no si)))))
           (if (and cs
                    (lyskom-read-conf-internal-verify-type
David Byers's avatar
David Byers committed
259
260
                     (uconf-stat->conf-no cs)
                     (uconf-stat->conf-type cs)
261
262
263
264
265
266
                     predicate 
                     login-list
                     x-list))
               (if return-cs
                   cs
                 (list string)))))))
267
268
269
270

(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
271
272
273
274
275
276
277
278
  (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))))
279
280

(defun lyskom-lookup-conf-by-name (string predicate)
281
  "Return the conf-z-info associated with STRING that also satisfies
282
283
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
284
285
286
  (if (string= string "")
      nil
    (lyskom-read-conf-internal string predicate 'lyskom-lookup)))
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302


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

STRING is a string to complete.
PREDICATE is a list of name types to return. Valid types are
    all     Any existing name may be returned,
    pers    Names of persons may be returned,
    conf    Names of conferences may be returned,
    login   Names of logged-in persons may be returned, and
    none    Names that match nothing may be returned.
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."

303
304
305
306
307
308
309
310
  ;;
  ;;  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)
311
         (string-match "^\\s-*$" string)) "")
312
   ((and (eq all 'lyskom-lookup)
David Byers's avatar
David Byers committed
313
         (string-match "^\\s-*$" string)) nil)
314
   ((and (eq all 'lambda)
David Byers's avatar
David Byers committed
315
         (string-match "^\\s-*$" string)) nil)
316
317
318
319
   (t

    (let* ((login-list (and (memq 'login predicate)
                            (lyskom-read-conf-get-logins)))
320
321
322
323
324
           (x-list (lyskom-completing-lookup-z-name string 
                                                    1 1))
           (candidate-list 
            (and x-list
                 (listify-vector (conf-z-info-list->conf-z-infos x-list))))
325
           (result-list nil))
326
327

      ;;
328
329
330
331
332
333
      ;;  login-list now contains a list of logins, IF the predicate
      ;;  includes 'login
      ;;
      ;;  candidate-list contains a list of conf-nos, with the
      ;;  corresponding conf-types in candidate-type-list.
      ;;
334
      ;;  Now set result-list to the conf-z-infos that fulfill the
335
      ;;  predicate, fetching the conf-stats asynchronously.
336
337
      ;;

338
339
340
341
342
343
344
      (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))))
345
      
346

347
      ;;
348
      ;;  Now the matching conf-z-infos are in result-list
349
      ;;
350

351
352
      (cond 
       ((eq all 'lyskom-lookup)
353
        (let ((names (mapcar 'conf-z-info->name 
354
355
                             result-list))
              (specials (lyskom-read-conf-expand-specials string
356
357
                                                          predicate
                                                          login-list
358
                                                          candidate-list)))
359

David Byers's avatar
David Byers committed
360
          (cond ((and kom-complete-numbers-before-names specials)
361
362
363
364
365
                 (lyskom-read-conf-lookup-specials string
                                                   predicate
                                                   login-list
                                                   candidate-list))
                ((= (length result-list) 1)
366
                 (car result-list))
David Byers's avatar
David Byers committed
367

368
369
370
371
372
373
374
375
376
                ((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
377
                                                            candidate-list))
378
379
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
380
381
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
382
                ((lyskom-read-conf-internal-verify-type nil
383
384
385
                                                        nil
                                                        predicate
                                                        login-list
386
                                                        candidate-list)
387
388
389
390
391
392
393
394
395
396
397
398
                 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
399
                                                          candidate-list)))
400
          (cond ((= (length result-list) 1) t)
David Byers's avatar
David Byers committed
401
402
403
404
405
                ((and (> (length result-list) 1)
                      (let ((names (mapcar 'conf-z-info->name
                                           result-list)))
                        (and (lyskom-completing-member string names)
                             t))))
406
407
408
409
410
                (result-list nil)
                ((= (length specials) 1) t)
                (specials nil)
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
411
412
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
David Byers's avatar
David Byers committed
413

414
415
416
417
                (t (lyskom-read-conf-internal-verify-type nil
                                                          nil
                                                          predicate
                                                          login-list
418
                                                          candidate-list)))))
419
420


421
422
423
424
425
426
427
428
       ;;
       ;;  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.
       ;;
429
          
430
       (all
431
        (let ((names (mapcar 'conf-z-info->name result-list))
432
433
434
              (specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
435
                                                          candidate-list)))
436
437
438
439
          (cond (specials (append specials names))
                (names names)
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
440
441
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
442
443
                ((lyskom-read-conf-internal-verify-type nil
                                                        nil
444
445
                                                        predicate
                                                        login-list
446
                                                        candidate-list)
447
448
449
450
451
452
453
454
455
456
457
458
459
460
                 (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
461
                                                          candidate-list)))
462
          (cond (specials (car specials))
463
464
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
465
466
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
467
468
                ((lyskom-read-conf-internal-verify-type nil
                                                        nil
469
470
                                                        predicate
                                                        login-list
471
                                                        candidate-list)
472
                 t)
473
474
475
476
477
478
479
480
481
482
                (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
483
        (let ((name-list (mapcar 'conf-z-info->name result-list))
484
485
486
              (specials (lyskom-read-conf-expand-specials string
                                                          predicate
                                                          login-list
David Kågedal's avatar
David Kågedal committed
487
                                                          candidate-list)))
488
          (if specials (setq name-list (nconc specials name-list)))
489

David Byers's avatar
David Byers committed
490
491
          (cond ((lyskom-completing-member string name-list) 
                 (or (and (= (length name-list) 1) t) string)) ; Exact match
492
493
494
                ((= (length name-list) 1) (car name-list))
                ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
                               string) nil)
495
496
                ((string-match (lyskom-get-string 'session-no-regexp)
                               string) nil)
497
498
499
500
501
502
503
504
505
                (t (or (lyskom-completing-cache-completion
                        (lyskom-complete-string name-list)
                        x-list)
                       (and (lyskom-read-conf-internal-verify-type 
                             nil
                             nil
                             predicate
                             login-list
                             candidate-list)
506
                            (list string))))))))))))
507

David Byers's avatar
David Byers committed
508
509
510
511
(defun lyskom-completing-member (string list)
  (let ((string (lyskom-unicase (lyskom-completing-strip-name string)))
        (result nil))
    (while (and list (not result))
512
      (if (lyskom-string= string (lyskom-unicase 
David Byers's avatar
David Byers committed
513
514
515
516
                           (lyskom-completing-strip-name (car list))))
          (setq result list)
        (setq list (cdr list))))
    result))
517

518

David Byers's avatar
David Byers committed
519
520
521
522
523
524
525
526
527
(defun lyskom-completing-strip-name (string)
  "Strip parens and crap from a name"
  (while (string-match "([^()]*)" string)
    (setq string (replace-match " " t t string)))
  (while (string-match "\\s-\\s-+" string)
    (setq string (replace-match " " t t string)))
  (if (string-match "^\\s-*\\(.*\\S-\\)\\s-*$" string)
      (match-string 1 string)
    string))
528

529
530
531
532
533
534
535
536
537

(defun lyskom-read-conf-internal-verify-type (conf-no
                                              conf-type
                                              predicate
                                              logins
                                              x-list)
  (or (and (memq 'all predicate)
           conf-no)
      (and (memq 'conf predicate)
538
           conf-type
539
540
           (not (conf-type->letterbox conf-type)))
      (and (memq 'pers predicate) 
541
           conf-type
542
543
           (conf-type->letterbox conf-type))
      (and (memq 'login predicate)
544
           conf-type
545
546
547
           (memq conf-no logins))
      (and (memq 'none predicate) 
           (and (null conf-no)
548
                (null x-list)))))
549
550


551
552
553
554
555
; (defun lyskom-complete-show-data-list (state data)
;   (save-excursion
;     (pop-to-buffer (get-buffer-create "*kom*-complete"))
;     (erase-buffer)
;     (set-buffer-multibyte nil)
David Byers's avatar
David Byers committed
556
;    (while data
557
558
559
560
561
562
563
564
565
;       (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)))
566
567
      

568
569
570
571
572
573
574
575
576
577
578
(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)
579
580
        (have-here nil)
        (last-event-worth-noting nil)
581
582
583
584
585
        (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)
586
;      (lyskom-complete-show-data-list next-char-state data-list)
587
588
589
590
591
592
593
594
      (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
595
596
597
598
599
600
601
602
603
604
605
606
607
        (if (eq (aref next-char-state 1) ?\ )
            (progn
              (cond ((or (eq (symbol-value current-state) 'start-of-word)
                         (eq (symbol-value current-state) 'start-of-string))
                     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))
608
          (progn
David Byers's avatar
David Byers committed
609
            (set current-state 'in-a-word)
610
            (lyskom-complete-string-accumulate current-accumulator
David Byers's avatar
David Byers committed
611
612
613
                                               (aref next-char-state 1))
            (lyskom-complete-string-advance data-list)))
        (setq last-event-worth-noting 'match))
614
615
616
617
618
619
620
621
622
       
       ;;
       ;; 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)
623
        (setq last-event-worth-noting 'match)
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
        (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)
644
        (setq last-event-worth-noting 'match)
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
        (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)
             (or (eq (aref next-char-state 0) 'mismatch)
                 (eq (aref next-char-state 0) 'space-mismatch)
                 (eq (aref next-char-state 0) 'open-paren-mismatch)))
667
        (setq last-event-worth-noting 'mismatch)
668
669
670
671
672
673
674
675
676
677
678
679
680
        (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)
681
682
             (or (eq (symbol-value current-state) 'start-of-string)
                 (eq (symbol-value current-state) 'start-of-word)))
David Byers's avatar
David Byers committed
683
        (setq last-event-worth-noting nil)
684
685
686
687
688
689
        (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
       ;;
690

691
692
693
       ((and (or (eq (aref next-char-state 0) 'mismatch)
                 (eq (aref next-char-state 0) 'space-mismatch))
             (zerop paren-depth))
David Byers's avatar
David Byers committed
694
        (setq last-event-worth-noting 'mismatch)
695
696
697
698
        (if (or (eq (symbol-value current-state) 'start-of-word)
                (eq (symbol-value current-state) 'start-of-string))
            (setq done t)
          (progn
699
700
701
702
703
            (if (not have-here)
                (progn
                  (lyskom-complete-string-accumulate current-accumulator 
                                                     'HERE)
                  (setq have-here t)))
704
705
            (lyskom-complete-string-advance-to-end-of-word data-list)
            (set current-state 'in-a-word))))
706

707
708
709
       ;;
       ;; Case four, a mistmatch where one character is an open-paren
       ;;
710

711
       ((eq (aref next-char-state 0) 'open-paren-mismatch)
712
        (setq last-event-worth-noting 'mismatch)
713
        (lyskom-complete-string-skip-parens data-list))
714
715


716
717
718
       ;;
       ;; Case five, eof
       ;;
719

720
721
       ((eq (aref next-char-state 0) 'eof)
        (setq done t))
722

723
724
725
726
727
728
729
730
731
732
733
       ;;
       ;; 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
734
735
    (if (eq (car main-accumulator) 'SPC)
        (setq main-accumulator (cdr main-accumulator)))
736
737
738

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

David Byers's avatar
David Byers committed
739
740
741
    (if (memq 'HERE main-accumulator)
        (let ((backup (length (memq 'HERE main-accumulator))))
          (if lyskom-experimental-features
742
743
              (setq unread-command-events
                    (append (cons ? (make-list (1- backup) 2))
David Byers's avatar
David Byers committed
744
745
                            unread-command-events)))
          (setq main-accumulator (delq 'HERE main-accumulator))))
746
747
748
    
    (concat (mapcar (lambda (el) (if (eq el 'SPC) ?\  el))
		    main-accumulator))))
749

750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766

(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
767
   (string-match "\\([ \t]+\\|[^ \t]\\|$\\)"
768
769
770
771
772
773
774
                 (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
775
   (string-match "[ \t]*" (aref el 2) (aref el 0))
776
777
778
779
780
781
782
783
784
   (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
785
   (aset el 0 (string-match "\\([ \t]\\|$\\)" 
786
787
788
789
790
791
                            (aref el 2)
                            (aref el 0)))))

;;;
;;; Unwind a number of parens
;;;
792

793
794
795
796
797
798
799
800
801
802
803
804
805
806
(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
807
  (let ((string (aref el 2))
David Byers's avatar
David Byers committed
808
        (pos (aref el 0)))
809
    (while (> depth 0)
David Byers's avatar
David Byers committed
810
811
      (cond ((>= pos (length string)) 
             (setq depth 0))
David Byers's avatar
David Byers committed
812
            ((eq (aref string pos) ?\))
David Byers's avatar
David Byers committed
813
             (setq depth (1- depth)))
David Byers's avatar
David Byers committed
814
            ((eq (aref string pos) ?\))
David Byers's avatar
David Byers committed
815
816
817
818
             (setq depth (1+ depth))))
      (setq pos (1+ pos)))
    (aset el 0 pos)))

819
820
821
822
823
824
825
826
827
828
829
830
831
832

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

833
    (lyskom-save-excursion
David Byers's avatar
X    
David Byers committed
834
     (set-buffer lyskom-buffer)
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
     (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))
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874

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

875
876
877
878
879
880
881
882
883
884
885
886
887







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

Per Cederqvist's avatar
.    
Per Cederqvist committed
888
889


890
(defun lyskom-read-session-no (prompt &optional empty initial only-one)
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
  (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
909
    (if (lyskom-have-feature dynamic-session-info)
910
	(while who-list
David Byers's avatar
David Byers committed
911
	  (if (eq (dynamic-session-info->person (car who-list)) conf-no)
912
913
914
915
916
917
918
919
920
921
	      (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))))
922
923
    (cond ((and (null sessions) kom-permissive-completion) (list (- conf-no)))
          (t sessions))))
924
925
926
927


(defun lyskom-read-session-resolve-ambiguity (sessions)
  (lyskom-insert "\n")
David Kågedal's avatar
David Kågedal committed
928
929
  (let* ((s-width (1+ (apply 'max (mapcar (function
					   (lambda (x)
David Byers's avatar
David Byers committed
930
					     (string-width (int-to-string x))))
David Kågedal's avatar
David Kågedal committed
931
932
933
					  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")))
934
    (lyskom-format-insert format-string-s
David Kågedal's avatar
David Kågedal committed
935
			  ""
936
937
938
			  (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
939
			  ""
940
941
942
943
944
945
946
947
948
949
950
			  (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
951
			      (blocking-do 'get-uconf-stat
952
953
954
					   (session-info->working-conf info))))
			(lyskom-format-insert
			 format-string-p
David Kågedal's avatar
David Kågedal committed
955
956
957
958
959
960
			 (format "%d%s"
				 (session-info->connection info)
				 (if (eq (session-info->connection info)
					 lyskom-session-no)
				     "*" " "))
			 (session-info->pers-no info)
961
962
			 (or confconfstat
                             (lyskom-get-string 'not-present-anywhere)))
963
964
			(lyskom-format-insert
			 format-string-p
David Kågedal's avatar
David Kågedal committed
965
			 ""
966
967
968
969
970
971
972
973
974
975
			 (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"))
976
      (lyskom-insert (lyskom-format 'total-users-sans-date (length who-info)))
977
978
      (lyskom-scroll)
      (while (string= ""
David Byers's avatar
X    
David Byers committed
979
980
                      (lyskom-with-lyskom-minibuffer
                       (setq result (completing-read
981
982
983
984
985
				    (lyskom-get-string 'resolve-session)
				    who-info
				    nil
				    t
				    (car (car who-info))
David Byers's avatar
X    
David Byers committed
986
				    nil)))))
987
      (list (session-info->connection (cdr (assoc result who-info)))))))
988
989
990