[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Thu Jan 8 10:37:51 UTC 2009
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv18152
Modified Files:
ChangeLog slime.el swank.lisp
Log Message:
Move the tree widget for compiler notes to contrib/.
--- /project/slime/cvsroot/slime/ChangeLog 2009/01/08 10:33:43 1.1653
+++ /project/slime/cvsroot/slime/ChangeLog 2009/01/08 10:37:51 1.1654
@@ -1,5 +1,9 @@
2009-01-08 Helmut Eller <heller at common-lisp.net>
+ * slime.el: Move the tree widget for compiler notes to contrib/.
+
+2009-01-08 Helmut Eller <heller at common-lisp.net>
+
* swank-backend.lisp (swank-compile-string): Pass the
buffer-file-name to Lisp, not only the directory.
Update callers accordingly.
--- /project/slime/cvsroot/slime/slime.el 2009/01/08 10:33:43 1.1112
+++ /project/slime/cvsroot/slime/slime.el 2009/01/08 10:37:51 1.1113
@@ -2597,6 +2597,7 @@
"When non-nil compile defuns with this debug optimization level.")
(defun slime-compute-policy (arg)
+ "Return the policy for the prefix argument ARG."
(flet ((between (min n max)
(if (< n min)
min
@@ -2607,7 +2608,6 @@
((eq arg '-) `((cl:speed . 3)))
(t `((cl:speed . ,(between 0 (abs n) 3))))))))
-
(defstruct (slime-compilation-result
(:type list)
(:conc-name slime-compilation-result.)
@@ -2894,29 +2894,6 @@
(format "%s:%d:%d: " (or filename "") line col)))
(t "")))
-(defun slime-maybe-list-compiler-notes (notes)
- "Show the compiler notes if appropriate."
- ;; don't pop up a buffer if all notes are already annotated in the
- ;; buffer itself
- (unless (every #'slime-note-has-location-p notes)
- (slime-list-compiler-notes notes)))
-
-(defun slime-list-compiler-notes (notes)
- "Show the compiler notes NOTES in tree view."
- (interactive (list (slime-compiler-notes)))
- (with-temp-message "Preparing compiler note tree..."
- (slime-with-popup-buffer ("*SLIME Compiler-Notes*")
- (erase-buffer)
- (slime-compiler-notes-mode)
- (when (null notes)
- (insert "[no notes]"))
- (let ((collapsed-p))
- (dolist (tree (slime-compiler-notes-to-tree notes))
- (when (slime-tree.collapsed-p tree) (setf collapsed-p t))
- (slime-tree-insert tree "")
- (insert "\n"))
- (goto-char (point-min))))))
-
(defun slime-alistify (list key test)
"Partition the elements of LIST into an alist.
KEY extracts the key from an element and TEST is used to compare
@@ -2954,152 +2931,6 @@
(:read-error "Read Errors")
(:style-warning "Style Warnings")))
-(defvar slime-tree-printer 'slime-tree-default-printer)
-
-(defun slime-tree-for-note (note)
- (make-slime-tree :item (slime-note.message note)
- :plist (list 'note note)
- :print-fn slime-tree-printer))
-
-(defun slime-tree-for-severity (severity notes collapsed-p)
- (make-slime-tree :item (format "%s (%d)"
- (slime-severity-label severity)
- (length notes))
- :kids (mapcar #'slime-tree-for-note notes)
- :collapsed-p collapsed-p))
-
-(defun slime-compiler-notes-to-tree (notes)
- (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
- (collapsed-p (slime-length> alist 1)))
- (loop for (severity . notes) in alist
- collect (slime-tree-for-severity severity notes
- collapsed-p))))
-
-(defvar slime-compiler-notes-mode-map)
-
-(define-derived-mode slime-compiler-notes-mode fundamental-mode
- "Compiler-Notes"
- "\\<slime-compiler-notes-mode-map>\
-\\{slime-compiler-notes-mode-map}
-\\{slime-popup-buffer-mode-map}
-"
- (slime-set-truncate-lines))
-
-(slime-define-keys slime-compiler-notes-mode-map
- ((kbd "RET") 'slime-compiler-notes-default-action-or-show-details)
- ([return] 'slime-compiler-notes-default-action-or-show-details)
- ([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse))
-
-(defun slime-compiler-notes-default-action-or-show-details/mouse (event)
- "Invoke the action pointed at by the mouse, or show details."
- (interactive "e")
- (destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
- (save-excursion
- (goto-char pos)
- (let ((fn (get-text-property (point)
- 'slime-compiler-notes-default-action)))
- (if fn (funcall fn) (slime-compiler-notes-show-details))))))
-
-(defun slime-compiler-notes-default-action-or-show-details ()
- "Invoke the action at point, or show details."
- (interactive)
- (let ((fn (get-text-property (point) 'slime-compiler-notes-default-action)))
- (if fn (funcall fn) (slime-compiler-notes-show-details))))
-
-(defun slime-compiler-notes-show-details ()
- (interactive)
- (let* ((tree (slime-tree-at-point))
- (note (plist-get (slime-tree.plist tree) 'note))
- (inhibit-read-only t))
- (cond ((not (slime-tree-leaf-p tree))
- (slime-tree-toggle tree))
- (t
- (slime-show-source-location (slime-note.location note) t)))))
-
-
-;;;;;; Tree Widget
-
-(defstruct (slime-tree (:conc-name slime-tree.))
- item
- (print-fn #'slime-tree-default-printer :type function)
- (kids '() :type list)
- (collapsed-p t :type boolean)
- (prefix "" :type string)
- (start-mark nil)
- (end-mark nil)
- (plist '() :type list))
-
-(defun slime-tree-leaf-p (tree)
- (not (slime-tree.kids tree)))
-
-(defun slime-tree-default-printer (tree)
- (princ (slime-tree.item tree) (current-buffer)))
-
-(defun slime-tree-decoration (tree)
- (cond ((slime-tree-leaf-p tree) "-- ")
- ((slime-tree.collapsed-p tree) "[+] ")
- (t "-+ ")))
-
-(defun slime-tree-insert-list (list prefix)
- "Insert a list of trees."
- (loop for (elt . rest) on list
- do (cond (rest
- (insert prefix " |")
- (slime-tree-insert elt (concat prefix " |"))
- (insert "\n"))
- (t
- (insert prefix " `")
- (slime-tree-insert elt (concat prefix " "))))))
-
-(defun slime-tree-insert-decoration (tree)
- (insert (slime-tree-decoration tree)))
-
-(defun slime-tree-indent-item (start end prefix)
- "Insert PREFIX at the beginning of each but the first line.
-This is used for labels spanning multiple lines."
- (save-excursion
- (goto-char end)
- (beginning-of-line)
- (while (< start (point))
- (insert-before-markers prefix)
- (forward-line -1))))
-
-(defun slime-tree-insert (tree prefix)
- "Insert TREE prefixed with PREFIX at point."
- (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
- (let ((line-start (line-beginning-position)))
- (setf start-mark (point-marker))
- (slime-tree-insert-decoration tree)
- (funcall print-fn tree)
- (slime-tree-indent-item start-mark (point) (concat prefix " "))
- (add-text-properties line-start (point) (list 'slime-tree tree))
- (set-marker-insertion-type start-mark t)
- (when (and kids (not collapsed-p))
- (terpri (current-buffer))
- (slime-tree-insert-list kids prefix))
- (setf (slime-tree.prefix tree) prefix)
- (setf end-mark (point-marker)))))
-
-(defun slime-tree-at-point ()
- (cond ((get-text-property (point) 'slime-tree))
- (t (error "No tree at point"))))
-
-(defun slime-tree-delete (tree)
- "Delete the region for TREE."
- (delete-region (slime-tree.start-mark tree)
- (slime-tree.end-mark tree)))
-
-(defun slime-tree-toggle (tree)
- "Toggle the visibility of TREE's children."
- (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
- (setf collapsed-p (not collapsed-p))
- (slime-tree-delete tree)
- (insert-before-markers " ") ; move parent's end-mark
- (backward-char 1)
- (slime-tree-insert tree prefix)
- (delete-char 1)
- (goto-char start-mark)))
-
;;;;; Adding a single compiler note
--- /project/slime/cvsroot/slime/swank.lisp 2009/01/08 10:33:44 1.627
+++ /project/slime/cvsroot/slime/swank.lisp 2009/01/08 10:37:51 1.628
@@ -253,8 +253,9 @@
;;; Connection structures represent the network connections between
;;; Emacs and Lisp. Each has a socket stream, a set of user I/O
;;; streams that redirect to Emacs, and optionally a second socket
-;;; used solely to pipe user-output to Emacs (an optimization).
-;;;
+;;; used solely to pipe user-output to Emacs (an optimization). This
+;;; is also the place where we keep everything that needs to be
+;;; freed/closed/killed when we disconnect.
(defstruct (connection
(:conc-name connection.)
More information about the slime-cvs
mailing list