gdl.el 11.7 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
  (add-hook 'slime-connected-hook 'load-and-or-start-gendl t)
Dave Cooper's avatar
Dave Cooper committed
130
131
132
  (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
133
134
135
136
  (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
137
(defun agdl () (interactive) (gendl 'agdl))
Dave Cooper's avatar
Dave Cooper committed
138
(defun glime () (interactive) (gendl))
139
140
141
142

(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
143
144
145
(defun quit-gendl () (interactive) (gdl-quit))
(defun quit-gdl () (interactive) (gdl-quit))

146
147


148
;; 4.2. Locate Common Lisp / Locate SLIME
149
150
;;
;; Where is our Common Lisp implementation? Where is slime-helper.el?
Dave Cooper's avatar
Dave Cooper committed
151
152
153
154
;;
;; 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
155
;; correct slime-lisp-implementations and quicklisp-slime-helper
Dave Cooper's avatar
Dave Cooper committed
156
;;
157
158
;; Loading the latter means we can load slime-autoloads.el (which
;; enables SLIME itself).
Dave Cooper's avatar
Dave Cooper committed
159
160
;;
;;
161
162

(defun configure-slime ()
163
  (setq quicklisp-slime-helper nil)
Dave Cooper's avatar
Dave Cooper committed
164
165
166
167
168
169
170
171
  (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.
      ;;
172
      (when (file-exists-p quicklisp-slime-helper)
Dave Cooper's avatar
Dave Cooper committed
173
	(load-file quicklisp-slime-helper)))))
Dave Cooper's avatar
Dave Cooper committed
174

175
176
177
178
179
180
181
182
183

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


;; 4.3. Configure SLIME

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

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


(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
198
199
200
(defvar gdl-startup-string 
  (format 
   "(progn (unless (find-package :gendl)
Dave Cooper's avatar
Dave Cooper committed
201
	    (let ((load-file (probe-file (merge-pathnames \".load-gendl.lisp\" (user-homedir-pathname)))))
Dave Cooper's avatar
Dave Cooper committed
202
	      (load load-file)))
Dave Cooper's avatar
Dave Cooper committed
203
          (funcall (symbol-function (read-from-string \"uiop:setup-temporary-directory\")))
Dave Cooper's avatar
Dave Cooper committed
204
205
206
207
208
209
210
211
	  (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
212
(defun load-and-or-start-gendl ()
213
  (setq slime-enable-evaluate-in-emacs t)
214
  (slime-repl)
Dave Cooper's avatar
Dave Cooper committed
215
  (insert gdl-startup-string)
216
217
218
  (slime-repl-return)
  (end-of-buffer))

Dave Cooper's avatar
Dave Cooper committed
219
220


221
222
223
224
225
226
(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*"))))

227
228
229
(defun customise-slime ()
  (setq slime-autodoc-use-multiline-p t))

230
231
232
233
234
235
236
237
238
(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
239
240


Dave Cooper's avatar
Dave Cooper committed
241
(defun prior-to-glime ()
Dave Cooper's avatar
Dave Cooper committed
242
  (find-file (concat *gendl-home* "emacs/README.txt"))
243
  (toggle-read-only)
244
  (let ((frame-title "Genworks® GDL Interactive Authoring Environment"))
Dave Cooper's avatar
Dave Cooper committed
245
    (modify-frame-parameters nil (list (cons 'name frame-title))))
246
  (setq inhibit-splash-screen t)
Dave Cooper's avatar
Dave Cooper committed
247
248
  (cd "~/"))

249

Dave Cooper's avatar
Dave Cooper committed
250
(defun load-user-emacs-glime ()
251
252
253
254
255
256
257
258
259
  (dolist (file (list "~/.emacs-glime" "~/.emacs-glime.el"))
    (when (file-exists-p file) (load-file file))))

(defun load-user-emacs-gendl ()
  (dolist (file (list "~/.emacs-gendl" "~/.emacs-gdl" 
		      "~/.emacs-gendl.el" "~/.emacs-gdl.el"))
    (when (file-exists-p file) (load-file file))))


Dave Cooper's avatar
Dave Cooper committed
260

261

Dave Cooper's avatar
Dave Cooper committed
262
263
264
265
266
267
268
(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
269
270
271
272
273
274
	       '("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
275
276


277
278
;; 5.  MAKE IT HAPPEN

Dave Cooper's avatar
Dave Cooper committed
279
(prior-to-glime)
Dave Cooper's avatar
Dave Cooper committed
280
281
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

;;
;; 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)))

Dave Cooper's avatar
Dave Cooper committed
310
311
312
  (defun agdle () (interactive)
     (gdl-devo (get-executable 'agdl)))
  
Dave Cooper's avatar
Dave Cooper committed
313
  (defun gdle () (interactive)
314
    (gdl-devo (get-executable 'gdl)))
Dave Cooper's avatar
Dave Cooper committed
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335

  (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)))
336

Dave Cooper's avatar
Dave Cooper committed
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358

(defun timestamp ()
  (insert (format-time-string "%Y-%m-%dT%H:%M:%S" (current-time))))

;;
;; See http://pomodorotechnique.com/
;;
(defun pomodoro ()
  (timestamp)
  (insert (format-time-string ";%Y-%m-%dT%H:%M:%S;" 
			      (time-add (current-time) (seconds-to-time (* 25 60))))))
(global-set-key "\C-t" '(lambda() (interactive) (pomodoro)))

(defun post-pomodoro ()
  (insert (format-time-string "%Y-%m-%dT%H:%M:%S" 
			      (time-subtract (current-time) (seconds-to-time (* 25 60)))))
  (insert (format-time-string ";%Y-%m-%dT%H:%M:%S;" (current-time))))

(global-set-key "\M-t" '(lambda() (interactive) (post-pomodoro)))



Dave Cooper's avatar
Dave Cooper committed
359
;;
360
;; Establish input method for I.A.S.T diacritics
Dave Cooper's avatar
Dave Cooper committed
361
;;
362
363
364
365
366
367
368
(let ((file (concat *gendl-home* "emacs/sa-translit.el"))) 
  (when (file-exists-p file)
    (load-file file)
    (register-input-method
     "sa-translit" "Sanskrit Transliteration" 'quail-use-package
     "sa-translit" "Converts Harvard-Kyoto and ITRANS scheme to IAST diacritics."
     file)))
Dave Cooper's avatar
Dave Cooper committed
369
370


371
(load-user-emacs-gendl)
372

373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
;; 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/>.