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