command.el 12.1 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)
David Byers's avatar
David Byers committed
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
  (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))))))))
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



;;
;; 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
112
113
                                      cmd))))
        (bufsym (intern (format "%S-start-buffer" cmd))))
114
115
116
117
118
119
120
121
122
    (`
     (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
123
124
125
126
127
128
129
130
131
132
133
134
         (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))))))))))
135

David Kågedal's avatar
David Kågedal committed
136
137
138
139
140
141
142
143


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

144
145
146
147
148
149
(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
150
151
152
153
154
155
156
157


;;;; ================================================================
;;;;                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
158
  (condition-case nil
David Byers's avatar
X    
David Byers committed
159
160
      (lyskom-get-string command 'lyskom-command)
    (error nil)))
David Kågedal's avatar
David Kågedal committed
161
162
163
164
165
166
167
168
169
170
171

(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
172
  (let ((fnc (lyskom-read-extended-command current-prefix-arg)))
David Kågedal's avatar
David Kågedal committed
173
174
175
176
    (cond
     (fnc (call-interactively fnc))
     (t (kom-next-command)))) )

David Byers's avatar
David Byers committed
177
(defun lyskom-read-extended-command (&optional prefix-arg)
David Kågedal's avatar
David Kågedal committed
178
179
  "Reads and returns a command"
  (let* ((completion-ignore-case t)
David Kågedal's avatar
David Kågedal committed
180
	 (minibuffer-setup-hook minibuffer-setup-hook)
David Kågedal's avatar
David Kågedal committed
181
182
183
184
	 (alternatives (mapcar (function (lambda (pair)
					   (cons (cdr pair) (car pair))))
			       (lyskom-get-strings lyskom-commands
						   'lyskom-command)))
David Byers's avatar
David Byers committed
185
186
187
188
189
190
191
192
193
194
195
196
197
198
	 (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
199
200
201
202
203
204
205
    ;; (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
206
    (lyskom-with-lyskom-minibuffer
David Byers's avatar
David Byers committed
207
     (setq name (completing-read prompt
David Byers's avatar
X    
David Byers committed
208
209
210
211
212
213
214
215
                                 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
216
                                 t nil 'lyskom-command-history)))
David Byers's avatar
X    
David Byers committed
217
    (cdr (lyskom-string-assoc name alternatives))))
David Kågedal's avatar
David Kågedal committed
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
251
252
253
254
255
256
257
258
259
260
261

(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
262
263
264
265
266
267
268
269
270
            (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
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
  (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."
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
  (lyskom-save-excursion
   (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
329

330
(eval-and-compile (provide 'lyskom-command))
David Kågedal's avatar
David Kågedal committed
331
332

;;; command.el ends here