completing-read.el 10.7 KB
Newer Older
Linus Tolke's avatar
Linus Tolke 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
64
65
66
67
;;; 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.")

(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.
68
69
70
71
72
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.
73
74
75
76
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
77
			       (lyskom-read-conf-name prompt type t initial))
78
79
80
81
82
83
			 "")
		(not empty)))
    (if (string= read "")
	0
      (lyskom-read-conf-name-internal read type 'conf-no))))

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

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

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
(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's avatar
Linus Tolke committed
115
116
117
118
119
	 ; 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)
120
121
122
123
	 (minibuffer-local-completion-map 
	  lyskom-minibuffer-local-completion-map)
	 (minibuffer-local-must-match-map 
	  lyskom-minibuffer-local-must-match-map))
124
125
126
127
128
129
130
131
132
133
134
    (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)))
    ))
135
136


137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
(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))))


153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
(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)))
	 (nos (append (conf-list->conf-nos list) nil))
	 (parlist (if (memq predicate '(pers confs))
		      (let ((nos nos)
			    (typs (append (conf-list->conf-types list) nil))
			    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)))
		       (append (blocking-do 'who-is-on) nil))))
	 (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 '<))
205
206
			     ;; We need logins later on
			     (lis (sort (copy-sequence logins) '<))
207
208
209
210
211
212
213
214
215
216
217
218
			     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)
219
220
221
222
223
224
225
226
227
228
      (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)))
229
230
231
232
233
234
235
236
237
238
239
240
	    (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))))))))

241
     ((eq all 'lambda)
242
243
244
245
246
247
248
249
250
      (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)))
251
252
253
254
255
256
257
258
259
260
261
	    (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)))))))
262
     (all
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
      (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)))
	    
279
     ((= (length mappedlist) 1)
280
281
      t)
     ((= (length mappedlist) 0)
282
283
284
285
286
287
288
289
290
291
      (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))))

292
293
294
295
296
297
298
299
300
301
302
303
304
305
     (t					; No exact match
      (lyskom-try-complete-partials 
       string
       (mapcar (function (lambda (no)
			   (list (conf-stat->name 
				  (blocking-do 'get-conf-stat no)))))
	       mappedlist))))))


(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]\\|([^)]*)\\)+")
306
307
308
309
	 (string (let ((initwhite (concat "\\`" a-whitespace)))
		   (if (string-match initwhite string)
		       (substring string (match-end 0))
		     string)))
310
311
312
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
	 (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
339
340