command.el 8.89 KB
Newer Older
David Kågedal's avatar
David Kågedal 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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
;;;;;
;;;;; $Id$
;;;;; Copyright (C) 1991, 1996  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 2, 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. 
;;;;;
;;;; ================================================================
;;;; ================================================================
;;;;
;;;; File: command.el
;;;;
;;;; This file contains stuff regarding commands.
;;;;


(eval-when-compile
  (require 'lyskom-vars "vars")
  (require 'lyskom-services "services")
  (require 'lyskom-language "language")
  (require 'lyskom-clienttypes "clienttypes"))


;;; ======================================================================
;;; LysKOM user commands
;;; The new, blocking commands have a very similar structure
;;;
;;;  (defun kom-cmd (args)
;;;    "Documentation"
;;;    (interactive "...")
;;;    (lyskom-start-of-command 'kom-cmd)
;;;    (unwind-protect
;;;        (progn ...)
;;;      (lyskom-end-of-command)))
;;;
;;; This can now be written as
;;;
;;; (def-kom-command kom-cmd (args)
;;;   "Documentation"
;;;   (interactive "...")
;;;   ...)

(defmacro def-kom-command (cmd args doc interactive-decl &rest forms)
  (list 'defun cmd args doc interactive-decl
	(list 'lyskom-start-of-command (list 'quote cmd))
	(list 'unwind-protect
	      (list 'condition-case nil
		    (cons 'progn
			  forms)
		    (list 'quit
			  (list 'ding)
			  (list 'lyskom-insert-before-prompt
				(list 'lyskom-get-string
				      (list 'quote 'interrupted)))))
	      (list 'lyskom-end-of-command))))


(put 'def-kom-command 'edebug-form-spec
     '(&define name lambda-list
	       [&optional stringp]	; Match the doc string, if present.
	       ("interactive" interactive)
	       def-body))



;;;; ================================================================
;;;;                User-level commands and functions.


(defsubst lyskom-command-name (command)
  "Get the command name for the command COMMAND"
David Byers's avatar
David Byers committed
89
  (condition-case nil
David Byers's avatar
X    
David Byers committed
90
91
      (lyskom-get-string command 'lyskom-command)
    (error nil)))
David Kågedal's avatar
David Kågedal committed
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110

(defun lyskom-ok-command (alternative administrator)
  "Returns non-nil if it is ok to do such a command right now."
  (if administrator
      (not (memq (cdr alternative) lyskom-admin-removed-commands))
    (not (memq (cdr alternative) lyskom-noadmin-removed-commands))))


(defun kom-extended-command ()
  "Read a LysKOM function name and call the function."
  (interactive)
  (let ((fnc (lyskom-read-extended-command)))
    (cond
     (fnc (call-interactively fnc))
     (t (kom-next-command)))) )

(defun lyskom-read-extended-command ()
  "Reads and returns a command"
  (let* ((completion-ignore-case t)
David Kågedal's avatar
David Kågedal committed
111
	 (minibuffer-setup-hook minibuffer-setup-hook)
David Kågedal's avatar
David Kågedal committed
112
113
114
115
	 (alternatives (mapcar (function (lambda (pair)
					   (cons (cdr pair) (car pair))))
			       (lyskom-get-strings lyskom-commands
						   'lyskom-command)))
David Kågedal's avatar
David Kågedal committed
116
117
118
119
120
121
122
123
	 (name nil))
    ;; (add-hook 'minibuffer-setup-hook
    ;; 		 (function
    ;; 		  (lambda ()
    ;; 		    (let ((table (make-char-table 'case-table)))
    ;; 		      (set-char-table-parent table (current-case-table))
    ;; 		      (aset table ?\} 345)
    ;; 		      (set-case-table table)))))
David Byers's avatar
X    
David Byers committed
124
125
126
127
128
129
130
131
132
133
134
135
    (lyskom-with-lyskom-minibuffer
     (setq name (completing-read (lyskom-get-string 'extended-command)
                                 alternatives 
                                 ;; lyskom-is-administrator is buffer-local and
                                 ;; must be evalled before the call to 
                                 ;; completing-read
                                 ;; Yes, this is not beautiful
                                 (list 'lambda '(alternative)	     
                                       (list 'lyskom-ok-command 'alternative
                                             lyskom-is-administrator))
                                 t nil)))
    (cdr (lyskom-string-assoc name alternatives))))
David Kågedal's avatar
David Kågedal committed
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
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

(defun lyskom-start-of-command (function &optional may-interrupt)
  "This function is run at the beginning of every LysKOM command.
It moves the cursor one line down, and +++ later it will tell the server
that the previous text has been read.

Argument FUNCTION is a string the string will be written in the buffer
on start of the command. If it is a symbol it searches for the corresponding
command name in lyskom-commands and writes this in the message buffer.

If optional argument MAY-INTERRUPT is present and non-nil,
don't signal an error if this call is interrupting another command.

Special: if lyskom-is-waiting then we are allowed to break if we set 
lyskom-is-waiting nil.

This function checks if lyskom-doing-default-command and
lyskom-first-time-around are bound. The text entered in the buffer is
chosen according to this"

  (if (not lyskom-proc)
      (lyskom-error "%s" (lyskom-get-string 'dead-session)))

  (if (and lyskom-is-waiting
           (listp lyskom-is-waiting))
      (progn
        (setq lyskom-is-waiting nil)
        (lyskom-end-of-command)))

  (setq lyskom-is-waiting nil)
  (if (and lyskom-executing-command (not may-interrupt))
      (lyskom-error "%s" (lyskom-get-string 'wait-for-prompt)))
  (if (not (and (boundp 'lyskom-doing-default-command)
                lyskom-doing-default-command))
      (cond
       (lyskom-first-time-around)
       ((stringp function) (lyskom-insert function))
       ((and function (symbolp function))
        (let ((name (lyskom-command-name function)))
          (if name (lyskom-insert name)))))
    (save-excursion
      (if lyskom-current-prompt
          (let ((inhibit-read-only t))
            (goto-char (point-max))
David Byers's avatar
X    
David Byers committed
180
181
182
183
184
185
186
187
188
            (beginning-of-line)
            (delete-region (point) (point-max)))))
    (lyskom-insert (lyskom-modify-prompt 
                    (cond ((stringp lyskom-current-prompt) 
                           lyskom-current-prompt)
                          ((symbolp lyskom-current-prompt)
                           (lyskom-get-string lyskom-current-prompt))
                          (t (format "%S" lyskom-current-prompt)))
                    t)))
David Kågedal's avatar
David Kågedal committed
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
  (setq mode-line-process (lyskom-get-string 'mode-line-working))
  (if (pos-visible-in-window-p (point-max))
      (save-excursion
        (goto-char (point-max))
        (lyskom-set-last-viewed)))
  (setq lyskom-executing-command t)
  (setq lyskom-current-command function)
  (setq lyskom-current-prompt nil)
  (lyskom-insert "\n")
  (if (and (eq (window-buffer (selected-window))
               (current-buffer))
           ;; (= (point) (point-max))
	   ) 
      (progn
	(if (pos-visible-in-window-p (1- (point-max)))
	    (goto-char (point-max)))
        (sit-for 0))) 
                                        ;  (lyskom-scroll)
  (run-hooks 'lyskom-before-command-hook)
  (if kom-page-before-command           ;Nice with dumb terminals.
      (if (or (not (listp kom-page-before-command))
              (memq function kom-page-before-command))
          (recenter 1))))


(defun lyskom-end-of-command ()
  "Print prompt, maybe scroll, prefetch info."
  (message "")
  (while (and lyskom-to-be-printed-before-prompt
	      (lyskom-queue->first lyskom-to-be-printed-before-prompt))
    (if (not (bolp)) (lyskom-insert "\n"))
    (lyskom-insert (car (lyskom-queue->first 
			 lyskom-to-be-printed-before-prompt)))
    (lyskom-queue-delete-first lyskom-to-be-printed-before-prompt))
  (setq lyskom-executing-command nil)
  (setq lyskom-current-command nil)
  (setq lyskom-current-prompt nil)	; Already set in s-o-c really
  (lyskom-scroll)
  (setq mode-line-process (lyskom-get-string 'mode-line-waiting))
  (if (pos-visible-in-window-p (point-max) (selected-window))
      (lyskom-set-last-viewed))
  (lyskom-prefetch-and-print-prompt)
  (run-hooks 'lyskom-after-command-hook)
  (if lyskom-idle-time-flag
David Byers's avatar
X    
David Byers committed
233
234
      (save-excursion (set-buffer lyskom-buffer)
                      (initiate-user-active 'background nil)))
David Kågedal's avatar
David Kågedal committed
235
  (if kom-inhibit-typeahead
236
237
238
239
240
241
242
243
      (discard-input))
  ;; lyskom-pending-commands should probably be a queue or a stack.
  (when lyskom-pending-commands
    (let ((command (car lyskom-pending-commands)))
      (setq lyskom-pending-commands (cdr lyskom-pending-commands))
      (if (symbolp command)
	  (call-interactively command)
	(eval command)))))
David Kågedal's avatar
David Kågedal committed
244
245
246
247

(provide 'lyskom-command)

;;; command.el ends here