misc/fuel/fuel-listener.el

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