misc/fuel/fuel-listener.el

   1 ;;; fuel-listener.el --- starting the fuel listener
   2
   3 ;; Copyright (C) 2008, 2009  Jose Antonio Ortega Ruiz
   4 ;; See http://factorcode.org/license.txt for BSD license.
   5
   6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   7 ;; Keywords: languages
   8
   9 ;;; Commentary:
  10
  11 ;; Utilities to maintain and switch to a factor listener comint
  12 ;; buffer, with an accompanying major fuel-listener-mode.
  13
  14 ;;; Code:
  15
  16 (require 'fuel-stack)
  17 (require 'fuel-completion)
  18 (require 'fuel-xref)
  19 (require 'fuel-eval)
  20 (require 'fuel-connection)
  21 (require 'fuel-syntax)
  22 (require 'fuel-base)
  23
  24 (require 'comint)
  25
  26 \f
  27 ;;; Customization:
  28
  29 (defgroup fuel-listener nil
  30   "Interacting with a Factor listener inside Emacs."
  31   :group 'fuel)
  32
  33 (defcustom fuel-listener-factor-binary
  34   (expand-file-name (cond ((eq system-type 'windows-nt)
  35                            "factor.com")
  36                           ((eq system-type 'darwin)
  37                            "Factor.app/Contents/MacOS/factor")
  38                           (t "factor"))
  39                     fuel-factor-root-dir)
  40   "Full path to the factor executable to use when starting a listener."
  41   :type '(file :must-match t)
  42   :group 'fuel-listener)
  43
  44 (defcustom fuel-listener-factor-image
  45   (expand-file-name "factor.image" fuel-factor-root-dir)
  46   "Full path to the factor image to use when starting a listener."
  47   :type '(file :must-match t)
  48   :group 'fuel-listener)
  49
  50 (defcustom fuel-listener-use-other-window t
  51   "Use a window other than the current buffer's when switching to
  52 the factor-listener buffer."
  53   :type 'boolean
  54   :group 'fuel-listener)
  55
  56 (defcustom fuel-listener-window-allow-split t
  57   "Allow window splitting when switching to the fuel listener
  58 buffer."
  59   :type 'boolean
  60   :group 'fuel-listener)
  61
  62 (defcustom fuel-listener-history-filename (expand-file-name "~/.fuel_history")
  63   "File where listener input history is saved, so that it persists between sessions."
  64   :type 'filename
  65   :group 'fuel-listener)
  66
  67 (defcustom fuel-listener-history-size comint-input-ring-size
  68   "Maximum size of the saved listener input history."
  69   :type 'integer
  70   :group 'fuel-listener)
  71
  72 \f
  73 ;;; Listener history:
  74
  75 (defun fuel-listener--sentinel (proc event)
  76   (when (string= event "finished\n")
  77     (with-current-buffer (process-buffer proc)
  78       (let ((comint-input-ring-file-name fuel-listener-history-filename))
  79         (comint-write-input-ring)
  80         (when (buffer-name (current-buffer))
  81           (insert "\nBye bye. It's been nice listening to you!\n")
  82           (insert "Press C-cz to bring me back.\n" ))))))
  83
  84 (defun fuel-listener--history-setup ()
  85   (set (make-local-variable 'comint-input-ring-file-name) fuel-listener-history-filename)
  86   (set (make-local-variable 'comint-input-ring-size) fuel-listener-history-size)
  87   (add-hook 'kill-buffer-hook 'comint-write-input-ring nil t)
  88   (comint-read-input-ring t)
  89   (set-process-sentinel (get-buffer-process (current-buffer)) 'fuel-listener--sentinel))
  90
  91 \f
  92 ;;; Fuel listener buffer/process:
  93
  94 (defvar fuel-listener--buffer nil
  95   "The buffer in which the Factor listener is running.")
  96
  97 (defun fuel-listener--buffer ()
  98   (if (buffer-live-p fuel-listener--buffer)
  99       fuel-listener--buffer
 100     (with-current-buffer (get-buffer-create "*fuel listener*")
 101       (fuel-listener-mode)
 102       (setq fuel-listener--buffer (current-buffer)))))
 103
 104 (defun fuel-listener--start-process ()
 105   (let ((factor (expand-file-name fuel-listener-factor-binary))
 106         (image (expand-file-name fuel-listener-factor-image))
 107         (comint-redirect-perform-sanity-check nil))
 108     (unless (file-executable-p factor)
 109       (error "Could not run factor: %s is not executable" factor))
 110     (unless (file-readable-p image)
 111       (error "Could not run factor: image file %s not readable" image))
 112     (message "Starting FUEL listener (this may take a while) ...")
 113     (pop-to-buffer (fuel-listener--buffer))
 114     (make-comint-in-buffer "fuel listener" (current-buffer) factor nil
 115                            "-run=listener" (format "-i=%s" image))
 116     (fuel-listener--wait-for-prompt 60000)
 117     (fuel-listener--history-setup)
 118     (fuel-con--setup-connection (current-buffer))))
 119
 120 (defun fuel-listener--connect-process (port)
 121   (message "Connecting to remote listener ...")
 122   (pop-to-buffer (fuel-listener--buffer))
 123   (let ((process (get-buffer-process (current-buffer))))
 124     (when (or (not process)
 125               (y-or-n-p "Kill current listener? "))
 126       (make-comint-in-buffer "fuel listener" (current-buffer)
 127                              (cons "localhost" port))
 128       (fuel-listener--wait-for-prompt 10000)
 129       (fuel-con--setup-connection (current-buffer)))))
 130
 131 (defun fuel-listener--process (&optional start)
 132   (or (and (buffer-live-p (fuel-listener--buffer))
 133            (get-buffer-process (fuel-listener--buffer)))
 134       (if (not start)
 135           (error "No running factor listener (try M-x run-factor)")
 136         (fuel-listener--start-process)
 137         (fuel-listener--process))))
 138
 139 (setq fuel-eval--default-proc-function 'fuel-listener--process)
 140
 141 (defun fuel-listener--wait-for-prompt (timeout)
 142   (let ((p (point)) (seen))
 143     (while (and (not seen) (> timeout 0))
 144       (sleep-for 0.1)
 145       (setq timeout (- timeout 100))
 146       (goto-char p)
 147       (setq seen (re-search-forward comint-prompt-regexp nil t)))
 148     (goto-char (point-max))
 149     (unless seen (error "No prompt found!"))))
 150
 151
 152 \f
 153 ;;; Interface: starting and interacting with fuel listener:
 154
 155 (defalias 'switch-to-factor 'run-factor)
 156 (defalias 'switch-to-fuel-listener 'run-factor)
 157 ;;;###autoload
 158 (defun run-factor (&optional arg)
 159   "Show the fuel-listener buffer, starting the process if needed."
 160   (interactive)
 161   (let ((buf (process-buffer (fuel-listener--process t)))
 162         (pop-up-windows fuel-listener-window-allow-split))
 163     (if fuel-listener-use-other-window
 164         (pop-to-buffer buf)
 165       (switch-to-buffer buf))))
 166
 167 (defun connect-to-factor (&optional arg)
 168   "Connects to a remote listener running in the same host.
 169 Without prefix argument, the default port, 9000, is used.
 170 Otherwise, you'll be prompted for it. To make this work, in the
 171 remote listener you need to issue the words
 172 'fuel-start-remote-listener*' or 'port
 173 fuel-start-remote-listener', from the fuel vocabulary."
 174   (interactive "P")
 175   (let ((port (if (not arg) 9000 (read-number "Port: "))))
 176     (fuel-listener--connect-process port)))
 177
 178 (defun fuel-listener-nuke ()
 179   "Try this command if the listener becomes unresponsive."
 180   (interactive)
 181   (goto-char (point-max))
 182   (comint-kill-region comint-last-input-start (point))
 183   (comint-redirect-cleanup)
 184   (fuel-con--setup-connection fuel-listener--buffer))
 185
 186 (defun fuel-refresh-all ()
 187   "Switch to the listener buffer and invokes Factor's refresh-all.
 188 With prefix, you're teletransported to the listener's buffer."
 189   (interactive)
 190   (let ((buf (process-buffer (fuel-listener--process))))
 191     (pop-to-buffer buf)
 192     (comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
 193     (comint-send-string nil " refresh-all \"Done!\" write nl flush\n")))
 194
 195 \f
 196 ;;; Completion support
 197
 198 (defsubst fuel-listener--current-vocab () nil)
 199 (defsubst fuel-listener--usings () nil)
 200
 201 (defun fuel-listener--setup-completion ()
 202   (setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
 203   (setq fuel-syntax--usings-function 'fuel-listener--usings))
 204
 205 \f
 206 ;;; Stack mode support
 207
 208 (defun fuel-listener--stack-region ()
 209   (fuel--region-to-string (if (zerop (fuel-syntax--brackets-depth))
 210                               (comint-line-beginning-position)
 211                             (1+ (fuel-syntax--brackets-start)))))
 212
 213 (defun fuel-listener--setup-stack-mode ()
 214   (setq fuel-stack--region-function 'fuel-listener--stack-region))
 215
 216 \f
 217 ;;; Fuel listener mode:
 218
 219 (defun fuel-listener--bol ()
 220   (interactive)
 221   (when (= (point) (comint-bol)) (beginning-of-line)))
 222
 223 ;;;###autoload
 224 (define-derived-mode fuel-listener-mode comint-mode "Fuel Listener"
 225   "Major mode for interacting with an inferior Factor listener process.
 226 \\{fuel-listener-mode-map}"
 227   (set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex)
 228   (set (make-local-variable 'comint-use-prompt-regexp) t)
 229   (set (make-local-variable 'comint-prompt-read-only) t)
 230   (fuel-listener--setup-completion)
 231   (fuel-listener--setup-stack-mode))
 232
 233 (define-key fuel-listener-mode-map "\C-cz" 'run-factor)
 234 (define-key fuel-listener-mode-map "\C-c\C-z" 'run-factor)
 235 (define-key fuel-listener-mode-map "\C-a" 'fuel-listener--bol)
 236 (define-key fuel-listener-mode-map "\C-ca" 'fuel-autodoc-mode)
 237 (define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
 238 (define-key fuel-listener-mode-map "\C-cr" 'fuel-refresh-all)
 239 (define-key fuel-listener-mode-map "\C-cs" 'fuel-stack-mode)
 240 (define-key fuel-listener-mode-map "\C-cp" 'fuel-apropos)
 241 (define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
 242 (define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary)
 243 (define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary)
 244 (define-key fuel-listener-mode-map "\C-ck" 'fuel-run-file)
 245 (define-key fuel-listener-mode-map (kbd "TAB") 'fuel-completion--complete-symbol)
 246
 247 \f
 248 (provide 'fuel-listener)
 249 ;;; fuel-listener.el ends here