dc7cea4f7854241cdb1fc3511bc366c77c7acf79
[software/guile-studio.git] / guile-studio-configure.scm
1 (use-modules (ice-9 pretty-print)
2 (ice-9 match))
3
4 (define (generate-configuration prefix emacsdir picture-language icons emacs-package-dirs)
5 `(progn
6 (load (expand-file-name
7 ,(string-append emacsdir "/share/emacs/site-lisp/guix-emacs.el")))
8 (when (require 'guix-emacs nil t)
9 (guix-emacs-autoload-packages ,@emacs-package-dirs))
10
11 (setq-default indent-tabs-mode nil)
12 (tool-bar-mode 1)
13 (menu-bar-mode 1)
14 (set-scroll-bar-mode 'right)
15
16 ;; Use Ctrl-C/X/Z for copy, cut, paste
17 (require 'cua-base)
18 (cua-mode 1)
19 (require 'company)
20 (setq company-idle-delay 0.3)
21 (require 'elec-pair)
22 (electric-pair-mode 1)
23 (require 'scheme)
24 (require 'geiser)
25 (setq geiser-guile-load-path
26 '(,(string-append picture-language
27 "/share/guile/site/2.2/")
28 ,(string-append picture-language
29 "/lib/guile/2.2/site-ccache/")))
30 (setq geiser-guile-init-file ,(string-append prefix
31 "/share/guile-studio-init"))
32 (setq geiser-autodoc-identifier-format "%s ~ %s")
33 (setq geiser-default-implementation 'guile
34 initial-major-mode 'scheme-mode
35 inhibit-splash-screen t
36 x-select-enable-clipboard t
37 x-select-enable-primary t
38 save-interprogram-paste-before-kill t
39 apropos-do-all t
40 mouse-yank-at-point t
41 require-final-newline t
42 visible-bell t
43 load-prefer-newer t
44 save-place-file (concat user-emacs-directory "places"))
45
46 ;; Hide the fact that this is Emacs
47 (modify-frame-parameters nil '((title . "Guile Studio")))
48
49 ;; Remember location in buffers
50 (require 'saveplace)
51 (setq-default save-place t)
52
53 ;; Mode line settings
54 (require 'smart-mode-line)
55 (setq sml/no-confirm-load-theme t)
56 (setq sml/theme 'respectful)
57 (setq sml/position-percentage-format nil)
58 (setq sml/mule-info nil)
59 (setq sml/read-only-char
60 (propertize "R" 'display
61 (create-image "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"20\" height=\"14\" viewBox=\"0 0 448 612\">\
62 <path fill=\"currentColor\" \
63 d=\"M400 224h-24v-72C376 68.2 307.8 0 224 0S72 68.2 72 \
64 152v72H48c-26.5 0-48 21.5-48 48v192c0 26.5 21.5 48 48 48h352c26.5 \
65 0 48-21.5 48-48V272c0-26.5-21.5-48-48-48zm-104 0H152v-72c0-39.7 \
66 32.3-72 72-72s72 32.3 72 72v72z\"></path></svg>" 'svg t)))
67 (sml/setup)
68 (setq rm-whitelist '("Paredit"))
69
70 (require 'uniquify)
71 (setq uniquify-buffer-name-style 'forward)
72
73 ;; Add close button for opened buffers.
74 (require 'mouse)
75 (defconst my-mode-line-map
76 (let ((map (make-sparse-keymap)))
77 (define-key map (vector 'mode-line 'mouse-1)
78 'mouse-delete-window)
79 map))
80 (setq global-mode-string
81 (append global-mode-string
82 '(:eval (if (window-dedicated-p (selected-window))
83 ""
84 (propertize "[тип]"
85 'local-map my-mode-line-map
86 'mouse-face 'mode-line-highlight)))))
87 (global-unset-key (vector 'mode-line 'mouse-2)) ; 'mouse-delete-other-windows
88 (global-unset-key (vector 'mode-line 'mouse-3)) ; 'mouse-delete-window
89
90
91 (defun geiser--guile-picture-language--pict-from-file ()
92 (interactive)
93 (let ((file (read-file-name "Insert image: " nil nil t)))
94 (geiser-repl--send
95 (concat "(pict-from-file \""
96 file
97 "\")"))))
98
99 (defvar geiser-repl-tool-bar-map (make-sparse-keymap))
100 (define-key geiser-repl-tool-bar-map (vector 'insert-image)
101 '(menu-item " Insert image" geiser--guile-picture-language--pict-from-file
102 :image
103 (image :type png
104 :file ,(string-append icons "/24x24/actions/insert-image.png"))
105 :help "Insert image..."))
106
107 (defvar scheme-tool-bar-map (make-sparse-keymap))
108 (define-key scheme-tool-bar-map (vector 'eval-buffer)
109 '(menu-item " Evaluate" geiser-eval-buffer
110 :image
111 (image :type png
112 :file ,(string-append icons "/24x24/actions/media-playback-start.png"))
113 :help "Evaluate buffer..."))
114 (define-key scheme-tool-bar-map (vector 'lookup-documentation)
115 '(menu-item " Documentation" geiser-doc-symbol-at-point
116 :image
117 (image :type png
118 :file ,(string-append icons "/24x24/actions/help-faq.png"))
119 :help "Show documentation for the current symbol"))
120
121 (add-hook 'emacs-startup-hook
122 (lambda ()
123 (let ((buf (generate-new-buffer "untitled.scm")))
124 (switch-to-buffer buf nil t)
125 (funcall (and initial-major-mode))
126 (setq buffer-offer-save t)
127 (delete-other-windows)
128 (set-window-dedicated-p (selected-window) t))
129 (run-guile)
130 (set-window-dedicated-p (selected-window) t)
131 ;; Hide the cluttered Tools and Options menu items
132 (define-key global-map (vector 'menu-bar 'tools) 'undefined)
133 (define-key global-map (vector 'menu-bar 'options) 'undefined)
134
135 ;; Prefer horizontal splits
136 (setq split-height-threshold nil)
137 (setq split-width-threshold 80)))
138
139 (add-hook 'after-init-hook 'global-company-mode)
140 (add-hook 'geiser-repl-mode-hook
141 (lambda ()
142 (paren-face-mode 1)
143 (show-paren-mode 1)
144 (unless (local-variable-p 'tool-bar-map)
145 (set (make-local-variable 'tool-bar-map)
146 geiser-repl-tool-bar-map))))
147 (add-hook 'scheme-mode-hook
148 (lambda ()
149 (paren-face-mode 1)
150 (show-paren-mode 1)
151 (unless (local-variable-p 'tool-bar-map)
152 (set (make-local-variable 'tool-bar-map)
153 scheme-tool-bar-map))))
154
155 ;; Don't show the Geiser menu in a Scheme buffer
156 (add-hook 'geiser-mode-hook
157 (lambda ()
158 (define-key geiser-mode-map
159 (vector 'menu-bar 'geiserm) 'undefined)))
160 (load-theme 'adwaita t)))
161
162 (define (make-guile-studio-wrapper prefix share emacsdir)
163 (let ((wrapper (string-append prefix "/bin/guile-studio")))
164 (with-output-to-file wrapper
165 (lambda ()
166 (format #t "#!/bin/sh
167 exec ~a/bin/emacs -Q --load ~a/guile-studio.el
168 "
169 emacsdir share)))
170 (chmod wrapper #o555)))
171
172 (define (main)
173 (match (command-line)
174 ((_ prefix emacsdir picture-language icons . emacs-package-dirs)
175 (let ((share (string-append prefix "/share")))
176 (with-output-to-file (string-append share "/guile-studio.el")
177 (lambda ()
178 (pretty-print (generate-configuration prefix emacsdir picture-language icons emacs-package-dirs)
179 #:display? #f)))
180 (make-guile-studio-wrapper prefix share emacsdir)
181 (with-output-to-file (string-append share "/guile-studio-init")
182 (lambda ()
183 (format #t "~s" '(use-modules (pict))))))
184 #t)
185 ((script . _)
186 (format (current-error-port)
187 "usage: ~a prefix emacsdir picture-language icons emacs-package-dirs ...\n"
188 script))))
189
190 (main)