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

Diff of /slime/swank-ccl.lisp

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

revision 1.25 by heller, Fri Jan 6 09:02:43 2012 UTC revision 1.29 by sboukarev, Mon Dec 3 03:43:16 2012 UTC
# Line 23  Line 23 
23  (import-from :ccl *gray-stream-symbols* :swank-backend)  (import-from :ccl *gray-stream-symbols* :swank-backend)
24    
25  (eval-when (:compile-toplevel :load-toplevel :execute)  (eval-when (:compile-toplevel :load-toplevel :execute)
26    (require 'xref))    (multiple-value-bind (ok err) (ignore-errors (require 'xref))
27        (unless ok
28          (warn "~a~%" err))))
29    
30  ;;; swank-mop  ;;; swank-mop
31    
# Line 156  Line 158 
158    
159  (defun handle-compiler-warning (condition)  (defun handle-compiler-warning (condition)
160    "Resignal a ccl:compiler-warning as swank-backend:compiler-warning."    "Resignal a ccl:compiler-warning as swank-backend:compiler-warning."
161    (signal (make-condition    (signal 'compiler-condition
162             'compiler-condition            :original-condition condition
163             :original-condition condition            :message (compiler-warning-short-message condition)
164             :message (compiler-warning-short-message condition)            :source-context nil
165             :source-context nil            :severity (compiler-warning-severity condition)
166             :severity (compiler-warning-severity condition)            :location (source-note-to-source-location
167             :location (source-note-to-source-location                       (ccl:compiler-warning-source-note condition)
168                        (ccl:compiler-warning-source-note condition)                       (lambda () "Unknown source")
169                        (lambda () "Unknown source")                       (ccl:compiler-warning-function-name condition))))
                       (ccl:compiler-warning-function-name condition)))))  
170    
171  (defgeneric compiler-warning-severity (condition))  (defgeneric compiler-warning-severity (condition))
172  (defmethod compiler-warning-severity ((c ccl:compiler-warning)) :warning)  (defmethod compiler-warning-severity ((c ccl:compiler-warning)) :warning)
# Line 205  Line 206 
206        (unwind-protect        (unwind-protect
207             (progn             (progn
208               (with-open-file (s temp-file-name :direction :output               (with-open-file (s temp-file-name :direction :output
209                                  :if-exists :error)                                  :if-exists :error :external-format :utf-8)
210                 (write-string string s))                 (write-string string s))
211               (let ((binary-filename (compile-temp-file               (let ((binary-filename (compile-temp-file
212                                       temp-file-name filename buffer position)))                                       temp-file-name filename buffer position)))
# Line 224  Line 225 
225                        (setf (gethash temp-file-name *temp-file-map*)                        (setf (gethash temp-file-name *temp-file-map*)
226                              buffer-name)                              buffer-name)
227                        temp-file-name))                        temp-file-name))
228                  :compile-file-original-buffer-offset (1- offset)))                  :compile-file-original-buffer-offset (1- offset)
229                    :external-format :utf-8))
230    
231  (defimplementation save-image (filename &optional restart-function)  (defimplementation save-image (filename &optional restart-function)
232    (ccl:save-application filename :toplevel-function restart-function))    (ccl:save-application filename :toplevel-function restart-function))
# Line 235  Line 237 
237    (delete-duplicates    (delete-duplicates
238     (mapcan #'find-definitions     (mapcan #'find-definitions
239             (if inverse             (if inverse
240               (ccl:get-relation relation name :wild :exhaustive t)               (ccl::get-relation relation name :wild :exhaustive t)
241               (ccl:get-relation relation :wild name :exhaustive t)))               (ccl::get-relation relation :wild name :exhaustive t)))
242     :test 'equal))     :test 'equal))
243    
244  (defimplementation who-binds (name)  (defimplementation who-binds (name)
# Line 795  Line 797 
797    
798  (defimplementation hash-table-weakness (hashtable)  (defimplementation hash-table-weakness (hashtable)
799    (ccl:hash-table-weak-p hashtable))    (ccl:hash-table-weak-p hashtable))
800    
801    (pushnew 'deinit-log-output ccl:*save-exit-functions*)

Legend:
Removed from v.1.25  
changed lines
  Added in v.1.29

  ViewVC Help
Powered by ViewVC 1.1.5