command.el 12.4 KB
Newer Older
David Byers's avatar
David Byers committed
1
;;;;; -*-coding: iso-8859-1;-*-
David Kågedal's avatar
David Kågedal committed
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
;;;;;
;;;;; $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.
;;;;


35
36
37
38
39
40
41
42
43
(setq lyskom-clientversion-long 
      (concat lyskom-clientversion-long
	      "$Id$\n"))

;;; (eval-when-compile
;;;   (require 'lyskom-vars "vars")
;;;   (require 'lyskom-services "services")
;;;   (require 'lyskom-language "language")
;;;   (require 'lyskom-clienttypes "clienttypes"))
David Kågedal's avatar
David Kågedal committed
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65


;;; ======================================================================
;;; 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)
David Byers's avatar
David Byers committed
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
  (let ((bufsym (intern (format "%S-start-buffer" cmd))))
    (`
     (defun (, cmd) (, args)
       (, doc)
       (, interactive-decl)
       (lyskom-start-of-command (quote (, cmd)))
       (let (((, bufsym) (current-buffer)))
         (unwind-protect
             (condition-case nil
                 (progn (,@ forms))
               (quit (ding)
                     (lyskom-insert-before-prompt
                      (lyskom-get-string 'interrupted))))
           (lyskom-save-excursion
            (when (buffer-live-p (, bufsym))
              (set-buffer (, bufsym)))
             (lyskom-end-of-command))))))))
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116



;;
;; def-kom-emacs-command works like def-kom-command, but the template 
;; is different. Commands defined this way will run as regular Emacs
;; commands when invoked outside of a LysKOM buffer. 
;;
;; The variable <cmd>-running-as-kom-command is non-nil when running
;; as a LysKOM command and nil otherwise.
;;
;; Note: this function catches *all* errors in lyskom-start-of-command
;;       which may not be what you want, so be careful.
;;
;; 
;; (defun kom-cmd (args)
;;   "Documentation"
;;   (interactive "...")
;;   (let ((kom-cmd-running-as-kom-command nil))
;;     (condition-case nil
;;         (progn (lyskom-start-of-command 'kom-cmd)
;;                (setq kom-cmd-running-as-kom-command t))
;;       (error nil))
;;     (unwind-protect
;;         (condition-case nil
;;             (progn ...)
;;           (quit (ding)
;;                 (lyskom-insert-before-prompt
;;                  (lyskom-get-string 'interrupted))))
;;       (and kom-cmd-running-as-kom-command (lyskom-end-of-command)))))
;; 

(defmacro def-kom-emacs-command (cmd args doc interactive-decl &rest forms)
  (let ((rsym (intern (concat (format "%S-running-as-kom-command"
David Byers's avatar
David Byers committed
117
118
                                      cmd))))
        (bufsym (intern (format "%S-start-buffer" cmd))))
119
120
121
122
123
124
125
126
127
    (`
     (defun (, cmd) (, args)
       (, doc)
       (, interactive-decl)
       (let (((, rsym) nil))
         (condition-case nil
             (progn (lyskom-start-of-command (quote (, cmd)))
                    (setq (, rsym) t))
           (error nil))
David Byers's avatar
David Byers committed
128
129
130
131
132
133
134
135
136
137
138
139
         (let (((, bufsym) (current-buffer)))
           (unwind-protect
               (condition-case nil
                   (progn (,@ forms))
                 (quit (ding)
                       (lyskom-insert-before-prompt
                        (lyskom-get-string 'interrupted))))
             (and (, rsym)
                  (lyskom-save-excursion
                   (when (buffer-live-p (, bufsym))
                     (set-buffer (, bufsym)))
                   (lyskom-end-of-command))))))))))
140

David Kågedal's avatar
David Kågedal committed
141
142
143
144
145
146
147
148


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

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

David Kågedal's avatar
David Kågedal committed
155
156
157
158
159
160
161
162


;;;; ================================================================
;;;;                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
163
  (condition-case nil
David Byers's avatar
X    
David Byers committed
164
165
      (lyskom-get-string command 'lyskom-command)
    (error nil)))
David Kågedal's avatar
David Kågedal committed
166
167
168
169
170
171
172
173
174
175
176

(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)
David Byers's avatar
David Byers committed
177
  (let ((fnc (lyskom-read-extended-command current-prefix-arg)))
David Kågedal's avatar
David Kågedal committed
178
179
180
181
    (cond
     (fnc (call-interactively fnc))
     (t (kom-next-command)))) )

David Byers's avatar
David Byers committed
182
(defun lyskom-read-extended-command (&optional prefix-arg)
David Kågedal's avatar
David Kågedal committed
183
184
  "Reads and returns a command"
  (let* ((completion-ignore-case t)
David Kågedal's avatar
David Kågedal committed
185
	 (minibuffer-setup-hook minibuffer-setup-hook)
David Kågedal's avatar
David Kågedal committed
186
187
188
189
	 (alternatives (mapcar (function (lambda (pair)
					   (cons (cdr pair) (car pair))))
			       (lyskom-get-strings lyskom-commands
						   'lyskom-command)))
David Byers's avatar
David Byers committed
190
191
192
193
194
195
196
197
198
199
200
201
202
203
	 (name nil)
         (prefix-text
          (cond ((eq prefix-arg '-) "- ")
                              ((equal prefix-arg '(4)) "C-u ")
                              ((integerp prefix-arg) 
                               (format "%d " prefix-arg))
                              ((and (consp prefix-arg) 
                                    (integerp (car prefix-arg)))
                               (format "%d " (car prefix-arg)))
                              (t nil)))
         (prompt (if prefix-text
                     (concat prefix-text (lyskom-get-string 'extended-command))
                   (lyskom-get-string 'extended-command))))

David Byers's avatar
X    
David Byers committed
204
    (lyskom-with-lyskom-minibuffer
David Byers's avatar
David Byers committed
205
     (setq name (completing-read prompt
David Byers's avatar
X    
David Byers committed
206
207
208
209
210
211
212
213
                                 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))
David Byers's avatar
David Byers committed
214
                                 t nil 'lyskom-command-history)))
David Byers's avatar
X    
David Byers committed
215
    (cdr (lyskom-string-assoc name alternatives))))
David Kågedal's avatar
David Kågedal committed
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235

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

David Byers's avatar
David Byers committed
236
237
  (if (or (not lyskom-proc)
          (memq (process-status lyskom-proc) '(closed signal exited nil)))
David Kågedal's avatar
David Kågedal committed
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
      (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
261
262
263
264
            (beginning-of-line)
            (delete-region (point) (point-max)))))
    (lyskom-insert (lyskom-modify-prompt 
                    (cond ((stringp lyskom-current-prompt) 
265
266
267
                           (apply 'lyskom-format 
                                  lyskom-current-prompt
                                  lyskom-current-prompt-args))
David Byers's avatar
X    
David Byers committed
268
                          ((symbolp lyskom-current-prompt)
269
270
271
                           (apply 'lyskom-format 
                                  (lyskom-get-string lyskom-current-prompt)
                                  lyskom-current-prompt-args))
David Byers's avatar
X    
David Byers committed
272
273
                          (t (format "%S" lyskom-current-prompt)))
                    t)))
David Kågedal's avatar
David Kågedal committed
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
  (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)))
290
	(sit-for 0)))
David Kågedal's avatar
David Kågedal committed
291
292
293
294
295
296
297
298
299
300
                                        ;  (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."
301
302
  (lyskom-save-excursion
   (message "")
David Byers's avatar
David Byers committed
303
   (lyskom-clean-all-buffer-lists)
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
   (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)
319
320
321
322
   (when (and (lyskom-have-feature idle-time)
              (not lyskom-is-anonymous))
     (save-excursion (set-buffer lyskom-buffer)
                     (initiate-user-active 'background nil)))
323
324
325
326
   (if kom-inhibit-typeahead
       (discard-input))
   ;; lyskom-pending-commands should probably be a queue or a stack.
   (when lyskom-pending-commands
David Byers's avatar
David Byers committed
327
      (let ((command (car lyskom-pending-commands)))
328
329
330
331
332
333
       (setq lyskom-pending-commands (cdr lyskom-pending-commands))
       (if (symbolp command)
           (call-interactively command)
         (eval command))))
   (when lyskom-slow-mode
     (buffer-enable-undo))))
David Kågedal's avatar
David Kågedal committed
334

335
(eval-and-compile (provide 'lyskom-command))
David Kågedal's avatar
David Kågedal committed
336
337

;;; command.el ends here