haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make utop-mode to defined via define-derived-mode. Sinc define-derived-mode can't produce mode accepting arguments - now the arguments are taken from the utop-command. Factor out utop-get-arguments to utop-query-arguments and utop-arguments 

Ignore-this: ad14d3459012cf828815b72999328b49

darcs-hash:20120229042009-33bd9-039c63518e33f2001b86d07388b8d0c3e61dbca0
This commit is contained in:
wojciech.meyer 2012-02-29 05:20:09 +01:00
parent 010febbc4f
commit a186e64385
1 changed files with 21 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
src/top/utop.el
View File

@ -819,17 +819,21 @@ defaults to 0."
;; | The mode | ;; | The mode |
;; +-----------------------------------------------------------------+ ;; +-----------------------------------------------------------------+
(defun utop-get-arguments () (defun utop-arguments ()
"Returns the arguments of the utop command to run." "Get argument list from the given command line of utop"
;; Read the command to run
(when utop-edit-command
(setq utop-command (read-shell-command "utop command line: " utop-command)))
;; Split the command line ;; Split the command line
(let ((arguments (split-string-and-unquote utop-command))) (let ((arguments (split-string-and-unquote utop-command)))
;; Ensure it contains at least one argument ;; Ensure it contains at least one argument
(when (not arguments) (error "The utop command line is empty")) (when (not arguments) (error "The utop command line is empty"))
arguments)) arguments))
(defun utop-query-arguments ()
"Returns the arguments of the utop command to run."
;; Read the command to run
(when utop-edit-command
(setq utop-command (read-shell-command "utop command line: " utop-command))
(utop-arguments)))
(defun utop-start (arguments) (defun utop-start (arguments)
"Start utop." "Start utop."
;; Reset variables ;; Reset variables
@ -858,12 +862,12 @@ defaults to 0."
(defun utop-restart () (defun utop-restart ()
"Restart utop." "Restart utop."
(let ((arguments (utop-get-arguments))) (let ((arguments (utop-query-arguments)))
(goto-char (point-max)) (goto-char (point-max))
(utop-insert "\nRestarting...\n\n") (utop-insert "\nRestarting...\n\n")
(utop-start arguments))) (utop-start arguments)))
(defun utop-mode (arguments) (define-derived-mode utop-mode fundamental-mode "utop"
"Set the buffer mode to utop." "Set the buffer mode to utop."
;; Local variables ;; Local variables
@ -880,13 +884,6 @@ defaults to 0."
(make-local-variable 'utop-pending-position) (make-local-variable 'utop-pending-position)
(make-local-variable 'utop-pending-entry) (make-local-variable 'utop-pending-entry)
;; Set the major mode
(setq major-mode 'utop-mode)
(setq mode-name "utop")
;; Use the utop keymap
(use-local-map utop-mode-map)
;; Set the hook to call before changing the buffer ;; Set the hook to call before changing the buffer
(add-hook 'before-change-functions 'utop-before-change nil t) (add-hook 'before-change-functions 'utop-before-change nil t)
@ -897,14 +894,7 @@ defaults to 0."
(add-hook 'kill-buffer-query-functions (lambda () (utop-save-history) t) nil t) (add-hook 'kill-buffer-query-functions (lambda () (utop-save-history) t) nil t)
;; Start utop ;; Start utop
(utop-start arguments) (utop-start (utop-arguments)))
;; Call hooks
(run-mode-hooks 'utop-mode-hook)
;; Add the menu
(easy-menu-add utop-menu))
;; +-----------------------------------------------------------------+ ;; +-----------------------------------------------------------------+
;; | Starting utop | ;; | Starting utop |
;; +-----------------------------------------------------------------+ ;; +-----------------------------------------------------------------+
@ -936,13 +926,13 @@ Special keys for utop:
(t (t
;; The buffer does not exist, read the command line before ;; The buffer does not exist, read the command line before
;; creating it so if the user quit it won't be created ;; creating it so if the user quit it won't be created
(let ((arguments (utop-get-arguments))) (utop-query-arguments)
;; Create the buffer ;; Create the buffer
(setq buf (get-buffer-create utop-buffer-name)) (setq buf (get-buffer-create utop-buffer-name))
;; Jump to the buffer ;; Jump to the buffer
(pop-to-buffer buf) (pop-to-buffer buf)
;; Put it in utop mode ;; Put it in utop mode
(with-current-buffer buf (utop-mode arguments))))) (with-current-buffer buf (utop-mode))))
buf)) buf))
(provide 'utop) (provide 'utop)