command.el 11.7 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
;;;;;
;;;;; $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)
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
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
117
118
119
120
121
122
123
124
  (`
   (defun (, cmd) (, args)
     (, doc)
     (, interactive-decl)
     (lyskom-start-of-command (quote (, cmd)))
     (unwind-protect
         (condition-case nil
             (progn (,@ forms))
           (quit (ding)
                 (lyskom-insert-before-prompt
                  (lyskom-get-string 'interrupted))))
       (lyskom-end-of-command)))))



;;
;; 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"
                                      cmd)))))
    (`
     (defun (, cmd) (, args)
       (, doc)
       (, interactive-decl)
       (let (((, rsym) nil))
         (condition-case nil
             (progn (lyskom-start-of-command (quote (, cmd)))
                    (setq (, rsym) t))
           (error nil))
         (unwind-protect
             (condition-case nil
                 (progn (,@ forms))
               (quit (ding)
                     (lyskom-insert-before-prompt
                      (lyskom-get-string 'interrupted))))
           (and (, rsym) (lyskom-end-of-command))))))))

David Kågedal's avatar
David Kågedal committed
125
126
127
128
129
130
131
132


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

133
134
135
136
137
138
(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
139
140
141
142
143
144
145
146


;;;; ================================================================
;;;;                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
147
  (condition-case nil
David Byers's avatar
X    
David Byers committed
148
149
      (lyskom-get-string command 'lyskom-command)
    (error nil)))
David Kågedal's avatar
David Kågedal committed
150
151
152
153
154
155
156
157
158
159
160

(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
161
  (let ((fnc (lyskom-read-extended-command current-prefix-arg)))
David Kågedal's avatar
David Kågedal committed
162
163
164
165
    (cond
     (fnc (call-interactively fnc))
     (t (kom-next-command)))) )

David Byers's avatar
David Byers committed
166
(defun lyskom-read-extended-command (&optional prefix-arg)
David Kågedal's avatar
David Kågedal committed
167
168
  "Reads and returns a command"
  (let* ((completion-ignore-case t)
David Kågedal's avatar
David Kågedal committed
169
	 (minibuffer-setup-hook minibuffer-setup-hook)
David Kågedal's avatar
David Kågedal committed
170
171
172
173
	 (alternatives (mapcar (function (lambda (pair)
					   (cons (cdr pair) (car pair))))
			       (lyskom-get-strings lyskom-commands
						   'lyskom-command)))
David Byers's avatar
David Byers committed
174
175
176
177
178
179
180
181
182
183
184
185
186
187
	 (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 Kågedal's avatar
David Kågedal committed
188
189
190
191
192
193
194
    ;; (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
195
    (lyskom-with-lyskom-minibuffer
David Byers's avatar
David Byers committed
196
     (setq name (completing-read prompt
David Byers's avatar
X    
David Byers committed
197
198
199
200
201
202
203
204
                                 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
205
                                 t nil 'lyskom-command-history)))
David Byers's avatar
X    
David Byers committed
206
    (cdr (lyskom-string-assoc name alternatives))))
David Kågedal's avatar
David Kågedal committed
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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250

(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
251
252
253
254
255
256
257
258
259
            (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
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
  (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."
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
  (lyskom-save-excursion
   (when (and (boundp 'lyskom-buffer)
              (buffer-live-p lyskom-buffer))
     (set-buffer lyskom-buffer))
   (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
       (save-excursion (set-buffer lyskom-buffer)
                       (initiate-user-active 'background nil)))
   (if kom-inhibit-typeahead
       (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))))
   (when lyskom-slow-mode
     (buffer-enable-undo))))
David Kågedal's avatar
David Kågedal committed
321
322
323
324

(provide 'lyskom-command)

;;; command.el ends here