misc/fuel/fuel-listener.el

   1 ;;; fuel-listener.el --- starting the fuel listener
   2
   3 ;; Copyright (C) 2008, 2009, 2010  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-eval)
  19 (require 'fuel-connection)
  20 (require 'fuel-menu)
  21 (require 'fuel-base)
  22
  23 (require 'comint)
  24
  25 \f
  26 ;;; Customization:
  27
  28 ;;;###autoload
  29 (defgroup fuel-listener nil
  30   "Interacting with a Factor listener inside Emacs."
  31   :group 'fuel)
  32
  33 (defcustom fuel-factor-root-dir nil
  34   "Full path to the factor root directory when starting a listener."
  35   :type 'directory
  36   :group 'fuel-listener)
  37
  38 ;;; Is factor.com still valid on Windows...?
  39 (defcustom fuel-listener-factor-binary nil
  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 nil
  45   "Full path to the factor image to use when starting a listener."
  46   :type '(file :must-match t)
  47   :group 'fuel-listener)
  48
  49 (defcustom fuel-listener-use-other-window t
  50   "Use a window other than the current buffer's when switching to
  51 the factor-listener buffer."
  52   :type 'boolean
  53   :group 'fuel-listener)
  54
  55 (defcustom fuel-listener-window-allow-split t
  56   "Allow window splitting when switching to the fuel listener
  57 buffer."
  58   :type 'boolean
  59   :group 'fuel-listener)
  60
  61 (defcustom fuel-listener-history-filename
  62   (expand-file-name "~/.fuel_history.eld")
  63   "File where listener input history is saved, so that it persists between
  64 sessions."
  65   :type 'filename
  66   :group 'fuel-listener)
  67
  68 (defcustom fuel-listener-history-size comint-input-ring-size
  69   "Maximum size of the saved listener input history."
  70   :type 'integer
  71   :group 'fuel-listener)
  72
  73 (defcustom fuel-listener-prompt-read-only-p t
  74   "Whether listener's prompt should be read-only."
  75   :type 'boolean
  76   :group 'fuel-listener)
  77
  78 \f
  79 ;;; Factor paths:
  80
  81 (defun fuel-listener-factor-binary ()
  82   "Full path to the factor executable to use when starting a listener."
  83   (or fuel-listener-factor-binary
  84       (expand-file-name (cond ((eq system-type 'windows-nt)
  85                                "factor.com")
  86                               ((eq system-type 'darwin)
  87                                "Factor.app/Contents/MacOS/factor")
  88                               (t "factor"))
  89                         fuel-factor-root-dir)))
  90
  91 (defun fuel-listener-factor-image ()
  92   "Full path to the factor image to use when starting a listener."
  93   (or fuel-listener-factor-image
  94       (expand-file-name "factor.image" fuel-factor-root-dir)))
  95
  96 \f
  97 ;;; Listener history:
  98
  99 (defun fuel-listener--sentinel (proc event)
 100   (when (string= event "finished\n")
 101     (with-current-buffer (process-buffer proc)
 102       (let ((comint-input-ring-file-name fuel-listener-history-filename))
 103         (comint-write-input-ring)
 104         (when (buffer-name (current-buffer))
 105           (insert "\nBye bye. It's been nice listening to you!\n")
 106           (insert "Press C-c C-z to bring me back.\n" ))))))
 107
 108 (defun fuel-listener--history-setup ()
 109   (setq-local comint-input-ring-file-name fuel-listener-history-filename)
 110   (setq-local comint-input-ring-size fuel-listener-history-size)
 111   (add-hook 'kill-buffer-hook 'comint-write-input-ring nil t)
 112   (comint-read-input-ring t)
 113   (set-process-sentinel (get-buffer-process (current-buffer))
 114                         'fuel-listener--sentinel))
 115
 116 \f
 117 ;;; Fuel listener buffer/process:
 118
 119 (defvar fuel-listener--buffer nil
 120   "The buffer in which the Factor listener is running.")
 121
 122 (defun fuel-listener--buffer ()
 123   (if (buffer-live-p fuel-listener--buffer)
 124       fuel-listener--buffer
 125     (with-current-buffer (get-buffer-create "*fuel listener*")
 126       (fuel-listener-mode)
 127       (setq fuel-listener--buffer (current-buffer)))))
 128
 129 (defun fuel-listener--start-process ()
 130   (let ((factor (expand-file-name (fuel-listener-factor-binary)))
 131         (image (expand-file-name (fuel-listener-factor-image)))
 132         (comint-redirect-perform-sanity-check nil))
 133     (unless (file-executable-p factor)
 134       (error "Could not run factor: %s is not executable" factor))
 135     (unless (file-readable-p image)
 136       (error "Could not run factor: image file %s not readable" image))
 137     (message "Starting FUEL listener (this may take a while) ...")
 138     (pop-to-buffer (fuel-listener--buffer))
 139     (make-comint-in-buffer "fuel listener" (current-buffer) factor nil
 140                            "-run=fuel.listener" (format "-i=%s" image))
 141     (fuel-listener--wait-for-prompt 60000)
 142     (fuel-listener--history-setup)
 143     (fuel-con--setup-connection (current-buffer))))
 144
 145 ;;; TODO Add the ability to debug to non-localhost
 146 (defun fuel-listener--connect-process (port)
 147   (message "Connecting to remote listener ...")
 148   (pop-to-buffer (fuel-listener--buffer))
 149   (let ((process (get-buffer-process (current-buffer))))
 150     (when (or (not process)
 151               (y-or-n-p "Kill current listener? "))
 152       (make-comint-in-buffer "fuel listener" (current-buffer)
 153                              (cons "localhost" port))
 154       (fuel-listener--wait-for-prompt 10000)
 155       (fuel-con--setup-connection (current-buffer)))))
 156
 157 (defun fuel-listener--process (&optional start)
 158   (or (and (buffer-live-p (fuel-listener--buffer))
 159            (get-buffer-process (fuel-listener--buffer)))
 160       (if (not start)
 161           (error "No running factor listener (try M-x run-factor)")
 162         (fuel-listener--start-process)
 163         (fuel-listener--process))))
 164
 165 (setq fuel-eval--default-proc-function 'fuel-listener--process)
 166
 167 (defun fuel-listener--wait-for-prompt (timeout)
 168   (let ((p (point)) (seen))
 169     (while (and (not seen) (> timeout 0))
 170       (sleep-for 0.1)
 171       (setq timeout (- timeout 100))
 172       (goto-char p)
 173       (setq seen (re-search-forward comint-prompt-regexp nil t)))
 174     (goto-char (point-max))
 175     (unless seen (error "No prompt found!"))))
 176
 177 \f
 178 ;;; Interface: starting and interacting with fuel listener:
 179
 180 ;;;###autoload
 181 (defun run-factor (&optional arg)
 182   "Show the fuel-listener buffer, starting the process if needed."
 183   (interactive)
 184   (let ((buf (process-buffer (fuel-listener--process t)))
 185         (pop-up-windows fuel-listener-window-allow-split))
 186     (if fuel-listener-use-other-window
 187         (pop-to-buffer buf)
 188       (switch-to-buffer buf))
 189     (add-hook 'factor-mode-hook 'fuel-mode)))
 190
 191 ;;;###autoload
 192 (defun connect-to-factor (&optional arg)
 193   "Connects to a remote listener running in the same host.
 194 Without prefix argument, the default port, 9000, is used.
 195 Otherwise, you'll be prompted for it. To make this work, in the
 196 remote listener you need to issue the words
 197 'fuel-start-remote-listener*' or 'port
 198 fuel-start-remote-listener', from the fuel vocabulary."
 199   (interactive "P")
 200   (let ((port (if (not arg) 9000 (read-number "Port: "))))
 201     (fuel-listener--connect-process port)
 202     (add-hook 'factor-mode-hook 'fuel-mode)))
 203
 204 (defun fuel-listener-nuke ()
 205   "Try this command if the listener becomes unresponsive."
 206   (interactive)
 207   (goto-char (point-max))
 208   (comint-kill-region comint-last-input-start (point))
 209   (comint-redirect-cleanup)
 210   (fuel-con--setup-connection fuel-listener--buffer))
 211
 212 (defun fuel-refresh-all (&optional arg)
 213   "Switch to the listener buffer and invokes Factor's refresh-all.
 214 With prefix, you're teletransported to the listener's buffer."
 215   (interactive "P")
 216   (let ((buf (process-buffer (fuel-listener--process))))
 217     (with-current-buffer buf
 218       (comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
 219       (comint-send-string nil " refresh-all \"Done!\" write nl flush\n"))
 220     (when arg (pop-to-buffer buf))))
 221
 222 (defun fuel-test-vocab (&optional arg)
 223   "Run the unit tests for the current vocabulary. With prefix argument, ask for
 224 the vocabulary name."
 225   (interactive "P")
 226   (let* ((vocab (or (and (not arg) (factor-current-vocab))
 227                     (fuel-completion--read-vocab nil))))
 228     (comint-send-string (fuel-listener--process)
 229                         (concat "\"" vocab "\" reload nl flush\n"
 230                                 "\"" vocab "\" test nl flush\n"))))
 231
 232 \f
 233 ;;; Completion support:
 234
 235 (defsubst fuel-listener--current-vocab () nil)
 236 (defsubst fuel-listener--usings () nil)
 237
 238 (defun fuel-listener--setup-completion ()
 239   (setq factor-current-vocab-function 'fuel-listener--current-vocab)
 240   (setq factor-usings-function 'fuel-listener--usings))
 241
 242 \f
 243 ;;; Stack mode support:
 244
 245 (defun fuel-listener--stack-region ()
 246   (fuel-region-to-string
 247    (if (zerop (factor-brackets-depth))
 248        (comint-line-beginning-position)
 249      (1+ (factor-brackets-start)))))
 250
 251 (defun fuel-listener--setup-stack-mode ()
 252   (setq fuel-stack--region-function 'fuel-listener--stack-region))
 253
 254 \f
 255 ;;; Fuel listener mode:
 256
 257 (defun fuel-listener--bol ()
 258   (interactive)
 259   (when (= (point) (comint-bol)) (beginning-of-line)))
 260
 261 ;;;###autoload
 262 (define-derived-mode fuel-listener-mode comint-mode "Fuel Listener"
 263   "Major mode for interacting with an inferior Factor listener process.
 264 \\{fuel-listener-mode-map}"
 265   (setq-local comint-prompt-regexp fuel-con--prompt-regex)
 266   (setq-local comint-use-prompt-regexp nil)
 267   (setq-local comint-prompt-read-only fuel-listener-prompt-read-only-p)
 268   (fuel-listener--setup-completion)
 269   (fuel-listener--setup-stack-mode)
 270   (set-syntax-table (fuel-syntax-table)))
 271
 272 (define-key fuel-listener-mode-map "\C-a" 'fuel-listener--bol)
 273
 274 (fuel-menu--defmenu listener fuel-listener-mode-map
 275   ("Complete symbol" ((kbd "TAB") (kbd "M-TAB"))
 276    fuel-completion--complete-symbol :enable (symbol-at-point))
 277   ("Edit word or vocab at point" "\M-." fuel-edit-word-at-point)
 278   ("Edit vocabulary" "\C-c\C-v" fuel-edit-vocabulary)
 279   --
 280   ("Word help" "\C-c\C-w" fuel-help)
 281   ("Apropos" "\C-c\C-p" fuel-apropos)
 282   (mode "Autodoc mode" "\C-c\C-a" fuel-autodoc-mode)
 283   (mode "Show stack mode" "\C-c\C-s" fuel-stack-mode)
 284   --
 285   ("Run file" "\C-c\C-k" fuel-run-file)
 286   ("Refresh vocabs" "\C-c\C-r" fuel-refresh-all))
 287
 288 (define-key fuel-listener-mode-map [menu-bar completion] 'undefined)
 289
 290 \f
 291 (provide 'fuel-listener)
 292
 293 ;;; fuel-listener.el ends here