completing-read.el 36.3 KB
Newer Older
1
;;;;; -*-coding: raw-text;-*-
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."
271
272
273
274
275
  (lyskom-read-conf-expand-specials string
                                    predicate
                                    login-list
                                    x-list
                                    t))
276
277

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


(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."

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

    (let* ((login-list (and (memq 'login predicate)
                            (lyskom-read-conf-get-logins)))
317
318
319
320
321
           (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))))
322
           (result-list nil))
323
324

      ;;
325
326
327
328
329
330
      ;;  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.
      ;;
331
      ;;  Now set result-list to the conf-z-infos that fulfill the
332
      ;;  predicate, fetching the conf-stats asynchronously.
333
334
      ;;

335
336
337
338
339
340
341
      (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))))
342
      
343

344
      ;;
345
      ;;  Now the matching conf-z-infos are in result-list
346
      ;;
347

348
349
      (cond 
       ((eq all 'lyskom-lookup)
350
        (let ((names (mapcar 'conf-z-info->name 
351
352
                             result-list))
              (specials (lyskom-read-conf-expand-specials string
353
354
                                                          predicate
                                                          login-list
355
                                                          candidate-list)))
356
357
358
359
360
361
362
363
364
365
366
367

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

405
406
407
408
                (t (lyskom-read-conf-internal-verify-type nil
                                                          nil
                                                          predicate
                                                          login-list
409
                                                          candidate-list)))))
410
411


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

David Byers's avatar
David Byers committed
481
482
          (cond ((lyskom-completing-member string name-list) 
                 (or (and (= (length name-list) 1) t) string)) ; Exact match
483
484
485
                ((= (length name-list) 1) (car name-list))
                ((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
489
490
491
492
493
494
495
496
                (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)
497
                            (list string))))))))))))
498

David Byers's avatar
David Byers committed
499
500
501
502
503
504
505
506
507
(defun lyskom-completing-member (string list)
  (let ((string (lyskom-unicase (lyskom-completing-strip-name string)))
        (result nil))
    (while (and list (not result))
      (if (string= string (lyskom-unicase 
                           (lyskom-completing-strip-name (car list))))
          (setq result list)
        (setq list (cdr list))))
    result))
508

509

David Byers's avatar
David Byers committed
510
511
512
513
514
515
516
517
518
(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))
519

520
521
522
523
524
525
526
527
528

(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)
529
           conf-type
530
531
           (not (conf-type->letterbox conf-type)))
      (and (memq 'pers predicate) 
532
           conf-type
533
534
           (conf-type->letterbox conf-type))
      (and (memq 'login predicate)
535
           conf-type
536
537
538
           (memq conf-no logins))
      (and (memq 'none predicate) 
           (and (null conf-no)
539
                (null x-list)))))
540
541


542
543
544
545
546
; (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
547
;    (while data
548
549
550
551
552
553
554
555
556
;       (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)))
557
558
      

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

682
683
684
       ((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
685
        (setq last-event-worth-noting 'mismatch)
686
687
688
689
        (if (or (eq (symbol-value current-state) 'start-of-word)
                (eq (symbol-value current-state) 'start-of-string))
            (setq done t)
          (progn
690
691
692
693
694
            (if (not have-here)
                (progn
                  (lyskom-complete-string-accumulate current-accumulator 
                                                     'HERE)
                  (setq have-here t)))
695
696
            (lyskom-complete-string-advance-to-end-of-word data-list)
            (set current-state 'in-a-word))))
697

698
699
700
       ;;
       ;; Case four, a mistmatch where one character is an open-paren
       ;;
701

702
       ((eq (aref next-char-state 0) 'open-paren-mismatch)
703
        (setq last-event-worth-noting 'mismatch)
704
        (lyskom-complete-string-skip-parens data-list))
705
706


707
708
709
       ;;
       ;; Case five, eof
       ;;
710

711
712
       ((eq (aref next-char-state 0) 'eof)
        (setq done t))
713

714
715
716
717
718
719
720
721
722
723
724
       ;;
       ;; 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
725
726
    (if (eq (car main-accumulator) 'SPC)
        (setq main-accumulator (cdr main-accumulator)))
727
728
729

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

David Byers's avatar
David Byers committed
730
731
732
    (if (memq 'HERE main-accumulator)
        (let ((backup (length (memq 'HERE main-accumulator))))
          (if lyskom-experimental-features
733
734
              (setq unread-command-events
                    (append (cons ? (make-list (1- backup) 2))
David Byers's avatar
David Byers committed
735
736
                            unread-command-events)))
          (setq main-accumulator (delq 'HERE main-accumulator))))
737

738
739
740
    (let ((tmp (make-string (length main-accumulator) 0))
          (index 0))
      (lyskom-traverse
741
       el main-accumulator
David Byers's avatar
David Byers committed
742
       (aset tmp index (if (eq el 'SPC) 32 el))
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
       (setq index (1+ index)))
      tmp)))

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

;;;
;;; Unwind a number of parens
;;;
787

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

814
815
816
817
818
819
820
821
822
823
824
825
826
827

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

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

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

870
871
872
873
874
875
876
877
878
879
880
881
882







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

Per Cederqvist's avatar
.    
Per Cederqvist committed
883
884


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


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