Changeset 2593

Show
Ignore:
Timestamp:
02/22/08 13:00:39 (11 months ago)
Author:
hans
Message:

update from cvs slime

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/thirdparty/slime/CVS/Entries

    r2475 r2593  
    1313/slime-autoloads.el/1.4/Thu Feb  7 08:07:30 2008// 
    1414/swank-gray.lisp/1.10/Thu Oct 11 14:10:25 2007// 
    15 /swank-loader.lisp/1.77/Thu Feb  7 08:07:31 2008// 
    1615/swank-source-file-cache.lisp/1.8/Thu Oct 11 14:10:25 2007// 
    1716/swank-source-path-parser.lisp/1.18/Thu Feb  7 07:59:36 2008// 
    18 /swank.asd/1.5/Thu Oct 11 14:10:25 2007// 
    1917/test-all.sh/1.2/Thu Oct 11 14:10:25 2007// 
    2018/test.sh/1.9/Thu Oct 11 14:10:25 2007// 
    2119/xref.lisp/1.2/Thu Oct 11 14:10:25 2007// 
    22 /ChangeLog/1.1289/Mon Feb 11 14:20:11 2008// 
    23 /slime.el/1.904/Mon Feb 11 14:20:11 2008// 
    2420/swank-abcl.lisp/1.47/Mon Feb 11 14:20:11 2008// 
    2521/swank-allegro.lisp/1.101/Mon Feb 11 14:20:11 2008// 
    …… 
    3329/swank-sbcl.lisp/1.191/Mon Feb 11 14:20:11 2008// 
    3430/swank-scl.lisp/1.18/Mon Feb 11 14:20:11 2008// 
    35 /swank.lisp/1.531/Mon Feb 11 14:20:11 2008// 
     31/ChangeLog/1.1294/Fri Feb 22 11:53:48 2008// 
     32/swank.lisp/1.534/Result of merge// 
     33/slime.el/1.907/Fri Feb 22 11:56:31 2008// 
     34/swank-loader.lisp/1.81/Fri Feb 22 11:56:31 2008// 
     35/swank.asd/1.6/Fri Feb 22 11:56:31 2008// 

  • trunk/thirdparty/slime/ChangeLog

    r2475 r2593  
     12008-02-21  Tobias C. Rittweiler  <tcr@freebits.de> 
     2 
     3        Fix regressions in the `find-definition' test case on SBCL: 
     4 
     5        M-. on e.g. SWANK::READ-FROM-EMACS would bring the user to 
     6 
     7          (|defun read-from-emacs ...) 
     8 
     9        and not 
     10 
     11          |(defun read-from-emacs ...) 
     12         
     13        * swank-sbcl.lisp (source-file-position): Don't 1+ the returned 
     14        position; i.e. return a position usable as a CL /file position/ 
     15        which start from 0, and not a position usable in Emacs where 
     16        buffer points start from 1. This is important because the return 
     17        value is passed to SWANK-BACKEND::READ-SNIPPET which invokes 
     18        CL:FILE-POSITION on it. 
     19        (make-definition-source-location): Adapted to 1+ the position 
     20        passed to Emacs, to reflect above change. 
     21         
     222008-02-20  Helmut Eller  <heller@common-lisp.net> 
     23 
     24        Better factorization for M-. and xref commands. 
     25 
     26        * slime.el (slime-xref): Renamed from slime-definition. 
     27        (slime-location, slime-location-p): New ADT def. 
     28        (slime-xref-has-location-p, slime-analyze-xrefs): New functions. 
     29        This work used to be done on the Lisp side. 
     30        (slime-pop-to-location): New function. 
     31        (slime-edit-definition, slime-edit-definition-cont): Simplified. 
     32        (slime-find-definitions): New function. 
     33        (slime-goto-definition, slime-goto-definition-other-window) 
     34        (slime-pop-to-other-window, slime-show-definitions): Deleted. 
     35        (slime-insert-xrefs): Simplified. 
     36        (slime-insert-xref-location): Deleted. No need to show the filename 
     37        twice. 
     38 
     39        * swank.lisp (find-definitions-for-emacs, xref): Use common 
     40        representation for "definitions" and "xrefs". 
     41        (xref>elisp): New helper. 
     42        (group-xrefs, alistify, parition, location-position<, xref-position) 
     43        (xref-buffer, location-valid-p): Deleted. This work is now done on 
     44        the Emacs side. 
     45 
     462008-02-20  Helmut Eller  <heller@common-lisp.net> 
     47 
     48        Emit a warning if the SWANK package already exists. 
     49 
     50        * swank-loader.lisp (init): Issue a warning when SWANK will not be 
     51        reloaded. 
     52 
     532008-02-18  Helmut Eller  <heller@common-lisp.net> 
     54 
     55        Minor cleanups for inspector code. 
     56 
     57        * swank.lisp (inspector-content, inspect-list-aux): Slight 
     58        cleanups. 
     59 
     602008-02-17  Marco Baringer  <mb@bese.it> 
     61 
     62        * swank.asd: Update for recent changes to swank-loader.lisp, we 
     63        need to call swank-loader::init after loading. 
     64 
     652008-02-16  Helmut Eller  <heller@common-lisp.net> 
     66 
     67        In the REPL, mark the trailing newline also as input. 
     68 
     69        * slime.el (slime-repl-send-input): Mark the newline with 
     70        the 'slime-repl-old-input property. 
     71        (slime-repl-grab-old-input): Strip the newline. 
     72 
     732008-02-16  Helmut Eller  <heller@common-lisp.net> 
     74 
     75        Split loading and initialization (again). 
     76 
     77        * swank-loader.lisp (init): New.  Delete old packages only if 
     78        explicitly requested.  Also, if the swank package already exists 
     79        don't load swank again. 
     80        (setup): New function. 
     81 
     82        * swank.lisp (setup): New function.  Moved over here from 
     83        swank-loader.lisp. 
     84 
     85        * slime.el (slime-init-command): Call swank-loader:init. 
     86 
    1872008-02-10  Helmut Eller  <heller@common-lisp.net> 
    288 
    …… 
    28762962        (slime-repl-next-input-starting-with-current-input): New functions, 
    28772963        work like the old slime-repl-previous-input / next-input. 
    2878         (slime-repl-matching-input-regexp): Restore old version.        
     2964        (slime-repl-matching-input-regexp): Restore old version. 
    28792965        (slime-repl-mode-map): Bind s-r-p-i-s-w-c-i and s-r-n-i-s-w-c-i 
    28802966        to M-p and M-n respectively. slime-repl-previous-input and 
    28812967        slime-repl-next-input are still accessible with C-up / C-down. 
    2882          
     2968 
    288329692006-11-25  Helmut Eller  <heller@common-lisp.net> 
    28842970 
    28852971        * slime.el (slime-repl-read-break): Use a :emacs-interrupt message 
    2886         instead of a RPC to swank:simple-break.  Suggested by Taylor R 
     2972        instead of a RPC to swank:simple-break.  Suggested by Taylor R. 
    28872973        Campbell. 
    28882974 
    …… 
    34293515        time zones. 
    34303516 
    3431 2006-09-13  Taylor R Campbell <campbell@mumble.net> 
     35172006-09-13  Taylor R. Campbell <campbell@mumble.net> 
    34323518 
    34333519        * slime.el (slime-init-output-buffer): Initial directory and 
    …… 
    36143700 
    36153701        * slime.el (slime-thread-quit): Call swank:quit-thread-browser. 
    3616         Reported by Taylor R Campbell. 
     3702        Reported by Taylor R. Campbell. 
    36173703 
    361837042006-07-28  Willem Broekema <metawilm@gmail.com> 
    …… 
    49715057        * slime.el (slime48): New command. 
    49725058 
    4973 2005-09-19 Taylor Campbell <campbell@mumble.net> 
     50592005-09-19 Taylor R. Campbell <campbell@mumble.net> 
    49745060 
    49755061        * swank-scheme48/: New backend. 

  • trunk/thirdparty/slime/contrib/CVS/Entries

    r2486 r2593  
    1010/slime-parse.el/1.10/Thu Feb  7 07:59:35 2008// 
    1111/slime-presentation-streams.el/1.2/Thu Oct 11 14:10:25 2007// 
    12 /slime-presentations.el/1.12/Thu Feb  7 07:59:35 2008// 
    1312/slime-references.el/1.4/Thu Oct 11 14:10:25 2007// 
    1413/slime-scratch.el/1.4/Thu Oct 11 14:10:25 2007// 
    …… 
    2120/swank-listener-hooks.lisp/1.1/Thu Oct 11 14:10:25 2007// 
    2221/swank-presentation-streams.lisp/1.5/Thu Feb  7 08:07:32 2008// 
    23 /swank-presentations.lisp/1.4/Thu Oct 11 14:10:25 2007// 
    2422/slime-fancy-inspector.el/1.3/Mon Feb 11 14:20:11 2008// 
    2523/slime-fancy.el/1.5/Mon Feb 11 14:20:11 2008// 
    2624/swank-fancy-inspector.lisp/1.11/Mon Feb 11 14:20:11 2008// 
    27 /ChangeLog/1.91/Wed Feb 13 19:38:01 2008// 
    2825/slime-c-p-c.el/1.9/Wed Feb 13 19:38:01 2008// 
    29 /slime-indentation.el/1.1/Wed Feb 13 19:38:02 2008// 
    30 /slime-motd.el/1.1/Wed Feb 13 19:38:02 2008// 
    31 /slime-scheme.el/1.1/Wed Feb 13 19:38:02 2008// 
    3226/slime-xref-browser.el/1.2/Wed Feb 13 19:38:02 2008// 
    33 /swank-goo.goo/1.1/Wed Feb 13 19:38:03 2008// 
    34 /swank-indentation.lisp/1.1/Wed Feb 13 19:38:03 2008// 
    35 /swank-kawa.scm/1.1/Wed Feb 13 19:38:03 2008// 
    36 /swank-motd.lisp/1.1/Wed Feb 13 19:38:03 2008// 
     27/ChangeLog/1.94/Fri Feb 22 11:53:56 2008// 
     28/slime-indentation.el/1.1/Fri Feb 22 11:53:56 2008// 
     29/slime-motd.el/1.1/Fri Feb 22 11:53:56 2008// 
     30/slime-presentations.el/1.13/Fri Feb 22 11:53:57 2008// 
     31/slime-scheme.el/1.1/Fri Feb 22 11:53:57 2008// 
     32/swank-goo.goo/1.1/Fri Feb 22 11:53:57 2008// 
     33/swank-indentation.lisp/1.1/Fri Feb 22 11:53:57 2008// 
     34/swank-kawa.scm/1.2/Fri Feb 22 11:53:57 2008// 
     35/swank-motd.lisp/1.1/Fri Feb 22 11:53:57 2008// 
     36/swank-presentations.lisp/1.5/Fri Feb 22 11:53:57 2008// 
    3737D 

  • trunk/thirdparty/slime/contrib/ChangeLog

    r2486 r2593  
     12008-02-21  Tobias C. Rittweiler  <tcr@freebits.de> 
     2 
     3        Having the `slime-presentations' contrib enabled, (princ 10) 
     4        resulted in "1010" rather than "10\n10". (This also caused a 
     5        regression in the `repl-test' test case.) 
     6         
     7        * swank-presentations.lisp (present-repl-results): Emit fresh-line 
     8        as the original SEND-REPL-RESULTS-TO-EMACS does. 
     9 
     102008-02-18  Helmut Eller  <heller@common-lisp.net> 
     11 
     12        Update Kawa backend to the changed inspector protocol. 
     13 
     14        * swank-kawa.scm (inspect-object): Return a list (content len 
     15        start end). 
     16        (<inspector-state>): New field: content. 
     17        (content-range, subseq): New functions. 
     18 
     192008-02-15  Matthias Koeppe  <mkoeppe@mail.math.uni-magdeburg.de> 
     20 
     21        * slime-presentations.el (slime-previous-presentation) 
     22        (slime-next-presentation): Accept a standard prefix argument. 
     23 
    1242008-02-13  Helmut Eller  <heller@common-lisp.net> 
    225 

  • trunk/thirdparty/slime/contrib/slime-presentations.el

    r2410 r2593  
    480480    (push-mark end nil t))) 
    481481 
    482 (defun slime-previous-presentation () 
    483   "Move point to the beginning of the first presentation before point." 
    484   (interactive) 
    485   ;; First skip outside the current surrounding presentation (if any) 
    486   (multiple-value-bind (presentation start end)  
    487       (slime-presentation-around-point (point)) 
    488     (when presentation 
    489       (goto-char start))) 
    490   (let ((p (previous-single-property-change (point) 'slime-repl-presentation))) 
    491     (unless p  
    492       (error "No previous presentation")) 
    493     (multiple-value-bind (presentation start end)  
    494         (slime-presentation-around-or-before-point-or-error p) 
    495       (goto-char start)))) 
    496  
    497 (defun slime-next-presentation () 
    498   "Move point to the beginning of the next presentation after point." 
    499   (interactive) 
    500   ;; First skip outside the current surrounding presentation (if any) 
    501   (multiple-value-bind (presentation start end)  
    502       (slime-presentation-around-point (point)) 
    503     (when presentation 
    504       (goto-char end))) 
    505   (let ((p (next-single-property-change (point) 'slime-repl-presentation))) 
    506     (unless p  
    507       (error "No next presentation")) 
    508     (multiple-value-bind (presentation start end)  
    509         (slime-presentation-around-or-before-point-or-error p) 
    510       (goto-char start)))) 
     482(defun slime-previous-presentation (&optional arg) 
     483  "Move point to the beginning of the first presentation before point. 
     484With ARG, do this that many times. 
     485A negative argument means move forward instead." 
     486  (interactive "p") 
     487  (unless arg (setq arg 1)) 
     488  (slime-next-presentation (- arg))) 
     489 
     490(defun slime-next-presentation (&optional arg) 
     491  "Move point to the beginning of the next presentation after point. 
     492With ARG, do this that many times. 
     493A negative argument means move backward instead." 
     494  (interactive "p") 
     495  (unless arg (setq arg 1)) 
     496  (cond 
     497   ((plusp arg) 
     498    (dotimes (i arg) 
     499      ;; First skip outside the current surrounding presentation (if any) 
     500      (multiple-value-bind (presentation start end)  
     501          (slime-presentation-around-point (point)) 
     502        (when presentation 
     503          (goto-char end))) 
     504      (let ((p (next-single-property-change (point) 'slime-repl-presentation))) 
     505        (unless p  
     506          (error "No next presentation")) 
     507        (multiple-value-bind (presentation start end)  
     508            (slime-presentation-around-or-before-point-or-error p) 
     509          (goto-char start))))) 
     510   ((minusp arg) 
     511    (dotimes (i (- arg)) 
     512      ;; First skip outside the current surrounding presentation (if any) 
     513      (multiple-value-bind (presentation start end) 
     514          (slime-presentation-around-point (point)) 
     515        (when presentation 
     516          (goto-char start))) 
     517      (let ((p (previous-single-property-change (point) 'slime-repl-presentation))) 
     518        (unless p  
     519          (error "No previous presentation")) 
     520        (multiple-value-bind (presentation start end)  
     521            (slime-presentation-around-or-before-point-or-error p) 
     522          (goto-char start))))))) 
    511523 
    512524(defvar slime-presentation-map (make-sparse-keymap)) 

  • trunk/thirdparty/slime/contrib/swank-presentations.lisp

    r2200 r2593  
    105105             (send-to-emacs `(:write-string ,(string #\Newline)  
    106106                                            :repl-result))))) 
     107    (fresh-line) 
     108    (finish-output) 
    107109    (if (null values) 
    108110        (send-to-emacs `(:write-string "; No value" :repl-result)) 

  • trunk/thirdparty/slime/slime.el

    r2486 r2593  
    14331433            `(progn 
    14341434               (load ,(expand-file-name loader) :verbose t) 
    1435                (funcall (read-from-string "swank-loader:load-swank")) 
     1435               (funcall (read-from-string "swank-loader:init")) 
    14361436               (funcall (read-from-string "swank:start-server") 
    14371437                        ,port-filename 
    …… 
    31743174    (slime-repl-add-to-input-history  
    31753175     (buffer-substring slime-repl-input-start-mark end)) 
    3176     (let ((inhibit-read-only t)) 
    3177       (add-text-properties slime-repl-input-start-mark  
    3178                            (point) 
    3179                            `(slime-repl-old-input 
    3180                              ,(incf slime-repl-old-input-counter)))) 
    31813176    (when newline  
    31823177      (insert "\n") 
    31833178      (slime-repl-show-maximum-output)) 
     3179    (add-text-properties slime-repl-input-start-mark  
     3180                         (point) 
     3181                         `(slime-repl-old-input 
     3182                           ,(incf slime-repl-old-input-counter))) 
    31843183    (let ((overlay (make-overlay slime-repl-input-start-mark end))) 
    31853184      ;; These properties are on an overlay so that they won't be taken 
    …… 
    32083207                 (insert " ")))) 
    32093208      (delete-region (point) slime-repl-input-end-mark) 
    3210       (save-excursion (insert old-input)) 
     3209      (save-excursion  
     3210        (insert old-input) 
     3211        (when (equal (char-before) ?\n)  
     3212          (delete-char -1))) 
    32113213      (forward-char offset)))) 
    32123214 
    …… 
    41064108 
    41074109(defun slime-alistify (list key test) 
    4108   "Partition the elements of LIST into an alist.   
    4109 KEY extracts the key from an element and TEST is used to compare keys." 
     4110  "Partition the elements of LIST into an alist. 
     4111KEY extracts the key from an element and TEST is used to compare 
     4112keys." 
    41104113  (declare (type function key)) 
    41114114  (let ((alist '())) 
    …… 
    41174120            (push (cons k (list e)) alist)))) 
    41184121    ;; Put them back in order. 
    4119     (loop for (key . value) in alist 
     4122    (loop for (key . value) in (reverse alist) 
    41204123          collect (cons key (reverse value))))) 
    41214124 
    …… 
    51405143            (slime-pop-find-definition-stack)))))) 
    51415144 
    5142 (defstruct (slime-definition (:conc-name slime-definition.) 
    5143                              (:type list)) 
     5145(defstruct (slime-xref (:conc-name slime-xref.) (:type list)) 
    51445146  dspec location) 
     5147 
     5148(defstruct (slime-location (:conc-name slime-location.) (:type list) 
     5149                           (:constructor nil) (:copier nil)) 
     5150  tag buffer position hints) 
     5151(defun slime-location-p (o) (and (consp o) (eq (car o) :location))) 
     5152 
     5153(defun slime-xref-has-location-p (xref) 
     5154  (slime-location-p (slime-xref.location xref))) 
    51455155 
    51465156(defun slime-edit-definition (name &optional where) 
    …… 
    51495159function name is prompted." 
    51505160  (interactive (list (slime-read-symbol-name "Name: "))) 
    5151   (let ((definitions (slime-eval `(swank:find-definitions-for-emacs ,name)))) 
    5152     (cond 
    5153      ((null definitions) 
    5154       (if slime-edit-definition-fallback-function 
    5155           (funcall slime-edit-definition-fallback-function name) 
    5156         (error "No known definition for: %s" name))) 
    5157      ((and (slime-length= definitions 1) 
    5158            (eql (car (slime-definition.location (car definitions))) :error)) 
    5159       (if slime-edit-definition-fallback-function 
    5160           (funcall slime-edit-definition-fallback-function name) 
    5161         (error "%s" (cadr (slime-definition.location (car definitions)))))) 
    5162      (t  
    5163       (slime-goto-definition name definitions where))))) 
     5161  (slime-find-definitions name 
     5162                          (slime-rcurry 
     5163                           #'slime-edit-definition-cont name where))) 
     5164 
     5165(defun slime-edit-definition-cont (xrefs name where) 
     5166  (destructuring-bind (1loc file-alist) (slime-analyze-xrefs xrefs) 
     5167    (cond ((null xrefs)  
     5168           (error "No known definition for: %s" name)) 
     5169          (1loc 
     5170           (slime-push-definition-stack) 
     5171           (slime-pop-to-location (slime-xref.location (car xrefs)) where)) 
     5172          ((= (length xrefs) 1) 
     5173           (error "%s" (cadr (slime-xref.location (car xrefs))))) 
     5174          (t 
     5175           (slime-push-definition-stack) 
     5176           (slime-show-xrefs file-alist 'definition name 
     5177                             (slime-current-package)))))) 
     5178 
     5179(defun slime-analyze-xrefs (xrefs) 
     5180  "Find common filenames in XREFS. 
     5181Return a list (SINGLE-LOCATION FILE-ALIST). 
     5182SINGLE-LOCATION is true if all xrefs point to the same location. 
     5183FILE-ALIST is an alist of the form ((FILENAME . (XREF ...)) ...)." 
     5184  (list (and xrefs 
     5185             (let ((loc (slime-xref.location (car xrefs)))) 
     5186               (and (slime-location-p loc) 
     5187                    (every (lambda (x) (equal (slime-xref.location x) loc)) 
     5188                           (cdr xrefs))))) 
     5189        (slime-alistify xrefs 
     5190                        (lambda (x) 
     5191                          (if (slime-xref-has-location-p x) 
     5192                              (slime-location-to-string (slime-xref.location x)) 
     5193                            "Error")) 
     5194                        #'equal))) 
     5195 
     5196(defun slime-location-to-string (location) 
     5197  (destructure-case (slime-location.buffer location) 
     5198    ((:file filename) filename) 
     5199    ((:buffer bufname) 
     5200     (let ((buffer (get-buffer bufname))) 
     5201       (if buffer  
     5202           (format "%S" buffer) ; "#<buffer foo.lisp>" 
     5203           (format "%s (previously existing buffer)" bufname)))))) 
     5204 
     5205(defun slime-pop-to-location (location &optional where) 
     5206  (ecase where 
     5207    ((nil) 
     5208     (slime-goto-source-location location) 
     5209     (switch-to-buffer (current-buffer))) 
     5210    (window 
     5211     (pop-to-buffer (current-buffer) t) 
     5212     (slime-goto-source-location location) 
     5213     (switch-to-buffer (current-buffer))) 
     5214    (frame 
     5215     (let ((pop-up-frames t)) 
     5216       (pop-to-buffer (current-buffer) t) 
     5217       (slime-goto-source-location location) 
     5218       (switch-to-buffer (current-buffer)))))) 
     5219 
     5220(defun slime-find-definitions (name cont) 
     5221  "Find definitions for NAME and pass them to CONT." 
     5222  ;; FIXME: append SWANK xrefs and etags xrefs 
     5223  (funcall cont 
     5224           (or (slime-eval `(swank:find-definitions-for-emacs ,name)) 
     5225               (funcall slime-edit-definition-fallback-function name)))) 
    51645226 
    51655227(defun slime-find-tag-if-tags-table-visited (name) 
    …… 
    51705232      (find-tag name) 
    51715233    (error "No known definition for: %s; use M-x visit-tags-table RET" name))) 
    5172  
    5173 (defun slime-goto-definition (name definitions &optional where) 
    5174   (slime-push-definition-stack) 
    5175   (let ((all-locations-equal 
    5176          (or (null definitions) 
    5177              (let ((first-location (slime-definition.location (first definitions)))) 
    5178                (every (lambda (definition) 
    5179                         (equal (slime-definition.location definition) 
    5180                                first-location)) 
    5181                       (rest definitions)))))) 
    5182     (if (and (slime-length> definitions 1) 
    5183              (not all-locations-equal)) 
    5184         (slime-show-definitions name definitions) 
    5185       (let ((def (car definitions))) 
    5186         (destructure-case (slime-definition.location def) 
    5187           ;; Take care of errors before switching any windows/buffers. 
    5188           ((:error message) 
    5189            (error "%s" message)) 
    5190           (t 
    5191            (cond ((equal where 'window) 
    5192                   (slime-goto-definition-other-window (car definitions))) 
    5193                  ((equal where 'frame) 
    5194                   (let ((pop-up-frames t)) 
    5195                     (slime-goto-definition-other-window (car definitions)))) 
    5196                  (t 
    5197                   (slime-goto-source-location (slime-definition.location 
    5198                                                (car definitions))) 
    5199                   (switch-to-buffer (current-buffer)))))))))) 
    5200  
    5201 (defun slime-goto-definition-other-window (definition) 
    5202   (slime-pop-to-other-window) 
    5203   (slime-goto-source-location (slime-definition.location definition)) 
    5204   (switch-to-buffer (current-buffer))) 
    5205  
    5206 (defun slime-pop-to-other-window () 
    5207   "Pop to the other window, but not to any particular buffer." 
    5208   (pop-to-buffer (current-buffer) t)) 
    5209  
     5234  
    52105235(defun slime-edit-definition-other-window (name) 
    52115236  "Like `slime-edit-definition' but switch to the other window." 
    …… 
    52205245(defun slime-edit-definition-with-etags (name) 
    52215246  (interactive (list (slime-read-symbol-name "Symbol: "))) 
    5222   (let ((tagdefs (slime-etags-definitions name))) 
    5223     (cond (tagdefs  
     5247  (let ((xrefs (slime-etags-definitions name))) 
     5248    (cond (xrefs  
    52245249           (message "Using tag file...") 
    5225            (slime-goto-definition name tagdefs)) 
     5250           (slime-edit-definition-cont xrefs name nil)) 
    52265251          (t 
    52275252           (error "No known definition for: %s" name))))) 
    …… 
    52475272                    (push (list hint loc) defs)))))))) 
    52485273      (reverse defs)))) 
    5249  
    5250 (defun slime-show-definitions (name definitions) 
    5251   (slime-show-xrefs  
    5252    `((,name . ,(loop for (dspec location) in definitions 
    5253                      collect (cons dspec location)))) 
    5254    'definition 
    5255    name 
    5256    (slime-current-package))) 
    52575274 
    52585275;;;;; first-change-hook 
    …… 
    60596076(put 'slime-with-xref-buffer 'lisp-indent-function 1) 
    60606077 
    6061 (defun slime-insert-xrefs (xrefs) 
    6062   "Insert XREFS in the current-buffer. 
    6063 XREFS is a list of the form ((GROUP . ((LABEL . LOCATION) ...)) ...) 
    6064 GROUP and LABEL are for decoration purposes.  LOCATION is a source-location." 
    6065   (unless (bobp) (insert "\n")) 
     6078(defun slime-insert-xrefs (xref-alist) 
     6079  "Insert XREF-ALIST in the current-buffer. 
     6080XREF-ALIST is of the form ((GROUP . ((LABEL LOCATION) ...)) ...). 
     6081GROUP and LABEL are for decoration purposes.  LOCATION is a 
     6082source-location." 
    60666083  (loop for (group . refs) in xrefs do  
    6067         (progn 
    6068           (slime-insert-propertized '(face bold) group "\n") 
    6069           (loop 
    6070              for (label . location) in refs  
    6071              do (slime-insert-propertized  
    6072                  (list 'slime-location location 
    6073                        'face 'font-lock-keyword-face) 
    6074                  "  " (slime-one-line-ify label)) 
    6075              do (insert " - " (slime-insert-xref-location location) "\n")))) 
     6084        (slime-insert-propertized '(face bold) group "\n") 
     6085        (loop for (label location) in refs do 
     6086              (slime-insert-propertized (list 'slime-location location 
     6087                                              'face 'font-lock-keyword-face) 
     6088                                        "  " (slime-one-line-ify label) "\n"))) 
    60766089  ;; Remove the final newline to prevent accidental window-scrolling 
    6077   (backward-char 1) 
    6078   (delete-char 1)) 
    6079  
    6080 (defun slime-insert-xref-location (location) 
    6081   (if (eql :location (car location)) 
    6082       (cond ((assoc :file (cdr location))  
    6083              (second (assoc :file (cdr location)))) 
    6084             ((assoc :buffer (cdr location)) 
    6085              (let* ((name (second (assoc :buffer (cdr location)))) 
    6086                     (buffer (get-buffer name))) 
    6087                (if buffer  
    6088                    (format "%S" buffer) 
    6089                    (format "%s (previously existing buffer)" name))))) 
    6090       "file unknown")) 
     6090  (backward-delete-char 1)) 
    60916091 
    60926092(defvar slime-next-location-function nil 
    …… 
    61646164                 (snapshot (slime-current-emacs-snapshot))) 
    61656165     (lambda (result) 
    6166        (slime-show-xrefs result type symbol package snapshot))))) 
     6166       (let ((file-alist (cadr (slime-analyze-xrefs result)))) 
     6167         (slime-show-xrefs file-alist type symbol package snapshot)))))) 
    61676168 
    61686169  

  • trunk/thirdparty/slime/swank-loader.lisp

    r2486 r2593  
    1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 
     1;;;; -*- indent-tabs-mode: nil -*- 
    22;;; 
    33;;; swank-loader.lisp --- Compile and load the Slime backend. 
    …… 
    1919;;   (load ".../swank-loader.lisp") 
    2020 
    21 ;(cl:eval-when (:compile-toplevel :load-toplevel :execute) 
    22 ;  (cl:when (cl:find-package :swank) 
    23 ;    (cl:delete-package :swank-loader) 
    24 ;    (cl:delete-package :swank) 
    25 ;    (cl:delete-package :swank-backend))) 
    26  
    2721(cl:defpackage :swank-loader 
    2822  (:use :cl) 
    2923  (:export :load-swank 
     24           :init 
    3025           :*source-directory* 
    3126           :*fasl-directory*)) 
    …… 
    8075  #+armedbear (lisp-implementation-version)) 
    8176 
    82 (defun unique-directory-name () 
     77(defun unique-dir-name () 
    8378  "Return a name that can be used as a directory name that is 
    8479unique to a Lisp implementation, Lisp implementation version, 
    …… 
    115110    (and s (symbol-name (read s))))) 
    116111 
    117 (defun default-fasl-directory () 
     112(defun default-fasl-dir () 
    118113  (merge-pathnames 
    119114   (make-pathname 
    120115    :directory `(:relative ".slime" "fasl" 
    121116                 ,@(if (slime-version-string) (list (slime-version-string))) 
    122                  ,(unique-directory-name))) 
     117                 ,(unique-dir-name))) 
    123118   (user-homedir-pathname))) 
    124119 
    125 (defun binary-pathname (source-pathname binary-directory) 
    126   "Return the pathname where SOURCE-PATHNAME's binary should be compiled." 
    127   (let ((cfp (compile-file-pathname source-pathname))) 
     120(defun binary-pathname (src-pathname binary-dir) 
     121  "Return the pathname where SRC-PATHNAME's binary should be compiled." 
     122  (let ((cfp (compile-file-pathname src-pathname))) 
    128123    (merge-pathnames (make-pathname :name (pathname-name cfp) 
    129124                                    :type (pathname-type cfp)) 
    130                      binary-directory))) 
     125                     binary-dir))) 
    131126 
    132127(defun handle-loadtime-error (condition binary-pathname) 
    …… 
    136131            binary-pathname condition)) 
    137132  (when (equal (directory-namestring binary-pathname) 
    138                (directory-namestring (default-fasl-directory))) 
     133               (directory-namestring (default-fasl-dir))) 
    139134    (ignore-errors (delete-file binary-pathname))) 
    140135  (abort)) 
    141136 
    142 (defun compile-files-if-needed-serially (files fasl-directory &key load force) 
    143   "Compile each file in FILES if the source is newer than 
    144 its corresponding binary, or the file preceding it was 
    145 recompiled." 
     137(defun compile-files (files fasl-dir load) 
     138  "Compile each file in FILES if the source is newer than its 
     139corresponding binary, or the file preceding it was recompiled. 
     140If LOAD is true, load the fasl file." 
    146141  (let ((needs-recompile nil)) 
    147     (dolist (source-pathname files) 
    148       (let ((binary-pathname (binary-pathname source-pathname 
    149                                               fasl-directory))) 
     142    (dolist (src files) 
     143      (let ((dest (binary-pathname src fasl-dir))) 
    150144        (handler-case 
    151145            (progn 
    152               (when (or force 
    153                         needs-recompile 
    154                         (not (probe-file binary-pathname)) 
    155                         (file-newer-p source-pathname binary-pathname)) 
    156                 ;; need a to recompile source-pathname, so we'll 
     146              (when (or needs-recompile 
     147                        (not (probe-file dest)) 
     148                        (file-newer-p src dest)) 
     149                ;; need a to recompile src-pathname, so we'll 
    157150                ;; need to recompile everything after this too. 
    158151                (setq needs-recompile t) 
    159                 (ensure-directories-exist binary-pathname) 
    160                 (compile-file source-pathname :output-file binary-pathname 
    161                               :print nil 
    162                               :verbose t)) 
     152                (ensure-directories-exist dest) 
     153                (compile-file src :output-file dest :print nil :verbose t)) 
    163154              (when load 
    164                 (load binary-pathname :verbose t))) 
     155                (load dest :verbose t))) 
    165156          ;; Fail as early as possible 
    166157          (serious-condition (c) 
    167             (handle-loadtime-error c binary-pathname))))))) 
     158            (handle-loadtime-error c dest))))))) 
    168159 
    169160#+(or cormanlisp ecl) 
    170 (defun compile-files-if-needed-serially (files fasl-directory load) 
     161(defun compile-files (files fasl-dir load) 
    171162  "Corman Lisp and ECL have trouble with compiled files." 
    172   (declare (ignore fasl-directory)) 
     163  (declare (ignore fasl-dir)) 
    173164  (when load 
    174165    (dolist (file files) 
    …… 
    182173        :if-does-not-exist nil)) 
    183174 
    184 (defun load-site-init-file (directory) 
     175(defun load-site-init-file (dir) 
    185176  (load (make-pathname :name "site-init" :type "lisp" 
    186                        :defaults directory) 
     177                       :defaults dir) 
    187178        :if-does-not-exist nil)) 
    188179 
    189 (defun source-files (names src-dir) 
     180(defun src-files (names src-dir) 
    190181  (mapcar (lambda (name) 
    191182            (make-pathname :name (string-downcase name) :type "lisp" 
    …… 
    193184          names)) 
    194185 
    195 (defun swank-source-files (src-dir) 
    196   (source-files `("swank-backend" ,@*sysdep-files* "swank")  
    197                 src-dir)) 
    198  
    199 (defvar *fasl-directory* (default-fasl-directory) 
     186(defun swank-src-files (src-dir) 
     187  (src-files `("swank-backend" ,@*sysdep-files* "swank")  
     188             src-dir)) 
     189 
     190(defvar *fasl-directory* (default-fasl-dir) 
    200191  "The directory where fasl files should be placed.") 
    201192 
    …… 
    212203   absolute)) 
    213204 
    214 (defun contrib-src-dir (src-dir) 
    215   (append-dir src-dir "contrib")) 
    216  
    217 (defun contrib-source-files (src-dir) 
    218   (source-files *contribs* (contrib-src-dir src-dir))) 
    219  
    220 (defun load-swank (&key 
    221                    (source-directory *source-directory*) 
    222                    (fasl-directory *fasl-directory*) 
    223                    (contrib-fasl-directory  
    224                     (append-dir fasl-directory "contrib")) 
    225                    (force nil)) 
    226   (compile-files-if-needed-serially (swank-source-files source-directory) 
    227                                     fasl-directory :load t :force force) 
    228   (compile-files-if-needed-serially (contrib-source-files source-directory) 
    229                                     contrib-fasl-directory :load nil :force force) 
    230  
    231   (setf (symbol-value (read-from-string "swank::*swank-wire-protocol-version*")) (slime-version-string)) 
    232   (push (contrib-src-dir *source-directory*) 
    233         (symbol-value (read-from-string "swank::*load-path*"))) 
    234   (funcall (read-from-string "swank-backend::warn-unimplemented-interfaces")) 
    235   (load-site-init-file *source-directory*) 
    236   (load-user-init-file) 
    237   (funcall (read-from-string "swank:run-after-init-hook"))) 
     205(defun contrib-dir (base-dir) 
     206  (append-dir base-dir "contrib")) 
     207 
     208(defun load-swank (&key (src-dir *source-directory*) 
     209                   (fasl-dir *fasl-directory*)) 
     210  (compile-files (swank-src-files src-dir) fasl-dir t)) 
     211 
     212(defun compile-contribs (&key (src-dir (contrib-dir *source-directory*)) 
     213                         (fasl-dir (contrib-dir *fasl-directory*))) 
     214  (compile-files (src-files *contribs* src-dir) fasl-dir nil)) 
     215 
     216(defun setup () 
     217  (flet ((q (s) (read-from-string s))) 
     218    (load-site-init-file *source-directory*) 
     219    (load-user-init-file) 
     220    (eval `(pushnew 'compile-contribs ,(q "swank::*after-init-hook*"))) 
     221    (funcall (q "swank::setup")  
     222             (slime-version-string) 
     223             (list (contrib-dir *fasl-directory*)     
     224                   (contrib-dir *source-directory*))))) 
     225 
     226(defun init (&key delete reload) 
     227  (when (and delete (find-package :swank)) 
     228    (mapc #'delete-package '(:swank :swank-io-package :swank-backend))) 
     229  (cond ((or (not (find-package :swank)) reload) 
     230         (load-swank)) 
     231        (t  
     232         (warn "Not reloading SWANK.  Package already exists."))) 
     233  (setup)) 

  • trunk/thirdparty/slime/swank.asd

    r2486 r2593  
    2525(in-package :swank-loader) 
    2626 
    27 (defclass swank-loader-file (asdf:source-file) ()) 
     27(defclass swank-loader-file (asdf:cl-source-file) ()) 
    2828 
    29 ;; asdf:compile-op does nothing for swank. 
     29;;;; make compile-op a nop 
    3030 
    31 (defmethod asdf:perform ((o asdf:compile-op) (f swank-loader-file)) t) 
     31(defmethod asdf:operation-done-p ((o asdf:compile-op) (f swank-loader-file)) 
     32  t) 
    3233 
    33 (defmethod asdf:operation-done-p ((o asdf:compile-op) (f swank-loader-file)) t) 
    34  
    35 (defmethod asdf:output-files ((o asdf:compile-op) (f swank-loader-file)) '()) 
    36  
    37 ;; asdf:load-op acutally loads it 
     34;;;; after loading run init 
    3835 
    3936(defmethod asdf:perform ((o asdf:load-op) (f swank-loader-file)) 
    40   (if (find-package :swank) 
    41       (warn "Attempting to load re-load swank into this image. Ignoring request.") 
    42       (progn 
    43         (load (merge-pathnames (asdf:component-pathname f))) 
    44         (funcall (read-from-string "swank-loader:load-swank") 
    45                  :source-directory (asdf:component-pathname (asdf:find-system :swank)))))) 
    46  
    47 (defmethod asdf:operation-done-p ((o asdf:load-op) (f swank-loader-file)) 
    48   (find-package :swank)) 
    49  
    50 (defmethod asdf:source-file-type ((c swank-loader-file) (s asdf:module)) 
    51   "lisp") 
     37  (load (asdf::component-pathname f)) 
     38  (funcall (read-from-string "swank-loader::init") 
     39           :reload (asdf::operation-forced o) 
     40           :delete (asdf::operation-forced o))) 
    5241 
    5342(asdf:defsystem :swank 
    54     :default-component-class swank-loader-file 
    55     :components ((:file "swank-loader"))) 
     43  :default-component-class swank-loader-file 
     44  :components ((:file "swank-loader"))) 

  • trunk/thirdparty/slime/swank.lisp

    r2491 r2593  
    2828           #:print-indentation-lossage 
    2929           #:swank-debugger-hook 
    30            #:run-after-init-hook 
    3130           #:emacs-inspect 
    3231           ;;#:inspect-slot-for-emacs 
    …… 
    189188(defvar *after-init-hook* '() 
    190189  "Hook run after user init files are loaded.") 
    191  
    192 (defun run-after-init-hook () 
    193   (run-hook *after-init-hook*)) 
    194190 
    195191  
    …… 
    22992295    defaults))) 
    23002296 
    2301 (defvar *load-path* 
    2302   (list (make-pathname :directory (merged-directory "contrib" *load-truename*) 
    2303                        :name nil :type nil :version nil 
    2304                        :defaults *load-truename*)) 
     2297(defvar *load-path* '() 
    23052298  "A list of directories to search for modules.") 
    23062299 
    …… 
    26022595  "Return a list ((DSPEC LOCATION) ...) of definitions for NAME. 
    26032596DSPEC is a string and LOCATION a source location. NAME is a string." 
    2604   (multiple-value-bind (sexp error) 
    2605       (ignore-errors (values (from-string name))) 
     2597  (multiple-value-bind (sexp error) (ignore-errors (values (from-string name))) 
    26062598    (unless error 
    2607       (loop for (dspec loc) in (find-definitions sexp) 
    2608          collect (list (to-string dspec) loc))))) 
    2609  
    2610 (defun alistify (list key test) 
    2611   "Partition the elements of LIST into an alist.  KEY extracts the key 
    2612 from an element and TEST is used to compare keys." 
    2613   (declare (type function key)) 
    2614   (let ((alist '())) 
    2615     (dolist (e list) 
    2616       (let* ((k (funcall key e)) 
    2617              (probe (assoc k alist :test test))) 
    2618         (if probe 
    2619             (push e (cdr probe)) 
    2620             (push (cons k (list e)) alist)))) 
    2621     alist)) 
    2622  
    2623 (defun location-position< (pos1 pos2) 
    2624   (cond ((and (position-p pos1) (position-p pos2)) 
    2625          (< (position-pos pos1) 
    2626             (position-pos pos2))) 
    2627         (t nil))) 
    2628  
    2629 (defun partition (list test key) 
    2630   (declare (type function test key)) 
    2631   (loop for e in list 
    2632         if (funcall test (funcall key e)) collect e into yes 
    2633         else collect e into no 
    2634         finally (return (values yes no)))) 
    2635  
    2636 (defstruct (xref (:conc-name xref.) 
    2637                  (:type list)) 
    2638   dspec location) 
    2639  
    2640 (defun location-valid-p (location) 
    2641   (eq (car location) :location)) 
    2642  
    2643 (defun xref-buffer (xref) 
    2644   (location-buffer (xref.location xref))) 
    2645  
    2646 (defun xref-position (xref) 
    2647   (location-buffer (xref.location xref))) 
    2648  
    2649 (defun group-xrefs (xrefs) 
    2650   "Group XREFS, a list of the form ((DSPEC LOCATION) ...) by location. 
    2651 The result is a list of the form ((LOCATION . ((DSPEC . LOCATION) ...)) ...)." 
    2652   (multiple-value-bind (resolved errors) 
    2653       (partition xrefs #'location-valid-p #'xref.location) 
    2654     (let ((alist (alistify resolved #'xref-buffer #'equal))) 
    2655       (append 
    2656        (loop for (buffer . list) in alist 
    2657              collect (cons (second buffer) 
    2658                            (mapcar (lambda (xref) 
    2659                                      (cons (to-string (xref.dspec xref)) 
    2660                                            (xref.location xref))) 
    2661                                    (sort list #'location-position< 
    2662                                          :key #'xref-position)))) 
    2663        (if errors 
    2664            (list (cons "Unresolved" 
    2665                        (mapcar (lambda (xref) 
    2666                                  (cons (to-string (xref.dspec xref)) 
    2667                                        (xref.location xref))) 
    2668