cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-mod.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-mod.el --
   4 ;;; ILISP mode top level definitions.
   5 ;;;
   6 ;;; This file is part of ILISP.
   7 ;;; Please refer to the file COPYING for copyrights and licensing
   8 ;;; information.
   9 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
  10 ;;; of present and past contributors.
  11 ;;;
  12 ;;; $Id: ilisp-mod.el,v 1.3 2001-07-02 09:40:47 youngs Exp $
  13
  14 ;;;%ilisp-mode
  15
  16 (defun ilisp-byte-code-to-list (function)
  17   "Returns a list suitable for passing to make-byte-code from FUNCTION."
  18   (let ((function-object
  19          (if (symbolp function)
  20              (symbol-function function)
  21            function)))
  22     (if (fboundp 'compiled-function-arglist)
  23         ;; XEmacs
  24         (read (concat "("
  25                       (substring (let ((print-readably t))
  26                                    (prin1-to-string function-object))
  27                                  2 -1)
  28                       ")"))
  29       ;; FSFmacs
  30       (append function-object nil))))
  31
  32 ;;;
  33 (defun ilisp-set-doc (function string)
  34   "Set the documentation of the symbol FUNCTION to STRING."
  35   (let* ((old-function (symbol-function function)))
  36     (cond ((listp old-function)
  37            ;; Probe to test whether function is in preloaded read-only
  38            ;; memory, and if so make writable copy:
  39            (condition-case nil
  40                (setcar old-function (car old-function))
  41              (error
  42               (setq old-function (copy-sequence old-function)) ; shallow copy only
  43               (fset function old-function)))
  44            (let ((ndoc-cdr (nthcdr 2 old-function)))
  45              (if (stringp (car ndoc-cdr))
  46                  ;; Replace the existing docstring.
  47                  (setcar ndoc-cdr string)
  48                ;; There is no docstring.  Insert the overwrite msg.
  49                (setcdr ndoc-cdr (cons (car ndoc-cdr) (cdr ndoc-cdr)))
  50                (setcar ndoc-cdr string))))
  51           (t
  52            ;; it's an emacs19 compiled-code object
  53            (let ((new-code (ilisp-byte-code-to-list old-function)))
  54              (if (nthcdr 4 new-code)
  55                  (setcar (nthcdr 4 new-code) string)
  56                (setcdr (nthcdr 3 new-code) (cons string nil)))
  57              (fset function (apply 'make-byte-code new-code)))))))
  58
  59
  60
  61 ;;;
  62 (defun ilisp-mode ()
  63   (interactive)
  64   (run-ilisp))
  65
  66 (ilisp-set-doc 'ilisp-mode ilisp-documentation)
  67 (ilisp-set-doc 'lisp-mode ilisp-documentation)
  68
  69 ;;;%%ILISP
  70 (defun lisp-command-args (command-line)
  71   "Break up COMMAND-LINE into (command args ...)"
  72   (condition-case nil
  73       (loop with start = 0
  74             while start
  75             for pos = (string-match "\\S-" command-line start)
  76             while pos
  77             if (char-equal (aref command-line pos) ?\")
  78             collect (let ((str+end-pos (read-from-string command-line pos)))
  79                       (setq start (cdr str+end-pos))
  80                       (car str+end-pos))
  81             else collect (let ((end-pos (string-match "\\s-" command-line pos)))
  82                            (setq start end-pos)
  83                            (substring command-line pos end-pos)))
  84     (error (error "Invalid inferior Lisp program command line"))))
  85
  86
  87 ;;;
  88 (defun ilisp (name setup)
  89   "Run an inferior LISP process NAME, input and output via buffer *name*.
  90 If there is a process already running in *name*, just switch to that buffer.
  91 Takes the program name from the variable ilisp-program.
  92 \(Type \\[describe-mode] in the process buffer for a list of commands.)"
  93   (set-buffer ilisp-buffer)
  94   (if (not (comint-check-proc ilisp-buffer))
  95       (let* ((dialect (car ilisp-dialect))
  96              (program ilisp-program)
  97              (args (lisp-command-args program))
  98              ;; Use pipes so that strings can be long
  99              (process-connection-type nil)
 100              (names (format "%s" name))
 101              start)
 102         (apply 'make-comint name (car args) nil (cdr args))
 103         (comint-setup-ipc)
 104         ;; Because comint-mode kills all buffer-local variables in
 105         ;; fsf-19 we have to re-call the setup here.
 106         (funcall setup name)
 107         (setq major-mode 'ilisp-mode
 108               mode-name "ILISP")
 109         (rplaca (car comint-send-queue)
 110                 (function (lambda ()
 111                             (run-hooks 'ilisp-init-hook-local))))
 112         (setq ilisp-initialized (delete* ilisp-buffer ilisp-initialized
 113                                          :test #'equal))
 114         (unless (member* names ilisp-buffers :key #'car)
 115           (setq ilisp-buffers (cons (list names) ilisp-buffers)))
 116         (lisp-pop-to-buffer ilisp-buffer)
 117         (setq start (window-start (selected-window))
 118               ilisp-program program)
 119         (goto-char (point-max))
 120         (insert (format "Starting %s ...\n" ilisp-program))
 121         (set-marker (process-mark (ilisp-process)) (point))
 122         (funcall comint-update-status 'start)
 123
 124         (when ilisp-motd
 125           (lisp-display-output (format ilisp-motd ilisp-*version*))
 126           (sleep-for 3)
 127           (set-window-start (selected-window) start))
 128
 129         (unless ilisp-*prefix-match* (require 'completer)))
 130
 131       (lisp-pop-to-buffer ilisp-buffer))
 132   (use-local-map ilisp-use-map)
 133   ;; This is necessary to get mode documentation to come out right
 134   (set-default 'ilisp-use-map ilisp-use-map))
 135
 136
 137 ;;;%Manual
 138 (autoload 'fi:clman         "fi/clman"
 139           "Look up SYMBOL in the online manual with completion." t)
 140 (autoload 'fi:clman-apropos "fi/clman"
 141           "Do an apropos search in online manual for STRING." t)
 142
 143 ;;;%Bridges
 144 (autoload 'install-bridge "bridge" "Install process bridge." t)
 145
 146 ;;;%Modes
 147 (set-default 'auto-mode-alist
 148              (append '(("\\.cl$" . lisp-mode) ("\\.lisp$" . lisp-mode))
 149                      auto-mode-alist))
 150 (setq completion-ignored-extensions
 151       (append '(".68fasl" ".sfasl" ".ifasl" ".pfasl"
 152                 ".68fasl4" ".sfasl4" ".ifasl4" ".pfasl4"
 153                 ".sbin")
 154               completion-ignored-extensions))