completing-read.el 17.5 KB
Newer Older
Linus Tolke Y's avatar
Linus Tolke Y committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
;;;;;
;;;;; $Id$
;;;;; Copyright (C) 1991  Lysator Academic Computer Association.
;;;;;
;;;;; 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 
;;;;; the Free Software Foundation; either version 1, or (at your option) 
;;;;; 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
25
26
27
28
29
30
31
32
33
;;;; ================================================================
;;;; ================================================================
;;;;
;;;; File: completing-read.el
;;;;
;;;; This file implements functions for reading a conference name
;;;; or a person name with completion and other help.
;;;;

34
35
36
37
38
39
;; Overview of `exported' functions from this file:
;; lyskom-read-conf-no        returns conf-no
;; lyskom-read-conf-stat      returns conf-stat
;; lyskom-read-conf-name      returns name


40
41
42
43
44
(setq lyskom-clientversion-long 
      (concat lyskom-clientversion-long
	      "$Id$\n"))


Per Cederqvist's avatar
.    
Per Cederqvist committed
45
46
47
;;; Author: Linus Tolke


48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
;;; Completing-function

(defvar lyskom-name-hist nil)

(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)))
    (define-key map " " nil)
    map)
  "Keymap used for reading LysKOM names.")

64

65
66
67
68
(defun lyskom-read-conf-no (prompt type &optional empty initial)
  "Returns the conf-no of a conf or person read by lyskom-read-conf-name.
The question is prompted with PROMPT.
Only the conferences of TYPE are allowed.
69
70
71
72
73
The TYPE allows for subsets of the entire Lyskom-name space:
* all
* confs only conferences
* pers only persons
* logins only persons that are logged in right now.
74
75
76
77
If EMPTY is non-nil then the empty string is allowed (returns 0).
INITIAL is the initial contents of the input field."
  (let (read)
    (while (and (string= (setq read
David Kågedal's avatar
David Kågedal committed
78
			       (lyskom-read-conf-name prompt type nil initial))
79
80
81
82
83
84
			 "")
		(not empty)))
    (if (string= read "")
	0
      (lyskom-read-conf-name-internal read type 'conf-no))))

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

(defun lyskom-read-conf-stat (prompt type &optional empty initial)
  "Exactly the same as lyskom-read-conf-no but returns the conf-stat if possible.
Arguments: PROMPT TYPE EMPTY INITIAL
The TYPE allows for subsets of the entire Lyskom-name space:
* all
* confs only conferences
* pers only persons
* logins only persons that are logged in right now.

If EMPTY is non-nil then the empty string is allowed (returns nil)."
  (let ((no (lyskom-read-conf-no prompt type empty initial)))
    (if (zerop no)
	nil
      (blocking-do 'get-conf-stat no))))

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
(defun lyskom-read-conf-name (prompt type 
				     &optional mustmatch 
				     initial)
  "Read a LysKOM name, prompting with PROMPT.
The TYPE allows for subsets of the entire Lyskom-name space:
* all
* confs only conferences
* pers only persons
* logins only persons that are logged in right now.
The third argument MUSTMATCH makes the function always return the conf-no and 
never the read string.
The fourth argument INITIAL is the initial contents of the input-buffer.

Returns the name."
  (let* ((completion-ignore-case t)
Linus Tolke Y's avatar
Linus Tolke Y committed
116
117
118
119
120
	 ; When lyskom-read-conf-name-internal is called the current-buffer
	 ; is the minibuffer and the buffer-local variable lyskom-proc is not
	 ; correct. Then the variable lyskom-blocking-process must be set
	 ; instead. It is not buffer-local but scopes the let.
	 (lyskom-blocking-process lyskom-proc)
121
122
123
124
	 (minibuffer-local-completion-map 
	  lyskom-minibuffer-local-completion-map)
	 (minibuffer-local-must-match-map 
	  lyskom-minibuffer-local-must-match-map))
125
126
127
128
129
130
131
132
133
134
135
    (condition-case error
	(completing-read prompt 
			 'lyskom-read-conf-name-internal
			 type
			 mustmatch
			 initial
			 'lyskom-name-hist)
      (wrong-number-of-arguments ; This is for emacs 18.
       (completing-read prompt 'lyskom-read-conf-name-internal
			type mustmatch)))
    ))
136
137


138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
(defun lyskom-read-conf-name-internal-verify-type (cs predicate logins)
  "Returns true if CONF-STAT is of the correct type.

For types se documentation of lyskom-read-conf-name-internal.
Logins is a list of conf-nos (only significant when PREDICATE is logins)."
  (or (eq predicate 'all)
      (and (eq predicate 'confs)
	   (not (conf-type->letterbox 
		 (conf-stat->conf-type cs))))
      (and (eq predicate 'pers)
	   (conf-type->letterbox
	    (conf-stat->conf-type cs)))
      (and (eq predicate 'logins)
	   (memq (conf-stat->conf-no cs) logins))))


154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
(defun lyskom-read-conf-name-internal (string predicate all)
  "The \"try-completion\" for the lyskom-read name.
STRING is the string to be matched.
PREDICATE is one of:
* all
* confs only conferences
* pers only persons
* logins only persons that are logged in right now.
If third argument ALL is t then we are called from all-completions.
If third argument ALL is nil then we are called from try-completion.
If third argument ALL is 'conf-no then we are called from lyskom name
to conf-no translator."
  (let* ((alllogins (and (string= string "")
			 (eq predicate 'logins)))
	 (list (if (not alllogins)
		   (blocking-do 'lookup-name string)))
David Kågedal's avatar
David Kågedal committed
170
	 (nos (listify-vector (conf-list->conf-nos list)))
171
172
	 (parlist (if (memq predicate '(pers confs))
		      (let ((nos nos)
David Kågedal's avatar
David Kågedal committed
173
			    (typs (listify-vector (conf-list->conf-types list)))
174
175
176
177
178
179
180
181
182
183
			    res)
			(while nos
			  (setq res (cons (cons (car nos) (car typs)) res))
			  (setq nos (cdr nos)
				typs (cdr typs)))
			res)))
	 (logins (and (eq predicate 'logins)
		      (mapcar
		       (function (lambda (ele)
				   (who-info->pers-no ele)))
David Kågedal's avatar
David Kågedal committed
184
		       (listify-vector (blocking-do 'who-is-on)))))
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
	 (mappedlist (cond
		      (alllogins
		       logins)
		      ((eq predicate 'all)
		       nos)
		      ((eq predicate 'confs)
		       (apply 'append 
			(mapcar (function 
				 (lambda (par)
				   (and (not (conf-type->letterbox (cdr par)))
					(list (car par)))))
				parlist)))
		      ((eq predicate 'pers)
		       (apply 'append
			(mapcar (function
				 (lambda (par)
				   (and (conf-type->letterbox (cdr par))
					(list (car par)))))
				parlist)))
		      ((eq predicate 'logins)
		       (let ((nos (sort nos '<))
206
207
			     ;; We need logins later on
			     (lis (sort (copy-sequence logins) '<))
208
209
210
211
212
213
214
215
216
217
218
219
			     res)
			 (while (and nos
				     lis)
			   (if (= (car nos) (car lis))
			       (setq res (cons (car nos) res)))
			   (if (> (car nos)
				  (car lis))
			       (setq lis (cdr lis))
			     (setq nos (cdr nos))))
			 res)))))
    (cond
     ((eq all 'conf-no)
220
221
222
223
224
225
226
227
228
229
      (cond
       ((= (length mappedlist) 1)
	(car mappedlist))
       (t (let ((found nil))
	    (while (and (not found) mappedlist)
	      (if (string= string
			   (conf-stat->name (blocking-do 'get-conf-stat
							 (car mappedlist))))
		  (setq found (car mappedlist)))
	      (setq mappedlist (cdr mappedlist)))
230
231
232
233
234
235
236
237
238
239
240
241
	    (cond
	     (found)
	     ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
			    string)
	      (let* ((no (string-to-int (substring string
						   (match-beginning 1)
						   (match-end 1))))
		     (cs (blocking-do 'get-conf-stat no)))
		(if (lyskom-read-conf-name-internal-verify-type
		     cs predicate logins)
		    no))))))))

242
     ((eq all 'lambda)
243
244
245
246
247
248
249
250
251
      (or (= (length mappedlist) 1)
	  (let ((found nil))
	    (while (and (not found)
			mappedlist)
	      (if (string= string 
			   (conf-stat->name (blocking-do 'get-conf-stat 
							 (car mappedlist))))
		  (setq found t))
	      (setq mappedlist (cdr mappedlist)))
252
253
254
255
256
257
258
259
260
261
262
	    (cond
	     (found)
	     ((string-match (lyskom-get-string 'person-or-conf-no-regexp)
			    string)
	      (let* ((no (string-to-int (substring string
						   (match-beginning 1)
						   (match-end 1))))
		     (cs (blocking-do 'get-conf-stat no)))
		(if (lyskom-read-conf-name-internal-verify-type
		     cs predicate logins)
		    string)))))))
263
     (all
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
      (let ((names (mapcar (function (lambda (no)
				       (conf-stat->name 
					(blocking-do 'get-conf-stat no))))
			   mappedlist)))
	(if (and (string-match (lyskom-get-string 'person-or-conf-no-regexp)
			       string)
		 (let* ((no (string-to-int (substring string
						      (match-beginning 1)
						      (match-end 1))))
			(cs (blocking-do 'get-conf-stat no)))
		   (lyskom-read-conf-name-internal-verify-type cs 
							       predicate
							       logins)))
	    (cons string names)
	  names)))
	    
280
     ((= (length mappedlist) 0)
281
282
283
284
285
286
287
288
289
290
      (if (string-match (lyskom-get-string 'person-or-conf-no-regexp)
			string)
	  (let* ((no (string-to-int (substring string
					       (match-beginning 1)
					       (match-end 1))))
		 (cs (blocking-do 'get-conf-stat no)))
	    (if (lyskom-read-conf-name-internal-verify-type
		 cs predicate logins)
		t))))

David Kågedal's avatar
David Kågedal committed
291
292
293
294
295
296
     (t					; Some matches, maybe exact?
      (let ((strings (mapcar (function
			      (lambda (no)
				(list (conf-stat->name 
				       (blocking-do 'get-conf-stat no)))))
			     mappedlist)))
David Kågedal's avatar
David Kågedal committed
297
298
299
300
	(if (= (length strings) 1)
	    (if (string= string (car (car strings)))
		t				; Exact
	      (car (car strings)))
David Kågedal's avatar
David Kågedal committed
301
	(lyskom-try-complete-partials string strings)))))))
302
303
304
305
306
307
308


(defun lyskom-try-complete-partials (string alist)
  "Returns the longest string matching STRING.
Where every word matches the corresponding word in the car part of ALIST.
parst matching ([^)]) in string and alist are disgarded."
  (let* ((a-whitespace "\\([ \t]\\|([^)]*)\\)+")
309
310
311
312
	 (string (let ((initwhite (concat "\\`" a-whitespace)))
		   (if (string-match initwhite string)
		       (substring string (match-end 0))
		     string)))
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
	 (endfirstword (string-match a-whitespace string))
	 (firstword (substring string 0 endfirstword))
	 (reststring (and endfirstword
			  (substring string (match-end 0))))
	 (words (let ((res (try-completion firstword alist)))
		  (cond
		   ((eq res t) string)
		   (res)
		   (t string))))	;+++ Buggfix. Inget error om []\->{}|
	 (endfirstwords (string-match a-whitespace words))
	 (firstwords (substring words 0 endfirstwords))
	 (restlist (mapcar
		    (function
		     (lambda (part)
		       (cond
			((string-match a-whitespace
				       (car part))
			 (list (substring (car part) (match-end 0))))
			((list "")))))
		    alist)))
    (if	(= (length reststring) 0)
	words
      (concat (if (> (length firstwords) (length firstword))
		  firstwords
		firstword)
	      " " (lyskom-try-complete-partials reststring
						restlist)))))	 

					  
Per Cederqvist's avatar
.    
Per Cederqvist committed
342
343


344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
(defun lyskom-read-session-no (prompt &optional empty initial only-one)
  "Returns a list of session numbers of a session by reading either 
the number of the session or a name. 

The question is prompted with PROMPT.
If EMPTY is non-nil then the empty string is allowed (returns 0).
INITIAL is the initial contents of the input field.
If ONLY-ONE is non-nil only one session number will be returned."
  (let (result data done)
    (while (not done)
      (setq data (lyskom-read-session-no-aux prompt t initial))
      (cond ((and (string= data "") (not empty)))
            ((string= data "") (setq done t result nil))
            (t (setq result
                     (lyskom-read-session-internal data 'logins 'session-no)
                     done t))))
    (if (and only-one (> (length result) 1))
        (setq result
              (lyskom-read-session-resolve-ambiguity result)))
    result))
             


(defun lyskom-read-session-resolve-ambiguity (sessions)
  (lyskom-insert "\n")
  (lyskom-insert
   (lyskom-return-who-info-line
    "    "
    (lyskom-get-string 'lyskom-name)
    (lyskom-get-string 'is-in-conf)))
  (lyskom-insert
   (lyskom-return-who-info-line
    "    "
    (lyskom-get-string 'from-machine)
    (lyskom-get-string 'is-doing)))
  (lyskom-insert
   (concat (make-string (- (lyskom-window-width) 2) ?-)
           "\n"))
  (let ((who-info
         (mapcar (function
                  (lambda (el)
                    (let* ((info (blocking-do 'get-session-info el))
                           (persconfstat
                            (blocking-do 'get-conf-stat
                                         (session-info->pers-no info)))
                           (confconfstat
                            (blocking-do 'get-conf-stat
                                         (session-info->working-conf info))))
                      (lyskom-insert
                       (lyskom-return-who-info-line-as-state
                        (format "%4d%s"
                                (session-info->connection info)
                                (if (eq (session-info->connection info)
                                        lyskom-session-no)
                                    "*" " "))
                        (blocking-do 'get-conf-stat
                                     (session-info->pers-no info))
                        (if (conf-stat->name confconfstat)
                            confconfstat
                          (lyskom-get-string 'not-present-anywhere))))
                      (lyskom-insert
                       (lyskom-return-who-info-line-as-state
                        "     "
                        (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)))
    (while (string= ""
                    (setq result (completing-read
                                  (lyskom-get-string 'resolve-session)
                                  who-info
                                  nil
                                  t
                                  (car (car who-info))
                                  nil))))
    (list (session-info->connection (cdr (assoc result who-info))))))
    


(defun lyskom-read-session-no-aux (prompt 
                                   &optional mustmatch 
                                   initial)
  "Read a LysKOM name or session number, prompting with PROMPT.
The third argument MUSTMATCH makes the function always return the conf-no and 
never the read string.
The fourth argument INITIAL is the initial contents of the input-buffer.

Returns the name."
  (let* ((completion-ignore-case t)
	 ; When lyskom-read-conf-name-internal is called the current-buffer
	 ; is the minibuffer and the buffer-local variable lyskom-proc is not
	 ; correct. Then the variable lyskom-blocking-process must be set
	 ; instead. It is not buffer-local but scopes the let.
         (lyskom-blocking-process lyskom-proc)
         (minibuffer-local-completion-map 
          lyskom-minibuffer-local-completion-map)
         (minibuffer-local-must-match-map 
          lyskom-minibuffer-local-must-match-map))
    (condition-case error
        (completing-read prompt 
                         'lyskom-read-session-internal
                         'logins
                         mustmatch
                         initial
                         'lyskom-name-hist)
      (wrong-number-of-arguments ; This is for emacs 18.
       (completing-read prompt 'lyskom-read-session-internal
                        'logins mustmatch)))
    ))


(defun lyskom-read-session-internal (string predicate all)
  (let* ((result nil)
         (partial (lyskom-read-conf-name-internal string predicate all))
         (who-list (if (or (null partial)
                           (eq all 'session-no))
                       (mapcar (function 
                                (lambda (el)
                                  (cons 
                                   (number-to-string (who-info->connection el))
                                   el)))
                               (append (blocking-do 'who-is-on) nil))))
         (result (cond
                  ((and (null who-list)
                        (not (eq 'session-no all))) nil)
                  ((eq all nil)         ; try-completion
                   (try-completion string who-list nil))
                  ((eq all t)           ; all-completions
                   (all-completions string who-list nil))
David Byers's avatar
David Byers committed
478
479
480
481
                  ((eq all 'lambda)	; exact match
                   (and (assoc string who-list) t))
		  ((eq all 'session-no)	; get number
		   (car-safe (assoc string who-list))))))
482
483
484
485
    (cond ((eq all 'session-no)
           (if partial
               (let ((output nil)
                     (list who-list)
David Byers's avatar
David Byers committed
486
		     (num (string-to-number string))
487
                     (conf-no (lyskom-read-conf-name-internal string
David Byers's avatar
David Byers committed
488
489
							      predicate
							      'conf-no)))
490
                 (while list
David Byers's avatar
David Byers committed
491
492
                   (if (or (eq conf-no (who-info->pers-no (cdr (car list))))
			   (eq num (who-info->connection (cdr (car list)))))
493
494
495
496
497
                       (setq output (cons
                                     (who-info->connection (cdr (car list)))
                                     output)))
                   (setq list (cdr list)))
                 output)
David Byers's avatar
David Byers committed
498
             (list (string-to-number result))))
499
           (t (or partial result)))))