gdl.el 10.8 KB
Newer Older
1
;;;; -*- coding: utf-8 -*-
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
;;                              GDL.EL
;;
;; 1.  INTRODUCTION
;;
;; The purpose of this document is to configure emacs to load SLIME
;; and start an inferior lisp process which will itself load and run
;; the GENDL development environment.
;;
;; The intended readership is users and project developers.
;;
;; This document is not confidential. See end for copyright
;; information.

(require 'cl)


Dave Cooper's avatar
Dave Cooper committed
18
19
(defvar *default-font-size* 15)

Dave Cooper's avatar
Dave Cooper committed
20
21
22
23
24
25
26
27
28
29
30
(defun maximize-frame ()
  "Maximizes the active frame in Windows"
  (interactive)
  ;; Send a `WM_SYSCOMMAND' message to the active frame with the
  ;; `SC_MAXIMIZE' parameter.
  (when (eq system-type 'windows-nt) (w32-send-sys-command 61488))
  (unless (eq system-type 'windows-nt) (set-frame-parameter nil 'fullscreen 'maximized)))

(add-hook 'window-setup-hook 'maximize-frame t)


31
32
;; 2. WHERE ARE WE?

Dave Cooper's avatar
Dave Cooper committed
33
34
(defvar *gendl-home* (file-truename (concat (file-name-directory 
					     (file-truename load-file-name)) "../")))
35
36


Dave Cooper's avatar
Dave Cooper committed
37
;; 3. CONFIGURE EMACS
38
39
40
41
42
43
44
45
46
;;
;; This section is not SLIME-specific.
;;
;; 3.1 Flags, for commenting in or out.

;; FLAG -- comment the following if you want a tool bar.
;;         (errors ignored in case running in a console terminal)
(ignore-errors (tool-bar-mode -1))

47
;;(setq visible-bell t)
48
49
50
51
52
53
54
55
56

;; FLAG -- uncomment the following if you don't need a menu bar.
;;         (errors ignored in case running in a console terminal)
;;
;;(ignore-errors (menu-bar-mode -1))


;; 3.2. Set up color-theme and solarized color-themes

57
(add-to-list 'load-path (concat *gendl-home* "emacs/emacs-color-theme")) 
58
59
(require 'color-theme)
(color-theme-initialize)
60
61
(color-theme-sitaramv-solaris)
;;(color-theme-feng-shui)
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
;; 3.3. Indents

(defmacro defindent (name indentation)
  (let* ((keyword-list '(lisp-font-lock-keywords t t t nil nil nil "&allow-other-keys"))
         (spec (if (eq indentation 'gdl-object-style) `((1 t ,keyword-list) (0 t 2)) indentation)))
    `(put ',name 'lisp-indent-hook ',spec)))

(defun gdl:define-indents ()
  (defindent define-object gdl-object-style)
  (defindent define-view (like define-object))
  (defindent define-format (like define-object))
  (defindent defpart (like define-object))
  (defindent defwriter (like define-object))
  (defindent defcompanion (like define-object)))

(gdl:define-indents)

;; 3.4. Some handy global keybindings

(defun gdl:global-keys ()
  (global-set-key "\M-p" 'fi:pop-input)
  (global-set-key "\M-n" 'fi:push-input)
  (global-set-key "\C-xy" '(lambda() (interactive) (other-window -1)))
  ;;
  ;; Use C-j for newline-and-indent. If you really like it, you can bind
  ;; it to [Enter] by uncommenting the following line (from
  ;; http://emacswiki.org/emacs/AutoIndentation).
  ;;
  ;;(global-set-key (kbd "C-m") 'newline-and-indent)
Dave Cooper's avatar
Dave Cooper committed
93
  )
Dave Cooper's avatar
Dave Cooper committed
94

95
96
97
98
99
100
(gdl:global-keys)

;; 3.5. Font

(defun gdl:set-font ()
  (interactive)
Dave Cooper's avatar
Dave Cooper committed
101
  (let ((font-size *default-font-size*)) ;; (/ (display-mm-height) 16)
102
103
104
105
106
107
108
    (set-frame-font
     (format 
      (case system-type
	(darwin  "-apple-Courier_New-medium-normal-normal-*-%s-*-*-*-m-0-iso10646-1")
	(windows-nt "-outline-Courier New-normal-normal-normal-mono-%s-*-*-*-c-*-iso8859-1")
	(gnu/linux "-bitstream-Courier 10 Pitch-normal-normal-normal-*-%s-*-*-*-m-0-iso10646-1"))
      font-size))))
109

Dave Cooper's avatar
Dave Cooper committed
110
(ignore-errors (gdl:set-font))
111

112

113
114
115
116
;; 3.6. Miscellania

(show-paren-mode t)

Dave Cooper's avatar
Dave Cooper committed
117

118
119
120
121
122
123
124
125
126
127
;; Use M-x clear-kill-ring in case you have too much garbage in the
;; kill ring
;;
(defun clear-kill-ring () (interactive) (setq kill-ring nil))


;; 4.  SLIME SETUP
;;
;; 4.1. Some synonyms

Dave Cooper's avatar
Dave Cooper committed
128
(defun gendl (&optional exe) (interactive) 
Dave Cooper's avatar
Dave Cooper committed
129
130
  (add-hook 'slime-connected-hook 'load-and-or-start-gendl t)
  ;;(add-hook 'slime-connected-hook 'load-base-ql)
Dave Cooper's avatar
Dave Cooper committed
131
132
133
  (add-to-list 'auto-mode-alist '("\\.cl\\'" . lisp-mode))
  (add-to-list 'auto-mode-alist '("\\.gdl\\'" . lisp-mode))
  (add-to-list 'auto-mode-alist '("\\.gendl\\'" . lisp-mode))
Dave Cooper's avatar
Dave Cooper committed
134
135
136
137
  (with-temp-buffer (cd *gendl-home*) (slime exe)))

(defun gdl () (interactive) (gendl 'gdl))
(defun agdl8 () (interactive) (gendl 'agdl8))
Dave Cooper's avatar
Dave Cooper committed
138
(defun agdl () (interactive) (gendl 'agdl))
Dave Cooper's avatar
Dave Cooper committed
139
(defun glime () (interactive) (gendl))
140
141
142
143

(defun gdl-quit () (interactive) (slime-quit-lisp))
(defun gq () (interactive) (gdl-quit))
(defun gendl-quit () (interactive) (gdl-quit))
Dave Cooper's avatar
Dave Cooper committed
144
145
146
(defun quit-gendl () (interactive) (gdl-quit))
(defun quit-gdl () (interactive) (gdl-quit))

147
148


149
;; 4.2. Locate Common Lisp / Locate SLIME
150
151
;;
;; Where is our Common Lisp implementation? Where is slime-helper.el?
Dave Cooper's avatar
Dave Cooper committed
152
153
154
155
;;
;; If you don't have slime loaded yet, and/or you don't have 
;; slime-lisp-implementations set, then please make a file
;; .configure-glime.el in your home directory which sets
156
;; correct slime-lisp-implementations and quicklisp-slime-helper
Dave Cooper's avatar
Dave Cooper committed
157
;;
158
159
;; Loading the latter means we can load slime-autoloads.el (which
;; enables SLIME itself).
Dave Cooper's avatar
Dave Cooper committed
160
161
;;
;;
162
163

(defun configure-slime ()
164
  (setq quicklisp-slime-helper nil)
Dave Cooper's avatar
Dave Cooper committed
165
166
167
168
169
170
171
172
  (let ((built-in-config (concat *gendl-home* "emacs/configure-glime.el"))
	(home-config "~/.configure-glime.el"))
    (let ((config-file (if (file-exists-p built-in-config) built-in-config home-config)))
      (when (file-exists-p config-file) (load-file config-file))
      ;;
      ;; path-to-quicklisp-helper should have been set by config-file,
      ;; or slime must already be set up.
      ;;
173
      (when (file-exists-p quicklisp-slime-helper)
Dave Cooper's avatar
Dave Cooper committed
174
	(load-file quicklisp-slime-helper)))))
Dave Cooper's avatar
Dave Cooper committed
175

176
177
178
179
180
181
182
183
184

(configure-slime)
(require 'slime-autoloads)


;; 4.3. Configure SLIME

(eval-after-load "slime"
  '(progn
185
    (slime-setup '(slime-fancy slime-banner slime-tramp))
186
    (add-hook 'slime-connected-hook 'set-slime-shortcuts)
187
    (add-hook 'slime-connected-hook 'customise-slime)
188
    (add-hook 'slime-repl-mode-hook 'remove-dos-eol)
Dave Cooper's avatar
Dave Cooper committed
189
    (add-hook 'slime-connected-hook 'load-user-emacs-glime)))
190

Dave Cooper's avatar
Dave Cooper committed
191
192
193
194
195
196
197
198


(defun load-base-ql ()
  (slime-repl)
  (insert "(load (merge-pathnames \".load-base-ql.lisp\" (user-homedir-pathname)))")
  (slime-repl-return))


Dave Cooper's avatar
Dave Cooper committed
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
(defvar gdl-startup-string 
  (format 
   "(progn (unless (find-package :gendl)
	    (let ((load-file (or (probe-file (merge-pathnames \".load-gendl.lisp\" (user-homedir-pathname)))
				 (probe-file \"c:/users/dcooper8/.load-gendl.lisp\"))))
	      (load load-file)))
	  (when (and (find-package :gendl) (find-package :swank))
            (load (compile-file \"%semacs/glime.lisp\"

				:output-file 
				(merge-pathnames 
				 (make-pathname :name \"glime\" 
						:type (symbol-value 
						       (read-from-string \"glisp:*fasl-extension*\")))
				 (funcall (symbol-function (read-from-string \"glisp:temporary-folder\")))))))
	  (when (find-package :gendl) (funcall (symbol-function (read-from-string \"gendl::startup-banner\"))))
	  (let ((gendl-loaded? (find-package :gendl)) (genworks-gdl-loaded? (find-package :genworks-gdl)))
	    (cond (genworks-gdl-loaded? (funcall (symbol-function (read-from-string \"gdl:start-gdl!\"))))
		  (gendl-loaded? (funcall (symbol-function (read-from-string \"gendl:start-gendl!\"))))
		  (t (format t  \"~%%~%%***~%%Gendl or GDL is not loaded and did not load successfully from .load-gendl.lisp in your home directory.~%%***~%%~%%\"))))
	  (when (find-package :gendl) (in-package :gdl-user)))" *gendl-home*))


Dave Cooper's avatar
Dave Cooper committed
222
(defun load-and-or-start-gendl ()
223
  (slime-repl)
Dave Cooper's avatar
Dave Cooper committed
224
  (insert gdl-startup-string)
225
226
227
  (slime-repl-return)
  (end-of-buffer))

Dave Cooper's avatar
Dave Cooper committed
228
229


230
231
232
233
234
235
(defun set-slime-shortcuts ()
  "Set keybindings for switching to slime buffers"
  (interactive)
  (global-set-key "\C-x&" '(lambda()(interactive) (switch-to-buffer (slime-repl-buffer))))
  (global-set-key "\C-x*" '(lambda()(interactive) (switch-to-buffer "*inferior-lisp*"))))

236
237
238
(defun customise-slime ()
  (setq slime-autodoc-use-multiline-p t))

239
240
241
242
243
244
245
246
247
(defun remove-dos-eol ()
  "Do not show ^M in files containing mixed UNIX and DOS line endings."
  (interactive)
  (setq buffer-display-table (make-display-table))
  (aset buffer-display-table ?\^M []))


;; 4.4. Prior to SLIME

Dave Cooper's avatar
Dave Cooper committed
248
249


Dave Cooper's avatar
Dave Cooper committed
250
(defun prior-to-glime ()
Dave Cooper's avatar
Dave Cooper committed
251
  (find-file (concat *gendl-home* "emacs/README.txt"))
252
  (toggle-read-only)
253
  (let ((frame-title "Genworks® GDL Interactive Authoring Environment"))
Dave Cooper's avatar
Dave Cooper committed
254
    (modify-frame-parameters nil (list (cons 'name frame-title))))
255
  (setq inhibit-splash-screen t)
Dave Cooper's avatar
Dave Cooper committed
256
257
  (cd "~/"))

258

Dave Cooper's avatar
Dave Cooper committed
259
260
261
262
(defun load-user-emacs-glime ()
  (when (file-exists-p "~/.emacs-glime") (load-file "~/.emacs-glime"))
  (when (file-exists-p "~/.emacs-glime.el") (load-file "~/.emacs-glime.el")))

263

Dave Cooper's avatar
Dave Cooper committed
264
265
266
267
268
269
270
(ignore-errors 
  (require 'package)
  ;; Add the original Emacs Lisp Package Archive
  (add-to-list 'package-archives
	       '("elpa" . "http://tromey.com/elpa/"))
  ;; Add the user-contributed repository
  (add-to-list 'package-archives
271
272
273
274
275
276
	       '("marmalade" . "http://marmalade-repo.org/packages/"))

  (add-to-list 'package-archives
	       '("melpa" . "http://melpa.milkbox.net/packages/") t)
  
  )
Dave Cooper's avatar
Dave Cooper committed
277
278


279
280
;; 5.  MAKE IT HAPPEN

Dave Cooper's avatar
Dave Cooper committed
281
(prior-to-glime)
Dave Cooper's avatar
Dave Cooper committed
282
283
284
285
286
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
321
322
323
324
325
326
327
328
329
330
331
332
333
334

;;
;; FLAG -- conditionalize based on running slime or ELI
;;
;;(glime)

(defvar *eli-init* (concat *gendl-home* "program/eli/fi-site-init.el"))


(when (file-exists-p *eli-init*)

  (defun get-executable (exe-name)

      (let* ((info (assoc exe-name slime-lisp-implementations )))
	(replace-regexp-in-string 
	 "/program/program/" "/program/"
	 (case system-type 
	   (windows-nt
	    (concat (file-name-directory (first (second info)))
		    (replace-regexp-in-string "\\\\" "/" (second (second info)))))
	   ((darwin gnu/linux)
	    (first (second info)))))))


  (defvar gdl:*gdl-toplevel-base* "*gdl toplevel*")


  (defun agdl8e () (interactive)
    (gdl-devo (get-executable 'agdl8)))

  (defun gdle () (interactive)
    (gdl-devo (get-executable 'gdl)))

  (defun gdl-devo (executable) 
    (interactive)
    (load-file *eli-init*)
	  
    (setq gdl:*gdl-toplevel* 
	  (concat gdl:*gdl-toplevel-base*
		  (if (equalp (subseq (file-name-sans-extension (file-name-nondirectory executable))
				      0 1) "a")
		      "(ANSI)" "(modern)")))
    (fi:common-lisp gdl:*gdl-toplevel* *gendl-home* executable nil)


    (global-set-key "\C-x&" '(lambda()(interactive) (switch-to-buffer gdl:*gdl-toplevel*)))

    (switch-to-buffer gdl:*gdl-toplevel*)
    (end-of-buffer)
    (goto-char (point-max))
    (insert gdl-startup-string)
    (fi:inferior-lisp-newline)
    (end-of-buffer)))
335
336


337

338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
;; A.  REFERENCES
;;
;;
;; B.  HISTORY
;;
;;
;; C.  COPYRIGHT
;;
;; Copyright 2013 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file 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
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file.  If not, see
;; <http://www.gnu.org/licenses/>.