/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.76 by lgorrie, Sun Dec 7 23:42:40 2003 UTC revision 1.77 by heller, Wed Dec 10 13:24:27 2003 UTC
# Line 50  Line 50 
50    
51  ;;;; Setup and Hooks  ;;;; Setup and Hooks
52    
53  (defun start-server (port-file-namestring)  (defun announce-server-port (file)
54    "Create a SWANK server and write its port number to the file    (lambda (port)
55  PORT-FILE-NAMESTRING in ascii text."      (with-open-file (s file
   (let ((port (create-swank-server 0 :reuse-address t)))  
     (with-open-file (s port-file-namestring  
56                         :direction :output                         :direction :output
57                         :if-exists :overwrite                         :if-exists :overwrite
58                         :if-does-not-exist :create)                         :if-does-not-exist :create)
59        (format s "~S~%" port)))        (format s "~S~%" port))
60        (when *swank-debug-p*
61          (format *debug-io* "~&;; Swank ready.~%"))))
62    
63    (defun simple-announce-function (port)
64    (when *swank-debug-p*    (when *swank-debug-p*
65      (format *debug-io* "~&;; Swank ready.~%")))      (format *debug-io* "~&;; Swank started at port: ~A.~%" port)))
66    
67    (defun start-server (port-file-namestring)
68      "Create a SWANK server and write its port number to the file
69    PORT-FILE-NAMESTRING in ascii text."
70      (create-swank-server
71       0 :reuse-address t
72       :announce (announce-server-port port-file-namestring)))
73    
74    
75  ;;;; IO to Emacs  ;;;; IO to Emacs
# Line 703  that symbols accessible in the current p Line 712  that symbols accessible in the current p
712      (cond (foundp (print-description-to-string symbol))      (cond (foundp (print-description-to-string symbol))
713            (t (format nil "Unkown symbol: ~S [in ~A]"            (t (format nil "Unkown symbol: ~S [in ~A]"
714                       symbol-name *buffer-package*)))))                       symbol-name *buffer-package*)))))
   
715    
716  (defslimefun describe-function (symbol-name)  (defslimefun describe-function (symbol-name)
717    (print-description-to-string    (print-description-to-string
# Line 747  that symbols accessible in the current p Line 755  that symbols accessible in the current p
755  (defstruct (:position (:type list) :named (:constructor)) pos)  (defstruct (:position (:type list) :named (:constructor)) pos)
756    
757  (defun alistify (list key test)  (defun alistify (list key test)
758    "Partition the element of LIST into an alist.  KEY extracts the key    "Partition the elements of LIST into an alist.  KEY extracts the key
759  from an element and TEST is used to compare keys."  from an element and TEST is used to compare keys."
760    (let ((alist '()))    (let ((alist '()))
761      (dolist (e list)      (dolist (e list)
# Line 757  from an element and TEST is used to comp Line 765  from an element and TEST is used to comp
765              (push e (cdr probe))              (push e (cdr probe))
766              (push (cons k (list e)) alist))))              (push (cons k (list e)) alist))))
767      alist))      alist))
768    
769  (defun location-position< (pos1 pos2)  (defun location-position< (pos1 pos2)
770    (cond ((and (position-p pos1) (position-p pos2))    (cond ((and (position-p pos1) (position-p pos2))
771           (< (position-pos pos1)           (< (position-pos pos1)
# Line 769  from an element and TEST is used to comp Line 777  from an element and TEST is used to comp
777          if (funcall predicate e) collect e into yes          if (funcall predicate e) collect e into yes
778          else collect e into no          else collect e into no
779          finally (return (values yes no))))          finally (return (values yes no))))
780    
781  (defun group-xrefs (xrefs)  (defun group-xrefs (xrefs)
782    (flet ((xref-buffer (xref) (location-buffer (cdr xref)))    (flet ((xref-buffer (xref) (location-buffer (cdr xref)))
783           (xref-position (xref) (location-position (cdr xref))))           (xref-position (xref) (location-position (cdr xref))))

Legend:
Removed from v.1.76  
changed lines
  Added in v.1.77

  ViewVC Help
Powered by ViewVC 1.1.5