From heller at common-lisp.net Mon Nov 1 16:56:39 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 01 Nov 2004 17:56:39 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4850 Modified Files: slime.el Log Message: (slime-easy-menu): Add item for slime-update-indentation. Suggested by Lynn Quam. (slime-severity-faceslime-show-note-counts) (slime-most-severe, slime-choose-overlay-region): Handle read-errors. (slime-show-buffer-position): New function. (slime-show-source-location): Use it. Date: Mon Nov 1 17:56:38 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.416 slime/slime.el:1.417 --- slime/slime.el:1.416 Thu Oct 28 23:37:18 2004 +++ slime/slime.el Mon Nov 1 17:56:38 2004 @@ -718,6 +718,7 @@ ("Editing" [ "Close All Parens" slime-close-all-sexp t] [ "Check Parens" check-parens t] + [ "Update Indentation" slime-update-indentation ,C] [ "Select Buffer" slime-selector t]) ("Profiling" [ "Toggle Profiling..." slime-toggle-profile-fdefinition ,C ] @@ -3242,21 +3243,21 @@ (t (format "%2d %s%s " count severity (if (= count 1) "" "s"))))) (defun slime-show-note-counts (notes &optional secs) - (loop for note in notes - for severity = (plist-get note :severity) - count (eq :error severity) into errors - count (eq :warning severity) into warnings - count (eq :style-warning severity) into style-warnings - count (eq :note severity) into notes - finally - (message - "Compilation finished:%s%s%s%s%s" - (slime-note-count-string "error" errors) - (slime-note-count-string "warning" warnings) - (slime-note-count-string "style-warning" style-warnings - slime-hide-style-warning-count-if-zero) - (slime-note-count-string "note" notes) - (if secs (format "[%s secs]" secs) "")))) + (let ((nerrors 0) (nwarnings 0) (nstyle-warnings 0) (nnotes 0)) + (dolist (note notes) + (ecase (slime-note.severity note) + ((:error :read-error) (incf nerrors)) + (:warning (incf nwarnings)) + (:style-warning (incf nstyle-warnings)) + (:note (incf nnotes)))) + (message + "Compilation finished:%s%s%s%s%s" + (slime-note-count-string "error" nerrors) + (slime-note-count-string "warning" nwarnings) + (slime-note-count-string "style-warning" nstyle-warnings + slime-hide-style-warning-count-if-zero) + (slime-note-count-string "note" nnotes) + (if secs (format "[%s secs]" secs) "")))) (defun slime-xrefs-for-notes (notes) (let ((xrefs)) @@ -3444,6 +3445,7 @@ (:note "Notes") (:warning "Warnings") (:error "Errors") + (:read-error "Read Errors") (:style-warning "Style Warnings"))) (defun slime-tree-for-note (note) @@ -3493,8 +3495,7 @@ (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))) + (let ((fn (get-text-property (point) 'slime-compiler-notes-default-action))) (if fn (funcall fn) (slime-compiler-notes-show-details)))) (defun slime-compiler-notes-quit () @@ -3512,6 +3513,7 @@ (slime-tree-toggle tree)) (t (slime-show-source-location (slime-note.location note)))))) + ;;;;;; Tree Widget @@ -3679,20 +3681,29 @@ "Choose the start and end points for an overlay over NOTE. If the location's sexp is a list spanning multiple lines, then the region around the first element is used." - (let ((location (getf note :location))) - (unless (eq (car location) :error) - (slime-goto-source-location location) - (skip-chars-forward "'#`") - (let ((start (point))) - (ignore-errors (slime-forward-sexp)) - (if (slime-same-line-p start (point)) - (values start (point)) - (values (1+ start) - (progn (goto-char (1+ start)) - (or (ignore-errors - (forward-sexp 1) - (point)) - (+ start 2))))))))) + (let ((location (slime-note.location note))) + (destructure-case location + ((:error msg) ) ; do nothing + ((:location _file pos _hints) + (destructure-case pos + ((:position pos &optional alignp) + (if (eq (slime-note.severity note) :read-error) + (values pos (1+ pos)) + (slime-choose-overlay-for-sexp location))) + (t + (slime-choose-overlay-for-sexp location))))))) + +(defun slime-choose-overlay-for-sexp (location) + (slime-goto-source-location location) + (skip-chars-forward "'#`") + (let ((start (point))) + (ignore-errors (slime-forward-sexp)) + (if (slime-same-line-p start (point)) + (values start (point)) + (values (1+ start) + (progn (goto-char (1+ start)) + (or (forward-sexp 1) + (point))))))) (defun slime-same-line-p (pos1 pos2) "Return t if buffer positions POS1 and POS2 are on the same line." @@ -3703,6 +3714,7 @@ "Return the name of the font-lock face representing SEVERITY." (ecase severity (:error 'slime-error-face) + (:read-error 'slime-error-face) (:warning 'slime-warning-face) (:style-warning 'slime-style-warning-face) (:note 'slime-note-face))) @@ -3711,7 +3723,7 @@ "Return the most servere of two conditions. Severity is ordered as :NOTE < :STYLE-WARNING < :WARNING < :ERROR." ; Well, not exactly Smullyan.. - (let ((order '(:note :style-warning :warning :error))) + (let ((order '(:note :style-warning :warning :error :read-error))) (if (>= (position sev1 order) (position sev2 order)) sev1 @@ -6048,14 +6060,17 @@ (defun slime-show-source-location (source-location) (slime-goto-source-location source-location) (when sldb-highlight (sldb-highlight-sexp)) - (let ((position (point))) - (save-selected-window - (let ((w (select-window (or (get-buffer-window (current-buffer) t) - (display-buffer (current-buffer) t))))) - (goto-char position) - (push-mark) - (unless (pos-visible-in-window-p) - (slime-recenter-window w sldb-show-location-recenter-arg)))))) + (slime-show-buffer-position (point))) + +(defun slime-show-buffer-position (position) + "Ensure sure that the POSITION in the current buffer is visible." + (save-selected-window + (let ((w (select-window (or (get-buffer-window (current-buffer) t) + (display-buffer (current-buffer) t))))) + (goto-char position) + (push-mark) + (unless (pos-visible-in-window-p) + (slime-recenter-window w sldb-show-location-recenter-arg))))) (defun slime-recenter-window (window line) "Set window-start in WINDOW LINE lines before point." @@ -6071,7 +6086,7 @@ "Highlight the first sexp after point." (sldb-delete-overlays) (let ((start (or start (point))) - (end (or end (save-excursion (forward-sexp) (point))))) + (end (or end (save-excursion (ignore-errors (forward-sexp)) (point))))) (push (make-overlay start (1+ start)) sldb-overlays) (push (make-overlay (1- end) end) sldb-overlays) (dolist (overlay sldb-overlays) From heller at common-lisp.net Mon Nov 1 17:16:02 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 01 Nov 2004 18:16:02 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6472 Modified Files: swank.lisp Log Message: (assign-index): Avoid linear search. Date: Mon Nov 1 18:16:00 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.257 slime/swank.lisp:1.258 --- slime/swank.lisp:1.257 Fri Oct 29 00:16:01 2004 +++ slime/swank.lisp Mon Nov 1 18:15:55 2004 @@ -3076,8 +3076,8 @@ (label-value-line "Precision" (float-precision f)))))) (defvar *inspectee*) -(defvar *inspectee-parts* (make-array 10 :adjustable t :fill-pointer 0)) -(defvar *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)) +(defvar *inspectee-parts*) +(defvar *inspectee-actions*) (defvar *inspector-stack* '()) (defvar *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)) (declaim (type vector *inspector-history*)) @@ -3117,9 +3117,9 @@ (action-part-for-emacs label lambda))))))) (defun assign-index (object vector) - (or (position object vector) - (progn (vector-push-extend object vector) - (position object vector)))) + (let ((index (fill-pointer vector))) + (vector-push-extend object vector) + index)) (defun value-part-for-emacs (object string) (list :value From heller at common-lisp.net Mon Nov 1 17:18:57 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 01 Nov 2004 18:18:57 +0100 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7057 Modified Files: swank-cmucl.lisp Log Message: (severity-for-emacs): Special case read-errors. (read-error-location): Add the offset to the buffer start. Date: Mon Nov 1 18:18:56 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.126 slime/swank-cmucl.lisp:1.127 --- slime/swank-cmucl.lisp:1.126 Thu Oct 28 23:34:36 2004 +++ slime/swank-cmucl.lisp Mon Nov 1 18:18:56 2004 @@ -291,7 +291,8 @@ (defimplementation swank-compile-file (filename load-p) (clear-xref-info filename) (with-compilation-hooks () - (let ((*buffer-name* nil)) + (let ((*buffer-name* nil) + (ext:*ignore-extra-close-parentheses* nil)) (multiple-value-bind (output-file warnings-p failure-p) (compile-file filename) (unless failure-p @@ -334,17 +335,21 @@ :severity (severity-for-emacs condition) :short-message (brief-compiler-message-for-emacs condition) :message (long-compiler-message-for-emacs condition context) - :location (if (eq (type-of condition) 'c::compiler-read-error) + :location (if (read-error-p condition) (read-error-location condition) (compiler-note-location context))))) (defun severity-for-emacs (condition) "Return the severity of CONDITION." (etypecase condition + ((satisfies read-error-p) :read-error) (c::compiler-error :error) (c::style-warning :note) (c::warning :warning))) +(defun read-error-p (condition) + (eq (type-of condition) 'c::compiler-read-error)) + (defun brief-compiler-message-for-emacs (condition) "Briefly describe a compiler error for Emacs. When Emacs presents the message it already has the source popped up @@ -368,10 +373,10 @@ (pos (c::compiler-read-error-position condition))) (cond ((and (eq file :stream) *buffer-name*) (make-location (list :buffer *buffer-name*) - (list :position *buffer-start-position* pos))) + (list :position (+ *buffer-start-position* pos)))) ((and (pathnamep file) (not *buffer-name*)) (make-location (list :file (unix-truename file)) - (list :position pos))) + (list :position (1+ pos)))) (t (break))))) (defun compiler-note-location (context) From heller at common-lisp.net Mon Nov 1 17:19:36 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 01 Nov 2004 18:19:36 +0100 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7090 Modified Files: swank-backend.lisp Log Message: (deftype severity): Add read-errors. Date: Mon Nov 1 18:19:35 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.71 slime/swank-backend.lisp:1.72 --- slime/swank-backend.lisp:1.71 Thu Oct 28 23:23:10 2004 +++ slime/swank-backend.lisp Mon Nov 1 18:19:35 2004 @@ -296,7 +296,8 @@ "Compile FILENAME signalling COMPILE-CONDITIONs. If LOAD-P is true, load the file after compilation.") -(deftype severity () '(member :error :warning :style-warning :note)) +(deftype severity () + '(member :error :read-error :warning :style-warning :note)) ;; Base condition type for compiler errors, warnings and notes. (define-condition compiler-condition (condition) From heller at common-lisp.net Mon Nov 1 17:29:50 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 01 Nov 2004 18:29:50 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv7497 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Nov 1 18:29:49 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.563 slime/ChangeLog:1.564 --- slime/ChangeLog:1.563 Sat Oct 30 12:21:54 2004 +++ slime/ChangeLog Mon Nov 1 18:29:48 2004 @@ -1,3 +1,20 @@ +2004-11-01 Helmut Eller + + * slime.el (slime-easy-menu): Add item for + slime-update-indentation. Suggested by Lynn Quam. + (slime-severity-faceslime-show-note-counts) + (slime-most-severe, slime-choose-overlay-region): Handle + read-errors. + (slime-show-buffer-position): New function. + (slime-show-source-location): Use it. + + * swank-backend.lisp (deftype severity): Add read-errors. + + * swank-cmucl.lisp (severity-for-emacs): Special case read-errors. + (read-error-location): Add the offset to the buffer start. + + * swank.lisp (assign-index): Avoid linear search. + 2004-10-30 Helmut Eller * swank-source-path-parser.lisp (source-path-stream-position): From bdowning at common-lisp.net Sun Nov 7 15:07:02 2004 From: bdowning at common-lisp.net (Brian Downing) Date: Sun, 07 Nov 2004 16:07:02 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp slime/slime.el slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30863 Modified Files: swank.lisp slime.el ChangeLog Log Message: * slime.el (slime-fuzzy-explanation): Added line to describe flags (:boundp, :fboundp, :macro, etc), which are now reported in the fuzzy-completion output. (slime-fuzzy-insert-completion-choice): Added flags. (slime-fuzzy-choices-buffer): Added flags header. * swank.lisp (fuzzy-completions): Changed docstring to describe new flags in the completion results. (convert-fuzzy-completion-result): New function to marshall the results from the completion core into something Emacs is expecting. Added flags. (fuzzy-completion-set): Use the above. (compute-completion): Removed. (score-completion): Cleaned up a little bit. (highlight-completion): Use destructive nstring-upcase. Date: Sun Nov 7 16:07:00 2004 Author: bdowning Index: slime/swank.lisp diff -u slime/swank.lisp:1.258 slime/swank.lisp:1.259 --- slime/swank.lisp:1.258 Mon Nov 1 18:15:55 2004 +++ slime/swank.lisp Sun Nov 7 16:07:00 2004 @@ -1939,12 +1939,14 @@ The result is a list of completion objects, where a completion object is: - (COMPLETED-STRING SCORE (&rest CHUNKS)) + (COMPLETED-STRING SCORE (&rest CHUNKS) FLAGS) where a CHUNK is a description of a matched string of characters: (OFFSET STRING) +and FLAGS is a list of keywords describing properties of the symbol. For example, the top result for completing \"mvb\" in a package that uses COMMON-LISP would be something like: - (\"multiple-value-bind\" 42.391666 ((0 \"mul\") (9 \"v\") (15 \"b\"))) + (\"multiple-value-bind\" 42.391666 ((0 \"mul\") (9 \"v\") (15 \"b\")) + (:FBOUNDP :MACRO)) If STRING is package qualified the result list will also be qualified. If string is non-qualified the result strings are @@ -1958,8 +1960,55 @@ PKG::FOO - Symbols accessible in package PKG." (fuzzy-completion-set string default-package-name limit)) +(defun convert-fuzzy-completion-result (result converter + internal-p package-name) + "Converts a result from the fuzzy completion core into +something that emacs is expecting. Converts symbols to strings, +fixes case issues, and adds information describing if the symbol +is :bound, :fbound, a :class, a :macro, a :generic-function, +a :special-operator, or a :package." + (destructuring-bind (symbol-or-name score chunks) result + (multiple-value-bind (name added-length) + (format-completion-result + (funcall converter + (if (symbolp symbol-or-name) + (symbol-name symbol-or-name) + symbol-or-name)) + internal-p package-name) + (list name score + (mapcar + #'(lambda (chunk) + ;; fix up chunk positions to account for possible + ;; added package identifier + (list (+ added-length (first chunk)) + (second chunk))) + chunks) + (loop for flag in '(:boundp :fboundp :generic-function + :class :macro :special-operator + :package) + if (if (symbolp symbol-or-name) + (case flag + (:boundp (boundp symbol-or-name)) + (:fboundp (fboundp symbol-or-name)) + (:class (find-class symbol-or-name nil)) + (:macro (macro-function symbol-or-name)) + (:special-operator + (special-operator-p symbol-or-name)) + (:generic-function + (typep (ignore-errors (fdefinition symbol-or-name)) + 'generic-function))) + (case flag + (:package (stringp symbol-or-name) + ;; KLUDGE: depends on internal + ;; knowledge that packages are + ;; brought up from the bowels of + ;; the completion algorithm as + ;; strings! + ))) + collect flag))))) + (defun fuzzy-completion-set (string default-package-name &optional limit) - "Prepares list of completion objects, sorted by SCORE, of fuzzy + "Prepares list of completion obajects, sorted by SCORE, of fuzzy completions of STRING in DEFAULT-PACKAGE-NAME. If LIMIT is set, only the top LIMIT results will be returned." (multiple-value-bind (name package-name package internal-p) @@ -1973,26 +2022,10 @@ (fuzzy-find-matching-packages name))) (converter (output-case-converter name)) (results - (sort (mapcar - #'(lambda (result) - (destructuring-bind (symbol-or-name score chunks) result - (multiple-value-bind (name added-length) - (format-completion-result - (funcall converter - (if (symbolp symbol-or-name) - (symbol-name symbol-or-name) - symbol-or-name)) - internal-p package-name) - (list name score - (mapcar - #'(lambda (chunk) - ;; fix up chunk positions to - ;; account for possible added - ;; package identifier - (list (+ added-length (first chunk)) - (second chunk))) - chunks))))) - (nconc symbols packs)) + (sort (mapcar #'(lambda (result) + (convert-fuzzy-completion-result + result converter internal-p package-name)) + (nconc symbols packs)) #'> :key #'second))) (when (and limit (> limit 0) @@ -2151,17 +2184,6 @@ (push rev-chunks *all-chunks*) rev-chunks)))) -;;; XXX Debugging tool? Not called anywhere. -luke (11/Jul/2004) -(defun compute-completion (short full test) - "Finds the first way to complete FULL with the letters in SHORT. -Calls RECURSIVELY-COMPUTE-MOST-COMPLETIONS non-recursively. -Returns a list of one (&rest CHUNKS), where CHUNKS is a -description of how the completion matched." - (let ((*all-chunks* nil)) - (declare (special *all-chunks*)) - (recursively-compute-most-completions short full test 0 0 nil nil nil nil) - *all-chunks*)) - ;;;;; Fuzzy completion scoring (defparameter *fuzzy-completion-symbol-prefixes* "*+-%&?<" @@ -2201,53 +2223,44 @@ Finally, a small scaling factor is applied to favor shorter matches, all other things being equal." - (flet ((score-chunk (chunk) - (let ((initial-pos (first chunk)) - (str (second chunk))) - (labels ((at-beginning-p (pos) - (= pos 0)) - (after-prefix-p (pos) - (and (= pos 1) - (find (aref full 0) - *fuzzy-completion-symbol-prefixes*))) - (word-separator-p (pos) - (find (aref full pos) - *fuzzy-completion-word-separators*)) - (after-word-separator-p (pos) - (find (aref full (1- pos)) - *fuzzy-completion-word-separators*)) - (at-end-p (pos) - (= pos (1- (length full)))) - (before-suffix-p (pos) - (and (= pos (- (length full) 2)) - (find (aref full (1- (length full))) - *fuzzy-completion-symbol-suffixes*))) - (score-or-percentage-of-previous - (base-score pos chunk-pos) - (if (zerop chunk-pos) - base-score - (max base-score - (* (score-char (1- pos) (1- chunk-pos)) - 0.85)))) - (score-char (pos chunk-pos) - (score-or-percentage-of-previous - (cond ((at-beginning-p pos) 10) - ((after-prefix-p pos) 10) - ((word-separator-p pos) 1) - ((after-word-separator-p pos) 8) - ((at-end-p pos) 6) - ((before-suffix-p pos) 6) - (t 1)) - pos chunk-pos))) - (loop for chunk-pos below (length str) - for pos from initial-pos - summing (score-char pos chunk-pos)))))) + (labels ((at-beginning-p (pos) + (= pos 0)) + (after-prefix-p (pos) + (and (= pos 1) + (find (aref full 0) *fuzzy-completion-symbol-prefixes*))) + (word-separator-p (pos) + (find (aref full pos) *fuzzy-completion-word-separators*)) + (after-word-separator-p (pos) + (find (aref full (1- pos)) *fuzzy-completion-word-separators*)) + (at-end-p (pos) + (= pos (1- (length full)))) + (before-suffix-p (pos) + (and (= pos (- (length full) 2)) + (find (aref full (1- (length full))) + *fuzzy-completion-symbol-suffixes*))) + (score-or-percentage-of-previous (base-score pos chunk-pos) + (if (zerop chunk-pos) + base-score + (max base-score + (* (score-char (1- pos) (1- chunk-pos)) 0.85)))) + (score-char (pos chunk-pos) + (score-or-percentage-of-previous + (cond ((at-beginning-p pos) 10) + ((after-prefix-p pos) 10) + ((word-separator-p pos) 1) + ((after-word-separator-p pos) 8) + ((at-end-p pos) 6) + ((before-suffix-p pos) 6) + (t 1)) + pos chunk-pos)) + (score-chunk (chunk) + (loop for chunk-pos below (length (second chunk)) + for pos from (first chunk) + summing (score-char pos chunk-pos)))) (let* ((chunk-scores (mapcar #'score-chunk completion)) - (length-score - (/ 10 (coerce (1+ (- (length full) (length short))) - 'single-float)))) + (length-score (/ 10.0 (1+ (- (length full) (length short)))))) (values - (+ (apply #'+ chunk-scores) length-score) + (+ (reduce #'+ chunk-scores) length-score) (list (mapcar #'list chunk-scores completion) length-score))))) (defun highlight-completion (completion full) @@ -2255,12 +2268,12 @@ HIGHLIGHT-COMPLETION will create a string that demonstrates where the completion matched in the string. Matches will be capitalized, while the rest of the string will be lower-case." - (let ((highlit (string-downcase full))) + (let ((highlit (nstring-downcase (copy-seq full)))) (dolist (chunk completion) - (setf highlit (string-upcase highlit - :start (first chunk) - :end (+ (first chunk) - (length (second chunk)))))) + (setf highlit (nstring-upcase highlit + :start (first chunk) + :end (+ (first chunk) + (length (second chunk)))))) highlit)) (defun format-fuzzy-completions (winners) Index: slime/slime.el diff -u slime/slime.el:1.417 slime/slime.el:1.418 --- slime/slime.el:1.417 Mon Nov 1 17:56:38 2004 +++ slime/slime.el Sun Nov 7 16:07:00 2004 @@ -4571,6 +4571,7 @@ "Click on a completion to select it. In this buffer, type n and p to navigate between completions. Type RET to select the completion near point. Type q to abort. +Flags: boundp fboundp generic-function class macro special-operator \n" "The explanation that gets inserted at the beginning of the *Fuzzy Completions* buffer.") @@ -4582,7 +4583,8 @@ (let ((start (point)) (symbol (first completion)) (score (second completion)) - (chunks (third completion))) + (chunks (third completion)) + (flags (fourth completion))) (insert symbol) (let ((end (point))) (dolist (chunk chunks) @@ -4593,7 +4595,14 @@ (put-text-property start (point) 'mouse-face 'highlight) (dotimes (i (- max-length (- end start))) (insert " ")) - (insert (format " %8.2f" score)) + (insert (format " %s%s%s%s%s%s %8.2f" + (if (member :boundp flags) "b" "-") + (if (member :fboundp flags) "f" "-") + (if (member :generic-function flags) "g" "-") + (if (member :class flags) "c" "-") + (if (member :macro flags) "m" "-") + (if (member :special-operator flags) "s" "-") + score)) (insert "\n") (put-text-property start (point) 'completion completion)))) @@ -4641,9 +4650,9 @@ (setf max-length (max max-length (length (first completion))))) (insert "Completion:") (dotimes (i (- max-length 10)) (insert " ")) - (insert "Score:\n") + (insert "Flags: Score:\n") (dotimes (i max-length) (insert "-")) - (insert " --------\n") + (insert " ------ --------\n") (setq slime-fuzzy-first (point)) (dolist (completion completions) (slime-fuzzy-insert-completion-choice completion max-length)) Index: slime/ChangeLog diff -u slime/ChangeLog:1.564 slime/ChangeLog:1.565 --- slime/ChangeLog:1.564 Mon Nov 1 18:29:48 2004 +++ slime/ChangeLog Sun Nov 7 16:07:00 2004 @@ -1,3 +1,21 @@ +2004-11-07 Brian Downing + + * slime.el (slime-fuzzy-explanation): Added line to describe + flags (:boundp, :fboundp, :macro, etc), which are now reported in + the fuzzy-completion output. + (slime-fuzzy-insert-completion-choice): Added flags. + (slime-fuzzy-choices-buffer): Added flags header. + + * swank.lisp (fuzzy-completions): Changed docstring to describe + new flags in the completion results. + (convert-fuzzy-completion-result): New function to marshall the + results from the completion core into something Emacs is + expecting. Added flags. + (fuzzy-completion-set): Use the above. + (compute-completion): Removed. + (score-completion): Cleaned up a little bit. + (highlight-completion): Use destructive nstring-upcase. + 2004-11-01 Helmut Eller * slime.el (slime-easy-menu): Add item for From heller at common-lisp.net Tue Nov 9 10:23:34 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 09 Nov 2004 11:23:34 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23734 Modified Files: slime.el Log Message: (slime-eval-feature-conditional): Convert AND, OR, and NOT to lowercase keywords. (slime-net-read3): Silly optimization: use give char-after the offset as argument to avoid save-excursion and forward-char. Date: Tue Nov 9 11:23:33 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.418 slime/slime.el:1.419 --- slime/slime.el:1.418 Sun Nov 7 16:07:00 2004 +++ slime/slime.el Tue Nov 9 11:23:30 2004 @@ -1551,10 +1551,9 @@ (defun slime-net-read3 () "Read a 24-bit big-endian integer from buffer." - (save-excursion - (logior (prog1 (ash (char-after) 16) (forward-char 1)) - (prog1 (ash (char-after) 8) (forward-char 1)) - (char-after)))) + (logior (ash (char-after 1) 16) + (ash (char-after 2) 8) + (char-after 3))) (defun slime-net-enc3 (n) "Encode an integer into a 24-bit big-endian string." @@ -3905,10 +3904,10 @@ "Interpret a reader conditional expression." (if (symbolp e) (memq (slime-to-feature-keyword e) (slime-lisp-features)) - (funcall (ecase (car e) - ((and AND) #'every) - ((or OR) #'some) - ((not NOT) (lambda (f l) (not (apply f l))))) + (funcall (ecase (slime-to-feature-keyword (car e)) + (:and #'every) + (:or #'some) + (:not (lambda (f l) (not (apply f l))))) #'slime-eval-feature-conditional (cdr e)))) From heller at common-lisp.net Tue Nov 9 10:27:16 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 09 Nov 2004 11:27:16 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23874 Modified Files: swank.lisp Log Message: (features-for-emacs): New function to avoid keyword/string confusion. Case doesn't matter since Emacs will downcase them anyway. (connection-info, sync-features-to-emacs): Use it. Should fix highlighting bug reported by Edi Weitz. Date: Tue Nov 9 11:27:14 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.259 slime/swank.lisp:1.260 --- slime/swank.lisp:1.259 Sun Nov 7 16:07:00 2004 +++ slime/swank.lisp Tue Nov 9 11:27:13 2004 @@ -912,10 +912,11 @@ (defslimefun connection-info () "Return a list of the form: \(PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)." + (setq *slime-features* *features*) (list (getpid) (lisp-implementation-type) (lisp-implementation-type-name) - (setq *slime-features* *features*))) + (features-for-emacs))) ;;;; Reading and printing @@ -3279,7 +3280,11 @@ ;; FIXME: *slime-features* should be connection-local (unless (eq *slime-features* *features*) (setq *slime-features* *features*) - (send-to-emacs (list :new-features (mapcar #'symbol-name *features*))))) + (send-to-emacs (list :new-features (features-for-emacs))))) + +(defun features-for-emacs () + "Return `*slime-features*' in a format suitable to send it to Emacs." + *slime-features*) (add-hook *pre-reply-hook* 'sync-features-to-emacs) From heller at common-lisp.net Tue Nov 9 10:28:28 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 09 Nov 2004 11:28:28 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23905 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Nov 9 11:28:26 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.565 slime/ChangeLog:1.566 --- slime/ChangeLog:1.565 Sun Nov 7 16:07:00 2004 +++ slime/ChangeLog Tue Nov 9 11:28:26 2004 @@ -1,3 +1,16 @@ +2004-11-09 Helmut Eller + + * swank.lisp (features-for-emacs): New function to avoid + keyword/string confusion. Case doesn't matter since Emacs will + downcase them anyway. + (connection-info, sync-features-to-emacs): Use it. Should fix + highlighting bug reported by Edi Weitz. + + * slime.el (slime-eval-feature-conditional): Convert AND, OR, and + NOT to lowercase keywords. + (slime-net-read3): Silly optimization: give char-after the offset + as argument to avoid save-excursion and forward-char. + 2004-11-07 Brian Downing * slime.el (slime-fuzzy-explanation): Added line to describe From asimon at common-lisp.net Tue Nov 9 12:15:48 2004 From: asimon at common-lisp.net (Andras Simon) Date: Tue, 09 Nov 2004 13:15:48 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv30431 Modified Files: slime.el Log Message: call slime-start-lisp in ,restart-inferior-lisp with the right number of args Date: Tue Nov 9 13:15:45 2004 Author: asimon Index: slime/slime.el diff -u slime/slime.el:1.419 slime/slime.el:1.420 --- slime/slime.el:1.419 Tue Nov 9 11:23:30 2004 +++ slime/slime.el Tue Nov 9 13:15:44 2004 @@ -3094,7 +3094,7 @@ (sit-for 0 20)) (let* ((args (mapconcat #'identity (process-command proc) " ")) (buffer (buffer-name (process-buffer proc))) - (new-proc (slime-start-lisp args buffer))) + (new-proc (slime-start-lisp args buffer (slime-init-command)))) (slime-inferior-connect new-proc))))) (:one-liner "Restart *inferior-lisp* and reconnect SLIME.")) From mbaringer at common-lisp.net Tue Nov 9 22:58:02 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 09 Nov 2004 23:58:02 +0100 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3692 Modified Files: swank-backend.lisp Log Message: (definterface): Eliminate unused variable received-args. (emacs-connected, make-stream-interactive, condition-references, condition-extras, buffer-first-change): Add (declare (ignore X)) for unused arguments in default implementations. (inspect-for-emacs): Remove (declare (ignore)) for inexistent variable inspection-mode. Added T qualifiers in method arguments. Date: Tue Nov 9 23:58:01 2004 Author: mbaringer Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.72 slime/swank-backend.lisp:1.73 --- slime/swank-backend.lisp:1.72 Mon Nov 1 18:19:35 2004 +++ slime/swank-backend.lisp Tue Nov 9 23:58:01 2004 @@ -106,8 +106,7 @@ Backends implement these functions using DEFIMPLEMENTATION." (check-type documentation string "a documentation string") (flet ((gen-default-impl () - (let ((received-args (gensym "ARGS-"))) - `(defmethod ,name ,args , at default-body)))) + `(defmethod ,name ,args , at default-body))) `(progn (defgeneric ,name ,args (:documentation ,documentation)) (pushnew ',name *interface-functions*) ,(if (null default-body) @@ -214,8 +213,9 @@ that the calling thread is the one that interacts with Emacs. STREAM is the redirected user output stream to Emacs. This is passed -so that the backend can apply buffer flushing magic." - nil) +so that the backend can apply buffer flushing magic." + (declare (ignore stream)) + nil) ;;;; Unix signals @@ -346,6 +346,7 @@ \(e.g. *standard-output*). An implementation could setup some implementation-specific functions to control output flushing at the like." + (declare (ignore stream)) nil) @@ -444,6 +445,7 @@ (definterface frame-package (frame) "Return the preferred package to use when printing local variables. NIL can be used if no particular package is known." + (declare (ignore frame)) nil) (definterface frame-source-location-for-emacs (frame-number) @@ -507,12 +509,14 @@ {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY } symbol-or-name) (:SBCL :NODE node-name)" + (declare (ignore condition)) '()) (definterface condition-extras (condition) "Return a list of extra for the debugger. The allowed elements are of the form: (:SHOW-FRAME-SOURCE frame-number)" + (declare (ignore condition)) '()) (definterface activate-stepping (frame-number) @@ -556,6 +560,7 @@ (definterface buffer-first-change (filename) "Called for effect the first time FILENAME's buffer is modified." + (declare (ignore filename)) nil) @@ -678,12 +683,12 @@ NIL - do nothing.") -(defmethod inspect-for-emacs (object inspector) +(defmethod inspect-for-emacs ((object t) (inspector t)) "Generic method for inspecting any kind of object. Since we don't know how to deal with OBJECT we simply dump the output of CL:DESCRIBE." - (declare (ignore inspector inspection-mode)) + (declare (ignore inspector)) (values "A value." `("Type: " (:value ,(type-of object)) (:newline) From mbaringer at common-lisp.net Tue Nov 9 22:58:24 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Tue, 09 Nov 2004 23:58:24 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv3711 Modified Files: ChangeLog Log Message: Date: Tue Nov 9 23:58:23 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.566 slime/ChangeLog:1.567 --- slime/ChangeLog:1.566 Tue Nov 9 11:28:26 2004 +++ slime/ChangeLog Tue Nov 9 23:58:23 2004 @@ -1,3 +1,19 @@ +2004-11-10 Marco Baringer + + * swank-backend.lisp (definterface): Eliminate unused variable + received-args. + (emacs-connected, make-stream-interactive, condition-references, + condition-extras, buffer-first-change): Add (declare (ignore X)) + for unused arguments in default implementations. + (inspect-for-emacs): Remove (declare (ignore)) for inexistent + variable inspection-mode. Added T qualifiers in method arguments. + + * swank-openmcl.lisp (inspect-for-emacs): Use definterface so + SLIME knows we implement this. + (arglist function): Use ccl:arglist, not ccl::arglist-from-map. + (inspect-for-emacs): Added support for inspecting the uvector + objects under lisp datums. + 2004-11-09 Helmut Eller * swank.lisp (features-for-emacs): New function to avoid From heller at common-lisp.net Thu Nov 11 22:20:09 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 11 Nov 2004 23:20:09 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22293 Modified Files: slime.el Log Message: (slime-activate-font-lock-magic): Add support XEmacs. From Raymond Toy. Date: Thu Nov 11 23:20:06 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.420 slime/slime.el:1.421 --- slime/slime.el:1.420 Tue Nov 9 13:15:44 2004 +++ slime/slime.el Thu Nov 11 23:20:02 2004 @@ -7030,13 +7030,14 @@ (slime-connected-p) (re-search-forward "^\\([^;\n]*[ \t(]\\)?#[-+]" limit t)) (ignore-errors - (let* ((char (char-before)) + (let* ((start (- (point) 2)) + (char (char-before)) (e (read (current-buffer))) (val (slime-eval-feature-conditional e))) (when (<= (point) limit) (if (or (and (eq char ?+) (not val)) (and (eq char ?-) val)) - (let ((start (point))) + (progn (forward-sexp) (assert (<= (point) limit)) (let ((md (match-data))) @@ -7047,14 +7048,19 @@ t)) (slime-search-suppressed-forms limit))))))) -;; XXX add XEmacs compatibility (defun slime-activate-font-lock-magic () - (font-lock-add-keywords - 'lisp-mode - '((slime-search-suppressed-forms 0 font-lock-comment-face t)))) + (if (featurep 'xemacs) + (let ((pattern '((slime-search-suppressed-forms + (0 font-lock-comment-face t))))) + (dolist (sym '(lisp-font-lock-keywords + lisp-font-lock-keywords-1 + lisp-font-lock-keywords-2)) + (set sym (append (symbol-value sym) pattern)))) + (font-lock-add-keywords + 'lisp-mode + '((slime-search-suppressed-forms 0 font-lock-comment-face t))))) -(when (and (fboundp 'font-lock-add-keywords) - slime-highlight-suppressed-forms) +(when slime-highlight-suppressed-forms (slime-activate-font-lock-magic)) From heller at common-lisp.net Thu Nov 11 22:27:56 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 11 Nov 2004 23:27:56 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22435 Modified Files: slime.el Log Message: (slime-reader-conditional-face): New face. Date: Thu Nov 11 23:27:51 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.421 slime/slime.el:1.422 --- slime/slime.el:1.421 Thu Nov 11 23:20:02 2004 +++ slime/slime.el Thu Nov 11 23:27:50 2004 @@ -7024,6 +7024,16 @@ :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil)) :group 'slime-mode) +(defface slime-reader-conditional-face + (if (slime-face-inheritance-possible-p) + '((t (:inherit font-lock-comment-face))) + '((((class grayscale) (background light)) + (:foreground "DimGray" :weight bold)) + (((class grayscale) (background dark)) + (:foreground "LightGray" :weight bold)))) + "Face for compiler notes while selected." + :group 'slime-mode-faces) + (defun slime-search-suppressed-forms (limit) "Find reader conditionalized forms where the test is false." (when (and slime-highlight-suppressed-forms @@ -7050,15 +7060,15 @@ (defun slime-activate-font-lock-magic () (if (featurep 'xemacs) - (let ((pattern '((slime-search-suppressed-forms - (0 font-lock-comment-face t))))) + (let ((pattern `((slime-search-suppressed-forms + (0 slime-reader-conditional-face t))))) (dolist (sym '(lisp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)) (set sym (append (symbol-value sym) pattern)))) (font-lock-add-keywords 'lisp-mode - '((slime-search-suppressed-forms 0 font-lock-comment-face t))))) + `((slime-search-suppressed-forms 0 ,''slime-reader-conditional-face t))))) (when slime-highlight-suppressed-forms (slime-activate-font-lock-magic)) From heller at common-lisp.net Thu Nov 11 22:30:26 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 11 Nov 2004 23:30:26 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv22589 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Nov 11 23:30:22 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.567 slime/ChangeLog:1.568 --- slime/ChangeLog:1.567 Tue Nov 9 23:58:23 2004 +++ slime/ChangeLog Thu Nov 11 23:30:20 2004 @@ -1,3 +1,8 @@ +2004-11-11 Raymond Toy + + * slime.el (slime-activate-font-lock-magic): Add XEmacs support. + (slime-reader-conditional-face): New face. + 2004-11-10 Marco Baringer * swank-backend.lisp (definterface): Eliminate unused variable From heller at common-lisp.net Mon Nov 15 22:42:53 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 15 Nov 2004 23:42:53 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16705 Modified Files: slime.el Log Message: (slime-communication-style): New connection variable. (slime-use-sigint-for-interrupt): Is no longer a connection local variable. It's derived from the new slime-communication-style. (slime-inhibit-pipelining): New user option. (slime-background-activities-enabled-p): New predicate to control various background activities like autodoc and arglist fetching. (slime-space, slime-autodoc-message-ok-p): Use it. (slime-search-call-site): Use hints provided to search a call-site in a defun. Useful for the show-frame-source command. (slime-goto-source-location): Use it. The REPL commands ,quit and ,sayoonara are now distinct. Previously Quit killed all Lisps an all buffers. The Quit command kills only the current Lisp. (slime-quit-lisp): New function. (repl-command quit): Use it. Don't delete all buffers. (repl-command sayoonara): No longer an alias for ,quit. (slime-connection-list-mode-map): Bind C-k to slime-quit-lisp. (slime-quit): Deleted, as it was broken. May come back later. (slime-inspector-label-face, slime-inspector-value-face) (slime-inspector-action-face, slime-reader-conditional-face): Provide better defaults for Emacsen which don't support :inherited faces. Date: Mon Nov 15 23:42:52 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.422 slime/slime.el:1.423 --- slime/slime.el:1.422 Thu Nov 11 23:27:50 2004 +++ slime/slime.el Mon Nov 15 23:42:50 2004 @@ -1739,12 +1739,12 @@ (slime-def-connection-var slime-connection-name nil "The short name for connection.") -(slime-def-connection-var slime-use-sigint-for-interrupt nil - "Non-nil means use SIGINT for interrupting.") - (slime-def-connection-var slime-inferior-process nil "The inferior process for the connection if any.") +(slime-def-connection-var slime-communication-style nil + "The communication style.") + ;;;;; Connection setup (defvar slime-connection-counter 0 @@ -1776,12 +1776,13 @@ (defun slime-set-connection-info (connection info) "Initialize CONNECTION with INFO received from Lisp." - (destructuring-bind (pid type name features) info + (destructuring-bind (pid type name features style) info (setf (slime-pid) pid (slime-lisp-implementation-type) type (slime-lisp-implementation-type-name) name (slime-connection-name) (slime-generate-connection-name name) - (slime-lisp-features) features)) + (slime-lisp-features) features + (slime-communication-style) style)) (setq slime-state-name "") ; FIXME (slime-hide-inferior-lisp-buffer) (slime-init-output-buffer connection) @@ -1855,6 +1856,20 @@ (defun slime-set-inferior-process (connection process) (setf (slime-inferior-process connection) process)) +(defun slime-use-sigint-for-interrupt (&optional connection) + (let ((c (or connection (slime-connection)))) + (ecase (slime-communication-style c) + ((:fd-handler nil) t) + ((:spawn :sigio) nil)))) + +(defvar slime-inhibit-pipelining t + "*If true, don't send background requests if Lisp already busy.") + +(defun slime-background-activities-enabled-p () + (and (slime-connected-p) + (or (not (slime-busy-p)) + (not slime-inhibit-pipelining)))) + ;;;; Communication protocol @@ -2048,7 +2063,7 @@ "Check that communication works." (interactive) (message "%s" (slime-eval "PONG"))) - + ;;;;; Protocol event handler (the guts) ;;; ;;; This is the protocol in all its glory. The input to this function @@ -2118,8 +2133,6 @@ (slime-handle-indentation-update info)) ((:open-dedicated-output-stream port) (slime-open-stream-to-lisp port)) - ((:use-sigint-for-interrupt) - (setf (slime-use-sigint-for-interrupt) t)) ((:%apply fn args) (apply (intern fn) args)) ((:ed what) @@ -2629,19 +2642,19 @@ (slime-repl-find-prompt (slime-search-property-change-fn 'slime-repl-prompt))) -(defun slime-repl-return () +(defun slime-repl-return (&optional end-of-input) "Evaluate the current input string, or insert a newline. Send the current input ony if a whole expression has been entered, i.e. the parenthesis are matched. With prefix argument send the input even if the parenthesis are not balanced." - (interactive) + (interactive "P") (slime-check-connected) (assert (<= (point) slime-repl-input-end-mark)) (cond ((get-text-property (point) 'slime-repl-old-input) (slime-repl-grab-old-input)) - (current-prefix-arg + (end-of-input (slime-repl-send-input)) (slime-repl-read-mode ; bad style? (slime-repl-send-input t)) @@ -2982,7 +2995,7 @@ (interactive) (let ((dir (slime-eval `(swank:default-directory)))) (message "Directory %s" dir)))) - (:one-liner "Change the current directory.")) + (:one-liner "Show the current directory.")) (defslime-repl-shortcut slime-repl-push-directory ("push-directory" "+d" "pushd") @@ -3030,13 +3043,17 @@ (slime-repl-send-input))) (:one-liner "Resend the last form.")) -(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara" "quit") +(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara") (:handler (lambda () (interactive) (when (slime-connected-p) (slime-eval-async '(swank:quit-lisp))) (slime-kill-all-buffers))) - (:one-liner "Quit the lisp and close all SLIME buffers.")) + (:one-liner "Quit all Lisps and close all SLIME buffers.")) + +(defslime-repl-shortcut slime-repl-quit ("quit") + (:handler 'slime-quit-lisp) + (:one-liner "Quit the current Lisp.")) (defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!") (:handler (lambda (name value) @@ -3094,7 +3111,8 @@ (sit-for 0 20)) (let* ((args (mapconcat #'identity (process-command proc) " ")) (buffer (buffer-name (process-buffer proc))) - (new-proc (slime-start-lisp args buffer (slime-init-command)))) + (new-proc (slime-start-lisp args buffer + (slime-init-command)))) (slime-inferior-connect new-proc))))) (:one-liner "Restart *inferior-lisp* and reconnect SLIME.")) @@ -3818,6 +3836,19 @@ (slime-isearch text) (forward-char delta)))) +(defun slime-search-call-site (fname) + "Move to the place where FNAME called. +Don't move if there are multiple or no calls in the current defun." + (save-restriction + (narrow-to-defun) + (let ((start (point)) + (regexp (concat "(" fname "[\n \t]"))) + (cond ((and (re-search-forward regexp nil t) + (not (re-search-forward regexp nil t))) + (goto-char (match-beginning 0))) + (t (goto-char start)))))) + + (defun slime-goto-source-location (location &optional noerror) "Move to the source location LOCATION. Several kinds of locations are supported: @@ -3840,7 +3871,9 @@ (slime-goto-location-buffer buffer) (slime-goto-location-position position) (when-let (snippet (getf hints :snippet)) - (slime-isearch snippet))) + (slime-isearch snippet)) + (when-let (fname (getf hints :call-site)) + (slime-search-call-site fname))) ((:error message) (if noerror (slime-message "%s" message) @@ -4049,11 +4082,7 @@ (interactive "p") (unwind-protect (when (and slime-space-information-p - (slime-connected-p) - (or (not (slime-busy-p)) - ;; XXX should we enable this? - ;; (not slime-use-sigint-for-interrupt)) - )) + (slime-background-activities-enabled-p)) (let ((names (slime-enclosing-operator-names))) (when names (slime-eval-async @@ -4211,8 +4240,7 @@ (not (and (boundp 'edebug-active) (symbol-value 'edebug-active))) (not cursor-in-echo-area) (not (eq (selected-window) (minibuffer-window))) - (slime-connected-p) - (not (slime-busy-p)))) + (slime-background-activities-enabled-p))) ;;;; Typeout frame @@ -5555,10 +5583,19 @@ (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread))) (defun slime-quit () + (error "Not implemented properly. Use `slime-interrupt' instead.")) + +(defun slime-quit-lisp () + "Quit lisp, kill the inferior process and associated buffers." (interactive) - (if (slime-busy-p) - (slime-dispatch-event '(:emacs-quit)) - (error "Not evaluating - nothing to quit."))) + (let* ((connection (slime-connection)) + (output (slime-output-buffer)) + (inferior (slime-inferior-process)) + (inferior-buffer (if inferior (process-buffer inferior)))) + (slime-eval-async '(swank:quit-lisp)) + (kill-buffer output) + (when inferior (delete-process inferior)) + (when inferior-buffer (kill-buffer inferior-buffer)))) (defun slime-set-package (package) (interactive (list (slime-read-package-name "Package: " @@ -6498,7 +6535,8 @@ (slime-define-keys slime-connection-list-mode-map ((kbd "RET") 'slime-goto-connection) ("d" 'slime-connection-list-make-default) - ("g" 'slime-update-connection-list)) + ("g" 'slime-update-connection-list) + ((kbd "C-k") 'slime-quit-connection-at-point)) (defun slime-connection-at-point () (or (get-text-property (point) 'slime-connection) @@ -6510,6 +6548,14 @@ (let ((slime-dispatching-connection (slime-connection-at-point))) (switch-to-buffer (slime-output-buffer)))) +(defun slime-quit-connection-at-point (connection) + (interactive (list (slime-connection-at-point))) + (let ((slime-dispatching-connection connection)) + (slime-quit-lisp) + (while (memq connection slime-net-processes) + (sit-for 0 100))) + (slime-update-connection-list)) + (defun slime-connection-list-make-default () "Make the connection at point the default connection." (interactive) @@ -6540,7 +6586,7 @@ (defun slime-draw-connection-list () (let ((default-pos nil) (default slime-default-connection) - (fstring "%s%2s %-7s %-17s %-7s %-s\n")) + (fstring "%s%2s %-10s %-17s %-7s %-s\n")) (insert (format fstring " " "Nr" "Name" "Port" "Pid" "Type") (format fstring " " "--" "----" "----" "---" "----")) (dolist (p (reverse slime-net-processes)) @@ -6571,17 +6617,22 @@ :group 'slime-inspector) (defface slime-inspector-label-face - '((t (:inherit font-lock-constant-face))) + '((t (:inherit font-lock-constant-face))) "Face for labels in the inspector." :group 'slime-inspector) (defface slime-inspector-value-face - '((t (:inherit font-lock-builtin-face))) + (if (slime-face-inheritance-possible-p) + '((t (:inherit font-lock-builtin-face))) + '((((background light)) (:foreground "MediumBlue" :bold t)) + (((background dark)) (:foreground "LightGray" :bold t)))) "Face for things which can themselves be inspected." :group 'slime-inspector) (defface slime-inspector-action-face - '((t (:inherit font-lock-warning-face))) + (if (slime-face-inheritance-possible-p) + '((t (:inherit font-lock-warning-face))) + '((t (:foreground "OrangeRed")))) "Face for labels of inspector actions." :group 'slime-inspector) @@ -7026,11 +7077,9 @@ (defface slime-reader-conditional-face (if (slime-face-inheritance-possible-p) - '((t (:inherit font-lock-comment-face))) - '((((class grayscale) (background light)) - (:foreground "DimGray" :weight bold)) - (((class grayscale) (background dark)) - (:foreground "LightGray" :weight bold)))) + '((t (:inherit font-lock-comment-face))) + '((((background light)) (:foreground "DimGray" :bold t)) + (((background dark)) (:foreground "LightGray" :bold t)))) "Face for compiler notes while selected." :group 'slime-mode-faces) From heller at common-lisp.net Mon Nov 15 22:45:25 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 15 Nov 2004 23:45:25 +0100 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17012 Modified Files: swank-backend.lisp Log Message: (emacs-connected): Don't pass the stream as argument. make-stream-interactive is a better place for setting buffering options. Date: Mon Nov 15 23:45:23 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.73 slime/swank-backend.lisp:1.74 --- slime/swank-backend.lisp:1.73 Tue Nov 9 23:58:01 2004 +++ slime/swank-backend.lisp Mon Nov 15 23:45:23 2004 @@ -204,17 +204,13 @@ ;;; Base condition for networking errors. (define-condition network-error (simple-error) ()) -(definterface emacs-connected (stream) +(definterface emacs-connected () "Hook called when the first connection from Emacs is established. Called from the INIT-FN of the socket server that accepts the connection. This is intended for setting up extra context, e.g. to discover -that the calling thread is the one that interacts with Emacs. - -STREAM is the redirected user output stream to Emacs. This is passed -so that the backend can apply buffer flushing magic." - (declare (ignore stream)) +that the calling thread is the one that interacts with Emacs." nil) From heller at common-lisp.net Mon Nov 15 22:48:41 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 15 Nov 2004 23:48:41 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17512 Modified Files: swank.lisp Log Message: (defstruct connection): Add new slot: communication-style for convenience. (create-connection): Initialize the new slot. (connection-info): Send the communication-style to Emacs. (install-fd-handler, simple-serve-requests): Sending :use-sigint-for-interrupt is no longer necessary. (notify-backend-of-connection): Don't pass the output stream to the backend. Date: Mon Nov 15 23:48:39 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.260 slime/swank.lisp:1.261 --- slime/swank.lisp:1.260 Tue Nov 9 11:27:13 2004 +++ slime/swank.lisp Mon Nov 15 23:48:39 2004 @@ -169,7 +169,10 @@ ;; Maps: symbol -> indentation-specification (indentation-cache (make-hash-table :test 'eq) :type hash-table) ;; The list of packages represented in the cache: - (indentation-cache-packages '())) + (indentation-cache-packages '()) + ;; The communication style used. + (communication-style nil :type (member nil :spawn :sigio :fd-handler)) + ) (defun print-connection (conn stream depth) (declare (ignore depth)) @@ -205,7 +208,8 @@ (add-hook *new-connection-hook* 'notify-backend-of-connection) (defun notify-backend-of-connection (connection) - (emacs-connected (connection.user-io connection))) + (declare (ignore connection)) + (emacs-connected)) ;;;; Helper macros @@ -557,7 +561,6 @@ client (lambda () (handle-request connection))))) ((eq (car *swank-state-stack*) :read-next-form)) (t (process-available-input client #'read-from-emacs))))) - (encode-message '(:use-sigint-for-interrupt) client) (setq *debugger-hook* (lambda (c h) (with-reader-error-handler (connection) @@ -576,7 +579,6 @@ (defun simple-serve-requests (connection) (let ((socket-io (connection.socket-io connection))) - (encode-message '(:use-sigint-for-interrupt) socket-io) (with-reader-error-handler (connection) (loop (handle-request connection))))) @@ -621,31 +623,33 @@ connection)) (defun create-connection (socket-io style) - (initialize-streams-for-connection - (ecase style - (:spawn - (make-connection :socket-io socket-io - :read #'read-from-control-thread - :send #'send-to-control-thread - :serve-requests #'spawn-threads-for-connection - :cleanup #'cleanup-connection-threads)) - (:sigio - (make-connection :socket-io socket-io - :read #'read-from-socket-io - :send #'send-to-socket-io - :serve-requests #'install-sigio-handler - :cleanup #'deinstall-sigio-handler)) - (:fd-handler - (make-connection :socket-io socket-io - :read #'read-from-socket-io - :send #'send-to-socket-io - :serve-requests #'install-fd-handler - :cleanup #'deinstall-fd-handler)) - ((nil) - (make-connection :socket-io socket-io - :read #'read-from-socket-io - :send #'send-to-socket-io - :serve-requests #'simple-serve-requests))))) + (let ((c (ecase style + (:spawn + (make-connection :socket-io socket-io + :read #'read-from-control-thread + :send #'send-to-control-thread + :serve-requests #'spawn-threads-for-connection + :cleanup #'cleanup-connection-threads)) + (:sigio + (make-connection :socket-io socket-io + :read #'read-from-socket-io + :send #'send-to-socket-io + :serve-requests #'install-sigio-handler + :cleanup #'deinstall-sigio-handler)) + (:fd-handler + (make-connection :socket-io socket-io + :read #'read-from-socket-io + :send #'send-to-socket-io + :serve-requests #'install-fd-handler + :cleanup #'deinstall-fd-handler)) + ((nil) + (make-connection :socket-io socket-io + :read #'read-from-socket-io + :send #'send-to-socket-io + :serve-requests #'simple-serve-requests))))) + (setf (connection.communication-style c) style) + (initialize-streams-for-connection c) + c)) ;;;; IO to Emacs @@ -916,7 +920,8 @@ (list (getpid) (lisp-implementation-type) (lisp-implementation-type-name) - (features-for-emacs))) + (features-for-emacs) + (connection.communication-style *emacs-connection*))) ;;;; Reading and printing From heller at common-lisp.net Mon Nov 15 22:59:46 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 15 Nov 2004 23:59:46 +0100 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv17762 Modified Files: swank-cmucl.lisp Log Message: (sos/misc :flush-output): There seem to be funny signal safety issues if the dedicated output stream is not used. So, lets first reset the buffer index before sending the buffer to the underlying stream. (emacs-connected): Install GC hooks to display GC messages in the echo area. Date: Mon Nov 15 23:59:44 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.127 slime/swank-cmucl.lisp:1.128 --- slime/swank-cmucl.lisp:1.127 Mon Nov 1 18:18:56 2004 +++ slime/swank-cmucl.lisp Mon Nov 15 23:59:44 2004 @@ -203,8 +203,9 @@ ((:force-output :finish-output) (let ((end (sos.index stream))) (unless (zerop end) - (funcall (sos.output-fn stream) (subseq (sos.buffer stream) 0 end)) - (setf (sos.index stream) 0)))) + (let ((s (subseq (sos.buffer stream) 0 end))) + (setf (sos.index stream) 0) + (funcall (sos.output-fn stream) s))))) (:charpos (sos.column stream)) (:line-length 75) (:file-position nil) @@ -2057,6 +2058,52 @@ (pop (mailbox.queue mbox))))) ) ;; #+mp + + + +;;;; GC hooks +;;; +;;; Display GC messages in the echo area to avoid cluttering the +;;; normal output. +;;; + +;; this should probably not be here, but where else? +(defun eval-in-emacs (form) + (let ((sym (find-symbol (string :eval-in-emacs) :swank))) + (funcall sym form))) + +(defun print-bytes (nbytes &optional stream) + "Print the number NBYTES to STREAM in KB, MB, or GB units." + (let ((names '((0 bytes) (10 kb) (20 mb) (30 gb) (40 tb) (50 eb)))) + (multiple-value-bind (power name) + (loop for ((p1 n1) (p2 n2)) on names + while n2 do + (when (<= (expt 2 p1) nbytes (1- (expt 2 p2))) + (return (values p1 n1)))) + (cond (name + (format stream "~,1F ~A" (/ nbytes (expt 2 power)) name)) + (t + (format stream "~:D bytes" nbytes)))))) + +(defun pre-gc-hook (bytes-in-use) + (let ((msg (format nil "[Commencing GC with ~A in use.]" + (print-bytes bytes-in-use)))) + (eval-in-emacs `(slime-background-message "%s" ,msg)))) + +(defun post-gc-hook (bytes-retained bytes-freed trigger) + (force-output) + (let ((msg (format nil "[GC completed. ~A freed ~A retained ~A trigger]" + (print-bytes bytes-freed) + (print-bytes bytes-retained) + (print-bytes trigger)))) + (eval-in-emacs `(slime-background-message "%s" ,msg)))) + +(defun install-gc-hooks () + (setq ext:*gc-notify-before* #'pre-gc-hook) + (setq ext:*gc-notify-after* #'post-gc-hook)) + +(defimplementation emacs-connected () + (install-gc-hooks)) ;; Local Variables: ;; pbook-heading-regexp: "^;;;\\(;+\\)" From heller at common-lisp.net Mon Nov 15 23:05:39 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 16 Nov 2004 00:05:39 +0100 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18777 Modified Files: swank-lispworks.lisp Log Message: (emacs-connected, make-stream-interactive): Move the soft-force-output stuff to make-stream-interactive. (frame-source-location-for-emacs): Pass the function name of the next (newer) frame as a hint to Emacs. This way we can highlight the call site in some cases, instead of the entire defun. (frame-location): Renamed from function-name-location. The argument is now a dspec, not only a name. Also include hints for Emacs. (lispworks-inspect): Simplified from old code. (inspect-for-emacs): Use it for also for simple functions. Date: Tue Nov 16 00:05:35 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.59 slime/swank-lispworks.lisp:1.60 --- slime/swank-lispworks.lisp:1.59 Fri Sep 17 14:50:41 2004 +++ slime/swank-lispworks.lisp Tue Nov 16 00:05:34 2004 @@ -120,14 +120,10 @@ (sys::set-signal-handler +sigint+ (make-sigint-handler mp:*current-process*))) -(defimplementation emacs-connected (stream) +(defimplementation emacs-connected () (declare (ignore stream)) (set-sigint-handler) (let ((lw:*handle-warn-on-redefinition* :warn)) - (defmethod stream:stream-soft-force-output ((o comm:socket-stream)) - (force-output o)) - (defmethod stream:stream-soft-force-output ((o slime-output-stream)) - (force-output o)) (defmethod env-internals:environment-display-notifier (env &key restarts condition) (declare (ignore restarts)) @@ -137,6 +133,11 @@ (env) *debug-io*))) +(defimplementation make-stream-interactive (stream) + (let ((lw:*handle-warn-on-redefinition* :warn)) + (defmethod stream:stream-soft-force-output ((o (eql stream))) + (force-output o)))) + ;;; Unix signals (defun sigint-handler () @@ -335,11 +336,14 @@ nil) (defimplementation frame-source-location-for-emacs (frame) - (let ((frame (nth-frame frame))) + (let ((frame (nth-frame frame)) + (callee (if (plusp frame) (nth-frame (1- frame))))) (if (dbg::call-frame-p frame) - (let ((name (dbg::call-frame-function-name frame))) - (if name - (function-name-location name)))))) + (let ((dspec (dbg::call-frame-function-name frame)) + (cname (and (dbg::call-frame-p callee) + (dbg::call-frame-function-name callee)))) + (if dspec + (frame-location dspec cname)))))) (defimplementation eval-in-frame (form frame-number) (let ((frame (nth-frame frame-number))) @@ -357,11 +361,18 @@ ;;; Definition finding -(defun function-name-location (name) - (let ((defs (find-definitions name))) - (cond (defs (cadr (first defs))) - (t (list :error (format nil "Source location not available for: ~S" - name)))))) +(defun frame-location (dspec callee-name) + (let ((infos (dspec:find-dspec-locations dspec))) + (cond (infos + (destructuring-bind ((rdspec location) &rest _) infos + (declare (ignore _)) + (let ((name (and callee-name (symbolp callee-name) + (string callee-name)))) + (make-dspec-location rdspec location + `(:call-site ,name))))) + (t + (list :error (format nil "Source location not available for: ~S" + dspec)))))) (defimplementation find-definitions (name) (let ((locations (dspec:find-name-locations dspec:*dspec-classes* name))) @@ -480,7 +491,7 @@ (and (consp location) (eq (car location) :emacs-buffer))) -(defun make-dspec-location (dspec location) +(defun make-dspec-location (dspec location &optional hints) (etypecase location ((or pathname string) (multiple-value-bind (file err) @@ -488,14 +499,16 @@ (if err (list :error (princ-to-string err)) (make-location `(:file ,file) - (dspec-file-position file dspec))))) + (dspec-file-position file dspec) + hints)))) (symbol `(:error ,(format nil "Cannot resolve location: ~S" location))) ((satisfies emacs-buffer-location-p) (destructuring-bind (_ buffer offset string) location (declare (ignore _ string)) (make-location `(:buffer ,buffer) - (dspec-buffer-position dspec offset)))))) + (dspec-buffer-position dspec offset) + hints))))) (defun make-dspec-progenitor-location (dspec location) (let ((canon-dspec (dspec:canonicalize-dspec dspec))) @@ -594,25 +607,21 @@ (defimplementation inspect-for-emacs ((o t) (inspector lispworks-inspector)) (declare (ignore inspector)) + (lispworks-inspect o)) + +(defimplementation inspect-for-emacs ((o function) + (inspector lispworks-inspector)) + (declare (ignore inspector)) + (lispworks-inspect o)) + +(defun lispworks-inspect (o) (multiple-value-bind (names values _getter _setter type) (lw:get-inspector-values o nil) (declare (ignore _getter _setter)) (values "A value." - `("Type: " (:value ,type) - (:newline) - "Getter: " (:value ,_getter) - (:newline) - "Setter: " (:value ,_setter) - (:newline) - "Slots:" - (:newline) - ,@(loop - for name in names - for value in values - collect `(:value ,name) - collect " = " - collect `(:value ,value) - collect `(:newline)))))) + (append + (label-value-line "Type" type) + (mapcan #'label-value-line names values))))) ;;; Miscellaneous From heller at common-lisp.net Mon Nov 15 23:07:03 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 16 Nov 2004 00:07:03 +0100 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19076 Modified Files: swank-openmcl.lisp Log Message: (emacs-connected, make-stream-interactive): Move buffering stuff to make-stream-interactive. Date: Tue Nov 16 00:07:00 2004 Author: heller Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.87 slime/swank-openmcl.lisp:1.88 --- slime/swank-openmcl.lisp:1.87 Tue Nov 9 23:57:11 2004 +++ slime/swank-openmcl.lisp Tue Nov 16 00:07:00 2004 @@ -139,8 +139,10 @@ (defimplementation accept-connection (socket) (ccl:accept-connection socket :wait t)) -(defimplementation emacs-connected (stream) +(defimplementation emacs-connected () (setq ccl::*interactive-abort-process* ccl::*current-process*) + +(defimplementation make-stream-interactive (stream) (push stream ccl::*auto-flush-streams*)) ;;; Unix signals From heller at common-lisp.net Mon Nov 15 23:07:38 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 16 Nov 2004 00:07:38 +0100 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19110 Modified Files: swank-sbcl.lisp Log Message: (emacs-connected): Updated for new interface. Date: Tue Nov 16 00:07:37 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.107 slime/swank-sbcl.lisp:1.108 --- slime/swank-sbcl.lisp:1.107 Wed Oct 27 12:57:43 2004 +++ slime/swank-sbcl.lisp Tue Nov 16 00:07:37 2004 @@ -131,8 +131,7 @@ (return (sb-bsd-sockets:socket-accept socket)) (sb-bsd-sockets:interrupted-error ())))) -(defimplementation emacs-connected (stream) - (declare (ignore stream)) +(defimplementation emacs-connected () (setq sb-ext:*invoke-debugger-hook* (find-symbol (string :swank-debugger-hook) (find-package :swank)))) From heller at common-lisp.net Mon Nov 15 23:08:45 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 16 Nov 2004 00:08:45 +0100 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19233 Modified Files: swank-abcl.lisp Log Message: (emacs-connected): Deleted. The default implementation should be good enough. Date: Tue Nov 16 00:08:44 2004 Author: heller Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.20 slime/swank-abcl.lisp:1.21 --- slime/swank-abcl.lisp:1.20 Fri Oct 1 15:17:42 2004 +++ slime/swank-abcl.lisp Tue Nov 16 00:08:44 2004 @@ -113,9 +113,6 @@ (defimplementation accept-connection (socket) (ext:get-socket-stream (ext:socket-accept socket))) -(defimplementation emacs-connected (stream) - (declare (ignore stream))) - ;;;; Unix signals (defimplementation call-without-interrupts (fn) From heller at common-lisp.net Mon Nov 15 23:15:36 2004 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 16 Nov 2004 00:15:36 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19642 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Nov 16 00:15:32 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.568 slime/ChangeLog:1.569 --- slime/ChangeLog:1.568 Thu Nov 11 23:30:20 2004 +++ slime/ChangeLog Tue Nov 16 00:15:29 2004 @@ -1,3 +1,66 @@ +2004-11-15 Helmut Eller + + * slime.el: The REPL commands ,quit and ,sayoonara are now + distinct. Previously Quit killed all Lisps an all buffers. The + new Quit command kills only the current Lisp. + (slime-quit-lisp): New function. + (repl-command quit): Use it. Don't delete all buffers. + (repl-command sayoonara): No longer an alias for ,quit. + (slime-connection-list-mode-map): Bind C-k to slime-quit-lisp. + (slime-communication-style): New connection variable. + (slime-use-sigint-for-interrupt): Is no longer a connection local + variable. It's derived from the new slime-communication-style. + (slime-inhibit-pipelining): New user option. + (slime-background-activities-enabled-p): New predicate to control + various background activities like autodoc and arglist fetching. + (slime-space, slime-autodoc-message-ok-p): Use it. + (slime-search-call-site): Use hints provided to search a call-site + in a defun. Useful for the show-frame-source command. + (slime-goto-source-location): Use it. + (slime-quit): Deleted, as it was broken. May come back later. + (slime-inspector-label-face, slime-inspector-value-face) + (slime-inspector-action-face, slime-reader-conditional-face): + Provide better defaults for Emacsen which don't support :inherited + faces. + + * swank-backend.lisp (emacs-connected): Don't pass the stream as + argument. make-stream-interactive is a better place for setting + buffering options. + + * swank-cmucl.lisp (emacs-connected): Install GC hooks to display + GC messages in the echo area. + (sos/misc :flush-output): There seem to be funny signal safety + issues if the dedicated output stream is not used. So, lets first + reset the buffer index before sending the buffer to the underlying + stream. + + * swank-lispworks.lisp (frame-source-location-for-emacs): Pass the + function name of the next (newer) frame as a hint to Emacs. This + way we can highlight the call site in some cases, instead of the + entire defun. + (frame-location): Renamed from function-name-location. The + argument is now a dspec, not only a name. Also include hints for + Emacs. + (lispworks-inspect): Simplified from old code. + (inspect-for-emacs): Use it for also for simple functions. + (emacs-connected, make-stream-interactive): Move the + soft-force-output stuff to make-stream-interactive. + + * swank-abcl.lisp (emacs-connected): Deleted. The default + implementation should be good enough. + + * swank-sbcl.lisp (emacs-connected): Updated for new interface. + + * swank-openmcl.lisp (emacs-connected, make-stream-interactive): + Move buffering stuff to make-stream-interactive. + + * swank.lisp (defstruct connection): Add new slot: + communication-style for convenience. + (create-connection): Initialize the new slot. + (connection-info): Send the communication-style to Emacs. + (install-fd-handler, simple-serve-requests): Sending + :use-sigint-for-interrupt is no longer necessary. + 2004-11-11 Raymond Toy * slime.el (slime-activate-font-lock-magic): Add XEmacs support. From mbaringer at common-lisp.net Wed Nov 17 15:17:27 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Wed, 17 Nov 2004 16:17:27 +0100 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv29631 Modified Files: swank-openmcl.lisp Log Message: Typo in defimplementation emacs-connected. Date: Wed Nov 17 16:17:26 2004 Author: mbaringer Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.88 slime/swank-openmcl.lisp:1.89 --- slime/swank-openmcl.lisp:1.88 Tue Nov 16 00:07:00 2004 +++ slime/swank-openmcl.lisp Wed Nov 17 16:17:26 2004 @@ -140,7 +140,7 @@ (ccl:accept-connection socket :wait t)) (defimplementation emacs-connected () - (setq ccl::*interactive-abort-process* ccl::*current-process*) + (setq ccl::*interactive-abort-process* ccl::*current-process*)) (defimplementation make-stream-interactive (stream) (push stream ccl::*auto-flush-streams*)) From mbaringer at common-lisp.net Thu Nov 18 17:35:15 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 18 Nov 2004 18:35:15 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26190 Modified Files: swank.lisp Log Message: (inspect-for-emacs): Fix bug in handling of arrays with fill-pointers. Date: Thu Nov 18 18:35:01 2004 Author: mbaringer Index: slime/swank.lisp diff -u slime/swank.lisp:1.261 slime/swank.lisp:1.262 --- slime/swank.lisp:1.261 Mon Nov 15 23:48:39 2004 +++ slime/swank.lisp Thu Nov 18 18:34:55 2004 @@ -2657,7 +2657,7 @@ ("Total size" (array-total-size array)) ("Adjustable" (adjustable-array-p array))) (when (array-has-fill-pointer-p array) - `(("Fill pointer" (fill-pointer array)))) + (label-value-line "Fill pointer" (fill-pointer array))) '("Contents:" (:newline)) (let ((darray (make-array (array-total-size array) :element-type (array-element-type array) From mbaringer at common-lisp.net Thu Nov 18 17:36:32 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Thu, 18 Nov 2004 18:36:32 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv26358 Modified Files: ChangeLog Log Message: Date: Thu Nov 18 18:36:19 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.569 slime/ChangeLog:1.570 --- slime/ChangeLog:1.569 Tue Nov 16 00:15:29 2004 +++ slime/ChangeLog Thu Nov 18 18:36:12 2004 @@ -1,3 +1,8 @@ +2004-11-18 Alexey Dejneka + + * swank.lisp (inspect-for-emacs): Fix bug in handling of arrays + with fill-pointers. + 2004-11-15 Helmut Eller * slime.el: The REPL commands ,quit and ,sayoonara are now From heller at common-lisp.net Fri Nov 19 01:08:48 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 02:08:48 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19726 Modified Files: slime.el Log Message: (slime-insert-xrefs): one-line-ify the label. From Matthew Danish. (slime-list-threads, slime-thread-insert): Show the thread-id. (slime-thread-control-mode-map): Remove the binding for the no-longer-existent slime-thread-goahead command. Date: Fri Nov 19 02:08:46 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.423 slime/slime.el:1.424 --- slime/slime.el:1.423 Mon Nov 15 23:42:50 2004 +++ slime/slime.el Fri Nov 19 02:08:45 2004 @@ -5414,7 +5414,7 @@ (slime-insert-propertized (list 'slime-location location 'face 'font-lock-keyword-face) - " " label "\n")))) + " " (slime-one-line-ify label) "\n")))) ;; Remove the final newline to prevent accidental window-scrolling (backward-char 1) (delete-char 1)) @@ -6464,15 +6464,16 @@ (slime-thread-control-mode) (let ((inhibit-read-only t)) (erase-buffer) - (loop for id from 0 - for (name status) in threads - do (slime-thread-insert id name status)) + (loop for idx from 0 + for (name status id) in threads + do (slime-thread-insert idx name status id)) (goto-char (point-min)) (setq buffer-read-only t) (pop-to-buffer (current-buffer))))))) -(defun slime-thread-insert (id name summary) - (slime-propertize-region `(thread-id ,id) +(defun slime-thread-insert (idx name summary id) + (slime-propertize-region `(thread-id ,idx) + (insert (format "%3s: " id)) (slime-insert-propertized '(face bold) name) (insert-char ?\040 (- 30 (current-column))) (let ((summary-start (point))) @@ -6496,7 +6497,6 @@ ("d" 'slime-thread-debug) ("g" 'slime-list-threads) ("k" 'slime-thread-kill) - ((kbd "RET") 'slime-thread-goahead) ("q" 'slime-thread-quit)) (defun slime-thread-quit () From heller at common-lisp.net Fri Nov 19 01:13:09 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 02:13:09 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19790 Modified Files: swank.lisp Log Message: (inspect-for-emacs array): Use row-major-aref instead of a displaced array. I that's the same. (inspect-for-emacs integer): Ignore errors in decode-universal-time. Negative values and in SBCL also small values cannot be decoded. (list-threads): Include the thread-id. Useful for SLIME debugging. Date: Fri Nov 19 02:13:07 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.262 slime/swank.lisp:1.263 --- slime/swank.lisp:1.262 Thu Nov 18 18:34:55 2004 +++ slime/swank.lisp Fri Nov 19 02:13:05 2004 @@ -2659,13 +2659,8 @@ (when (array-has-fill-pointer-p array) (label-value-line "Fill pointer" (fill-pointer array))) '("Contents:" (:newline)) - (let ((darray (make-array (array-total-size array) - :element-type (array-element-type array) - :displaced-to array - :displaced-index-offset 0))) - (loop for e across darray - for i from 0 - append (label-value-line i e)))))) + (loop for i below (array-total-size array) + append (label-value-line i (row-major-aref array i)))))) (defmethod inspect-for-emacs ((char character) inspector) (declare (ignore inspector)) @@ -3060,11 +3055,12 @@ (if (< -1 i char-code-limit) (label-value-line "Corresponding character" (code-char i))) (label-value-line "Length" (integer-length i)) - (list "As time: " - (multiple-value-bind (sec min hour date month year) - (decode-universal-time i) - (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ" - year month date hour min sec)))))) + (ignore-errors + (list "As time: " + (multiple-value-bind (sec min hour date month year) + (decode-universal-time i) + (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ" + year month date hour min sec))))))) (defmethod inspect-for-emacs ((c complex) inspector) (declare (ignore inspector)) @@ -3226,7 +3222,8 @@ (setq *thread-list* (all-threads)) (loop for thread in *thread-list* collect (list (thread-name thread) - (thread-status thread)))) + (thread-status thread) + (thread-id thread)))) (defslimefun quit-thread-browser () (setq *thread-list* nil)) From heller at common-lisp.net Fri Nov 19 01:18:20 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 02:18:20 +0100 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20480 Modified Files: swank-allegro.lisp Log Message: (swank-mop:slot-definition-documentation): ACL 7 says documentation should have 2 args. So, pass t as second argument. (fspec-primary-name): Recurse until we have a symbol. (count-cr): Convert file-offsets to match Emacs' eol-convetions. (find-definition-in-file): Use it. (allegro-inspect): New function. Mostly engineered from ACL's native inspector. (inspect-for-emacs (t), inspect-for-emacs (function)) Use it. Date: Fri Nov 19 02:18:19 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.61 slime/swank-allegro.lisp:1.62 --- slime/swank-allegro.lisp:1.61 Mon Oct 25 18:17:11 2004 +++ slime/swank-allegro.lisp Fri Nov 19 02:18:19 2004 @@ -34,7 +34,7 @@ (import-swank-mop-symbols :clos '(:slot-definition-documentation)) (defun swank-mop:slot-definition-documentation (slot) - (documentation slot)) + (documentation slot t)) ;;;; TCP Server @@ -271,16 +271,33 @@ (defun fspec-primary-name (fspec) (etypecase fspec - (symbol (string fspec)) - (list (string (second fspec))))) + (symbol fspec) + (list (fspec-primary-name (second fspec))))) +;; If Emacs uses DOS-style eol conventions, \n\r are considered as a +;; single character, but file-position counts them as two. Here we do +;; our own conversion. +(defun count-cr (file pos) + (let* ((bufsize 256) + (buf (make-array bufsize :element-type '(unsigned-byte 8))) + (cr-count 0)) + (with-open-file (stream file :direction :input) + (loop for bytes-read = (read-sequence buf stream) do + (incf cr-count (count (char-code #\return) buf + :end (min pos bytes-read))) + (decf pos bytes-read) + (when (<= pos 0) + (return cr-count)))))) + (defun find-definition-in-file (fspec type file) - (let* ((start (scm:find-definition-in-file fspec type file)) + (let* ((start (or (scm:find-definition-in-file fspec type file) + (scm:find-definition-in-file (fspec-primary-name fspec) + type file))) (pos (if start - (list :position (1+ start)) - (list :function-name (fspec-primary-name fspec))))) - (make-location (list :file (namestring (truename file))) - pos))) + (list :position (1+ (- start (count-cr file start)))) + (list :function-name (string (fspec-primary-name fspec)))))) + (make-location (list :file (namestring (truename file))) + pos))) (defun find-definition-in-buffer (filename) (let ((pos (position #\; filename :from-end t))) @@ -391,21 +408,6 @@ (defimplementation make-default-inspector () (make-instance 'acl-inspector)) -(defimplementation inspect-for-emacs ((o t) (inspector acl-inspector)) - (declare (ignore inspector)) - (values "A value." - `("Type: " (:value ,(class-of o)) - (:newline) - "Slots:" (:newline) - ,@(loop - for slot in (clos:class-slots class) - for name = (clos:slot-definition-name slot) - collect `(:value ,name) - collect " = " - collect (if (slot-boundp o name) - `(:value ,(slot-value o name)) - "#"))))) - ;; duplicated from swank.lisp in order to avoid package dependencies (defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v)))) (butlast @@ -414,13 +416,17 @@ collect (funcall callback i) collect ", "))) -(defmethod inspect-for-emacs ((f function) (inspector acl-inspector)) +#-allegro-v5.0 +(defmethod inspect-for-emacs ((f function) inspector) + inspector (values "A function." - `("Name: " (:value ,(function-name f)) (:newline) - "Its argument list is: " ,(princ-to-string (arglist f)) (:newline) - ,@ (let ((doc (documentation (excl::external-fn_symdef f) 'function))) - (when doc - `("Documentation:" (:newline) ,doc)))))) + (append + (label-value-line "Name" (function-name f)) + `("Formals" ,(princ-to-string (arglist f)) (:newline)) + (let ((doc (documentation (excl::external-fn_symdef f) 'function))) + (when doc + `("Documentation:" (:newline) ,doc)))))) + (defmethod inspect-for-emacs ((class structure-class) (inspector acl-inspector)) (values "A structure class." @@ -457,15 +463,15 @@ `(:value ,(swank-mop:class-prototype class)) '"N/A (class not finalized)")))) -#-:allegro-v5.0 +#-allegro-v5.0 (defmethod inspect-for-emacs ((slot excl::structure-slot-definition) (inspector acl-inspector)) (values "A structure slot." `("Name: " (:value ,(swank-mop:slot-definition-name slot)) (:newline) "Documentation:" (:newline) - ,@(when (documentation slot) - `((:value ,(documentation slot)) (:newline))) + ,@(when (documentation slot t) + `((:value ,(documentation slot t)) (:newline))) "Initform: " ,(if (swank-mop:slot-definition-initform slot) `(:value ,(swank-mop:slot-definition-initform slot)) "#") (:newline) @@ -497,6 +503,37 @@ else collect "#" collect '(:newline))))) + +(defmethod inspect-for-emacs ((o t) (inspector acl-inspector)) + inspector + (values "A value." (allegro-inspect o))) + +(defmethod inspect-for-emacs ((o function) (inspector acl-inspector)) + inspector + (values "A function." (allegro-inspect o))) + +(defun allegro-inspect (o) + (loop for (d dd) on (inspect::inspect-ctl o) + until (eq d dd) + for i from 0 + append (frob-allegro-field-def o d i))) + +(defun frob-allegro-field-def (object def idx) + (with-struct (inspect::field-def- name type access) def + (label-value-line name + (ecase type + ((:unsigned-word :unsigned-byte :unsigned-natural + :unsigned-half-long) + (inspect::component-ref-v object access type)) + (:lisp + (inspect::component-ref object access)) + (:indirect + (apply #'inspect::indirect-ref object idx access)))))) + +#| +(defun test (foo) + (inspect::show-object-structure foo (inspect::inspect-ctl foo) 1)) +|# ;;;; Multithreading From heller at common-lisp.net Fri Nov 19 01:19:27 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 02:19:27 +0100 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20547 Modified Files: swank-sbcl.lisp Log Message: (thread-status): Decode the thread-state-slot instead of returning ???. Date: Fri Nov 19 02:19:26 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.108 slime/swank-sbcl.lisp:1.109 --- slime/swank-sbcl.lisp:1.108 Tue Nov 16 00:07:37 2004 +++ slime/swank-sbcl.lisp Fri Nov 19 02:19:25 2004 @@ -838,8 +838,21 @@ (format nil "Thread ~D" thread)) (defimplementation thread-status (thread) - (declare (ignore thread)) - "???") + (sb-sys:without-gcing + (let ((thread (sb-thread::thread-sap-from-id thread))) + (cond (thread + (let* ((sap (sb-sys:sap-ref-sap thread + (* sb-vm::thread-state-slot + sb-vm::n-word-bytes))) + (state (ash (sb-sys:sap-int sap) + (- sb-vm::n-fixnum-tag-bits)))) + (case state + (0 "running") + (1 "stopping") + (2 "stopped") + (3 "dead") + (t (format nil "??? ~A" state))))) + (t "??? ???")))))) (defimplementation make-lock (&key name) (sb-thread:make-mutex :name name)) From heller at common-lisp.net Fri Nov 19 01:28:17 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 02:28:17 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv20683 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Nov 19 02:28:15 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.570 slime/ChangeLog:1.571 --- slime/ChangeLog:1.570 Thu Nov 18 18:36:12 2004 +++ slime/ChangeLog Fri Nov 19 02:28:14 2004 @@ -1,3 +1,37 @@ +2004-11-19 Matthew Danish + + * swank-allegro.lisp: (count-cr): New function. Convert + file-offsets to match Emacs' eol-conventions. + (find-definition-in-file): Use it. + + * slime.el (slime-insert-xrefs): Display the multi-line label much + more cleanly. + +2004-11-19 Helmut Eller + + * swank-sbcl.lisp (thread-status): Decode the thread-state-slot + instead of returning ???. + + * swank-allegro.lisp (swank-mop:slot-definition-documentation): + ACL 7 says documentation should have 2 args. So, pass t as second + argument. + (fspec-primary-name): Recurse until we have a symbol. + (allegro-inspect): New function. Mostly reverse engineered from + ACL's native inspector. + (inspect-for-emacs (t), inspect-for-emacs (function)): Use it. + + * wank.lisp (inspect-for-emacs array): Use row-major-aref instead + of a displaced array. I hope that does the same. + (inspect-for-emacs integer): Ignore errors in + decode-universal-time. Negative values and, in SBCL, also small + values cannot be decoded. + (list-threads): Include the thread-id. Useful for SLIME debugging. + + * slime.el (slime-list-threads, slime-thread-insert): Show the + thread-id. + (slime-thread-control-mode-map): Remove the binding for the + no-longer-existent slime-thread-goahead command. + 2004-11-18 Alexey Dejneka * swank.lisp (inspect-for-emacs): Fix bug in handling of arrays From heller at common-lisp.net Fri Nov 19 18:55:42 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 19:55:42 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv11863 Modified Files: slime.el Log Message: (slime-net-coding-system): New variable. Specifies the coding system to use for network communication. The default is iso-latin-1 and should work for all Lisps. Only a small set of coding systems is currently supported. (slime-net-valid-coding-systems): New variable. A list of coding systems which may be used. (slime-check-coding-system, slime-coding-system-mulibyte-p) (slime-coding-system-cl-name): New utility function for coding systems. (slime-net-connect, slime-make-net-buffer, slime-open-stream-to-lisp): Use it. (slime-net-decode-length, slime-net-encode-length): Renamed from slime-net-read3 and slime-net-enc3. The length is now encoded as a 6 char hex string. Date: Fri Nov 19 19:55:40 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.424 slime/slime.el:1.425 --- slime/slime.el:1.424 Fri Nov 19 02:08:45 2004 +++ slime/slime.el Fri Nov 19 19:55:39 2004 @@ -1162,6 +1162,7 @@ (interactive (list (if current-prefix-arg (read-string "Run lisp: " inferior-lisp-program)) "*inferior-lisp*")) + (slime-check-coding-system) (let ((command (or command inferior-lisp-program)) (buffer (or buffer "*inferior-lisp*"))) (when (or (not (slime-bytecode-stale-p)) @@ -1176,6 +1177,7 @@ (if (null slime-net-processes) t (y-or-n-p "Close old connections first? ")))) + (slime-check-coding-system) (when kill-old-p (slime-disconnect)) (message "Connecting to Swank on port %S.." port) (let* ((process (slime-net-connect host port)) @@ -1335,9 +1337,11 @@ (defun slime-start-swank-server (process) "Start a Swank server on the inferior lisp." - (comint-send-string process (format "(swank:start-server %S)\n" - (slime-to-lisp-filename - (slime-swank-port-file))))) + (let* ((encoding (slime-coding-system-cl-name slime-net-coding-system)) + (file (slime-to-lisp-filename (slime-swank-port-file)))) + (comint-send-string process + (format "(swank:start-server %S :external-format %s)\n" + file encoding)))) (defun slime-swank-port-file () "Filename where the SWANK server writes its TCP port number." @@ -1452,6 +1456,16 @@ "List of functions called when a slime network connection closes. The functions are called with the process as their argument.") +(defvar slime-net-coding-system 'iso-8859-1-unix + "*Coding system used for network connections.") + +(defvar slime-net-valid-coding-systems + '((iso-8859-1-unix nil :iso-latin-1-unix) + (emacs-mule-unix t :emacs-mule-unix) + (utf-8-unix t :utf-8-unix)) + "A list of valid coding systems. +Each element is of the form: (NAME MULTIBYTEP CL-NAME)") + ;;; Interface (defun slime-net-connect (host port) "Establish a connection with a CL." @@ -1465,7 +1479,9 @@ (when slime-kill-without-query-p (process-kill-without-query proc)) (when (fboundp 'set-process-coding-system) - (set-process-coding-system proc 'no-conversion 'no-conversion)) + (set-process-coding-system proc + slime-net-coding-system + slime-net-coding-system)) proc)) (defun slime-make-net-buffer (name) @@ -1473,19 +1489,38 @@ (let ((buffer (generate-new-buffer name))) (with-current-buffer buffer (when (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) + (set-buffer-multibyte + (slime-coding-system-mulibyte-p slime-net-coding-system))) (buffer-disable-undo)) buffer)) +(defun slime-find-coding-system (&optional coding-system) + (let* ((coding-system (or coding-system slime-net-coding-system)) + (props (assq coding-system slime-net-valid-coding-systems))) + (unless props + (error "Invalid slime-net-coding-system: %s. %s" + coding-system (mapcar #'car slime-net-valid-coding-systems))) + props)) + +(defun slime-check-coding-system (&optional coding-system) + (interactive) + (slime-find-coding-system coding-system)) + +(defun slime-coding-system-mulibyte-p (coding-system) + (second (slime-find-coding-system coding-system))) + +(defun slime-coding-system-cl-name (coding-system) + (third (slime-find-coding-system coding-system))) + ;;; Interface (defun slime-net-send (sexp proc) "Send a SEXP to Lisp over the socket PROC. This is the lowest level of communication. The sexp will be READ and EVAL'd by Lisp." (let* ((msg (concat (slime-prin1-to-string sexp) "\n")) - (string (concat (slime-net-enc3 (length msg)) msg))) + (string (concat (slime-net-encode-length (length msg)) msg))) (slime-log-event sexp) - (process-send-string proc (string-make-unibyte string)))) + (process-send-string proc string))) (defun slime-net-close (process) (setq slime-net-processes (remove process slime-net-processes)) @@ -1523,6 +1558,7 @@ (message "net-read error: %S" error) (ding) (sleep-for 2) + (debug) (ignore-errors (slime-net-close proc)) (error "PANIC!"))))) (save-current-buffer @@ -1536,30 +1572,26 @@ (defun slime-net-have-input-p () "Return true if a complete message is available." (goto-char (point-min)) - (and (>= (buffer-size) 3) - (>= (- (buffer-size) 3) (slime-net-read3)))) + (and (>= (buffer-size) 6) + (>= (- (buffer-size) 6) (slime-net-decode-length)))) (defun slime-net-read () "Read a message from the network buffer." (goto-char (point-min)) - (let* ((length (slime-net-read3)) - (start (+ 3 (point))) + (let* ((length (slime-net-decode-length)) + (start (+ 6 (point))) (end (+ start length))) (let ((string (buffer-substring start end))) (prog1 (read string) (delete-region (point-min) end))))) -(defun slime-net-read3 () - "Read a 24-bit big-endian integer from buffer." - (logior (ash (char-after 1) 16) - (ash (char-after 2) 8) - (char-after 3))) - -(defun slime-net-enc3 (n) - "Encode an integer into a 24-bit big-endian string." - (string (logand (ash n -16) 255) - (logand (ash n -8) 255) - (logand n 255))) +(defun slime-net-decode-length () + "Read a 24-bit hex-encoded integer from buffer." + (string-to-number (buffer-substring (point) (+ (point) 6)) 16)) + +(defun slime-net-encode-length (n) + "Encode an integer into a 24-bit hex string." + (format "%06x" n)) (defun slime-prin1-to-string (sexp) "Like `prin1-to-string' but don't octal-escape non-ascii characters. @@ -2349,6 +2381,9 @@ (when slime-kill-without-query-p (process-kill-without-query stream)) (set-process-filter stream 'slime-output-filter) + (set-process-coding-system stream + slime-net-coding-system + slime-net-coding-system) stream)) (defun slime-output-string (string) @@ -8252,7 +8287,7 @@ slime-dispatch-event slime-net-filter slime-net-have-input-p - slime-net-read3 + slime-net-decode-length slime-net-read slime-print-apropos slime-show-note-counts From heller at common-lisp.net Fri Nov 19 19:02:21 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:02:21 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12603 Modified Files: swank.lisp Log Message: (*coding-system*): New variable. (start-server): Accept external-format as argument. (create-server, create-swank-server, setup-server, serve-connection) (open-dedicated-output-stream, create-connection): Ditto. (defstruct connection): Add external-format slot. (decode-message-length): Use function for new length encoding. (decode-message): Use it. (encode-message): Use new encoding. Date: Fri Nov 19 20:02:20 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.263 slime/swank.lisp:1.264 --- slime/swank.lisp:1.263 Fri Nov 19 02:13:05 2004 +++ slime/swank.lisp Fri Nov 19 20:02:19 2004 @@ -129,6 +129,8 @@ ;;; used solely to pipe user-output to Emacs (an optimization). ;;; +(defvar *coding-system* ':iso-latin-1-unix) + (defstruct (connection (:conc-name connection.) (:print-function print-connection)) @@ -172,7 +174,10 @@ (indentation-cache-packages '()) ;; The communication style used. (communication-style nil :type (member nil :spawn :sigio :fd-handler)) - ) + ;; The coding system for network streams. + (external-format *coding-system* :type (member :iso-latin-1-unix + :emacs-mule-unix + :utf-8-unix))) (defun print-connection (conn stream depth) (declare (ignore depth)) @@ -273,56 +278,53 @@ (defvar *communication-style* (preferred-communication-style)) (defvar *log-events* nil) -(defun start-server (port-file &optional (style *communication-style*) - dont-close) +(defun start-server (port-file &key (style *communication-style*) + dont-close (external-format *coding-system*)) "Start the server and write the listen port number to PORT-FILE. This is the entry point for Emacs." (setup-server 0 (lambda (port) (announce-server-port port-file port)) - style dont-close)) + style dont-close external-format)) (defun create-server (&key (port default-server-port) (style *communication-style*) - dont-close) + dont-close (external-format *coding-system*)) "Start a SWANK server on PORT running in STYLE. If DONT-CLOSE is true then the listen socket will accept multiple connections, otherwise it will be closed after the first." - (setup-server port #'simple-announce-function style dont-close)) + (setup-server port #'simple-announce-function style dont-close + external-format)) (defun create-swank-server (&optional (port default-server-port) (style *communication-style*) (announce-fn #'simple-announce-function) - dont-close) - (setup-server port announce-fn style dont-close)) + dont-close (external-format *coding-system*)) + (setup-server port announce-fn style dont-close external-format)) (defparameter *loopback-interface* "127.0.0.1") -(defun setup-server (port announce-fn style dont-close) +(defun setup-server (port announce-fn style dont-close external-format) (declare (type function announce-fn)) (let* ((socket (create-socket *loopback-interface* port)) (port (local-port socket))) (funcall announce-fn port) - (ecase style - (:spawn - (spawn (lambda () - (loop do (serve-connection socket :spawn dont-close) - while dont-close)) - :name "Swank")) - ((:fd-handler :sigio) - (add-fd-handler socket - (lambda () - (serve-connection socket style dont-close)))) - ((nil) - (unwind-protect - (loop do (serve-connection socket style dont-close) - while dont-close) - (close-socket socket)))) - port)) + (flet ((serve () + (serve-connection socket style dont-close external-format))) + (ecase style + (:spawn + (spawn (lambda () (loop do (serve) while dont-close)) + :name "Swank")) + ((:fd-handler :sigio) + (add-fd-handler socket (lambda () (serve)))) + ((nil) + (unwind-protect (loop do (serve) while dont-close) + (close-socket socket)))) + port))) -(defun serve-connection (socket style dont-close) - (let ((client (accept-connection socket))) +(defun serve-connection (socket style dont-close external-format) + (let ((client (accept-connection socket :external-format external-format))) (unless dont-close (close-socket socket)) - (let ((connection (create-connection client style))) + (let ((connection (create-connection client style external-format))) (run-hook *new-connection-hook* connection) (push connection *connections*) (serve-requests connection)))) @@ -367,7 +369,8 @@ stream (or NIL if none was created)." (if *use-dedicated-output-stream* (let ((stream (open-dedicated-output-stream - (connection.socket-io connection)))) + (connection.socket-io connection) + (connection.external-format connection)))) (values (lambda (string) (write-string string stream) (force-output stream)) @@ -379,7 +382,7 @@ (send-to-emacs `(:read-output ,string))))) nil))) -(defun open-dedicated-output-stream (socket-io) +(defun open-dedicated-output-stream (socket-io external-format) "Open a dedicated output connection to the Emacs on SOCKET-IO. Return an output stream suitable for writing program output. @@ -387,7 +390,7 @@ (let* ((socket (create-socket *loopback-interface* 0)) (port (local-port socket))) (encode-message `(:open-dedicated-output-stream ,port) socket-io) - (accept-connection socket))) + (accept-connection socket :external-format external-format))) (defun handle-request (connection) "Read and process one request. The processing is done in the extend @@ -622,7 +625,7 @@ (connection.user-input connection) in) connection)) -(defun create-connection (socket-io style) +(defun create-connection (socket-io style external-format) (let ((c (ecase style (:spawn (make-connection :socket-io socket-io @@ -648,6 +651,7 @@ :send #'send-to-socket-io :serve-requests #'simple-serve-requests))))) (setf (connection.communication-style c) style) + (setf (connection.external-format c) external-format) (initialize-streams-for-connection c) c)) @@ -831,20 +835,23 @@ "Read an S-expression from STREAM using the SLIME protocol. If a protocol error occurs then a SLIME-PROTOCOL-ERROR is signalled." (let ((*swank-state-stack* (cons :read-next-form *swank-state-stack*))) - (flet ((next-byte () (char-code (read-char stream t)))) - (handler-case - (let* ((length (logior (ash (next-byte) 16) - (ash (next-byte) 8) - (next-byte))) - (string (make-string length)) - (pos (read-sequence string stream))) - (assert (= pos length) () - "Short read: length=~D pos=~D" length pos) - (let ((form (read-form string))) - (log-event "READ: ~A~%" string) - form)) - (serious-condition (c) - (error (make-condition 'slime-protocol-error :condition c))))))) + (handler-case + (let* ((length (decode-message-length stream)) + (string (make-string length)) + (pos (read-sequence string stream))) + (assert (= pos length) () + "Short read: length=~D pos=~D" length pos) + (let ((form (read-form string))) + (log-event "READ: ~A~%" string) + form)) + (serious-condition (c) + (error (make-condition 'slime-protocol-error :condition c)))))) + +(defun decode-message-length (stream) + (let ((buffer (make-string 6))) + (dotimes (i 6) + (setf (aref buffer i) (read-char stream))) + (parse-integer buffer :radix #x10))) (defun read-form (string) (with-standard-io-syntax @@ -868,9 +875,7 @@ (let* ((string (prin1-to-string-for-emacs message)) (length (1+ (length string)))) (log-event "WRITE: ~A~%" string) - (loop for position from 16 downto 0 by 8 - do (write-char (code-char (ldb (byte 8 position) length)) - stream)) + (format stream "~6,'0x" length) (write-string string stream) (terpri stream) (force-output stream))) From heller at common-lisp.net Fri Nov 19 19:04:53 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:04:53 +0100 Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12669 Modified Files: swank-abcl.lisp Log Message: (accept-connection): Accept :external-format as argument. Date: Fri Nov 19 20:04:52 2004 Author: heller Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.21 slime/swank-abcl.lisp:1.22 --- slime/swank-abcl.lisp:1.21 Tue Nov 16 00:08:44 2004 +++ slime/swank-abcl.lisp Fri Nov 19 20:04:51 2004 @@ -109,8 +109,8 @@ (defimplementation close-socket (socket) (ext:server-socket-close socket)) - -(defimplementation accept-connection (socket) +(defimplementation accept-connection (socket &key external-format) + (assert (eq external-format :iso-latin-1-unix)) (ext:get-socket-stream (ext:socket-accept socket))) ;;;; Unix signals From heller at common-lisp.net Fri Nov 19 19:05:11 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:05:11 +0100 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12697 Modified Files: swank-allegro.lisp Log Message: (accept-connection): Accept :external-format as argument. Date: Fri Nov 19 20:05:10 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.62 slime/swank-allegro.lisp:1.63 --- slime/swank-allegro.lisp:1.62 Fri Nov 19 02:18:19 2004 +++ slime/swank-allegro.lisp Fri Nov 19 20:05:09 2004 @@ -51,8 +51,13 @@ (defimplementation close-socket (socket) (close socket)) -(defimplementation accept-connection (socket) - (socket:accept-connection socket :wait t)) +(defimplementation accept-connection (socket &key external-format) + (let ((s (socket:accept-connection socket :wait t))) + (ecase external-format + (:iso-latin-1-unix (setf (stream-external-format s) :latin1)) + (:emacs-mule-unix (setf (stream-external-format s) :emacs-mule)) + (:utf-8-unix (setf (stream-external-format s) :utf8))) + s)) (defimplementation format-sldb-condition (c) (princ-to-string c)) @@ -279,15 +284,16 @@ ;; our own conversion. (defun count-cr (file pos) (let* ((bufsize 256) - (buf (make-array bufsize :element-type '(unsigned-byte 8))) + (type '(unsigned-byte 8)) + (buf (make-array bufsize :element-type type)) (cr-count 0)) - (with-open-file (stream file :direction :input) - (loop for bytes-read = (read-sequence buf stream) do - (incf cr-count (count (char-code #\return) buf - :end (min pos bytes-read))) - (decf pos bytes-read) - (when (<= pos 0) - (return cr-count)))))) + (with-open-file (stream file :direction :input :element-type type) + (loop for bytes-read = (read-sequence buf stream) do + (incf cr-count (count (char-code #\return) buf + :end (min pos bytes-read))) + (decf pos bytes-read) + (when (<= pos 0) + (return cr-count)))))) (defun find-definition-in-file (fspec type file) (let* ((start (or (scm:find-definition-in-file fspec type file) From heller at common-lisp.net Fri Nov 19 19:05:29 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:05:29 +0100 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12721 Modified Files: swank-backend.lisp Log Message: (accept-connection): Accept :external-format as argument. Date: Fri Nov 19 20:05:26 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.74 slime/swank-backend.lisp:1.75 --- slime/swank-backend.lisp:1.74 Mon Nov 15 23:45:23 2004 +++ slime/swank-backend.lisp Fri Nov 19 20:05:25 2004 @@ -181,7 +181,7 @@ (definterface close-socket (socket) "Close the socket SOCKET.") -(definterface accept-connection (socket) +(definterface accept-connection (socket &key external-format) "Accept a client connection on the listening socket SOCKET. Return a stream for the new connection.") From heller at common-lisp.net Fri Nov 19 19:05:51 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:05:51 +0100 Subject: [slime-cvs] CVS update: slime/swank-clisp.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12746 Modified Files: swank-clisp.lisp Log Message: (accept-connection): Accept :external-format as argument. Date: Fri Nov 19 20:05:50 2004 Author: heller Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.41 slime/swank-clisp.lisp:1.42 --- slime/swank-clisp.lisp:1.41 Fri Oct 29 00:12:22 2004 +++ slime/swank-clisp.lisp Fri Nov 19 20:05:49 2004 @@ -151,13 +151,18 @@ (defimplementation close-socket (socket) (socket:socket-server-close socket)) -(defimplementation accept-connection (socket) +(defun find-encoding (external-format) + (ecase external-format + (:iso-latin-1-unix (ext:make-encoding :charset 'charset:iso-8859-1 + :line-terminator :unix)) + (:utf-8-unix (ext:make-encoding :charset 'charset:utf-8 + :line-terminator :unix)))) + +(defimplementation accept-connection (socket &key external-format) (socket:socket-accept socket :buffered nil ;; XXX should be t :element-type 'character - :external-format (ext:make-encoding - :charset 'charset:iso-8859-1 - :line-terminator :unix))) + :external-format (find-encoding external-format))) ;;; Swank functions @@ -491,7 +496,6 @@ (with-condition-restarts condition (list (find-restart 'continue)) (invoke-debugger condition))))) nil)) - ;;; Inspecting From heller at common-lisp.net Fri Nov 19 19:06:06 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:06:06 +0100 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12769 Modified Files: swank-lispworks.lisp Log Message: (accept-connection): Accept :external-format as argument. Date: Fri Nov 19 20:06:05 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.60 slime/swank-lispworks.lisp:1.61 --- slime/swank-lispworks.lisp:1.60 Tue Nov 16 00:05:34 2004 +++ slime/swank-lispworks.lisp Fri Nov 19 20:06:04 2004 @@ -108,8 +108,9 @@ (defimplementation close-socket (socket) (comm::close-socket (socket-fd socket))) -(defimplementation accept-connection (socket) - (let ((fd (comm::get-fd-from-socket socket))) +(defimplementation accept-connection (socket &key external-format) + (assert (eq external-format :iso-latin-1-unix)) + (let* ((fd (comm::get-fd-from-socket socket))) (assert (/= fd -1)) (make-instance 'comm:socket-stream :socket fd :direction :io :element-type 'base-char))) From heller at common-lisp.net Fri Nov 19 19:06:23 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:06:23 +0100 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12791 Modified Files: swank-openmcl.lisp Log Message: (accept-connection): Accept :external-format as argument. Date: Fri Nov 19 20:06:21 2004 Author: heller Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.89 slime/swank-openmcl.lisp:1.90 --- slime/swank-openmcl.lisp:1.89 Wed Nov 17 16:17:26 2004 +++ slime/swank-openmcl.lisp Fri Nov 19 20:06:21 2004 @@ -136,7 +136,8 @@ (defimplementation close-socket (socket) (close socket)) -(defimplementation accept-connection (socket) +(defimplementation accept-connection (socket &key external-format) + (assert (eq external-format :iso-latin-1-unix)) (ccl:accept-connection socket :wait t)) (defimplementation emacs-connected () From heller at common-lisp.net Fri Nov 19 19:06:41 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:06:41 +0100 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12815 Modified Files: swank-sbcl.lisp Log Message: (accept-connection): Accept :external-format as argument. Date: Fri Nov 19 20:06:37 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.109 slime/swank-sbcl.lisp:1.110 --- slime/swank-sbcl.lisp:1.109 Fri Nov 19 02:19:25 2004 +++ slime/swank-sbcl.lisp Fri Nov 19 20:06:36 2004 @@ -69,8 +69,8 @@ (sb-sys:invalidate-descriptor (socket-fd socket)) (sb-bsd-sockets:socket-close socket)) -(defimplementation accept-connection (socket) - (make-socket-io-stream (accept socket))) +(defimplementation accept-connection (socket &key external-format) + (make-socket-io-stream (accept socket) external-format)) (defvar *sigio-handlers* '() "List of (key . fn) pairs to be called on SIGIO.") @@ -119,11 +119,15 @@ (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket)) (file-stream (sb-sys:fd-stream-fd socket)))) -(defun make-socket-io-stream (socket) - (sb-bsd-sockets:socket-make-stream socket - :output t - :input t - :element-type 'base-char)) +(defun make-socket-io-stream (socket external-format) + (let ((encoding (ecase external-format + (:iso-latin-1-unix :iso-8859-1) + (:utf-8-unix :utf-8)))) + (sb-bsd-sockets:socket-make-stream socket + :output t + :input t + :element-type 'character + :external-format encoding))) (defun accept (socket) "Like socket-accept, but retry on EAGAIN." From heller at common-lisp.net Fri Nov 19 19:08:26 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:08:26 +0100 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12875 Modified Files: swank-cmucl.lisp Log Message: (accept-connection): Accept external-format argument. (inspect-for-emacs): Add CMUCL specific versions. Date: Fri Nov 19 20:08:25 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.128 slime/swank-cmucl.lisp:1.129 --- slime/swank-cmucl.lisp:1.128 Mon Nov 15 23:59:44 2004 +++ slime/swank-cmucl.lisp Fri Nov 19 20:08:24 2004 @@ -89,7 +89,8 @@ (sys:invalidate-descriptor socket) (ext:close-socket (socket-fd socket))) -(defimplementation accept-connection (socket) +(defimplementation accept-connection (socket &key external-format) + (assert (eq external-format ':iso-latin-1-unix)) (make-socket-io-stream (ext:accept-tcp-connection socket))) ;;;;; Sockets @@ -1961,6 +1962,30 @@ (sys:int-sap (kernel:get-lisp-obj-address o)) (* vm:fdefn-raw-addr-slot vm:word-bytes)))))) +(defmethod inspect-for-emacs ((o array) (inspector cmucl-inspector)) + inspector + (values (format nil "~A is an array." o) + (label-value-line* + (:header (describe-primitive-type o)) + (:rank (array-rank o)) + (:fill-pointer (kernel:%array-fill-pointer o)) + (:fill-pointer-p (kernel:%array-fill-pointer-p o)) + (:elements (kernel:%array-available-elements o)) + (:data (kernel:%array-data-vector o)) + (:displacement (kernel:%array-displacement o)) + (:displaced-p (kernel:%array-displaced-p o)) + (:dimensions (array-dimensions o))))) + +(defmethod inspect-for-emacs ((o vector) (inspector cmucl-inspector)) + inspector + (values (format nil "~A is a vector." o) + (append + (label-value-line* + (:header (describe-primitive-type o)) + (:length (c::vector-length o))) + (loop for i below (length o) + append (label-value-line i (aref o i)))))) + ;;;; Profiling (defimplementation profile (fname) @@ -2102,6 +2127,10 @@ (setq ext:*gc-notify-before* #'pre-gc-hook) (setq ext:*gc-notify-after* #'post-gc-hook)) +(defun remove-gc-hooks () + (setq ext:*gc-notify-before* nil) + (setq ext:*gc-notify-after* nil)) + (defimplementation emacs-connected () (install-gc-hooks)) From heller at common-lisp.net Fri Nov 19 19:11:46 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 19 Nov 2004 20:11:46 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12958 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Nov 19 20:11:41 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.571 slime/ChangeLog:1.572 --- slime/ChangeLog:1.571 Fri Nov 19 02:28:14 2004 +++ slime/ChangeLog Fri Nov 19 20:11:41 2004 @@ -1,3 +1,40 @@ +2004-11-19 Helmut Eller + + * slime.el (slime-net-coding-system): New variable. Specifies the + coding system to use for network communication. The default is + iso-latin-1 and should work for all Lisps. Only a small set of + coding systems is currently supported. + (slime-net-valid-coding-systems): New variable. A list of coding + systems which may be used. + (slime-check-coding-system, slime-coding-system-mulibyte-p) + (slime-coding-system-cl-name): New utility function for coding + systems. + (slime-net-connect, slime-make-net-buffer, + slime-open-stream-to-lisp): Use it. + (slime-net-decode-length, slime-net-encode-length): Renamed from + slime-net-read3 and slime-net-enc3. The length is now encoded as + a 6 char hex string. + + * swank.lisp (*coding-system*): New variable. + (start-server): Accept external-format as argument. + (create-server, create-swank-server, setup-server) + (serve-connection, open-dedicated-output-stream) + (create-connection): Ditto. + (defstruct connection): Add external-format slot. + (decode-message-length): New function for new length encoding. + (decode-message): Use it. + (encode-message): Use new encoding. + + * swank-cmucl.lisp (accept-connection): Accept external-format + argument. + (inspect-for-emacs): Add CMUCL specific versions for array and + vectors. + + * swank-sbcl.lisp, swank-openmcl.lisp, swank-lispworks.lisp, + swank-clisp.lisp, swank-backend.lisp, swank-allegro.lisp, + swank-abcl.lisp (accept-connection): Accept :external-format as + argument. + 2004-11-19 Matthew Danish * swank-allegro.lisp: (count-cr): New function. Convert From mbaringer at common-lisp.net Sat Nov 20 12:06:33 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Sat, 20 Nov 2004 13:06:33 +0100 Subject: [slime-cvs] CVS update: slime/swank-openmcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4474 Modified Files: swank-openmcl.lisp Log Message: (make-stream-interactive): Only add ouptut streams (subclasses of ccl:fundamental-output-stream) to ccl::*auto-flush-streams*. Date: Sat Nov 20 13:06:32 2004 Author: mbaringer Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.90 slime/swank-openmcl.lisp:1.91 --- slime/swank-openmcl.lisp:1.90 Fri Nov 19 20:06:21 2004 +++ slime/swank-openmcl.lisp Sat Nov 20 13:06:32 2004 @@ -144,6 +144,9 @@ (setq ccl::*interactive-abort-process* ccl::*current-process*)) (defimplementation make-stream-interactive (stream) + nil) + +(defmethod make-stream-interactive ((stream ccl:fundamental-output-stream)) (push stream ccl::*auto-flush-streams*)) ;;; Unix signals From mbaringer at common-lisp.net Sat Nov 20 12:07:47 2004 From: mbaringer at common-lisp.net (Marco Baringer) Date: Sat, 20 Nov 2004 13:07:47 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv4496 Modified Files: ChangeLog Log Message: Date: Sat Nov 20 13:07:46 2004 Author: mbaringer Index: slime/ChangeLog diff -u slime/ChangeLog:1.572 slime/ChangeLog:1.573 --- slime/ChangeLog:1.572 Fri Nov 19 20:11:41 2004 +++ slime/ChangeLog Sat Nov 20 13:07:46 2004 @@ -1,3 +1,9 @@ +2004-11-20 Marco Baringer + + * swank-openmcl.lisp (make-stream-interactive): Only add ouptut + streams (subclasses of ccl:fundamental-output-stream) to + ccl::*auto-flush-streams*. + 2004-11-19 Helmut Eller * slime.el (slime-net-coding-system): New variable. Specifies the From heller at common-lisp.net Sat Nov 20 20:13:59 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 20 Nov 2004 21:13:59 +0100 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31321 Modified Files: swank-sbcl.lisp Log Message: Fix unbalanced parenthesis. Patch from Travis Cross. Date: Sat Nov 20 21:13:57 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.110 slime/swank-sbcl.lisp:1.111 --- slime/swank-sbcl.lisp:1.110 Fri Nov 19 20:06:36 2004 +++ slime/swank-sbcl.lisp Sat Nov 20 21:13:54 2004 @@ -856,7 +856,7 @@ (2 "stopped") (3 "dead") (t (format nil "??? ~A" state))))) - (t "??? ???")))))) + (t "??? ???"))))) (defimplementation make-lock (&key name) (sb-thread:make-mutex :name name)) From heller at common-lisp.net Sat Nov 20 20:15:35 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 20 Nov 2004 21:15:35 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv31567 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Nov 20 21:15:32 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.573 slime/ChangeLog:1.574 --- slime/ChangeLog:1.573 Sat Nov 20 13:07:46 2004 +++ slime/ChangeLog Sat Nov 20 21:15:28 2004 @@ -1,3 +1,7 @@ +2004-11-20 Travis Cross + + * swank-sbcl.lisp (thread-status): Fix unbalanced parenthesis. + 2004-11-20 Marco Baringer * swank-openmcl.lisp (make-stream-interactive): Only add ouptut From heller at common-lisp.net Sat Nov 20 20:47:27 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 20 Nov 2004 21:47:27 +0100 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1353 Modified Files: swank-sbcl.lisp Log Message: (make-socket-io-stream): Add #+sb-unicode. Date: Sat Nov 20 21:47:25 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.111 slime/swank-sbcl.lisp:1.112 --- slime/swank-sbcl.lisp:1.111 Sat Nov 20 21:13:54 2004 +++ slime/swank-sbcl.lisp Sat Nov 20 21:47:25 2004 @@ -122,12 +122,15 @@ (defun make-socket-io-stream (socket external-format) (let ((encoding (ecase external-format (:iso-latin-1-unix :iso-8859-1) + #+sb-unicode (:utf-8-unix :utf-8)))) (sb-bsd-sockets:socket-make-stream socket :output t :input t :element-type 'character - :external-format encoding))) + #+sb-unicode :external-format + #+sb-unicode encoding + ))) (defun accept (socket) "Like socket-accept, but retry on EAGAIN." From heller at common-lisp.net Sat Nov 20 20:49:11 2004 From: heller at common-lisp.net (Helmut Eller) Date: Sat, 20 Nov 2004 21:49:11 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1409 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Nov 20 21:49:09 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.574 slime/ChangeLog:1.575 --- slime/ChangeLog:1.574 Sat Nov 20 21:15:28 2004 +++ slime/ChangeLog Sat Nov 20 21:49:09 2004 @@ -1,3 +1,7 @@ +2004-11-20 Helmut Eller + + * swank-sbcl.lisp (make-socket-io-stream): Add some #+sb-unicode. + 2004-11-20 Travis Cross * swank-sbcl.lisp (thread-status): Fix unbalanced parenthesis. From lgorrie at common-lisp.net Wed Nov 24 03:03:53 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 24 Nov 2004 04:03:53 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv12994 Modified Files: slime.el Log Message: (slime-repl-mode-map): Add C-up and C-down to move through history. Consistent with comint-mode. Date: Wed Nov 24 04:03:51 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.425 slime/slime.el:1.426 --- slime/slime.el:1.425 Fri Nov 19 19:55:39 2004 +++ slime/slime.el Wed Nov 24 04:03:49 2004 @@ -2877,7 +2877,9 @@ ("\C-a" 'slime-repl-bol) ("\C-e" 'slime-repl-eol) ("\M-p" 'slime-repl-previous-input) + ([C-up] 'slime-repl-previous-input) ("\M-n" 'slime-repl-next-input) + ([C-down] 'slime-repl-next-input) ("\M-r" 'slime-repl-previous-matching-input) ("\M-s" 'slime-repl-next-matching-input) ("\C-c\C-c" 'slime-interrupt) From lgorrie at common-lisp.net Wed Nov 24 03:05:30 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 24 Nov 2004 04:05:30 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv13075 Modified Files: ChangeLog Log Message: Date: Wed Nov 24 04:05:29 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.575 slime/ChangeLog:1.576 --- slime/ChangeLog:1.575 Sat Nov 20 21:49:09 2004 +++ slime/ChangeLog Wed Nov 24 04:05:29 2004 @@ -1,3 +1,8 @@ +2004-11-24 Luke Gorrie + + * slime.el (slime-repl-mode-map): Add C-up and C-down to move + through history. Consistent with comint-mode. + 2004-11-20 Helmut Eller * swank-sbcl.lisp (make-socket-io-stream): Add some #+sb-unicode. From lgorrie at common-lisp.net Wed Nov 24 03:51:33 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 24 Nov 2004 04:51:33 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv15897 Modified Files: slime.el Log Message: (slime-repl-mode-map): Add slime-load-file on `C-c C-l'. Date: Wed Nov 24 04:51:32 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.426 slime/slime.el:1.427 --- slime/slime.el:1.426 Wed Nov 24 04:03:49 2004 +++ slime/slime.el Wed Nov 24 04:51:32 2004 @@ -2898,6 +2898,7 @@ ("\C-c\C-p" 'slime-repl-previous-prompt) ("\M-\C-a" 'slime-repl-beginning-of-defun) ("\M-\C-e" 'slime-repl-end-of-defun) + ("\C-c\C-l" 'slime-load-file) ) (define-key slime-repl-mode-map From lgorrie at common-lisp.net Wed Nov 24 03:52:54 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 24 Nov 2004 04:52:54 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16030 Modified Files: slime.el Log Message: (slime-load-file): Handle (buffer-file-name) being nil. Date: Wed Nov 24 04:52:53 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.427 slime/slime.el:1.428 --- slime/slime.el:1.427 Wed Nov 24 04:51:32 2004 +++ slime/slime.el Wed Nov 24 04:52:52 2004 @@ -5160,9 +5160,10 @@ "Load the Lisp file FILENAME." (interactive (list (read-file-name "Load file: " nil nil - nil (file-name-sans-extension - (file-name-nondirectory - (buffer-file-name)))))) + nil (if (buffer-file-name) + (file-name-sans-extension + (file-name-nondirectory + (buffer-file-name))))))) (let ((lisp-filename (slime-to-lisp-filename (expand-file-name filename)))) (slime-eval-with-transcript `(swank:load-file ,lisp-filename)))) From lgorrie at common-lisp.net Wed Nov 24 03:56:36 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 24 Nov 2004 04:56:36 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16216 Modified Files: slime.el Log Message: (slime-repl-mode-map): Add slime-load-file on `C-c C-l' and slime-compile-file on `C-c C-k'. This is mostly to override unwanted inf-lisp bindings in lisp-mode-map. Date: Wed Nov 24 04:56:35 2004 Author: lgorrie Index: slime/slime.el diff -u slime/slime.el:1.428 slime/slime.el:1.429 --- slime/slime.el:1.428 Wed Nov 24 04:52:52 2004 +++ slime/slime.el Wed Nov 24 04:56:34 2004 @@ -2899,6 +2899,7 @@ ("\M-\C-a" 'slime-repl-beginning-of-defun) ("\M-\C-e" 'slime-repl-end-of-defun) ("\C-c\C-l" 'slime-load-file) + ("\C-c\C-k" 'slime-compile-and-load-file) ) (define-key slime-repl-mode-map From lgorrie at common-lisp.net Wed Nov 24 03:57:19 2004 From: lgorrie at common-lisp.net (Luke Gorrie) Date: Wed, 24 Nov 2004 04:57:19 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv16237 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Nov 24 04:57:17 2004 Author: lgorrie Index: slime/ChangeLog diff -u slime/ChangeLog:1.576 slime/ChangeLog:1.577 --- slime/ChangeLog:1.576 Wed Nov 24 04:05:29 2004 +++ slime/ChangeLog Wed Nov 24 04:57:16 2004 @@ -2,6 +2,10 @@ * slime.el (slime-repl-mode-map): Add C-up and C-down to move through history. Consistent with comint-mode. + (slime-repl-mode-map): Add slime-load-file on `C-c C-l' and + slime-compile-file on `C-c C-k'. This is mostly to override + unwanted inf-lisp bindings in lisp-mode-map. + (slime-load-file): Handle (buffer-file-name) being nil. 2004-11-20 Helmut Eller From heller at common-lisp.net Wed Nov 24 19:47:08 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 20:47:08 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5788 Modified Files: slime.el Log Message: (slime-start-and-load) Use vanilla comint instead of inf-lisp. Let's try that for a while. (slime): Ask for the coding system when invoked with C-u C-u. (slime-net-coding-system, slime-net-valid-coding-systems): Add some alternatives for older Emacsen. (slime-find-buffer-package): Skip quotes. Old code looks sometimes like (in-package 'foo). (slime-repl-mode-map): Inhibit C-c C-z. Avoids accidental loading inf-lisp. Date: Wed Nov 24 20:47:07 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.429 slime/slime.el:1.430 --- slime/slime.el:1.429 Wed Nov 24 04:56:34 2004 +++ slime/slime.el Wed Nov 24 20:47:06 2004 @@ -54,7 +54,7 @@ (unless (fboundp 'define-minor-mode) (require 'easy-mmode) (defalias 'define-minor-mode 'easy-mmode-define-minor-mode))) -(require 'inf-lisp) +(require 'comint) (require 'pp) (require 'hideshow) (require 'hyperspec) @@ -1157,14 +1157,20 @@ ;;;;; Entry points -(defun slime (&optional command buffer) +(defun slime (&optional command buffer coding-system) "Start an inferior^_superior Lisp and connect to its Swank server." (interactive (list (if current-prefix-arg - (read-string "Run lisp: " inferior-lisp-program)) - "*inferior-lisp*")) - (slime-check-coding-system) + (read-string "Run lisp: " inferior-lisp-program + 'slime-inferior-lisp-program-history)) + "*inferior-lisp*" + (if (eq 16 (prefix-numeric-value current-prefix-arg)) + (read-coding-system "set slime-coding-system: " + slime-net-coding-system)))) (let ((command (or command inferior-lisp-program)) - (buffer (or buffer "*inferior-lisp*"))) + (buffer (or buffer "*inferior-lisp*")) + (coding-system (or coding-system slime-net-coding-system))) + (slime-check-coding-system coding-system) + (setq slime-net-coding-system coding-system) (when (or (not (slime-bytecode-stale-p)) (slime-urge-bytecode-recompile)) (let ((proc (slime-maybe-start-lisp command buffer))) @@ -1182,7 +1188,6 @@ (message "Connecting to Swank on port %S.." port) (let* ((process (slime-net-connect host port)) (slime-dispatching-connection process)) - (message "Initial handshake...") (slime-setup-connection process))) (defun slime-start-and-load (filename &optional package) @@ -1323,8 +1328,7 @@ (with-current-buffer (get-buffer-create buffername) (comint-mode) (comint-exec (current-buffer) "inferior-lisp" (car args) nil (cdr args)) - (inferior-lisp-mode) - (setq inferior-lisp-buffer (current-buffer)) + (lisp-mode-variables t) (pop-to-buffer (current-buffer)) (get-buffer-process (current-buffer))))) @@ -1456,13 +1460,16 @@ "List of functions called when a slime network connection closes. The functions are called with the process as their argument.") -(defvar slime-net-coding-system 'iso-8859-1-unix +(defvar slime-net-coding-system + (find-if #'coding-system-p '(iso-8859-1-unix iso-8859-1 raw-text-unix)) "*Coding system used for network connections.") (defvar slime-net-valid-coding-systems '((iso-8859-1-unix nil :iso-latin-1-unix) - (emacs-mule-unix t :emacs-mule-unix) - (utf-8-unix t :utf-8-unix)) + (iso-8859-1 nil :iso-latin-1-unix) ; for oldish Emacsen + (raw-text-unix nil :iso-latin-1-unix) ; ditto + (utf-8-unix t :utf-8-unix) + (emacs-mule-unix t :emacs-mule-unix)) "A list of valid coding systems. Each element is of the form: (NAME MULTIBYTEP CL-NAME)") @@ -1496,7 +1503,8 @@ (defun slime-find-coding-system (&optional coding-system) (let* ((coding-system (or coding-system slime-net-coding-system)) - (props (assq coding-system slime-net-valid-coding-systems))) + (props (assq coding-system slime-net-valid-coding-systems))) + (check-coding-system coding-system) (unless props (error "Invalid slime-net-coding-system: %s. %s" coding-system (mapcar #'car slime-net-valid-coding-systems))) @@ -1895,7 +1903,7 @@ ((:spawn :sigio) nil)))) (defvar slime-inhibit-pipelining t - "*If true, don't send background requests if Lisp already busy.") + "*If true, don't send background requests if Lisp is already busy.") (defun slime-background-activities-enabled-p () (and (slime-connected-p) @@ -2021,7 +2029,7 @@ (or (re-search-backward regexp nil t) (re-search-forward regexp nil t))) (goto-char (match-end 0)) - (skip-chars-forward " \n\t\f\r#") + (skip-chars-forward " \n\t\f\r#'") (let ((pkg (ignore-errors (read (current-buffer))))) (if pkg (format "%S" pkg))))))) @@ -2900,7 +2908,7 @@ ("\M-\C-e" 'slime-repl-end-of-defun) ("\C-c\C-l" 'slime-load-file) ("\C-c\C-k" 'slime-compile-and-load-file) - ) + ("\C-c\C-z" 'slime-nop)) (define-key slime-repl-mode-map (string slime-repl-shortcut-dispatch-char) 'slime-handle-repl-shortcut) From heller at common-lisp.net Wed Nov 24 19:49:19 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 20:49:19 +0100 Subject: [slime-cvs] CVS update: slime/swank-allegro.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5907 Modified Files: swank-allegro.lisp Log Message: (set-external-format): New function. Use LF as eol mark. (call-with-compilation-hooks): Trap compiler-notes too. Date: Wed Nov 24 20:49:18 2004 Author: heller Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.63 slime/swank-allegro.lisp:1.64 --- slime/swank-allegro.lisp:1.63 Fri Nov 19 20:05:09 2004 +++ slime/swank-allegro.lisp Wed Nov 24 20:49:18 2004 @@ -53,12 +53,19 @@ (defimplementation accept-connection (socket &key external-format) (let ((s (socket:accept-connection socket :wait t))) - (ecase external-format - (:iso-latin-1-unix (setf (stream-external-format s) :latin1)) - (:emacs-mule-unix (setf (stream-external-format s) :emacs-mule)) - (:utf-8-unix (setf (stream-external-format s) :utf8))) + (set-external-format s external-format) s)) +(defun set-external-format (stream external-format) + #-allegro-v5.0 + (let* ((name (ecase external-format + (:iso-latin-1-unix :latin1) + (:utf-8-unix :utf-8-unix) + (:emacs-mule-unix :emacs-mule))) + (ef (excl:crlf-base-ef + (excl:find-external-format name :try-variant t)))) + (setf (stream-external-format stream) ef))) + (defimplementation format-sldb-condition (c) (princ-to-string c)) @@ -205,31 +212,41 @@ (defvar *buffer-string*) (defvar *compile-filename* nil) +(defun compiler-note-p (x) + (member (type-of x) '(excl::compiler-note compiler::compiler-note))) + +(deftype compiler-note () + `(satisfies compiler-note-p)) + (defun handle-compiler-warning (condition) (let ((loc (getf (slot-value condition 'excl::plist) :loc))) - (signal (make-condition - 'compiler-condition - :original-condition condition - :severity :warning - :message (format nil "~A" condition) - :location (cond (*buffer-name* - (make-location - (list :buffer *buffer-name*) - (list :position *buffer-start-position*))) - (loc - (destructuring-bind (file . pos) loc - (make-location - (list :file (namestring (truename file))) - (list :position (1+ pos))))) - (*compile-filename* - (make-location - (list :file *compile-filename*) - (list :position 1))) - (t - (list :error "No error location available."))))))) + (signal + (make-condition + 'compiler-condition + :original-condition condition + :severity (etypecase condition + (warning :warning) + (compiler-note :note)) + :message (format nil "~A" condition) + :location (cond (*buffer-name* + (make-location + (list :buffer *buffer-name*) + (list :position *buffer-start-position*))) + (loc + (destructuring-bind (file . pos) loc + (make-location + (list :file (namestring (truename file))) + (list :position (1+ pos))))) + (*compile-filename* + (make-location + (list :file *compile-filename*) + (list :position 1))) + (t + (list :error "No error location available."))))))) (defimplementation call-with-compilation-hooks (function) - (handler-bind ((warning #'handle-compiler-warning)) + (handler-bind ((warning #'handle-compiler-warning) + (compiler-note #'handle-compiler-warning)) (funcall function))) (defimplementation swank-compile-file (*compile-filename* load-p) @@ -388,11 +405,12 @@ (t (funcall fn c)))))) -(defun in-constants-p (fn symbol) - (map-function-constants - fn - (lambda (c) (if (eq c symbol) (return-from in-constants-p t))) - 3)) +(defun in-constants-p (fun symbol) + (map-function-constants fun + (lambda (c) + (when (eq c symbol) + (return-from in-constants-p t))) + 3)) (defun function-callers (name) (let ((callers '())) From heller at common-lisp.net Wed Nov 24 19:50:50 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 20:50:50 +0100 Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv5955 Modified Files: swank-lispworks.lisp Log Message: (emacs-connected): Set sigint handler only for single threaded operation. I.e. when *communication-style* is nil. Date: Wed Nov 24 20:50:49 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.61 slime/swank-lispworks.lisp:1.62 --- slime/swank-lispworks.lisp:1.61 Fri Nov 19 20:06:04 2004 +++ slime/swank-lispworks.lisp Wed Nov 24 20:50:49 2004 @@ -25,47 +25,9 @@ stream:stream-line-column )) -(import-to-swank-mop - '( ;; classes - cl:standard-generic-function - clos:standard-slot-definition - cl:method - cl:standard-class - ;; standard-class readers - clos:class-default-initargs - clos:class-direct-default-initargs - clos:class-direct-slots - clos:class-direct-subclasses - clos:class-direct-superclasses - clos:class-finalized-p - cl:class-name - clos:class-precedence-list - clos:class-prototype - clos:class-slots - clos:specializer-direct-methods - ;; generic function readers - clos:generic-function-argument-precedence-order - clos:generic-function-declarations - clos:generic-function-lambda-list - clos:generic-function-methods - clos:generic-function-method-class - clos:generic-function-method-combination - clos:generic-function-name - ;; method readers - clos:method-generic-function - clos:method-function - clos:method-lambda-list - clos:method-specializers - clos:method-qualifiers - ;; slot readers - clos:slot-definition-allocation - clos:slot-definition-initargs - clos:slot-definition-initform - clos:slot-definition-initfunction - clos:slot-definition-name - clos:slot-definition-type - clos:slot-definition-readers - clos:slot-definition-writers)) +(import-swank-mop-symbols :clos '(:slot-definition-documentation + :eql-specializer + :eql-specializer-object)) (defun swank-mop:slot-definition-documentation (slot) (documentation slot t)) @@ -123,7 +85,9 @@ (defimplementation emacs-connected () (declare (ignore stream)) - (set-sigint-handler) + (when (eq nil (symbol-value + (find-symbol (string :*communication-style*) :swank))) + (set-sigint-handler)) (let ((lw:*handle-warn-on-redefinition* :warn)) (defmethod env-internals:environment-display-notifier (env &key restarts condition) From heller at common-lisp.net Wed Nov 24 19:52:53 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 20:52:53 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6041 Modified Files: swank.lisp Log Message: (inspect-for-emacs-list): subseq on improper lists breaks in Lispworks. Handle that case better. Date: Wed Nov 24 20:52:52 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.264 slime/swank.lisp:1.265 --- slime/swank.lisp:1.264 Fri Nov 19 20:02:19 2004 +++ slime/swank.lisp Wed Nov 24 20:52:52 2004 @@ -46,7 +46,7 @@ #:quit-lisp )) -(in-package #:swank) +(in-package :swank) ;;;; Top-level variables, constants, macros @@ -581,9 +581,8 @@ ;;;;;; Simple sequential IO (defun simple-serve-requests (connection) - (let ((socket-io (connection.socket-io connection))) - (with-reader-error-handler (connection) - (loop (handle-request connection))))) + (with-reader-error-handler (connection) + (loop (handle-request connection)))) (defun read-from-socket-io () (let ((event (decode-message (current-socket-io)))) @@ -957,9 +956,9 @@ ;; Don't shadow *readtable* unnecessarily because that prevents ;; the user from assigning to it. (if (eq *readtable* *buffer-readtable*) - #1=(call-with-syntax-hooks (lambda () , at body)) + (call-with-syntax-hooks (lambda () , at body)) (let ((*readtable* *buffer-readtable*)) - #1#))))) + (call-with-syntax-hooks (lambda () , at body))))))) (defun from-string (string) "Read string in the *BUFFER-PACKAGE*" @@ -1105,9 +1104,10 @@ (string= (arglist-to-string list (find-package :swank)) string)) ;; Should work: -(assert (test-print-arglist '(function cons) "(function cons)")) -(assert (test-print-arglist '(quote cons) "(quote cons)")) -(assert (test-print-arglist '(&key (function #'+)) "(&key (function #'+))")) +(progn + (assert (test-print-arglist '(function cons) "(function cons)")) + (assert (test-print-arglist '(quote cons) "(quote cons)")) + (assert (test-print-arglist '(&key (function #'+)) "(&key (function #'+))"))) ;; Expected failure: ;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))")) @@ -2601,13 +2601,18 @@ (defun inspect-for-emacs-list (list) (let ((maxlen 40)) (multiple-value-bind (length tail) (safe-length list) - (flet ((frob (title list &rest rest) - (values title - (append '("Elements:" (:newline)) - (loop for i from 0 - for e in list - append (label-value-line i e)) - rest)))) + (flet ((frob (title list) + (let ((lines + (do ((i 0 (1+ i)) + (l list (cdr l)) + (a '() (cons (label-value-line i (car l)) a))) + ((not (consp l)) + (let ((a (if (null l) + a + (cons (label-value-line :tail l) a)))) + (apply #'append (reverse a))))))) + (values title (append '("Elements:" (:newline)) lines))))) + (cond ((not length) ; circular (frob "A circular list." (cons (car list) @@ -2615,13 +2620,11 @@ ((and (<= length maxlen) (not tail)) (frob "A proper list." list)) (tail - (frob "An improper list." - (subseq list 0 length) - (list :value tail "tail"))) + (frob "An improper list." list)) (t - (frob "A proper list." - (subseq list 0 maxlen) - (list :value (nthcdr maxlen list) "rest")))))))) + (frob "A proper list." list))))))) + +;; (inspect-for-emacs-list '#1=(a #1# . #1# )) (defun safe-length (list) "Similar to `list-length', but avoid errors on improper lists. @@ -3055,7 +3058,7 @@ (values "A number." (append `(,(format nil "Value: ~D = #x~X = #o~O = #b~,,' ,8:B = ~E" - i i i i i) + i i i i i) (:newline)) (if (< -1 i char-code-limit) (label-value-line "Corresponding character" (code-char i))) From heller at common-lisp.net Wed Nov 24 19:56:03 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 20:56:03 +0100 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6149 Modified Files: swank-cmucl.lisp Log Message: (debug-var-value): Return #:invalid or #:unkown instead of :. (swank-compile-file): Load the fasl file only if load-p is true. (inspect-for-emacs, inspect-alien-record, inspect-alien-pointer): Add inspector support for some alien types. Date: Wed Nov 24 20:56:00 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.129 slime/swank-cmucl.lisp:1.130 --- slime/swank-cmucl.lisp:1.129 Fri Nov 19 20:08:24 2004 +++ slime/swank-cmucl.lisp Wed Nov 24 20:55:59 2004 @@ -300,7 +300,7 @@ (unless failure-p ;; Cache the latest source file for definition-finding. (source-cache-get filename (file-write-date filename)) - (load output-file)) + (when load-p (load output-file))) (values output-file warnings-p failure-p))))) (defimplementation swank-compile-string (string &key buffer position directory) @@ -1549,9 +1549,10 @@ (di::debug-function-debug-variables (di:frame-debug-function frame))) (defun debug-var-value (var frame location) - (ecase (di:debug-variable-validity var location) - (:valid (di:debug-variable-value var frame)) - ((:invalid :unknown) ':))) + (let ((validity (di:debug-variable-validity var location))) + (ecase validity + (:valid (di:debug-variable-value var frame)) + ((:invalid :unknown) (make-symbol (string validity)))))) (defimplementation frame-locals (index) (let* ((frame (nth-frame index)) @@ -1887,15 +1888,19 @@ (cond ((di::indirect-value-cell-p o) (values (format nil "~A is a value cell." o) `("Value: " (:value ,(c:value-cell-ref o))))) + ((alien::alien-value-p o) + (inspect-alien-value o)) (t - (destructuring-bind (text labeledp . parts) - (inspect::describe-parts o) - (values (format nil "~A~%" text) - (if labeledp - (loop for (label . value) in parts - append (label-value-line label value)) - (loop for value in parts for i from 0 - append (label-value-line i value)))))))) + (cmucl-inspect o)))) + +(defun cmucl-inspect (o) + (destructuring-bind (text labeledp . parts) (inspect::describe-parts o) + (values (format nil "~A~%" text) + (if labeledp + (loop for (label . value) in parts + append (label-value-line label value)) + (loop for value in parts for i from 0 + append (label-value-line i value)))))) (defmethod inspect-for-emacs :around ((o function) (inspector cmucl-inspector)) (declare (ignore inspector)) @@ -1986,6 +1991,34 @@ (loop for i below (length o) append (label-value-line i (aref o i)))))) +(defun inspect-alien-record (alien) + (values + (format nil "~A is an alien value." alien) + (with-struct (alien::alien-value- sap type) alien + (with-struct (alien::alien-record-type- kind name fields) type + (append + (label-value-line* + (:sap sap) + (:kind kind) + (:name name)) + (loop for field in fields + append (let ((slot (alien::alien-record-field-name field))) + (label-value-line slot (alien:slot alien slot))))))))) + +(defun inspect-alien-pointer (alien) + (values + (format nil "~A is an alien value." alien) + (with-struct (alien::alien-value- sap type) alien + (label-value-line* + (:sap sap) + (:type type) + (:to (alien::deref alien)))))) + +(defun inspect-alien-value (alien) + (typecase (alien::alien-value-type alien) + (alien::alien-record-type (inspect-alien-record alien)) + (alien::alien-pointer-type (inspect-alien-pointer alien)) + (t (cmucl-inspect alien)))) ;;;; Profiling (defimplementation profile (fname) From heller at common-lisp.net Wed Nov 24 19:57:11 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 20:57:11 +0100 Subject: [slime-cvs] CVS update: slime/swank-backend.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6190 Modified Files: swank-backend.lisp Log Message: (import-swank-mop-symbols): Better error message for the assertion. Date: Wed Nov 24 20:57:10 2004 Author: heller Index: slime/swank-backend.lisp diff -u slime/swank-backend.lisp:1.75 slime/swank-backend.lisp:1.76 --- slime/swank-backend.lisp:1.75 Fri Nov 19 20:05:25 2004 +++ slime/swank-backend.lisp Wed Nov 24 20:57:10 2004 @@ -107,15 +107,15 @@ (check-type documentation string "a documentation string") (flet ((gen-default-impl () `(defmethod ,name ,args , at default-body))) - `(progn (defgeneric ,name ,args (:documentation ,documentation)) - (pushnew ',name *interface-functions*) - ,(if (null default-body) - `(pushnew ',name *unimplemented-interfaces*) - (gen-default-impl)) - ;; see - (eval-when (:compile-toplevel :load-toplevel :execute) - (export ',name :swank-backend)) - ',name))) + `(progn (defgeneric ,name ,args (:documentation ,documentation)) + (pushnew ',name *interface-functions*) + ,(if (null default-body) + `(pushnew ',name *unimplemented-interfaces*) + (gen-default-impl)) + ;; see + (eval-when (:compile-toplevel :load-toplevel :execute) + (export ',name :swank-backend)) + ',name))) (defmacro defimplementation (name args &body body) `(progn (defmethod ,name ,args , at body) @@ -145,7 +145,7 @@ (do-symbols (s :swank-mop) (unless (member s except :test #'string=) (let ((real-symbol (find-symbol (string s) package))) - (assert real-symbol) + (assert real-symbol () "Symbol ~A not found in package ~A" s package) (unintern s :swank-mop) (import real-symbol :swank-mop) (export real-symbol :swank-mop))))) From heller at common-lisp.net Wed Nov 24 19:58:39 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 20:58:39 +0100 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6231 Modified Files: swank-sbcl.lisp Log Message: (inspect-for-emacs)[code-component]: Disassemble code-components too. Date: Wed Nov 24 20:58:38 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.112 slime/swank-sbcl.lisp:1.113 --- slime/swank-sbcl.lisp:1.112 Sat Nov 20 21:47:25 2004 +++ slime/swank-sbcl.lisp Wed Nov 24 20:58:37 2004 @@ -713,21 +713,33 @@ collect '(:newline))))) (t (call-next-method o))))) -(defmethod inspect-for-emacs ((o sb-kernel:code-component) (inspector sbcl-inspector)) - (declare (ignore inspector)) - (values "A code data-block." - `("First entry point: " (:value ,(sb-kernel:%code-entry-points o)) - (:newline) - "Constants: " (:newline) - ,@(loop - for i from sb-vm:code-constants-offset +(defmethod inspect-for-emacs ((o sb-kernel:code-component) (_ sbcl-inspector)) + (declare (ignore _)) + (values (format nil "~A is a code data-block." o) + (append + (label-value-line* + (:code-size (sb-kernel:%code-code-size o)) + (:entry-points (sb-kernel:%code-entry-points o)) + (:debug-info (sb-kernel:%code-debug-info o)) + (:trace-table-offset (sb-kernel:code-header-ref + o sb-vm:code-trace-table-offset-slot))) + `("Constants:" (:newline)) + (loop for i from sb-vm:code-constants-offset below (sb-kernel:get-header-data o) - collect (princ-to-string i) - collect " = " - collect `(:value ,(sb-kernel:code-header-ref o i)) - collect '(:newline)) - "Debug info: " (:value ,(sb-kernel:%code-debug-info o)) - "Instructions: " (:value ,(sb-kernel:code-instructions o))))) + append (label-value-line i (sb-kernel:code-header-ref o i))) + `("Code:" (:newline) + , (with-output-to-string (s) + (cond ((sb-kernel:%code-debug-info o) + (sb-disassem:disassemble-code-component o :stream s)) + (t + (sb-disassem:disassemble-memory + (sb-disassem::align + (+ (logandc2 (sb-kernel:get-lisp-obj-address o) + sb-vm:lowtag-mask) + (* sb-vm:code-constants-offset sb-vm:n-word-bytes)) + (ash 1 sb-vm:n-lowtag-bits)) + (ash (sb-kernel:%code-code-size o) sb-vm:word-shift) + :stream s)))))))) (defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector sbcl-inspector)) (declare (ignore inspector)) From heller at common-lisp.net Wed Nov 24 20:02:46 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 21:02:46 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv6952 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Nov 24 21:02:44 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.577 slime/ChangeLog:1.578 --- slime/ChangeLog:1.577 Wed Nov 24 04:57:16 2004 +++ slime/ChangeLog Wed Nov 24 21:02:44 2004 @@ -1,3 +1,38 @@ +2004-11-24 Helmut Eller + + * slime.el (slime-start-and-load): Use vanilla comint instead of + inf-lisp. Let's try that for a while. + (slime): Ask for the coding system when invoked with C-u C-u. + (slime-net-coding-system, slime-net-valid-coding-systems): Add + some alternatives for older Emacsen. + (slime-find-buffer-package): Skip quotes. Old code looks + sometimes like (in-package 'foo). + (slime-repl-mode-map): Inhibit C-c C-z. Avoids accidental loading + inf-lisp. + + * swank.lisp (inspect-for-emacs-list): subseq on improper lists + breaks in Lispworks. Handle that case better. + + * swank-sbcl.lisp (inspect-for-emacs)[code-component]: Disassemble + code-components too. + + * swank-backend.lisp (import-swank-mop-symbols): Better error + message for the assertion. + + * swank-cmucl.lisp (debug-var-value): Return #:invalid or + #:unknown instead of :. + (swank-compile-file): Load the fasl file only if load-p is true. + (inspect-for-emacs, inspect-alien-record, inspect-alien-pointer): + Add inspector support for some alien types. + + * swank-lispworks.lisp (emacs-connected): Set the sigint handler + only for single threaded operation. I.e. when + *communication-style* is nil. + + * swank-allegro.lisp (set-external-format): New function. Use LF + as eol mark. + (call-with-compilation-hooks): Trap compiler-notes too. + 2004-11-24 Luke Gorrie * slime.el (slime-repl-mode-map): Add C-up and C-down to move @@ -80,7 +115,7 @@ ACL's native inspector. (inspect-for-emacs (t), inspect-for-emacs (function)): Use it. - * wank.lisp (inspect-for-emacs array): Use row-major-aref instead + * swank.lisp (inspect-for-emacs array): Use row-major-aref instead of a displaced array. I hope that does the same. (inspect-for-emacs integer): Ignore errors in decode-universal-time. Negative values and, in SBCL, also small From heller at common-lisp.net Wed Nov 24 20:26:39 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 21:26:39 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8148 Modified Files: slime.el Log Message: (slime-net-coding-system): Use find-coding-system in XEmacs. coding-system-p means something different here. Date: Wed Nov 24 21:26:38 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.430 slime/slime.el:1.431 --- slime/slime.el:1.430 Wed Nov 24 20:47:06 2004 +++ slime/slime.el Wed Nov 24 21:26:38 2004 @@ -1460,8 +1460,9 @@ "List of functions called when a slime network connection closes. The functions are called with the process as their argument.") -(defvar slime-net-coding-system - (find-if #'coding-system-p '(iso-8859-1-unix iso-8859-1 raw-text-unix)) +(defvar slime-net-coding-system + (find-if (if (featurep 'xemacs) #'find-coding-system #'coding-system-p) + '(iso-8859-1-unix iso-8859-1 raw-text-unix)) "*Coding system used for network connections.") (defvar slime-net-valid-coding-systems @@ -2885,9 +2886,9 @@ ("\C-a" 'slime-repl-bol) ("\C-e" 'slime-repl-eol) ("\M-p" 'slime-repl-previous-input) - ([C-up] 'slime-repl-previous-input) + ((kbd "C-") 'slime-repl-previous-input) ("\M-n" 'slime-repl-next-input) - ([C-down] 'slime-repl-next-input) + ((kbd "C-") 'slime-repl-next-input) ("\M-r" 'slime-repl-previous-matching-input) ("\M-s" 'slime-repl-next-matching-input) ("\C-c\C-c" 'slime-interrupt) From heller at common-lisp.net Wed Nov 24 20:29:41 2004 From: heller at common-lisp.net (Helmut Eller) Date: Wed, 24 Nov 2004 21:29:41 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv8243 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Nov 24 21:29:40 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.578 slime/ChangeLog:1.579 --- slime/ChangeLog:1.578 Wed Nov 24 21:02:44 2004 +++ slime/ChangeLog Wed Nov 24 21:29:39 2004 @@ -9,6 +9,10 @@ sometimes like (in-package 'foo). (slime-repl-mode-map): Inhibit C-c C-z. Avoids accidental loading inf-lisp. + (slime-net-coding-system): Use find-coding-system in XEmacs. + coding-system-p means something different here. + (slime-repl-mode-map): XEmacs compatibilty: use (kbd "C-") + instead of [C-up]. * swank.lisp (inspect-for-emacs-list): subseq on improper lists breaks in Lispworks. Handle that case better. From heller at common-lisp.net Thu Nov 25 18:58:07 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 25 Nov 2004 19:58:07 +0100 Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv18590 Modified Files: slime.el Log Message: (slime-indent-and-complete-symbol): Echo the arglist if there's no symbol before point. Don't complete after parens. (slime-echo-arglist): Factorized from slime-space. (slime-space): Use it. (slime-repl-history-replace): Add argument to clear the input at the end of the history. (slime-net-coding-system): Emacs does funky encoding for `raw-text-unix' use `binary' instead. (slime-safe-encoding-p): New function. (slime-net-send): Use it and don't try to send stuff which can't be decoded by Lisp. (slime-inferior-lisp-program-history): XEmacs compatibility: declare it as a variable. (slime-xref-mode): In Emacs 21, set delayed-mode-hooks to nil because we don't want to run the lisp-mode-hook. Date: Thu Nov 25 19:58:06 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.431 slime/slime.el:1.432 --- slime/slime.el:1.431 Wed Nov 24 21:26:38 2004 +++ slime/slime.el Thu Nov 25 19:58:04 2004 @@ -1016,17 +1016,19 @@ (slime-propertize-region props (apply #'insert args))) (defun slime-indent-and-complete-symbol () - "Indent the current line and perform symbol completion. -First indent the line; if indenting doesn't move point, complete the -symbol." + "Indent the current line and perform symbol completion. First +indent the line. If indenting doesn't move point, complete the +symbol. If there's no symbol at the point, show the arglist for the +most recently enclosed macro or function." (interactive) (let ((pos (point))) (unless (get-text-property (line-beginning-position) 'slime-repl-prompt) (lisp-indent-line)) - (when (and (= pos (point)) - (save-excursion - (re-search-backward "[^ \n\t\r]+\\=" nil t))) - (slime-complete-symbol)))) + (when (= pos (point)) + (cond ((save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t)) + (slime-complete-symbol)) + ((memq (char-before) '(?\t ?\ )) + (slime-echo-arglist)))))) (defmacro slime-with-rigid-indentation (level &rest body) "Execute BODY and then rigidly indent its text insertions. @@ -1157,6 +1159,9 @@ ;;;;; Entry points +(defvar slime-inferior-lisp-program-history '() + "History list of command strings. Used by `slime'.") + (defun slime (&optional command buffer coding-system) "Start an inferior^_superior Lisp and connect to its Swank server." (interactive (list (if current-prefix-arg @@ -1462,15 +1467,15 @@ (defvar slime-net-coding-system (find-if (if (featurep 'xemacs) #'find-coding-system #'coding-system-p) - '(iso-8859-1-unix iso-8859-1 raw-text-unix)) + '(iso-latin-1-unix iso-8859-1-unix binary)) "*Coding system used for network connections.") (defvar slime-net-valid-coding-systems - '((iso-8859-1-unix nil :iso-latin-1-unix) - (iso-8859-1 nil :iso-latin-1-unix) ; for oldish Emacsen - (raw-text-unix nil :iso-latin-1-unix) ; ditto - (utf-8-unix t :utf-8-unix) - (emacs-mule-unix t :emacs-mule-unix)) + '((iso-latin-1-unix nil :iso-latin-1-unix) + (iso-8859-1-unix nil :iso-latin-1-unix) + (binary nil :iso-latin-1-unix) + (utf-8-unix t :utf-8-unix) + (emacs-mule-unix t :emacs-mule-unix)) "A list of valid coding systems. Each element is of the form: (NAME MULTIBYTEP CL-NAME)") @@ -1527,9 +1532,25 @@ This is the lowest level of communication. The sexp will be READ and EVAL'd by Lisp." (let* ((msg (concat (slime-prin1-to-string sexp) "\n")) - (string (concat (slime-net-encode-length (length msg)) msg))) + (string (concat (slime-net-encode-length (length msg)) msg)) + (coding-system (cdr (process-coding-system proc)))) (slime-log-event sexp) - (process-send-string proc string))) + (cond ((slime-safe-encoding-p coding-system string) + (process-send-string proc string)) + (t (error "Coding system %s not suitable for %S" + coding-system string))))) + +(defun slime-safe-encoding-p (coding-system string) + "Return true iff CODING-SYSTEM can safely encode STRING." + (if (featurep 'xemacs) + ;; FIXME: XEmacs encodes non-encodeable chars as ?~ automatically + t + (or (let ((candidates (find-coding-systems-string string)) + (base (coding-system-base coding-system))) + (or (equal candidates '(undecided)) + (memq base candidates))) + (and (not (multibyte-string-p string)) + (not (slime-coding-system-mulibyte-p coding-system)))))) (defun slime-net-close (process) (setq slime-net-processes (remove process slime-net-processes)) @@ -2483,7 +2504,8 @@ (defvar slime-repl-input-history '() "History list of strings read from the REPL buffer.") - (defvar slime-repl-input-history-position 0) + (defvar slime-repl-input-history-position 0 + "Newer items have smaller indices.") (defvar slime-repl-prompt-start-mark) (defvar slime-repl-input-start-mark) @@ -2822,25 +2844,43 @@ (defvar slime-repl-history-pattern nil "The regexp most recently used for finding input history.") -(defun slime-repl-history-replace (direction regexp) +(defun slime-repl-history-replace (direction regexp &optional delete-at-end-p) "Replace the current input with the next line in DIRECTION matching REGEXP. -DIRECTION is 'forward' or 'backward' (in the history list)." +DIRECTION is 'forward' or 'backward' (in the history list). +If DELETE-AT-END-P is non-nil then remove the string if the end of the +history is reached." + (setq slime-repl-history-pattern regexp) + (let ((pos (slime-repl-position-in-history direction regexp)) + (forward (eq direction 'forward))) + (cond (pos + (slime-repl-replace-input (nth pos slime-repl-input-history)) + (setq slime-repl-input-history-position pos) + (message "History item: %d" pos)) + (delete-at-end-p + (cond (forward + (slime-repl-replace-input "") + (setq slime-repl-input-history-position -1) + (message "End of history; no default available")) + (t + (message "Beginning of history; no preceeding item")))) + (t + (message "End of history; no matching item"))))) + +(defun slime-repl-position-in-history (direction regexp) + "Return the position of the history item matching regexp. +Return nil of no item matches" + ;; Loop through the history list looking for a matching line (let* ((step (ecase direction (forward -1) (backward 1))) (history-pos0 slime-repl-input-history-position)) - (setq slime-repl-history-pattern regexp) - ;; Loop through the history list looking for a matching line (loop for pos = (+ history-pos0 step) then (+ pos step) while (and (<= 0 pos) (< pos (length slime-repl-input-history))) do (let ((string (nth pos slime-repl-input-history))) (when (and (string-match regexp string) (not (string= string (slime-repl-current-input)))) - (slime-repl-replace-input string) - (setq slime-repl-input-history-position pos) - (return))) - finally (message "End of history; no matching item")))) + (return pos)))))) (defun slime-repl-matching-input-regexp () (if (memq last-command @@ -2850,11 +2890,11 @@ (defun slime-repl-previous-input () (interactive) - (slime-repl-history-replace 'backward (slime-repl-matching-input-regexp))) + (slime-repl-history-replace 'backward (slime-repl-matching-input-regexp) t)) (defun slime-repl-next-input () (interactive) - (slime-repl-history-replace 'forward (slime-repl-matching-input-regexp))) + (slime-repl-history-replace 'forward (slime-repl-matching-input-regexp) t)) (defun slime-repl-previous-matching-input (regexp) (interactive "sPrevious element matching (regexp): ") @@ -4128,19 +4168,23 @@ Designed to be bound to the SPC key. Prefix argument can be used to insert more than one space." (interactive "p") - (unwind-protect + (unwind-protect (when (and slime-space-information-p (slime-background-activities-enabled-p)) - (let ((names (slime-enclosing-operator-names))) - (when names - (slime-eval-async - `(swank:arglist-for-echo-area (quote ,names)) - (lexical-let ((buffer (current-buffer))) - (lambda (message) - (if message - (with-current-buffer buffer - (slime-message "%s" message))))))))) - (self-insert-command n))) + (slime-echo-arglist)) + (self-insert-command n))) + +(defun slime-echo-arglist () + "Display the arglist of the current form in the echo area." + (let ((names (slime-enclosing-operator-names))) + (when names + (slime-eval-async + `(swank:arglist-for-echo-area (quote ,names)) + (lexical-let ((buffer (current-buffer))) + (lambda (message) + (if message + (with-current-buffer buffer + (slime-message "%s" message))))))))) (defun slime-arglist (name) "Show the argument list for NAME." @@ -5380,6 +5424,7 @@ "\\ \\{slime-xref-mode-map}" (setq font-lock-defaults nil) + (setq delayed-mode-hooks nil) (slime-mode -1)) (slime-define-keys slime-xref-mode-map @@ -5388,8 +5433,7 @@ (" " 'slime-goto-xref) ("q" 'slime-xref-quit) ("n" 'slime-next-line/not-add-newlines) - ("p" 'previous-line) - ) + ("p" 'previous-line)) (defun slime-next-line/not-add-newlines () (interactive) From heller at common-lisp.net Thu Nov 25 19:03:24 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 25 Nov 2004 20:03:24 +0100 Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19298 Modified Files: swank.lisp Log Message: (dispatch-loop): Catch errors and close the connection. It's almost impossible to run the debugger inside the control-thread, so let it crash instead. A backtrace would be nice, though. (cleanup-connection-threads): Can know be called in the control-thread. Add a check to avoid thread suicide. (arglist-to-string): Don't show &whole, &aux and &environment args. (clean-arglist): New function. (start-swank-server-in-thread): Fix the call to start-server. Date: Thu Nov 25 20:03:23 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.265 slime/swank.lisp:1.266 --- slime/swank.lisp:1.265 Wed Nov 24 20:52:52 2004 +++ slime/swank.lisp Thu Nov 25 20:03:22 2004 @@ -268,6 +268,16 @@ (unwind-protect (progn , at body) (delete-package ,var)))) +(defvar *log-events* nil) +(defvar *log-io* *terminal-io*) + +(defun log-event (format-string &rest args) + "Write a message to *terminal-io* when *log-events* is non-nil. +Useful for low level debugging." + (when *log-events* + (apply #'format *log-io* format-string args) + (force-output *log-io*))) + ;;;; TCP Server (defparameter *redirect-io* t @@ -276,7 +286,6 @@ (defvar *use-dedicated-output-stream* t) (defvar *communication-style* (preferred-communication-style)) -(defvar *log-events* nil) (defun start-server (port-file &key (style *communication-style*) dont-close (external-format *coding-system*)) @@ -415,7 +424,8 @@ (setf *connections* (remove c *connections*)) (run-hook *connection-closed-hook* c) (when condition - (format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" condition))) + (format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" condition) + (finish-output *debug-io*))) (defmacro with-reader-error-handler ((connection) &body body) `(handler-case (progn , at body) @@ -439,8 +449,10 @@ (defun dispatch-loop (socket-io connection) (let ((*emacs-connection* connection)) - (loop (with-simple-restart (abort "Restart dispatch loop.") - (loop (dispatch-event (receive) socket-io)))))) + (handler-case + (loop (dispatch-event (receive) socket-io)) + (error (e) + (close-connection connection e))))) (defun repl-thread (connection) (let ((thread (connection.repl-thread connection))) @@ -524,8 +536,12 @@ connection))) (defun cleanup-connection-threads (connection) - (kill-thread (connection.control-thread connection)) - (kill-thread (connection.repl-thread connection))) + (let ((threads (list (connection.repl-thread connection) + (connection.reader-thread connection) + (connection.control-thread connection)))) + (dolist (thread threads) + (unless (equal (current-thread) thread) + (kill-thread thread))))) (defun repl-loop (connection) (with-connection (connection) @@ -814,15 +830,6 @@ (*terminal-io* io)) (funcall function))) -(defvar *log-io* *terminal-io*) - -(defun log-event (format-string &rest args) - "Write a message to *terminal-io* when *log-events* is non-nil. -Useful for low level debugging." - (when *log-events* - (apply #'format *log-io* format-string args) - (force-output *log-io*))) - (defun read-from-emacs () "Read and process a request from Emacs." (apply #'funcall (funcall (connection.read *emacs-connection*)))) @@ -1070,22 +1077,28 @@ (arglist-to-string (cons name arglist) (symbol-package symbol)))))) +(defun clean-arglist (arglist) + "Remove &whole, &enviroment, and &aux elements from ARGLIST." + (cond ((null arglist) '()) + ((member (car arglist) '(&whole &environment)) + (clean-arglist (cddr arglist))) + ((eq (car arglist) '&aux) + '()) + (t (cons (car arglist) (clean-arglist (cdr arglist)))))) + (defun arglist-to-string (arglist package) "Print the list ARGLIST for display in the echo area. The argument name are printed without package qualifiers and pretty printing of (function foo) as #'foo is suppressed." + (setq arglist (clean-arglist arglist)) (etypecase arglist (null "()") (cons (with-output-to-string (*standard-output*) (with-standard-io-syntax - (let ((*package* package) - (*print-case* :downcase) - (*print-pretty* t) - (*print-circle* nil) - (*print-readably* nil) - (*print-level* 10) - (*print-length* 20)) + (let ((*package* package) (*print-case* :downcase) + (*print-pretty* t) (*print-circle* nil) (*print-readably* nil) + (*print-level* 10) (*print-length* 20)) (pprint-logical-block (nil nil :prefix "(" :suffix ")") (loop (let ((arg (pop arglist))) @@ -1107,7 +1120,10 @@ (progn (assert (test-print-arglist '(function cons) "(function cons)")) (assert (test-print-arglist '(quote cons) "(quote cons)")) - (assert (test-print-arglist '(&key (function #'+)) "(&key (function #'+))"))) + (assert (test-print-arglist '(&key (function #'+)) "(&key (function #'+))")) + (assert (test-print-arglist '(&whole x y z) "(y z)")) + (assert (test-print-arglist '(x &aux y z) "(x)")) + (assert (test-print-arglist '(x &environment env y) "(x y)"))) ;; Expected failure: ;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))")) @@ -3253,8 +3269,8 @@ "Interrupt the INDEXth thread and make it start a swank server. The server port is written to PORT-FILE-NAME." (interrupt-thread (nth-thread index) - (lambda () - (start-server port-file-name nil)))) + (lambda () + (start-server port-file-name :style nil)))) ;;;; Class browser From heller at common-lisp.net Thu Nov 25 19:05:48 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 25 Nov 2004 20:05:48 +0100 Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19361 Modified Files: swank-sbcl.lisp Log Message: (%thread-state-slot, %thread-state): Refactored from thread-status. (thread-status): Use it. (all-threads): Exclude return zombies. Date: Thu Nov 25 20:05:46 2004 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.113 slime/swank-sbcl.lisp:1.114 --- slime/swank-sbcl.lisp:1.113 Wed Nov 24 20:58:37 2004 +++ slime/swank-sbcl.lisp Thu Nov 25 20:05:46 2004 @@ -856,22 +856,23 @@ (defimplementation thread-name (thread) (format nil "Thread ~D" thread)) - (defimplementation thread-status (thread) + (defun %thread-state-slot (thread) (sb-sys:without-gcing - (let ((thread (sb-thread::thread-sap-from-id thread))) - (cond (thread - (let* ((sap (sb-sys:sap-ref-sap thread - (* sb-vm::thread-state-slot - sb-vm::n-word-bytes))) - (state (ash (sb-sys:sap-int sap) - (- sb-vm::n-fixnum-tag-bits)))) - (case state - (0 "running") - (1 "stopping") - (2 "stopped") - (3 "dead") - (t (format nil "??? ~A" state))))) - (t "??? ???"))))) + (sb-kernel:make-lisp-obj + (sb-sys:sap-int + (sb-sys:sap-ref-sap (sb-thread::thread-sap-from-id thread) + (* sb-vm::thread-state-slot + sb-vm::n-word-bytes)))))) + + (defun %thread-state (thread) + (ecase (%thread-state-slot thread) + (0 :running) + (1 :stopping) + (2 :stopped) + (3 :dead))) + + (defimplementation thread-status (thread) + (string (%thread-state thread))) (defimplementation make-lock (&key name) (sb-thread:make-mutex :name name)) @@ -884,10 +885,12 @@ (sb-thread:current-thread-id)) (defimplementation all-threads () - (sb-thread::mapcar-threads - (lambda (sap) - (sb-sys:sap-ref-32 sap (* sb-vm:n-word-bytes - sb-vm::thread-pid-slot))))) + (let ((pids (sb-sys:without-gcing + (sb-thread::mapcar-threads + (lambda (sap) + (sb-sys:sap-ref-32 sap (* sb-vm:n-word-bytes + sb-vm::thread-pid-slot))))))) + (remove :dead pids :key #'%thread-state))) (defimplementation interrupt-thread (thread fn) (sb-thread:interrupt-thread thread fn)) From heller at common-lisp.net Thu Nov 25 19:09:12 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 25 Nov 2004 20:09:12 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19398 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Nov 25 20:09:08 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.579 slime/ChangeLog:1.580 --- slime/ChangeLog:1.579 Wed Nov 24 21:29:39 2004 +++ slime/ChangeLog Thu Nov 25 20:09:07 2004 @@ -1,3 +1,42 @@ +2004-11-25 Chris Capel + + * slime.el (slime-indent-and-complete-symbol): Echo the arglist if + there's no symbol before point. Don't complete after parens. + (slime-echo-arglist): Factorized from slime-space. + (slime-space): Use it. + (slime-repl-history-replace): Clear the input at the end of the + history. + + * swank.lisp (arglist-to-string): Don't show &whole, &aux and + &environment args. + (clean-arglist): New function. + +2004-11-25 Helmut Eller + + * slime.el (slime-net-coding-system): Emacs does funky encoding + for `raw-text-unix' use `binary' instead. + (slime-safe-encoding-p): New function. + (slime-net-send): Use it and don't try to send stuff which can't + be decoded by Lisp. + (slime-inferior-lisp-program-history): XEmacs compatibility: + declare it as a variable. + (slime-xref-mode): In Emacs 21, set delayed-mode-hooks to nil + because we don't want to run the lisp-mode-hook. Reported by + Chris Capel. + + * swank.lisp (dispatch-loop): Catch errors and close the + connection. It's almost impossible to run the debugger inside the + control-thread, so let it crash instead. A backtrace would be + nice, though. + (cleanup-connection-threads): Can know be called in the + control-thread. Add a check to avoid thread suicide. + (start-swank-server-in-thread): Fix the call to start-server. + + * swank-sbcl.lisp (%thread-state-slot, %thread-state): Refactored + from thread-status. + (thread-status): Use it. + (all-threads): Exclude return zombies. + 2004-11-24 Helmut Eller * slime.el (slime-start-and-load): Use vanilla comint instead of @@ -11,7 +50,7 @@ inf-lisp. (slime-net-coding-system): Use find-coding-system in XEmacs. coding-system-p means something different here. - (slime-repl-mode-map): XEmacs compatibilty: use (kbd "C-") + (slime-repl-mode-map): XEmacs compatibility: use (kbd "C-") instead of [C-up]. * swank.lisp (inspect-for-emacs-list): subseq on improper lists From heller at common-lisp.net Thu Nov 25 19:09:58 2004 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 25 Nov 2004 20:09:58 +0100 Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv19434 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Nov 25 20:09:54 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.580 slime/ChangeLog:1.581 --- slime/ChangeLog:1.580 Thu Nov 25 20:09:07 2004 +++ slime/ChangeLog Thu Nov 25 20:09:54 2004 @@ -1,4 +1,4 @@ -2004-11-25 Chris Capel +2004-11-25 Chris Capel * slime.el (slime-indent-and-complete-symbol): Echo the arglist if there's no symbol before point. Don't complete after parens. From heller at common-lisp.net Fri Nov 26 07:06:36 2004 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 26 Nov 2004 08:06:36 +0100 Subject: [slime-cvs] CVS update: slime/swank-cmucl.lisp Message-ID: Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27670 Modified Files: swank-cmucl.lisp Log Message: (read-into-simple-string): Use #-cmu19 instead of #+cmu18e. Date: Fri Nov 26 08:06:32 2004 Author: heller Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.130 slime/swank-cmucl.lisp:1.131 --- slime/swank-cmucl.lisp:1.130 Wed Nov 24 20:55:59 2004 +++ slime/swank-cmucl.lisp Fri Nov 26 08:06:31 2004 @@ -27,7 +27,7 @@ ;;; `READ-SEQUENCE' with large sequences has problems in 18e. This new ;;; definition works better. -#+cmu18e +#-cmu19 (progn (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp))) (when s From heller at common-lisp.net Mon Nov 29 17:31:10 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 29 Nov 2004 18:31:10 +0100 (CET) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20041129173110.525D2884CE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv1901 Modified Files: slime.el Log Message: (slime-global-variable-name-p): Allow optional ":" or "::". (slime-repl-wrap-history): New user variable. (slime-repl-history-replace): Implement wrap around. (slime-repl-easy-menu): Fix binding for "Next Input". Reported by Surendra Singhi. Date: Mon Nov 29 18:31:04 2004 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.432 slime/slime.el:1.433 --- slime/slime.el:1.432 Thu Nov 25 19:58:04 2004 +++ slime/slime.el Mon Nov 29 18:31:03 2004 @@ -749,7 +749,7 @@ [ "Interrupt Lisp process" slime-interrupt ,C ] "--" [ "Previous Input" slime-repl-previous-input t ] - [ "Next Input" slime-repl-previous-input t ] + [ "Next Input" slime-repl-next-input t ] [ "Goto Previous Prompt " slime-repl-previous-prompt t ] [ "Goto Next Prompt " slime-repl-next-prompt t ] [ "Clear Last Output" slime-repl-clear-output t ] @@ -2841,6 +2841,11 @@ ;;;;; History +(defcustom slime-repl-wrap-history nil + "T to wrap history around when the end is reached." + :type 'boolean + :group 'slime-repl) + (defvar slime-repl-history-pattern nil "The regexp most recently used for finding input history.") @@ -2856,13 +2861,16 @@ (slime-repl-replace-input (nth pos slime-repl-input-history)) (setq slime-repl-input-history-position pos) (message "History item: %d" pos)) - (delete-at-end-p - (cond (forward - (slime-repl-replace-input "") - (setq slime-repl-input-history-position -1) - (message "End of history; no default available")) - (t - (message "Beginning of history; no preceeding item")))) + ((and delete-at-end-p (not slime-repl-wrap-history)) + (cond (forward (slime-repl-replace-input "") + (message "End of history")) + (t (message "Beginning of history"))) + (setq slime-repl-input-history-position + (if forward -1 (length slime-repl-input-history)))) + ((and delete-at-end-p slime-repl-wrap-history) + (slime-repl-replace-input "") + (setq slime-repl-input-history-position + (if forward (length slime-repl-input-history) -1))) (t (message "End of history; no matching item"))))) @@ -4262,7 +4270,7 @@ (defun slime-global-variable-name-p (name) "Is NAME a global variable? Globals are recognised purely by *this-naming-convention*." - (string-match "^\\*.*\\*$" name)) + (string-match "^\\(.*::?\\)?\\*.*\\*$" name)) (defun slime-get-cached-autodoc (symbol-name) "Return the cached autodoc documentation for SYMBOL-NAME, or nil." From heller at common-lisp.net Mon Nov 29 17:31:59 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 29 Nov 2004 18:31:59 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20041129173159.4809B884CE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2182 Modified Files: swank.lisp Log Message: (macro-indentation): Call clean-arglist. Date: Mon Nov 29 18:31:54 2004 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.266 slime/swank.lisp:1.267 --- slime/swank.lisp:1.266 Thu Nov 25 20:03:22 2004 +++ slime/swank.lisp Mon Nov 29 18:31:53 2004 @@ -3404,7 +3404,7 @@ (defun macro-indentation (arglist) (if (well-formed-list-p arglist) - (position '&body (remove '&whole arglist)) + (position '&body (clean-arglist arglist)) nil)) (defun well-formed-list-p (list) From heller at common-lisp.net Mon Nov 29 17:33:05 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 29 Nov 2004 18:33:05 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-lispworks.lisp Message-ID: <20041129173305.DC8D7884CE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2411 Modified Files: swank-lispworks.lisp Log Message: (list-callers-internal): Return the function if dspec:object-dspec returns nil. (xref-results): Previously, functions for which dspec:dspec-definition-locations returned nil were ignored. Include them with a unknown source-location. (accept-connection): Add default for external-format. Date: Mon Nov 29 18:33:05 2004 Author: heller Index: slime/swank-lispworks.lisp diff -u slime/swank-lispworks.lisp:1.62 slime/swank-lispworks.lisp:1.63 --- slime/swank-lispworks.lisp:1.62 Wed Nov 24 20:50:49 2004 +++ slime/swank-lispworks.lisp Mon Nov 29 18:33:04 2004 @@ -70,7 +70,8 @@ (defimplementation close-socket (socket) (comm::close-socket (socket-fd socket))) -(defimplementation accept-connection (socket &key external-format) +(defimplementation accept-connection (socket + &key (external-format :iso-latin-1-unix)) (assert (eq external-format :iso-latin-1-unix)) (let* ((fd (comm::get-fd-from-socket socket))) (assert (/= fd -1)) @@ -543,7 +544,7 @@ (loop for object across callers collect (if (symbolp object) (list 'function object) - (dspec:object-dspec object))))) + (or (dspec:object-dspec object) object))))) ;; only for lispworks 4.2 and above #-lispworks4.1 @@ -557,13 +558,14 @@ (xref-results (mapcar #'dspec:object-dspec methods)))) (defun xref-results (dspecs) - (loop for dspec in dspecs - nconc (loop for (dspec location) - in (dspec:dspec-definition-locations dspec) - collect (list dspec - (make-dspec-location dspec location))))) + (flet ((frob-locs (dspec locs) + (cond (locs + (loop for (name loc) in locs + collect (list name (make-dspec-location name loc)))) + (t `((,dspec (:error "Source location not available"))))))) + (loop for dspec in dspecs + append (frob-locs dspec (dspec:dspec-definition-locations dspec))))) ;;; Inspector - (defclass lispworks-inspector (inspector) ()) From heller at common-lisp.net Mon Nov 29 17:35:10 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 29 Nov 2004 18:35:10 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp slime/swank-sbcl.lisp slime/swank-cmucl.lisp slime/swank-allegro.lisp slime/swank-clisp.lisp slime/swank-openmcl.lisp Message-ID: <20041129173510.F3E7F884CE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2443 Modified Files: swank-abcl.lisp swank-sbcl.lisp swank-cmucl.lisp swank-allegro.lisp swank-clisp.lisp swank-openmcl.lisp Log Message: (accept-connection): The :external-format argument defaults now to :iso-latin-1-unix. Date: Mon Nov 29 18:35:03 2004 Author: heller Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.22 slime/swank-abcl.lisp:1.23 --- slime/swank-abcl.lisp:1.22 Fri Nov 19 20:04:51 2004 +++ slime/swank-abcl.lisp Mon Nov 29 18:35:03 2004 @@ -109,7 +109,8 @@ (defimplementation close-socket (socket) (ext:server-socket-close socket)) -(defimplementation accept-connection (socket &key external-format) +(defimplementation accept-connection (socket + &key (external-format :iso-latin-1-unix)) (assert (eq external-format :iso-latin-1-unix)) (ext:get-socket-stream (ext:socket-accept socket))) Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.114 slime/swank-sbcl.lisp:1.115 --- slime/swank-sbcl.lisp:1.114 Thu Nov 25 20:05:46 2004 +++ slime/swank-sbcl.lisp Mon Nov 29 18:35:03 2004 @@ -69,7 +69,8 @@ (sb-sys:invalidate-descriptor (socket-fd socket)) (sb-bsd-sockets:socket-close socket)) -(defimplementation accept-connection (socket &key external-format) +(defimplementation accept-connection (socket + &key (external-format :iso-latin-1-unix)) (make-socket-io-stream (accept socket) external-format)) (defvar *sigio-handlers* '() Index: slime/swank-cmucl.lisp diff -u slime/swank-cmucl.lisp:1.131 slime/swank-cmucl.lisp:1.132 --- slime/swank-cmucl.lisp:1.131 Fri Nov 26 08:06:31 2004 +++ slime/swank-cmucl.lisp Mon Nov 29 18:35:03 2004 @@ -89,7 +89,8 @@ (sys:invalidate-descriptor socket) (ext:close-socket (socket-fd socket))) -(defimplementation accept-connection (socket &key external-format) +(defimplementation accept-connection (socket + &key (external-format :iso-latin-1-unix)) (assert (eq external-format ':iso-latin-1-unix)) (make-socket-io-stream (ext:accept-tcp-connection socket))) Index: slime/swank-allegro.lisp diff -u slime/swank-allegro.lisp:1.64 slime/swank-allegro.lisp:1.65 --- slime/swank-allegro.lisp:1.64 Wed Nov 24 20:49:18 2004 +++ slime/swank-allegro.lisp Mon Nov 29 18:35:03 2004 @@ -51,7 +51,8 @@ (defimplementation close-socket (socket) (close socket)) -(defimplementation accept-connection (socket &key external-format) +(defimplementation accept-connection (socket + &key (external-format :iso-latin-1-unix)) (let ((s (socket:accept-connection socket :wait t))) (set-external-format s external-format) s)) Index: slime/swank-clisp.lisp diff -u slime/swank-clisp.lisp:1.42 slime/swank-clisp.lisp:1.43 --- slime/swank-clisp.lisp:1.42 Fri Nov 19 20:05:49 2004 +++ slime/swank-clisp.lisp Mon Nov 29 18:35:03 2004 @@ -158,7 +158,8 @@ (:utf-8-unix (ext:make-encoding :charset 'charset:utf-8 :line-terminator :unix)))) -(defimplementation accept-connection (socket &key external-format) +(defimplementation accept-connection (socket + &key (external-format :iso-latin-1-unix)) (socket:socket-accept socket :buffered nil ;; XXX should be t :element-type 'character Index: slime/swank-openmcl.lisp diff -u slime/swank-openmcl.lisp:1.91 slime/swank-openmcl.lisp:1.92 --- slime/swank-openmcl.lisp:1.91 Sat Nov 20 13:06:32 2004 +++ slime/swank-openmcl.lisp Mon Nov 29 18:35:03 2004 @@ -136,7 +136,8 @@ (defimplementation close-socket (socket) (close socket)) -(defimplementation accept-connection (socket &key external-format) +(defimplementation accept-connection (socket + &key (external-format :iso-latin-1-unix)) (assert (eq external-format :iso-latin-1-unix)) (ccl:accept-connection socket :wait t)) From heller at common-lisp.net Mon Nov 29 17:36:38 2004 From: heller at common-lisp.net (Helmut Eller) Date: Mon, 29 Nov 2004 18:36:38 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20041129173638.B0675884D9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv2497 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Nov 29 18:36:37 2004 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.581 slime/ChangeLog:1.582 --- slime/ChangeLog:1.581 Thu Nov 25 20:09:54 2004 +++ slime/ChangeLog Mon Nov 29 18:36:37 2004 @@ -1,3 +1,36 @@ +2004-11-29 Lynn Quam + + * slime.el (slime-global-variable-name-p): Allow optional + ":" or "::". + +2004-11-29 Chris Capel + + * swank.lisp (macro-indentation): Ignore &whole, &aux, and + &environment args. + +2004-11-29 Helmut Eller + + * slime.el (slime-repl-wrap-history): New user variable. + (slime-repl-history-replace): Implement wrap around. + (slime-repl-easy-menu): Fix binding for "Next Input". Reported by + Surendra Singhi. + + * swank-lispworks.lisp (list-callers-internal): Return the + function if dspec:object-dspec returns nil. + (xref-results): Previously, functions for which + dspec:dspec-definition-locations returned nil were ignored. + Include them with a unknown source-location. + + * swank-abcl.lisp, swank-allegro.lisp, swank-clisp.lisp, + swank-cmucl.lisp, swank-openmcl.lisp, swank-sbcl.lisp, + swank-lispworks (accept-connection): The :external-format argument + defaults now to :iso-latin-1-unix. + +2004-11-26 Helmut Eller + + * swank-cmucl.lisp (read-into-simple-string): Use #-cmu19 instead + of #+cmu18e. + 2004-11-25 Chris Capel * slime.el (slime-indent-and-complete-symbol): Echo the arglist if @@ -28,14 +61,14 @@ connection. It's almost impossible to run the debugger inside the control-thread, so let it crash instead. A backtrace would be nice, though. - (cleanup-connection-threads): Can know be called in the + (cleanup-connection-threads): Can now be called in the control-thread. Add a check to avoid thread suicide. (start-swank-server-in-thread): Fix the call to start-server. * swank-sbcl.lisp (%thread-state-slot, %thread-state): Refactored from thread-status. (thread-status): Use it. - (all-threads): Exclude return zombies. + (all-threads): Exclude zombies. 2004-11-24 Helmut Eller