Hello world! This is Guile Studio.

3 files changed, 245 insertions, 0 deletions

diff --git a/README.org b/README.org
new file mode 100644
index 0000000..96db7b8
--- /dev/null
+++ b/README.org
@@ -0,0 +1,12 @@
+Racket has Dr Racket.  Guile has ... Emacs?  This is Emacs with a few
+settings that make working with Guile easier for people new to Emacs.
+Features include: CUA mode, Geiser, tool bar icons to evaluate Guile
+buffers, support for Guile's very own picture language, code
+completion, a simple mode line, etc.
+
+Imagine a person who would love to learn Guile but is told to first
+learn Emacs.  “Guile Studio” aims to be a more suitable programming
+environment for Guile learners and Emacs agnostics.  The goal is not
+to create yet another “prelude” or starter pack for general use of
+Emacs.  Instead the only goal is to hide Emacs quirks and provide a
+pleasant Guile + Geiser experience out of the box.
diff --git a/guile-studio-configure.scm b/guile-studio-configure.scm
new file mode 100644
index 0000000..31866f7
--- /dev/null
+++ b/guile-studio-configure.scm
@@ -0,0 +1,171 @@
+(use-modules (ice-9 pretty-print)
+             (ice-9 match))
+
+(define (generate-configuration prefix emacsdir picture-language icons emacs-package-dirs)
+  `(progn
+    (load (expand-file-name
+           ,(string-append emacsdir "/share/emacs/site-lisp/guix-emacs.el")))
+    (when (require 'guix-emacs nil t)
+      (guix-emacs-autoload-packages ,@emacs-package-dirs))
+
+    (setq-default indent-tabs-mode nil)
+    (tool-bar-mode 1)
+    (menu-bar-mode 1)
+    (set-scroll-bar-mode 'right)
+
+    ;; Use Ctrl-C/X/Z for copy, cut, paste
+    (require 'cua-base)
+    (cua-mode 1)
+    (require 'company)
+    (setq company-idle-delay 0.3)
+    (require 'scheme)
+    (require 'geiser)
+    (setq geiser-guile-load-path
+          '(,(string-append picture-language
+                            "/share/guile/site/2.2/")
+            ,(string-append picture-language
+                            "/lib/guile/2.2/site-ccache/")))
+    (setq geiser-guile-init-file ,(string-append prefix
+                                                 "/share/guile-studio-init"))
+    (setq geiser-autodoc-identifier-format "%s ~ %s")
+    (setq geiser-default-implementation 'guile
+          initial-major-mode 'scheme-mode
+          inhibit-splash-screen t
+          x-select-enable-clipboard t
+          x-select-enable-primary t
+          save-interprogram-paste-before-kill t
+          apropos-do-all t
+          mouse-yank-at-point t
+          require-final-newline t
+          visible-bell t
+          load-prefer-newer t
+          save-place-file (concat user-emacs-directory "places"))
+
+    ;; Remember location in buffers
+    (require 'saveplace)
+    (setq-default save-place t)
+
+    ;; Mode line settings
+    (require 'smart-mode-line)
+    (setq sml/no-confirm-load-theme t)
+    (setq sml/theme 'respectful)
+    (setq sml/position-percentage-format nil)
+    (setq sml/mule-info nil)
+    (setq sml/read-only-char
+          (propertize "R" 'display
+                      (create-image "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"20\" height=\"14\" viewBox=\"0 0 448 612\">\
+<path fill=\"currentColor\" \
+d=\"M400 224h-24v-72C376 68.2 307.8 0 224 0S72 68.2 72 \
+152v72H48c-26.5 0-48 21.5-48 48v192c0 26.5 21.5 48 48 48h352c26.5 \
+0 48-21.5 48-48V272c0-26.5-21.5-48-48-48zm-104 0H152v-72c0-39.7 \
+32.3-72 72-72s72 32.3 72 72v72z\"></path></svg>" 'svg t)))
+    (sml/setup)
+    (setq rm-whitelist '("Paredit"))
+
+    (require 'uniquify)
+    (setq uniquify-buffer-name-style 'forward)
+
+    ;; Add close button for opened buffers.
+    (require 'mouse)
+    (defconst my-mode-line-map
+      (let ((map (make-sparse-keymap)))
+        (define-key map (vector 'mode-line 'mouse-1)
+          'mouse-delete-window)
+        map))
+    (setq global-mode-string 
+          (append global-mode-string 
+                  '(:eval (if (window-dedicated-p (selected-window))
+                              ""
+                              (propertize "[⨯]"
+                                          'local-map my-mode-line-map
+                                          'mouse-face 'mode-line-highlight)))))
+    (global-unset-key (vector 'mode-line 'mouse-2)) ; 'mouse-delete-other-windows
+    (global-unset-key (vector 'mode-line 'mouse-3)) ; 'mouse-delete-window
+
+
+    (defun geiser--guile-picture-language--pict-from-file ()
+      (interactive)
+      (let ((file (read-file-name "Insert image: " nil nil t)))
+        (geiser-repl--send
+         (concat "(pict-from-file \""
+                 file
+                 "\")"))))
+
+    (defvar geiser-repl-tool-bar-map (make-sparse-keymap))
+    (define-key geiser-repl-tool-bar-map (vector 'insert-image)
+      '(menu-item " Insert image" geiser--guile-picture-language--pict-from-file
+                  :image
+                  (image :type png
+                         :file ,(string-append icons "/24x24/actions/insert-image.png"))
+                  :help "Insert image..."))
+
+    (defvar scheme-tool-bar-map (make-sparse-keymap))
+    (define-key scheme-tool-bar-map (vector 'eval-buffer)
+      '(menu-item " Evaluate" geiser-eval-buffer
+                  :image
+                  (image :type png
+                         :file ,(string-append icons "/24x24/actions/media-playback-start.png"))
+                  :help "Evaluate buffer..."))
+    (define-key scheme-tool-bar-map (vector 'lookup-documentation)
+      '(menu-item " Documentation" geiser-doc-symbol-at-point
+                  :image
+                  (image :type png
+                         :file ,(string-append icons "/24x24/actions/help-faq.png"))
+                  :help "Show documentation for the current symbol"))
+    
+    (add-hook 'emacs-startup-hook
+              (lambda ()
+                (let ((buf (generate-new-buffer "untitled.scm")))
+                  (switch-to-buffer buf nil t)
+                  (funcall (and initial-major-mode))
+                  (setq buffer-offer-save t)
+                  (delete-other-windows)
+                  (set-window-dedicated-p (selected-window) t))
+                (run-guile)
+                (set-window-dedicated-p (selected-window) t)))
+    (add-hook 'after-init-hook 'global-company-mode)
+    (add-hook 'geiser-repl-mode-hook
+              (lambda ()
+                (paren-face-mode 1)
+                (show-paren-mode 1)
+                (unless (local-variable-p 'tool-bar-map)
+                  (set (make-local-variable 'tool-bar-map)
+                       geiser-repl-tool-bar-map))))
+    (add-hook 'scheme-mode-hook
+              (lambda ()
+                (paren-face-mode 1)
+                (show-paren-mode 1)
+                (unless (local-variable-p 'tool-bar-map)
+                  (set (make-local-variable 'tool-bar-map)
+                       scheme-tool-bar-map))))
+    (load-theme 'adwaita t)))
+
+(define (make-guile-studio-wrapper prefix share emacsdir)
+  (let ((wrapper (string-append prefix "/bin/guile-studio")))
+    (with-output-to-file wrapper
+      (lambda ()
+        (format #t "#!/bin/sh
+exec ~a/bin/emacs -Q --load ~a/guile-studio.el
+"
+                emacsdir share)))
+    (chmod wrapper #o555)))
+
+(define (main)
+  (match (command-line)
+    ((_ prefix emacsdir picture-language icons . emacs-package-dirs)
+     (let ((share (string-append prefix "/share")))
+       (with-output-to-file (string-append share "/guile-studio.el")
+         (lambda ()
+           (pretty-print (generate-configuration prefix emacsdir picture-language icons emacs-package-dirs)
+                         #:display? #f)))
+       (make-guile-studio-wrapper prefix share emacsdir)
+       (with-output-to-file (string-append share "/guile-studio-init")
+         (lambda ()
+           (format #t "~s" '(use-modules (pict))))))
+     #t)
+    ((script . _)
+     (format (current-error-port)
+             "usage: ~a prefix emacsdir picture-language icons emacs-package-dirs ...\n"
+             script))))
+
+(main)
diff --git a/guix/rekado/guile-studio.scm b/guix/rekado/guile-studio.scm
new file mode 100644
index 0000000..d589105
--- /dev/null
+++ b/guix/rekado/guile-studio.scm
@@ -0,0 +1,62 @@
+(define-module (rekado guile-studio))
+(use-modules (guix packages)
+             (guix download)
+             (guix build-system gnu)
+             ((guix licenses) #:prefix license:)
+             (gnu packages guile)
+             (gnu packages guile-xyz)
+             (gnu packages emacs)
+             (gnu packages emacs-xyz)
+             (gnu packages gnome))
+
+(define-public guile-studio
+  (package
+    (name "guile-studio")
+    (version "0")
+    (source (origin
+              (method url-fetch)
+              (uri "https://elephly.net/downies/guile-studio-configure.scm")
+              (sha256
+               (base32
+                "025knvijpybjyygn9ljf53cfi1dza3n8h8xk4342krg42xlaiad3"))))
+    (build-system gnu-build-system)
+    (arguments
+     `(#:tests? #f                      ; there are none
+       #:phases
+       (modify-phases %standard-phases
+         (delete 'unpack)
+         (delete 'configure)
+         (replace 'build
+           (lambda* (#:key source inputs outputs #:allow-other-keys)
+             (let* ((out   (assoc-ref outputs "out"))
+                    (bin   (string-append out "/bin/"))
+                    (share (string-append out "/share/")))
+               (mkdir-p share)
+               (mkdir-p bin)
+               (apply invoke "guile" "-s" source
+                      out
+                      (assoc-ref inputs "emacs")
+                      (assoc-ref inputs "guile-picture-language")
+                      (string-append (assoc-ref inputs "adwaita-icon-theme")
+                                     "/share/icons/Adwaita/")
+                      (map cdr inputs))
+               #t)))
+         (delete 'install))))
+    (inputs
+     `(("guile" ,guile-2.2)
+       ("guile-picture-language" ,guile-picture-language)
+       ("emacs" ,emacs)
+       ("emacs-geiser" ,emacs-geiser)
+       ("emacs-company" ,emacs-company)
+       ("emacs-smart-mode-line" ,emacs-smart-mode-line)
+       ("emacs-paren-face" ,emacs-paren-face)
+       ("adwaita-icon-theme" ,adwaita-icon-theme)))
+    (home-page "https://gnu.org/software/guile")
+    (synopsis "Totally not a cheap copy of Dr Racket for Guile")
+    (description
+     "Racket has Dr Racket.  Guile has ... Emacs?  This is Emacs with a few
+settings that make working with Guile easier for people new to Emacs.
+Features include: CUA mode, Geiser, tool bar icons to evaluate Guile buffers,
+support for Guile's very own picture language, code completion, a simple mode
+line, etc.")
+    (license license:gpl3+)))