;; dyd-mode v0.1.0 20-03-2019 (require 'inf-haskell) (require 'ido) (require 'ox-latex) (define-derived-mode dyd-mode org-mode "Dyd" "Dydactic mode based on Org mode" (local-set-key (kbd "C-c c") 'org-babel-remove-result) (local-set-key (kbd "C-c s") 'dyd-save-this-block) (local-set-key (kbd "C-c l") 'dyd-load-this-block) (local-set-key (kbd "C-c e") 'dyd-eval) (local-set-key (kbd "C-c b") 'dyd-insert-code-block) (local-set-key (kbd "RET") 'dyd-return) ;; (add-to-list 'org-latex-packages-alist '("newfloat" "minted")) (setq display-buffer-alist '(("\\`\\*\\(shell\\|ruby\\|haskell\\)" display-buffer-pop-up-window))) (setq org-return-follows-link t) ;; (setcar (nthcdr 2 org-emphasis-regexp-components) " \n,") (setcar (nthcdr 2 org-emphasis-regexp-components) " \t\r\n,") (org-set-emph-re 'org-emphasis-regexp-components org-emphasis-regexp-components) (set 'org-pretty-entities t) (org-babel-do-load-languages 'org-babel-load-languages ;; '((emacs-lisp . t) (ruby . t) (haskell . t) (sh . t))) ;; org version < 8.6 '((emacs-lisp . t) (ruby . t) (haskell . t) (shell . t))) ;; org version >= 8.6 ) (defvar dyd-conf-plist '(ruby (:ext "rb" :run run-ruby :load (lambda (filename) (concat "load '" filename "'"))) shell (:ext "sh" :run (lambda () (pop-to-buffer (or (get-buffer "*shell*") (get-buffer-create (generate-new-buffer-name "*shell*")))) (shell (current-buffer))) :load (lambda (filename) (concat "source " filename))) haskell (:ext "hs" ;; :run run-haskell :run (lambda () (let ((proc (inferior-haskell-process))) (pop-to-buffer (process-buffer proc)))) :load (lambda (filename) (concat ":l " filename))))) (defvar dyd-interpreters-alist '((irb . ruby) (ruby . ruby) (ghci . haskell) (haskell . haskell) (shell . shell) (bash . shell))) (defvar dyd-current-language nil) (defun dyd-current-language () (interactive) (if dyd-current-language dyd-current-language (let* ((choice (mapcar 'symbol-name (dyd-languages))) (selected (ido-completing-read "Select language:" choice ))) (message "Current language: %s" selected) (set 'dyd-current-language (intern selected))))) (defvar dyd-temp-file-prefix "_dyd_temp.") (defun dyd-languages (&optional arg-given conf-plist) (let ((plist (if arg-given conf-plist dyd-conf-plist))) (unless (null plist) (cons (car plist) (dyd-languages t (cddr plist)))))) (defun dyd-lang-get (language prop) (plist-get (plist-get dyd-conf-plist language) prop)) (defun dyd-type (s &rest rest) (let ((return-buffer (current-buffer))) (funcall (dyd-lang-get (dyd-current-language) :run)) (sit-for 0.3) (end-of-buffer) (if (plist-get rest :interval) (dolist (character (string-to-list s)) (insert-char character) (redisplay) (sleep-for 0 (plist-get rest :interval))) (insert s)) (sleep-for 0 (plist-get rest :pause)) (if (plist-get rest :run) (comint-send-input)) (pop-to-buffer return-buffer))) (defun dyd-inline-code () (save-excursion (when (or (equal (char-after) ?~) (search-backward "~" (line-beginning-position) t)) (let ((from (progn (forward-char) (point)))) (when (search-forward "~" (line-end-position) t) (cons from (1- (point)))))))) (defun dyd-code-block () "If point in code block, returns block details, nil otherwise." (save-excursion (when (and (search-backward "#+" nil t) (equal (buffer-substring-no-properties (point) (+ (point) 11)) "#+begin_src")) (forward-word 3) (let* ((lang-end (point)) (lang-start (progn (backward-word) (point))) (lang (buffer-substring-no-properties lang-start lang-end)) (filename-start (when (search-forward "\"" (line-end-position) t) (point))) (filename-end (when (search-forward "\"" (line-end-position) t) (backward-char) (point))) (filename (when (and filename-start filename-end) (buffer-substring-no-properties filename-start filename-end))) (block-start (progn (forward-line) (point))) (block-end (progn (search-forward "#+end_src") (beginning-of-line) (point)))) (set 'dyd-current-language (intern lang)) (list block-start block-end (intern lang) filename))))) (defun dyd-save-this-block () (interactive) (let ((block-details (dyd-code-block))) (when block-details (apply 'dyd-save-region block-details)))) (defun dyd-load-this-block () (interactive) (let ((block-details (dyd-code-block))) (when block-details (apply 'dyd-load-region block-details)))) (defun dyd-save-region (start end language &optional filename) (unless filename (set 'filename (dyd-temp-filename language))) (write-region start end filename)) (defun dyd-load-region (start end language &optional filename) (unless filename (set 'filename (dyd-temp-filename language))) (dyd-save-region start end language filename) (dyd-type (funcall (dyd-lang-get language :load) filename) :interval 50 :run t)) (defun dyd-eval () (interactive) (if (use-region-p) (dyd-type (buffer-substring-no-properties (region-beginning) (region-end)) :interval 50 :run t) (let ((inline-code (dyd-inline-code))) (when inline-code (save-excursion (when (re-search-backward "\(\\([a-z]*\\)\)" (line-beginning-position) t) (set 'dyd-current-language (cdr (assoc (intern (match-string-no-properties 1)) dyd-interpreters-alist)))) (dyd-type (buffer-substring-no-properties (car inline-code) (cdr inline-code)) :interval 50 :run t)))))) (defun dyd-return () (interactive) (or (dyd-eval) (dyd-load-this-block) (org-return))) (defun dyd-temp-filename (&optional lang) (let ((language (or lang (dyd-current-language)))) (concat dyd-temp-file-prefix (dyd-lang-get language :ext)))) (defun dyd-insert-code-block () (interactive) (let* ((language (dyd-current-language)) (filename (read-from-minibuffer "filename: " (dyd-temp-filename language)))) (insert (concat "#+begin_src " (symbol-name language) (if (string= filename (dyd-temp-filename language)) "" (concat " \"" filename "\"")) "\n\n" "#+end_src")) (forward-line -1))) (provide 'dyd-mode)