From trittweiler at common-lisp.net Thu May 10 17:21:53 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 10 May 2007 13:21:53 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070510172153.588B05310B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv15808 Modified Files: slime.el Log Message: * slime.el: Within the Slime Inspector, `S-Tab' will now also work on X. Furthermore `Tab' and `S-Tab' will now correctly wrap around the beginning and end of the buffer; priorly it'd hang on the beginning with a message "Beginning of buffer", and would require an additional `S-Tab'. (slime-inspector-mode-map): Attached `[backtab]' to SLIME-INSPECTOR-PREVIOUS-INSPECTABLE-OBJECT, as Emacs translates `S-Tab' to `Backtab' on X. (slime-find-inspectable-object): New function; finds next or previous inspectable object. (slime-inspector-next-inspectable-object): Mostly rewritten. Use SLIME-FIND-INSPECTABLE-OBJECT to make the code clearer. --- /project/slime/cvsroot/slime/slime.el 2007/04/16 14:42:33 1.784 +++ /project/slime/cvsroot/slime/slime.el 2007/05/10 17:21:52 1.785 @@ -9455,53 +9455,57 @@ (set-window-configuration slime-saved-window-config) (kill-buffer (current-buffer))) +(defun slime-find-inspectable-object (direction limit) + "Finds the next or previous inspectable object within the +current buffer, depending on whether DIRECTION is 'NEXT or +'PREV. LIMIT is the maximum or minimum position in the current +buffer. + +Returns a list of two values: If an object could be found, the +starting position of the found object and T is returned; +otherwise LIMIT and NIL is returned. +" + (let ((finder (ecase direction + (next 'next-single-property-change) + (prev 'previous-single-property-change)))) + (let ((prop nil) (curpos (point))) + (while (and (not prop) (not (= curpos limit))) + (let ((newpos (funcall finder curpos 'slime-part-number nil limit))) + (setq prop (get-text-property newpos 'slime-part-number)) + (setq curpos newpos))) + (list curpos (and prop t))))) + (defun slime-inspector-next-inspectable-object (arg) "Move point to the next inspectable object. With optional ARG, move across that many objects. If ARG is negative, move backwards." (interactive "p") - (or (bobp) (> arg 0) (backward-char)) - (let ((wrapped 0) - (number arg) - (old (get-text-property (point) 'slime-part-number)) - new) + (let ((maxpos (point-max)) (minpos (point-min)) + (previously-wrapped-p nil)) ;; Forward. (while (> arg 0) - (cond ((eobp) - (goto-char (point-min)) - (setq wrapped (1+ wrapped))) - (t - (goto-char (or (next-single-property-change (point) - 'slime-part-number) - (point-max))))) - (and (= wrapped 2) - (eq arg number) - (error "No inspectable objects")) - (let ((new (get-text-property (point) 'slime-part-number))) - (when new - (unless (eq new old) - (setq arg (1- arg)) - (setq old new))))) + (destructuring-bind (pos foundp) + (slime-find-inspectable-object 'next maxpos) + (if foundp + (progn (goto-char pos) (setq arg (1- arg)) + (setq previously-wrapped-p nil)) + (if (not previously-wrapped-p) ; cycle detection + (progn (goto-char minpos) (setq previously-wrapped-p t)) + (error "No inspectable objects"))))) ;; Backward. (while (< arg 0) - (cond ((bobp) - (goto-char (point-max)) - (setq wrapped (1+ wrapped))) - (t - (goto-char (or (previous-single-property-change - (point) 'slime-part-number) - (point-min))))) - (and (= wrapped 2) - (eq arg number) - (error "No inspectable objects")) - (let ((new (get-text-property (point) 'slime-part-number))) - (when new - (unless (eq new old) - (setq arg (1+ arg)))))) - (let ((new (get-text-property (point) 'slime-part-number))) - (while (eq (get-text-property (point) 'slime-part-number) new) - (backward-char))) - (forward-char))) + (destructuring-bind (pos foundp) + (slime-find-inspectable-object 'prev minpos) + ;; SLIME-OPEN-INSPECTOR inserts the title of an inspector page + ;; as a presentation at the beginning of the buffer; skip + ;; that. (Notice how this problem can not arise in ``Forward.'') + (if (and foundp (/= pos minpos)) + (progn (goto-char pos) (setq arg (1+ arg)) + (setq previously-wrapped-p nil)) + (if (not previously-wrapped-p) ; cycle detection + (progn (goto-char maxpos) (setq previously-wrapped-p t)) + (error "No inspectable objects"))))))) + (defun slime-inspector-previous-inspectable-object (arg) "Move point to the previous inspectable object. @@ -9539,7 +9543,8 @@ ("q" 'slime-inspector-quit) ("g" 'slime-inspector-reinspect) ("\C-i" 'slime-inspector-next-inspectable-object) - ([(shift tab)] 'slime-inspector-previous-inspectable-object) + ([(shift tab)] 'slime-inspector-previous-inspectable-object) ; Emacs translates S-TAB + ([backtab] 'slime-inspector-previous-inspectable-object) ; to BACKTAB on X. ("\M-." 'slime-edit-definition)) From trittweiler at common-lisp.net Thu May 10 17:23:33 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 10 May 2007 13:23:33 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070510172333.4DD355F040@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16163 Modified Files: ChangeLog Log Message: * slime.el: Within the Slime Inspector, `S-Tab' will now also work on X. Furthermore `Tab' and `S-Tab' will now correctly wrap around the beginning and end of the buffer; priorly it'd hang on the beginning with a message "Beginning of buffer", and would require an additional `S-Tab'. (slime-inspector-mode-map): Attached `[backtab]' to SLIME-INSPECTOR-PREVIOUS-INSPECTABLE-OBJECT, as Emacs translates `S-Tab' to `Backtab' on X. (slime-find-inspectable-object): New function; finds next or previous inspectable object. (slime-inspector-next-inspectable-object): Mostly rewritten. Use SLIME-FIND-INSPECTABLE-OBJECT to make the code clearer. --- /project/slime/cvsroot/slime/ChangeLog 2007/04/23 17:10:12 1.1117 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/10 17:23:31 1.1118 @@ -1,3 +1,19 @@ +2007-04-21 Tobias C. Rittweiler + + * slime.el: Within the Slime Inspector, `S-Tab' will now also work + on X. Furthermore `Tab' and `S-Tab' will now correctly wrap + around the beginning and end of the buffer; priorly it'd hang on + the beginning with a message "Beginning of buffer", and would + require an additional `S-Tab'. + + (slime-inspector-mode-map): Attached `[backtab]' to + SLIME-INSPECTOR-PREVIOUS-INSPECTABLE-OBJECT, as Emacs translates + `S-Tab' to `Backtab' on X. + (slime-find-inspectable-object): New function; finds next or + previous inspectable object. + (slime-inspector-next-inspectable-object): Mostly rewritten. Use + SLIME-FIND-INSPECTABLE-OBJECT to make the code clearer. + 2007-04-19 Tobias C. Rittweiler * swank-backend.lisp (label-value-line): Add :newline as &key From trittweiler at common-lisp.net Thu May 10 17:45:10 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 10 May 2007 13:45:10 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070510174510.EF5F5710FB@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv21992 Modified Files: slime.el Log Message: * slime.el: Fix macroexpanding on things like ",(loop ...)". (slime-sexp-at-point-for-macroexpansion): New function; like SLIME-SEXP-AT-POINT-OR-ERROR, but fixes up some misbehaviour with respect to macroexpansion. (slime-eval-macroexpand, slime-eval-macroexpand-inplace): Use the new function. --- /project/slime/cvsroot/slime/slime.el 2007/05/10 17:21:52 1.785 +++ /project/slime/cvsroot/slime/slime.el 2007/05/10 17:45:10 1.786 @@ -7953,13 +7953,33 @@ (slime-remove-edits (point-min) (point-max))) (undo arg))))) +(defun slime-sexp-at-point-for-macroexpansion () + "Essentially like SLIME-SEXP-AT-POINT-OR-ERROR, but behaves a +bit more sanely in situations like ,(loop ...) where you want to +expand the LOOP form. See comment in the source of this function." + (let ((string (slime-sexp-at-point-or-error)) + (bounds (bounds-of-thing-at-point 'sexp)) + (char-at-point (substring-no-properties (thing-at-point 'char)))) + ;; SLIME-SEXP-AT-POINT(-OR-ERROR) uses (THING-AT-POINT 'SEXP) + ;; which is quite a bit botched: it returns "'(FOO BAR BAZ)" even + ;; when point is placed _at the opening parenthesis_, and hence + ;; "(FOO BAR BAZ)" wouldn't get expanded. Likewise for ",(...)", + ;; ",@(...)" (would return "@(...)"!!), and "\"(...)". + ;; So we better fix this up here: + (when (string= char-at-point "(") + (let ((char0 (elt string 0))) + (when (member char0 '(?\' ?\, ?\" ?\@)) + (setf string (substring string 1)) + (incf (car bounds))))) + (list string bounds))) + (defvar slime-eval-macroexpand-expression nil "Specifies the last macroexpansion preformed. This variable specifies both what was expanded and how.") (defun slime-eval-macroexpand (expander &optional string) (unless string - (setf string (slime-sexp-at-point-or-error))) + (setf string (first (slime-sexp-at-point-for-macroexpansion)))) (setf slime-eval-macroexpand-expression `(,expander ,string)) (lexical-let ((package (slime-current-package))) (slime-eval-async @@ -7978,31 +7998,26 @@ NB: Does not affect *slime-eval-macroexpand-expression*" (interactive) - (lexical-let* ((string (slime-sexp-at-point-or-error)) - (bounds (bounds-of-thing-at-point 'sexp)) - (start (car bounds)) - (end (cdr bounds)) - (point (point)) - (package (slime-current-package)) - (buffer (current-buffer))) - ;; SLIME-SEXP-AT-POINT returns "'(FOO BAR BAZ)" even when point is - ;; placed at the opening parenthesis, which wouldn't get expanded - ;; even though FOO was a macro. Hence this workaround: - (when (and (eq ?\' (elt string 0)) (eq ?\( (elt string 1))) - (setf string (substring string 1)) (incf start)) - (slime-eval-async - `(,expander ,string) - (lambda (expansion) - (with-current-buffer buffer - (let ((buffer-read-only nil)) - (when slime-use-highlight-edits-mode - (slime-remove-edits (point-min) (point-max))) - (goto-char start) - (delete-region start end) - (insert expansion) - (goto-char start) - (indent-sexp) - (goto-char point))))))) + (destructuring-bind (string bounds) + (slime-sexp-at-point-for-macroexpansion) + (lexical-let* ((start (car bounds)) + (end (cdr bounds)) + (point (point)) + (package (slime-current-package)) + (buffer (current-buffer))) + (slime-eval-async + `(,expander ,string) + (lambda (expansion) + (with-current-buffer buffer + (let ((buffer-read-only nil)) + (when slime-use-highlight-edits-mode + (slime-remove-edits (point-min) (point-max))) + (goto-char start) + (delete-region start end) + (insert expansion) + (goto-char start) + (indent-sexp) + (goto-char point)))))))) (defun slime-macroexpand-1 (&optional repeatedly) "Display the macro expansion of the form at point. The form is From trittweiler at common-lisp.net Thu May 10 17:45:28 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 10 May 2007 13:45:28 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070510174528.2C3037A001@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv22103 Modified Files: ChangeLog Log Message: * slime.el: Fix macroexpanding on things like ",(loop ...)". (slime-sexp-at-point-for-macroexpansion): New function; like SLIME-SEXP-AT-POINT-OR-ERROR, but fixes up some misbehaviour with respect to macroexpansion. (slime-eval-macroexpand, slime-eval-macroexpand-inplace): Use the new function. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/10 17:23:31 1.1118 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/10 17:45:27 1.1119 @@ -1,4 +1,14 @@ -2007-04-21 Tobias C. Rittweiler +2007-05-10 Tobias C. Rittweiler + + * slime.el: Fix macroexpanding on things like ",(loop ...)". + + (slime-sexp-at-point-for-macroexpansion): New function; like + SLIME-SEXP-AT-POINT-OR-ERROR, but fixes up some misbehaviour with + respect to macroexpansion. + (slime-eval-macroexpand, slime-eval-macroexpand-inplace): Use the + new function. + +2007-05-10 Tobias C. Rittweiler * slime.el: Within the Slime Inspector, `S-Tab' will now also work on X. Furthermore `Tab' and `S-Tab' will now correctly wrap From trittweiler at common-lisp.net Thu May 10 17:54:32 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 10 May 2007 13:54:32 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070510175432.BCCFF21054@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv23995 Modified Files: swank.lisp Log Message: * swank.lisp: Previously when using SLIME-APROPOS-PACKAGE, only those symbols were considered whose home package matched the given package; this would, however, prevent all those symbols from being listed that are imported from another package, and then exported again in the package they got imported into. (As an example, SWANK:RESTART-FRAME is actually from SWANK-BACKEND.) (apropos-matcher): Renamed to MAKE-REGEXP-MATCHER. (make-regexp-matcher): Changed to only match for a given regexp. (apropos-symbols): Use MAKE-REGEXP-MATCHER. --- /project/slime/cvsroot/slime/swank.lisp 2007/04/19 16:36:36 1.479 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/10 17:54:31 1.480 @@ -4187,6 +4187,8 @@ (let ((package (if package (or (parse-package package) (error "No such package: ~S" package))))) + ;; The MAPCAN will filter all uninteresting symbols, i.e. those + ;; who cannot be meaningfully described. (mapcan (listify #'briefly-describe-symbol-for-emacs) (sort (remove-duplicates (apropos-symbols name external-only case-sensitive package)) @@ -4243,26 +4245,23 @@ (lambda (s) (check-type s string) t) (compile nil (slime-nregex:regex-compile regex-string))))))) -(defun apropos-matcher (string case-sensitive package external-only) +(defun make-regexp-matcher (string case-sensitive) (let* ((case-modifier (if case-sensitive #'string #'string-upcase)) (regex (compiled-regex (funcall case-modifier string)))) (lambda (symbol) - (and (not (keywordp symbol)) - (if package (eq (symbol-package symbol) package) t) - (if external-only (symbol-external-p symbol) t) - (funcall regex (funcall case-modifier symbol)))))) + (funcall regex (funcall case-modifier symbol))))) (defun apropos-symbols (string external-only case-sensitive package) - (let ((result '()) - (matchp (apropos-matcher string case-sensitive package external-only))) - (with-package-iterator (next (or package (list-all-packages)) - :external :internal) - (loop - (multiple-value-bind (morep symbol) (next) - (cond ((not morep) - (return)) - ((funcall matchp symbol) - (push symbol result)))))) + (let ((packages (or package (remove (find-package :keyword) + (list-all-packages)))) + (matcher (make-apropos-matcher string case-sensitive)) + (result)) + (with-package-iterator (next packages :external :internal) + (loop (multiple-value-bind (morep symbol) (next) + (cond ((not morep) (return)) + ((and (if external-only (symbol-external-p symbol) t) + (funcall matcher symbol)) + (push symbol result)))))) result)) (defun call-with-describe-settings (fn) From trittweiler at common-lisp.net Thu May 10 17:55:08 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 10 May 2007 13:55:08 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070510175508.D35912D165@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv24088 Modified Files: ChangeLog Log Message: * swank.lisp: Previously when using SLIME-APROPOS-PACKAGE, only those symbols were considered whose home package matched the given package; this would, however, prevent all those symbols from being listed that are imported from another package, and then exported again in the package they got imported into. (As an example, SWANK:RESTART-FRAME is actually from SWANK-BACKEND.) (apropos-matcher): Renamed to MAKE-REGEXP-MATCHER. (make-regexp-matcher): Changed to only match for a given regexp. (apropos-symbols): Use MAKE-REGEXP-MATCHER. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/10 17:45:27 1.1119 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/10 17:55:08 1.1120 @@ -1,5 +1,18 @@ 2007-05-10 Tobias C. Rittweiler + * swank.lisp: Previously when using SLIME-APROPOS-PACKAGE, only + those symbols were considered whose home package matched the + given package; this would, however, prevent all those symbols from + being listed that are imported from another package, and then + exported again in the package they got imported into. (As an + example, SWANK:RESTART-FRAME is actually from SWANK-BACKEND.) + + (apropos-matcher): Renamed to MAKE-REGEXP-MATCHER. + (make-regexp-matcher): Changed to only match for a given regexp. + (apropos-symbols): Use MAKE-REGEXP-MATCHER. + +2007-05-10 Tobias C. Rittweiler + * slime.el: Fix macroexpanding on things like ",(loop ...)". (slime-sexp-at-point-for-macroexpansion): New function; like From trittweiler at common-lisp.net Fri May 11 14:41:06 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 11 May 2007 10:41:06 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070511144106.51592620CC@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv19230 Modified Files: swank.lisp Log Message: * swank.lisp (apropos-symbols): Really use MAKE-REGEXP-MATCHER. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/10 17:54:31 1.480 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/11 14:41:03 1.481 @@ -4254,7 +4254,7 @@ (defun apropos-symbols (string external-only case-sensitive package) (let ((packages (or package (remove (find-package :keyword) (list-all-packages)))) - (matcher (make-apropos-matcher string case-sensitive)) + (matcher (make-regexp-matcher string case-sensitive)) (result)) (with-package-iterator (next packages :external :internal) (loop (multiple-value-bind (morep symbol) (next) From trittweiler at common-lisp.net Fri May 11 14:41:46 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 11 May 2007 10:41:46 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070511144146.89512671C5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv19365 Modified Files: ChangeLog Log Message: * swank.lisp (apropos-symbols): Really use MAKE-REGEXP-MATCHER. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/10 17:55:08 1.1120 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/11 14:41:46 1.1121 @@ -1,3 +1,7 @@ +2007-05-11 Tobias C. Rittweiler + + * swank.lisp (apropos-symbols): Really use MAKE-REGEXP-MATCHER. + 2007-05-10 Tobias C. Rittweiler * swank.lisp: Previously when using SLIME-APROPOS-PACKAGE, only From trittweiler at common-lisp.net Fri May 11 15:31:47 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 11 May 2007 11:31:47 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070511153147.8870520027@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv947 Modified Files: swank.lisp Log Message: * swank.lisp (make-compound-prefix-matcher): New function. Abstracted from COMPOUND-PREFIX-MATCH. (compound-prefix-match): Use MAKE-COMPOUND-PREFIX-MATCHER. (compound-prefix-match/ci/underscores): Removed. (longest-completion): Renamed to LONGEST-COMPOUND-PREFIX. Changed to only return a compound prefix, instead of a concatenation of a compound prefix and a compound suffix. Added an &optional parameter to specify what delimeter the passed string is compounded with. (tokenize-completion): Takes additional parameter to specify the delimeter for tokenization. (longest-completion/underscores): Removed; not needed anymore. (tokenize-completion/underscores): Likewise. (untokenize-completion/underscores): Likewise. (completions): Slight docstring modification, also added an examplary use case; use LONGEST-COMPOUND-PREFIX instead of LONGEST-COMPLETION. (completions-for-character): Use LONGEST-COMPOUND-PREFIX, and MAKE-COMPOUND-PREFIX-MATCHER. (completions-for-keyword): Use LONGEST-COMPOUND-PREFIX. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/11 14:41:03 1.481 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/11 15:31:46 1.482 @@ -2376,7 +2376,7 @@ (completion-set (format-completion-set strings nil ""))) (list completion-set - (longest-completion completion-set))))))))))) + (longest-compound-prefix completion-set))))))))))) (defun arglist-to-string (arglist package &key print-right-margin highlight) @@ -3219,10 +3219,20 @@ (defslimefun completions (string default-package-name) "Return a list of completions for a symbol designator STRING. -The result is the list (COMPLETION-SET -COMPLETED-PREFIX). COMPLETION-SET is the list of all matching -completions, and COMPLETED-PREFIX is the best (partial) -completion of the input string. +The result is the list (COMPLETION-SET COMPLETED-PREFIX), where +COMPLETION-SET is the list of all matching completions, and +COMPLETED-PREFIX is the best (partial) completion of the input +string. + +Simple compound matching is supported on a per-hyphen basis: + + (completions \"m-v-\" \"COMMON-LISP\") + ==> ((\"multiple-value-bind\" \"multiple-value-call\" + \"multiple-value-list\" \"multiple-value-prog1\" + \"multiple-value-setq\" \"multiple-values-limit\") + \"multiple-value\") + +\(For more advanced compound matching, see FUZZY-COMPLETIONS.) If STRING is package qualified the result list will also be qualified. If string is non-qualified the result strings are @@ -3233,10 +3243,12 @@ format. The cases are as follows: FOO - Symbols with matching prefix and accessible in the buffer package. PKG:FOO - Symbols with matching prefix and external in package PKG. - PKG::FOO - Symbols with matching prefix and accessible in package PKG." - (let ((completion-set (completion-set string default-package-name + PKG::FOO - Symbols with matching prefix and accessible in package PKG. +" + (let ((completion-set (completion-set string default-package-name #'compound-prefix-match))) - (list completion-set (longest-completion completion-set)))) + (list completion-set (longest-compound-prefix completion-set)))) + (defslimefun simple-completions (string default-package-name) "Return a list of completions for a symbol designator STRING." @@ -3491,25 +3503,32 @@ ;;;;; Compound-prefix matching -(defun compound-prefix-match (prefix target) - "Return true if PREFIX is a compound-prefix of TARGET. -Viewing each of PREFIX and TARGET as a series of substrings delimited -by hyphens, if each substring of PREFIX is a prefix of the -corresponding substring in TARGET then we call PREFIX a -compound-prefix of TARGET. +(defun make-compound-prefix-matcher (delimeter &key (test #'char=)) + "Returns a matching function that takes a `prefix' and a +`target' string and which returns T if `prefix' is a +compound-prefix of `target', and otherwise NIL. + +Viewing each of `prefix' and `target' as a series of substrings +delimited by DELIMETER, if each substring of `prefix' is a prefix +of the corresponding substring in `target' then we call `prefix' +a compound-prefix of `target'." + (lambda (prefix target) + (declare (type simple-string prefix target)) + (loop for ch across prefix + with tpos = 0 + always (and (< tpos (length target)) + (if (char= ch delimeter) + (setf tpos (position #\- target :start tpos)) + (funcall test ch (aref target tpos)))) + do (incf tpos)))) -Examples: +(defun compound-prefix-match (prefix target) + "Examples: \(compound-prefix-match \"foo\" \"foobar\") => t \(compound-prefix-match \"m--b\" \"multiple-value-bind\") => t -\(compound-prefix-match \"m-v-c\" \"multiple-value-bind\") => NIL" - (declare (type simple-string prefix target)) - (loop for ch across prefix - with tpos = 0 - always (and (< tpos (length target)) - (if (char= ch #\-) - (setf tpos (position #\- target :start tpos)) - (char= ch (aref target tpos)))) - do (incf tpos))) +\(compound-prefix-match \"m-v-c\" \"multiple-value-bind\") => NIL +" + (funcall (make-compound-prefix-matcher #\-) prefix target)) (defun prefix-match-p (prefix string) "Return true if PREFIX is a prefix of STRING." @@ -3518,33 +3537,27 @@ ;;;;; Extending the input string by completion -(defun longest-completion (completions) - "Return the longest prefix for all COMPLETIONS. -COMPLETIONS is a list of strings." - (untokenize-completion - (mapcar #'longest-common-prefix - (transpose-lists (mapcar #'tokenize-completion completions))))) - -(defun tokenize-completion (string) - "Return all substrings of STRING delimited by #\-." +(defun longest-compound-prefix (completions &optional (delimeter #\-)) + "Return the longest compound _prefix_ for all COMPLETIONS." + (flet ((tokenizer (string) (tokenize-completion string delimeter))) + (untokenize-completion + (loop for sub-prefix in (mapcar #'longest-common-prefix + (transpose-lists (mapcar #'tokenizer completions))) + if (string= sub-prefix "") + collect sub-prefix and do (loop-finish) ; Collect the "" so that + else collect sub-prefix)))) ; UNTOKENIZE-COMPLETION + ; appends a hyphen. +(defun tokenize-completion (string delimeter) + "Return all substrings of STRING delimited by DELIMETER." (loop with end for start = 0 then (1+ end) until (> start (length string)) - do (setq end (or (position #\- string :start start) (length string))) + do (setq end (or (position delimeter string :start start) (length string))) collect (subseq string start end))) (defun untokenize-completion (tokens) (format nil "~{~A~^-~}" tokens)) -(defun longest-common-prefix (strings) - "Return the longest string that is a common prefix of STRINGS." - (if (null strings) - "" - (flet ((common-prefix (s1 s2) - (let ((diff-pos (mismatch s1 s2))) - (if diff-pos (subseq s1 0 diff-pos) s1)))) - (reduce #'common-prefix strings)))) - (defun transpose-lists (lists) "Turn a list-of-lists on its side. If the rows are of unequal length, truncate uniformly to the shortest. @@ -3557,6 +3570,25 @@ (t (cons (mapcar #'car lists) (transpose-lists (mapcar #'cdr lists)))))) +(defun longest-common-prefix (strings) + "Return the longest string that is a common prefix of STRINGS." + (if (null strings) + "" + (flet ((common-prefix (s1 s2) + (let ((diff-pos (mismatch s1 s2))) + (if diff-pos (subseq s1 0 diff-pos) s1)))) + (reduce #'common-prefix strings)))) + + +;;;; Completion for character names + +(defslimefun completions-for-character (prefix) + (let* ((matcher (make-compound-prefix-matcher #\_ :test #'char-equal)) + (completion-set (character-completion-set prefix matcher)) + (completions (sort completion-set #'string<))) + (list completions (longest-compound-prefix completions #\_)))) + + ;;;;; Completion Tests @@ -3577,7 +3609,8 @@ (assert (equal '("Foo" "foo") (names "F"))) (assert (equal '("Foo") (names "Fo"))) (assert (equal '("foo") (names "FO"))))) - + + ;;;; Fuzzy completion ;;; For nomenclature of the fuzzy completion section, please read @@ -4136,48 +4169,6 @@ max-len (highlight-completion result sym) score result)))) -;;;; Completion for character names - -(defslimefun completions-for-character (prefix) - (let ((completion-set - (sort - (character-completion-set prefix - #'compound-prefix-match/ci/underscores) - #'string<))) - (list completion-set (longest-completion/underscores completion-set)))) - -(defun compound-prefix-match/ci/underscores (prefix target) - "Like compound-prefix-match, but case-insensitive, and using the underscore, -not the hyphen, as a delimiter." - (declare (type simple-string prefix target)) - (loop for ch across prefix - with tpos = 0 - always (and (< tpos (length target)) - (if (char= ch #\_) - (setf tpos (position #\_ target :start tpos)) - (char-equal ch (aref target tpos)))) - do (incf tpos))) - -(defun longest-completion/underscores (completions) - "Return the longest prefix for all COMPLETIONS. -COMPLETIONS is a list of strings." - (untokenize-completion/underscores - (mapcar #'longest-common-prefix - (transpose-lists (mapcar #'tokenize-completion/underscores - completions))))) - -(defun tokenize-completion/underscores (string) - "Return all substrings of STRING delimited by #\_." - (loop with end - for start = 0 then (1+ end) - until (> start (length string)) - do (setq end (or (position #\_ string :start start) (length string))) - collect (subseq string start end))) - -(defun untokenize-completion/underscores (tokens) - (format nil "~{~A~^_~}" tokens)) - - ;;;; Documentation (defslimefun apropos-list-for-emacs (name &optional external-only From trittweiler at common-lisp.net Fri May 11 15:32:15 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 11 May 2007 11:32:15 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070511153215.5A3F42407B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1036 Modified Files: ChangeLog Log Message: * swank.lisp (make-compound-prefix-matcher): New function. Abstracted from COMPOUND-PREFIX-MATCH. (compound-prefix-match): Use MAKE-COMPOUND-PREFIX-MATCHER. (compound-prefix-match/ci/underscores): Removed. (longest-completion): Renamed to LONGEST-COMPOUND-PREFIX. Changed to only return a compound prefix, instead of a concatenation of a compound prefix and a compound suffix. Added an &optional parameter to specify what delimeter the passed string is compounded with. (tokenize-completion): Takes additional parameter to specify the delimeter for tokenization. (longest-completion/underscores): Removed; not needed anymore. (tokenize-completion/underscores): Likewise. (untokenize-completion/underscores): Likewise. (completions): Slight docstring modification, also added an examplary use case; use LONGEST-COMPOUND-PREFIX instead of LONGEST-COMPLETION. (completions-for-character): Use LONGEST-COMPOUND-PREFIX, and MAKE-COMPOUND-PREFIX-MATCHER. (completions-for-keyword): Use LONGEST-COMPOUND-PREFIX. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/11 14:41:46 1.1121 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/11 15:32:14 1.1122 @@ -1,5 +1,49 @@ 2007-05-11 Tobias C. Rittweiler + Removed support for completing to the longest compound pre- and + suffix with the default completion method (C-c TAB, or just TAB on + the REPL), because it has been causing trouble all the time, but + didn't offer any real advantage besides niftiness. E.g.: + + previous behaviour: + + asdf:*com TAB => asdf:*compile-file--behaviour* + + now simply: + + asdf:*com TAB => asdf:*compile-file- + + For discussing on this subject, please see the mail with + message-id <87y7l53lch.fsf at freebits.de> that was posted to + slime-devel 2007-04-06, or alternatively: + + http://common-lisp.net/pipermail/slime-devel/2007-April/006087.html + + * swank.lisp (make-compound-prefix-matcher): New function. + Abstracted from COMPOUND-PREFIX-MATCH. + (compound-prefix-match): Use MAKE-COMPOUND-PREFIX-MATCHER. + (compound-prefix-match/ci/underscores): Removed. + + (longest-completion): Renamed to LONGEST-COMPOUND-PREFIX. Changed + to only return a compound prefix, instead of a concatenation of a + compound prefix and a compound suffix. Added an &optional + parameter to specify what delimeter the passed string is + compounded with. + (tokenize-completion): Takes additional parameter to specify the + delimeter for tokenization. + (longest-completion/underscores): Removed; not needed anymore. + (tokenize-completion/underscores): Likewise. + (untokenize-completion/underscores): Likewise. + + (completions): Slight docstring modification, also added an + examplary use case; use LONGEST-COMPOUND-PREFIX instead of + LONGEST-COMPLETION. + (completions-for-character): Use LONGEST-COMPOUND-PREFIX, and + MAKE-COMPOUND-PREFIX-MATCHER. + (completions-for-keyword): Use LONGEST-COMPOUND-PREFIX. + +2007-05-11 Tobias C. Rittweiler + * swank.lisp (apropos-symbols): Really use MAKE-REGEXP-MATCHER. 2007-05-10 Tobias C. Rittweiler From trittweiler at common-lisp.net Fri May 11 15:40:55 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 11 May 2007 11:40:55 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070511154055.94BE3360F4@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv4427 Modified Files: swank.lisp Log Message: * swank.lisp (fuzzy-find-matching-symbols): Modified to take package nicknames into account. Previously, fuzzy completing on nicknames did (except for some incidental cases) not work. Thanks to Lu??s Oliveira and Attila Lendvai for pointing that out. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/11 15:31:46 1.482 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/11 15:40:52 1.483 @@ -3821,7 +3821,7 @@ ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo" (setf (values symbols time-limit) (find-symbols parsed-name package time-limit)) (setf symbols (convert symbols "" symbol-normalizer))) - (t ; E.g. STRING = "asdf:" or "asdf:foo" + (t ; E.g. STRING = "asd:" or "asd:foo" ;; Find fuzzy matchings of the denoted package identifier part. ;; After that, find matchings for the denoted symbol identifier ;; relative to all the packages found. @@ -3847,7 +3847,7 @@ ;; PARSED-NAME is empty, and all possible completions are to be returned.) (setf results (concatenate 'vector symbols packages)) (setf results (sort results #'string< :key #'first)) ; SORT + #'STRING-LESSP - (setf results (stable-sort results #'> :key #'second)); conses on at least SBCL. + (setf results (stable-sort results #'> :key #'second)); conses on at least SBCL 0.9.18. (values results (and time-limit (<= time-limit 0))))))) @@ -3920,17 +3920,19 @@ (declare (type function converter)) (if (and time-limit-p (<= time-limit 0)) (values #() time-limit) - (loop for package in (list-all-packages) - for package-name = (package-name package) + (loop with all-package-names = (mapcan #'(lambda (package) + (cons (package-name package) + (copy-list (package-nicknames package)))) + (list-all-packages)) + for package-name in all-package-names for converted-name = (funcall converter package-name) for package-symbol = (or (find-symbol package-name) - (make-symbol package-name)) ; INTERN'd be - for (result score) = (multiple-value-list ; too invasive. - (compute-highest-scoring-completion - name converted-name)) - when result do (vector-push-extend - (make-fuzzy-matching package-symbol score result '()) - completions) + (make-symbol package-name)) ; no INTERN + do (multiple-value-bind (result score) + (compute-highest-scoring-completion name converted-name) + (when result + (vector-push-extend (make-fuzzy-matching package-symbol score result '()) + completions))) finally (return (values completions From trittweiler at common-lisp.net Fri May 11 15:41:06 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 11 May 2007 11:41:06 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070511154106.D32AF3E05A@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv4474 Modified Files: ChangeLog Log Message: * swank.lisp (fuzzy-find-matching-symbols): Modified to take package nicknames into account. Previously, fuzzy completing on nicknames did (except for some incidental cases) not work. Thanks to Lu??s Oliveira and Attila Lendvai for pointing that out. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/11 15:32:14 1.1122 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/11 15:41:06 1.1123 @@ -1,4 +1,11 @@ 2007-05-11 Tobias C. Rittweiler + + * swank.lisp (fuzzy-find-matching-symbols): Modified to take + package nicknames into account. Previously, fuzzy completing on + nicknames did (except for some incidental cases) not work. Thanks + to Lu?s Oliveira and Attila Lendvai for pointing that out. + +2007-05-11 Tobias C. Rittweiler Removed support for completing to the longest compound pre- and suffix with the default completion method (C-c TAB, or just TAB on From trittweiler at common-lisp.net Sun May 13 09:40:28 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Sun, 13 May 2007 05:40:28 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070513094028.41A8948151@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv13703 Modified Files: slime.el Log Message: * slime.el (slime-pretty-lambdas): Removed. If you really want this, please use one of the external ressources that provide this; for instance, `pretty-lambda.el', `pretty-greek.el', or even `pretty-symbols.el'. For more information, please see http://www.emacswiki.org/cgi-bin/wiki/PrettyLambda --- /project/slime/cvsroot/slime/slime.el 2007/05/10 17:45:10 1.786 +++ /project/slime/cvsroot/slime/slime.el 2007/05/13 09:40:27 1.787 @@ -9853,19 +9853,6 @@ (forward-sexp)) (replace-match "")))) -(defun slime-pretty-lambdas () - "Show `lambda' as a lambda character, via font-lock. -This can be called from slime-mode-hook. - -Warning: Some people have had this insert funny characters in their -source files, for reasons unknown." - (interactive) - (font-lock-add-keywords - nil `(("(\\(lambda\\>\\)" - (0 (progn (compose-region (match-beginning 1) (match-end 1) - ,(make-char 'greek-iso8859-7 107)) - nil)))))) - (defvar slime-close-parens-limit 16 "Maxmimum parens for `slime-close-parens-at-point' to insert.") From trittweiler at common-lisp.net Sun May 13 09:41:08 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Sun, 13 May 2007 05:41:08 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070513094108.A3F9061059@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv15043 Modified Files: ChangeLog Log Message: * slime.el (slime-pretty-lambdas): Removed. If you really want this, please use one of the external ressources that provide this; for instance, `pretty-lambda.el', `pretty-greek.el', or even `pretty-symbols.el'. For more information, please see http://www.emacswiki.org/cgi-bin/wiki/PrettyLambda --- /project/slime/cvsroot/slime/ChangeLog 2007/05/11 15:41:06 1.1123 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/13 09:41:06 1.1124 @@ -1,3 +1,12 @@ +2007-05-13 Tobias C. Rittweiler + + * slime.el (slime-pretty-lambdas): Removed. If you really want + this, please use one of the external ressources that provide this; + for instance, `pretty-lambda.el', `pretty-greek.el', or even + `pretty-symbols.el'. For more information, please see + + http://www.emacswiki.org/cgi-bin/wiki/PrettyLambda + 2007-05-11 Tobias C. Rittweiler * swank.lisp (fuzzy-find-matching-symbols): Modified to take From trittweiler at common-lisp.net Mon May 14 15:21:18 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Mon, 14 May 2007 11:21:18 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070514152118.A78956012E@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv29585 Modified Files: swank.lisp Log Message: * swank.lisp (package-names): Make sure to return a fresh list. (fuzzy-find-matching-packages): Use PACKAGE-NAMES. (list-all-package-names): Use PACKAGE-NAMES. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/11 15:40:52 1.483 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/14 15:21:18 1.484 @@ -3920,11 +3920,7 @@ (declare (type function converter)) (if (and time-limit-p (<= time-limit 0)) (values #() time-limit) - (loop with all-package-names = (mapcan #'(lambda (package) - (cons (package-name package) - (copy-list (package-nicknames package)))) - (list-all-packages)) - for package-name in all-package-names + (loop for package-name in (mapcan #'package-names (list-all-packages)) for converted-name = (funcall converter package-name) for package-symbol = (or (find-symbol package-name) (make-symbol package-name)) ; no INTERN @@ -4307,9 +4303,9 @@ "Return a list of all package names. Include the nicknames if NICKNAMES is true." (mapcar #'unparse-name - (loop for package in (list-all-packages) - collect (package-name package) - when nicknames append (package-nicknames package)))) + (if nicknames + (mapcan #'package-names (list-all-packages)) + (mapcar #'package-name (list-all-packages))))) ;;;; Tracing @@ -5639,8 +5635,8 @@ alist)) (defun package-names (package) - "Return the name and all nicknames of PACKAGE in a list." - (cons (package-name package) (package-nicknames package))) + "Return the name and all nicknames of PACKAGE in a fresh list." + (cons (package-name package) (copy-list (package-nicknames package)))) (defun cl-symbol-p (symbol) "Is SYMBOL a symbol in the COMMON-LISP package?" From trittweiler at common-lisp.net Mon May 14 15:21:33 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Mon, 14 May 2007 11:21:33 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070514152133.54DDE671A6@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv29637 Modified Files: ChangeLog Log Message: * swank.lisp (package-names): Make sure to return a fresh list. (fuzzy-find-matching-packages): Use PACKAGE-NAMES. (list-all-package-names): Use PACKAGE-NAMES. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/13 09:41:06 1.1124 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/14 15:21:32 1.1125 @@ -1,3 +1,9 @@ +2007-05-14 Tobias C. Rittweiler + + * swank.lisp (package-names): Make sure to return a fresh list. + (fuzzy-find-matching-packages): Use PACKAGE-NAMES. + (list-all-package-names): Use PACKAGE-NAMES. + 2007-05-13 Tobias C. Rittweiler * slime.el (slime-pretty-lambdas): Removed. If you really want From trittweiler at common-lisp.net Mon May 14 18:56:56 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Mon, 14 May 2007 14:56:56 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070514185656.84A316200B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3810 Modified Files: swank.lisp Log Message: * swank.lisp: Liberated from unnecessary style-warnings! (eval-for-emacs): Don't use SLOT-VALUE on condition objects! (inspect-bigger-piece-actions): Changed from DEFMETHOD to DEFUN. (inspect-whole-thing-action): Likewise. (inspect-show-more-action): Likewise. (make-symbols-listing): Adds an explicit DEFGENERIC. (menu-choices-for-presentation): Likewise. (make-symbols-listing (eql :classification)): Use `(loop for k being EACH hash-key ...)' rather than `(loop for k being THE hash-key)', to omit the justified style-warning from CLISP. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/14 15:21:18 1.484 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/14 18:56:56 1.485 @@ -2520,7 +2520,7 @@ (setq ok t)) (request-abort (c) (setf ok nil - reason (list (slot-value c 'swank-backend::reason)))))) + reason (list (swank-backend::reason c)))))) (force-user-output) (send-to-emacs `(:return ,(current-thread) ,(if ok @@ -4544,7 +4544,7 @@ (lambda () (remhash key ht)))) (:newline)))))) -(defmethod inspect-bigger-piece-actions (thing size) +(defun inspect-bigger-piece-actions (thing size) (append (if (> size *slime-inspect-contents-limit*) (list (inspect-show-more-action thing) @@ -4553,14 +4553,14 @@ (list (inspect-whole-thing-action thing size) '(:newline)))) -(defmethod inspect-whole-thing-action (thing size) +(defun inspect-whole-thing-action (thing size) `(:action ,(format nil "Inspect all ~a elements." size) ,(lambda() (let ((*slime-inspect-contents-limit* nil)) (swank::inspect-object thing))))) -(defmethod inspect-show-more-action (thing) +(defun inspect-show-more-action (thing) `(:action ,(format nil "~a elements shown. Prompt for how many to inspect..." *slime-inspect-contents-limit* ) ,(lambda() @@ -4957,6 +4957,7 @@ (%%make-package-symbols-container :title title :description description :symbols symbols :grouping-kind :symbol)) +(defgeneric make-symbols-listing (grouping-kind symbols)) (defmethod make-symbols-listing ((grouping-kind (eql :symbol)) symbols) "Returns an object renderable by Emacs' inspector side that @@ -5004,7 +5005,7 @@ SPECIAL-OPERATOR groups." (let ((table (make-hash-table :test #'eq))) (flet ((maybe-convert-fboundps (classifications) - ;; Convert an :FBOUNDP in CLASSIFICATION to :FUNCTION if possible. + ;; Convert an :FBOUNDP in CLASSIFICATIONS to :FUNCTION if possible. (if (and (member :fboundp classifications) (not (member :macro classifications)) (not (member :special-operator classifications))) @@ -5013,9 +5014,9 @@ (loop for symbol in symbols do (loop for classification in (maybe-convert-fboundps (classify-symbol symbol)) ;; SYMBOLS are supposed to be sorted alphabetically; - ;; this property is preserved here expect for reversing. + ;; this property is preserved here except for reversing. do (push symbol (gethash classification table))))) - (let* ((classifications (loop for k being the hash-key in table collect k)) + (let* ((classifications (loop for k being each hash-key in table collect k)) (classifications (sort classifications #'string<))) (loop for classification in classifications for symbols = (gethash classification table) @@ -5743,10 +5744,9 @@ (let ((action (second (nth (1- count) (cdr *presentation-active-menu*))))) (swank-ioify (funcall action item ob id))))) -;; Default method -(defmethod menu-choices-for-presentation (ob) - (declare (ignore ob)) - nil) + +(defgeneric menu-choices-for-presentation (object) + (:method (ob) (declare (ignore ob)) nil)) ; default method ;; Pathname (defmethod menu-choices-for-presentation ((ob pathname)) From trittweiler at common-lisp.net Mon May 14 18:57:32 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Mon, 14 May 2007 14:57:32 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070514185732.7B74E68101@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3894 Modified Files: ChangeLog Log Message: * swank.lisp: Liberated from unnecessary style-warnings! (eval-for-emacs): Don't use SLOT-VALUE on condition objects! (inspect-bigger-piece-actions): Changed from DEFMETHOD to DEFUN. (inspect-whole-thing-action): Likewise. (inspect-show-more-action): Likewise. (make-symbols-listing): Adds an explicit DEFGENERIC. (menu-choices-for-presentation): Likewise. (make-symbols-listing (eql :classification)): Use `(loop for k being EACH hash-key ...)' rather than `(loop for k being THE hash-key)', to omit the justified style-warning from CLISP. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/14 15:21:32 1.1125 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/14 18:57:31 1.1126 @@ -1,5 +1,20 @@ 2007-05-14 Tobias C. Rittweiler + * swank.lisp: Liberated from unnecessary style-warnings! + + (eval-for-emacs): Don't use SLOT-VALUE on condition objects! + (inspect-bigger-piece-actions): Changed from DEFMETHOD to DEFUN. + (inspect-whole-thing-action): Likewise. + (inspect-show-more-action): Likewise. + (make-symbols-listing): Adds an explicit DEFGENERIC. + (menu-choices-for-presentation): Likewise. + + (make-symbols-listing (eql :classification)): Use `(loop for k + being EACH hash-key ...)' rather than `(loop for k being THE + hash-key)', to omit the justified style-warning from CLISP. + +2007-05-14 Tobias C. Rittweiler + * swank.lisp (package-names): Make sure to return a fresh list. (fuzzy-find-matching-packages): Use PACKAGE-NAMES. (list-all-package-names): Use PACKAGE-NAMES. From trittweiler at common-lisp.net Mon May 14 19:39:27 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Mon, 14 May 2007 15:39:27 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070514193927.BA86D1D0C9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv15485 Modified Files: swank.lisp Log Message: * swank.lisp (eval-for-emacs): Remove code that would suggest that it's possible to use the rex `(:abort ...)' with more than one argument. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/14 18:56:56 1.485 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/14 19:39:26 1.486 @@ -2519,13 +2519,13 @@ (finish-output) (setq ok t)) (request-abort (c) - (setf ok nil - reason (list (swank-backend::reason c)))))) + (setf ok nil) + (setf reason (swank-backend::reason c))))) (force-user-output) (send-to-emacs `(:return ,(current-thread) ,(if ok `(:ok ,result) - `(:abort , at reason)) + `(:abort ,reason)) ,id))))))) (defvar *echo-area-prefix* "=> " From trittweiler at common-lisp.net Mon May 14 19:40:29 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Mon, 14 May 2007 15:40:29 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070514194029.7E3327B538@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16472 Modified Files: slime.el Log Message: * slime.el: Fixed proper handling of the abortion of a request. (For instance, when calling (SWANK::ABORT-REQUEST "FOO") from the REPL.) (sldb-quit): Updated the DESTRUCTURE-CASE clause for (:abort) to take an argument. (sldb-continue): Likewise. (sldb-invoke-restart): Likewise. (sldb-break-with-default-debugger): Likewise. (sldb-return-from-frame): Likewise. (sldb-restart-frame): Likewise. (slime-repl-eval-string) Likewise. (slime-repl-show-abort): Now also inserts the reason for the abort into the REPL buffer. --- /project/slime/cvsroot/slime/slime.el 2007/05/13 09:40:27 1.787 +++ /project/slime/cvsroot/slime/slime.el 2007/05/14 19:40:28 1.788 @@ -3586,8 +3586,8 @@ ((list 'swank:listener-eval string) (slime-lisp-package)) ((:ok result) (slime-repl-insert-result result)) - ((:abort) - (slime-repl-show-abort)))) + ((:abort &optional reason) + (slime-repl-show-abort reason)))) (defun slime-repl-insert-result (result) (with-current-buffer (slime-output-buffer) @@ -3605,11 +3605,13 @@ (insert "\n"))))))) (slime-repl-insert-prompt))) -(defun slime-repl-show-abort () +(defun slime-repl-show-abort (reason) (with-current-buffer (slime-output-buffer) (slime-with-output-end-mark (unless (bolp) (insert-before-markers "\n")) - (insert-before-markers "; Evaluation aborted\n")) + (insert-before-markers (if reason + (concat "; Evaluation aborted: " reason "\n") + "; Evaluation aborted.\n"))) (slime-repl-insert-prompt))) (defun slime-repl-insert-prompt () @@ -8895,7 +8897,7 @@ (interactive) (slime-rex () ('(swank:throw-to-toplevel)) ((:ok _) (error "sldb-quit returned")) - ((:abort)))) + ((:abort &optional _)))) (defun sldb-continue () "Invoke the \"continue\" restart." @@ -8905,7 +8907,7 @@ ((:ok _) (message "No restart named continue") (ding)) - ((:abort) ))) + ((:abort &optional _)))) (defun sldb-abort () "Invoke the \"abort\" restart." @@ -8922,14 +8924,14 @@ (slime-rex () ((list 'swank:invoke-nth-restart-for-emacs sldb-level restart)) ((:ok value) (message "Restart returned: %s" value)) - ((:abort))))) + ((:abort &optional _))))) (defun sldb-break-with-default-debugger () "Enter default debugger." (interactive) (slime-rex () ('(swank:sldb-break-with-default-debugger) nil slime-current-thread) - ((:abort)))) + ((:abort &optional _)))) (defun sldb-step () "Select the \"continue\" restart and set a new break point." @@ -8971,7 +8973,7 @@ (slime-rex () ((list 'swank:sldb-return-from-frame number string)) ((:ok value) (message "%s" value)) - ((:abort))))) + ((:abort &optional _))))) (defun sldb-restart-frame () "Causes the frame to restart execution with the same arguments as it @@ -8981,7 +8983,7 @@ (slime-rex () ((list 'swank:restart-frame number)) ((:ok value) (message "%s" value)) - ((:abort))))) + ((:abort &optional _))))) ;;;;; SLDB references (rather SBCL specific) From trittweiler at common-lisp.net Mon May 14 19:40:52 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Mon, 14 May 2007 15:40:52 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070514194052.E1A842F049@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv17208 Modified Files: ChangeLog Log Message: * slime.el: Fixed proper handling of the abortion of a request. (For instance, when calling (SWANK::ABORT-REQUEST "FOO") from the REPL.) (sldb-quit): Updated the DESTRUCTURE-CASE clause for (:abort) to take an argument. (sldb-continue): Likewise. (sldb-invoke-restart): Likewise. (sldb-break-with-default-debugger): Likewise. (sldb-return-from-frame): Likewise. (sldb-restart-frame): Likewise. (slime-repl-eval-string) Likewise. (slime-repl-show-abort): Now also inserts the reason for the abort into the REPL buffer. * swank.lisp (eval-for-emacs): Remove code that would suggest that it's possible to use the rex `(:abort ...)' with more than one argument. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/14 18:57:31 1.1126 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/14 19:40:52 1.1127 @@ -1,5 +1,26 @@ 2007-05-14 Tobias C. Rittweiler + * slime.el: Fixed proper handling of the abortion of a + request. (For instance, when calling (SWANK::ABORT-REQUEST "FOO") + from the REPL.) + + (sldb-quit): Updated the DESTRUCTURE-CASE clause for (:abort) to + take an argument. + (sldb-continue): Likewise. + (sldb-invoke-restart): Likewise. + (sldb-break-with-default-debugger): Likewise. + (sldb-return-from-frame): Likewise. + (sldb-restart-frame): Likewise. + (slime-repl-eval-string) Likewise. + (slime-repl-show-abort): Now also inserts the reason for the abort + into the REPL buffer. + + * swank.lisp (eval-for-emacs): Remove code that would suggest that + it's possible to use the rex `(:abort ...)' with more than one + argument. + +2007-05-14 Tobias C. Rittweiler + * swank.lisp: Liberated from unnecessary style-warnings! (eval-for-emacs): Don't use SLOT-VALUE on condition objects! From trittweiler at common-lisp.net Wed May 16 19:27:45 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 16 May 2007 15:27:45 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070516192745.1866E4D05B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv8682 Modified Files: swank.lisp Log Message: * swank.lisp (inspect-for-emacs file-stream, stream-error): Fixed typo in keyword arg; it's `:refreshp', not `:refresh'. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/14 19:39:26 1.486 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/16 19:27:43 1.487 @@ -5270,7 +5270,7 @@ (position (file-position stream))) (lambda () (ed-in-emacs `(,pathname :charpos ,position)))) - :refresh nil) + :refreshp nil) (:newline)) content)))) @@ -5290,7 +5290,7 @@ (position (file-position stream))) (lambda () (ed-in-emacs `(,pathname :charpos ,position)))) - :refresh nil) + :refreshp nil) (:newline)) content)) (values title content))))) From trittweiler at common-lisp.net Wed May 16 19:27:58 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 16 May 2007 15:27:58 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070516192758.8306E59089@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv8725 Modified Files: ChangeLog Log Message: * swank.lisp (inspect-for-emacs file-stream, stream-error): Fixed typo in keyword arg; it's `:refreshp', not `:refresh'. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/14 19:40:52 1.1127 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/16 19:27:58 1.1128 @@ -1,3 +1,8 @@ +2007-05-16 Takehiko Abe + + * swank.lisp (inspect-for-emacs file-stream, stream-error): Fixed + typo in keyword arg; it's `:refreshp', not `:refresh'. + 2007-05-14 Tobias C. Rittweiler * slime.el: Fixed proper handling of the abortion of a From trittweiler at common-lisp.net Thu May 17 11:41:34 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 07:41:34 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517114134.6A3B61D205@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv15508 Modified Files: swank-loader.lisp Log Message: * swank-loader.lisp (*sysdep-files*): Load the auxiliary files swank-source-*.lisp before swank-sbcl.lisp to avoid undefined-function style warnings. --- /project/slime/cvsroot/slime/swank-loader.lisp 2007/01/12 15:23:48 1.64 +++ /project/slime/cvsroot/slime/swank-loader.lisp 2007/05/17 11:41:34 1.65 @@ -37,8 +37,8 @@ '("nregex") #+cmu '("swank-source-path-parser" "swank-source-file-cache" "swank-cmucl") #+scl '("swank-source-path-parser" "swank-source-file-cache" "swank-scl") - #+sbcl '("swank-sbcl" "swank-source-path-parser" - "swank-source-file-cache" "swank-gray") + #+sbcl '("swank-source-path-parser" "swank-source-file-cache" + "swank-sbcl" "swank-gray") #+openmcl '("metering" "swank-openmcl" "swank-gray") #+lispworks '("swank-lispworks" "swank-gray") #+allegro '("swank-allegro" "swank-gray") From trittweiler at common-lisp.net Thu May 17 11:41:56 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 07:41:56 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517114156.7B7102F046@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv15584 Modified Files: ChangeLog Log Message: * swank-loader.lisp (*sysdep-files*): Load the auxiliary files swank-source-*.lisp before swank-sbcl.lisp to avoid undefined-function style warnings. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/16 19:27:58 1.1128 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/17 11:41:55 1.1129 @@ -1,3 +1,9 @@ +2007-05-17 Tobias C. Rittweiler + + * swank-loader.lisp (*sysdep-files*): Load the auxiliary files + swank-source-*.lisp before swank-sbcl.lisp to avoid + undefined-function style warnings. + 2007-05-16 Takehiko Abe * swank.lisp (inspect-for-emacs file-stream, stream-error): Fixed From trittweiler at common-lisp.net Thu May 17 11:49:41 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 07:49:41 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517114941.3D07863088@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16672 Modified Files: swank-ecl.lisp Log Message: * swank-ecl.lisp (compile-from-stream): Fixed typo that prevented `slime-compile-defun' from actually compiling a function. --- /project/slime/cvsroot/slime/swank-ecl.lisp 2006/11/19 21:33:03 1.7 +++ /project/slime/cvsroot/slime/swank-ecl.lisp 2007/05/17 11:49:40 1.8 @@ -142,7 +142,7 @@ (let ((file (si::mkstemp "TMP:ECLXXXXXX"))) (with-open-file (s file :direction :output :if-exists :overwrite) (do ((line (read-line stream nil) (read-line stream nil))) - (line) + ((not line)) (write-line line s))) (unwind-protect (apply #'compile-file file args) From trittweiler at common-lisp.net Thu May 17 11:49:59 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 07:49:59 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517114959.EDE7D1B01C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16778 Modified Files: ChangeLog Log Message: * swank-ecl.lisp (compile-from-stream): Fixed typo that prevented `slime-compile-defun' from actually compiling a function. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/17 11:41:55 1.1129 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/17 11:49:59 1.1130 @@ -1,3 +1,8 @@ +2007-05-17 Dustin Long + + * swank-ecl.lisp (compile-from-stream): Fixed typo that prevented + `slime-compile-defun' from actually compiling a function. + 2007-05-17 Tobias C. Rittweiler * swank-loader.lisp (*sysdep-files*): Load the auxiliary files From trittweiler at common-lisp.net Thu May 17 14:31:27 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 10:31:27 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517143127.4E66D630A4@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv27043 Modified Files: swank.lisp Log Message: * swank.lisp: Fixed bug in completion as previously "swank:[tab]" would correctly list all the symbols in SWANK, but would simultaneously append a spooky dash to the original string ("swank:-"). (completions): Strip off the package identifier part, and only compute the longest compound prefix for the actual symbol identifiers. (untokenize-symbol): New function. Inverse of TOKENIZE-SYMBOL. (format-completion-result): Use UNTOKENIZE-SYMBOL. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/16 19:27:43 1.487 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/17 14:31:26 1.488 @@ -1423,6 +1423,18 @@ (vector-push-extend (casify-char char) token)))) (values token package (or (not package) internp)))) +(defun untokenize-symbol (package-name internal-p symbol-name) + "The inverse of TOKENIZE-SYMBOL. + + (untokenize-symbol \"quux\" nil \"foo\") ==> \"quux:foo\" + (untokenize-symbol \"quux\" t \"foo\") ==> \"quux::foo\" + (untokenize-symbol nil nil \"foo\") ==> \"foo\" +" + (let ((prefix (cond ((not package-name) "") + (internal-p (format nil "~A::" package-name)) + (t (format nil "~A:" package-name))))) + (concatenate 'string prefix symbol-name))) + (defun casify-char (char) "Convert CHAR accoring to readtable-case." (ecase (readtable-case *readtable*) @@ -3247,7 +3259,19 @@ " (let ((completion-set (completion-set string default-package-name #'compound-prefix-match))) - (list completion-set (longest-compound-prefix completion-set)))) + (when completion-set + (list completion-set + ;; We strip off the package identifier, and compute the + ;; longest compound prefix of the symbol identifiers only, + ;; because the package identifier is fixed anyway, so that + ;; LONGEST-COMPOUND-PREFIX will not think it found a prefix, + ;; even though all it found was the common package identifier. + (multiple-value-bind (_ package-identifier internalp) + (tokenize-symbol (first completion-set)) + (declare (ignore _)) + (untokenize-symbol package-identifier internalp + (longest-compound-prefix + (mapcar #'tokenize-symbol completion-set)))))))) (defslimefun simple-completions (string default-package-name) @@ -3438,11 +3462,10 @@ (sort strings #'string<))) (defun format-completion-result (string internal-p package-name) - (let ((prefix (cond ((not package-name) "") - (internal-p (format nil "~A::" package-name)) - (t (format nil "~A:" package-name))))) - (values (concatenate 'string prefix string) - (length prefix)))) + (let ((result (untokenize-symbol package-name internal-p string))) + ;; We return the length of the possibly added prefix as second value. + (values result (search string result)))) + (defun completion-output-case-converter (input &optional with-escaping-p) "Return a function to convert strings for the completion output. From trittweiler at common-lisp.net Thu May 17 14:31:43 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 10:31:43 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517143143.DBB9A650D9@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv27109 Modified Files: ChangeLog Log Message: * swank.lisp: Fixed bug in completion as previously "swank:[tab]" would correctly list all the symbols in SWANK, but would simultaneously append a spooky dash to the original string ("swank:-"). (completions): Strip off the package identifier part, and only compute the longest compound prefix for the actual symbol identifiers. (untokenize-symbol): New function. Inverse of TOKENIZE-SYMBOL. (format-completion-result): Use UNTOKENIZE-SYMBOL. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/17 11:49:59 1.1130 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/17 14:31:43 1.1131 @@ -1,3 +1,16 @@ +2007-05-17 Tobias C. Rittweiler + + * swank.lisp: Fixed bug in completion as previously "swank:[tab]" + would correctly list all the symbols in SWANK, but would + simultaneously append a spooky dash to the original + string ("swank:-"). + + (completions): Strip off the package identifier part, and only + compute the longest compound prefix for the actual symbol + identifiers. + (untokenize-symbol): New function. Inverse of TOKENIZE-SYMBOL. + (format-completion-result): Use UNTOKENIZE-SYMBOL. + 2007-05-17 Dustin Long * swank-ecl.lisp (compile-from-stream): Fixed typo that prevented From trittweiler at common-lisp.net Thu May 17 15:29:07 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 11:29:07 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517152907.4B7B84321B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7625 Modified Files: slime.el Log Message: * slime.el (slime-complete-form): Only insert a closing parenthesis if the form is not already closed. Reported by and adapted from Mac Chan. --- /project/slime/cvsroot/slime/slime.el 2007/05/14 19:40:28 1.788 +++ /project/slime/cvsroot/slime/slime.el 2007/05/17 15:29:02 1.789 @@ -5652,7 +5652,7 @@ (interactive) ;; Find the (possibly incomplete) form around point. (let* ((start (save-excursion (backward-up-list 1) (point))) - (end (point)) ; or try to find end (tricky)? + (end (point)) (form-string (concat (buffer-substring-no-properties start end) ")"))) (let ((result (slime-eval `(swank:complete-form ,form-string)))) @@ -5661,7 +5661,12 @@ (progn (just-one-space) (save-excursion - (insert result)) + ;; SWANK:COMPLETE-FORM always returns a closing + ;; parenthesis; but we only want to insert one if it's + ;; really necessary (thinking especially of paredit.el.) + (insert (substring result 0 -1)) + (let ((slime-close-parens-limit 1)) + (slime-close-parens-at-point))) (save-excursion (backward-up-list 1) (indent-sexp))))))) From trittweiler at common-lisp.net Thu May 17 15:29:17 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 May 2007 11:29:17 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517152917.34C0E55356@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7688 Modified Files: ChangeLog Log Message: * slime.el (slime-complete-form): Only insert a closing parenthesis if the form is not already closed. Reported by and adapted from Mac Chan. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/17 14:31:43 1.1131 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/17 15:29:16 1.1132 @@ -1,5 +1,11 @@ 2007-05-17 Tobias C. Rittweiler + * slime.el (slime-complete-form): Only insert a closing + parenthesis if the form is not already closed. Reported by and + adapted from Mac Chan. + +2007-05-17 Tobias C. Rittweiler + * swank.lisp: Fixed bug in completion as previously "swank:[tab]" would correctly list all the symbols in SWANK, but would simultaneously append a spooky dash to the original From msimmons at common-lisp.net Thu May 17 16:52:34 2007 From: msimmons at common-lisp.net (msimmons) Date: Thu, 17 May 2007 12:52:34 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070517165234.A50694D0F4@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv28008 Modified Files: ChangeLog swank-lispworks.lisp Log Message: (lispworks-inspect): Fix hanging caused by mapcan, i.e. nconc, on a constant list returned by label-value-line. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/17 15:29:16 1.1132 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/17 16:52:31 1.1133 @@ -1,3 +1,9 @@ +2007-05-17 Martin Simmons + + * swank-lispworks.lisp (lispworks-inspect): Fix hanging caused by + mapcan, i.e. nconc, on a constant list returned by + label-value-line. + 2007-05-17 Tobias C. Rittweiler * slime.el (slime-complete-form): Only insert a closing --- /project/slime/cvsroot/slime/swank-lispworks.lisp 2007/02/04 22:28:51 1.90 +++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2007/05/17 16:52:31 1.91 @@ -665,7 +665,9 @@ (values "A value." (append (label-value-line "Type" type) - (mapcan #'label-value-line names values))))) + (loop for name in names + for value in values + append (label-value-line name value)))))) ;;; Miscellaneous From mbaringer at common-lisp.net Wed May 23 14:22:11 2007 From: mbaringer at common-lisp.net (mbaringer) Date: Wed, 23 May 2007 10:22:11 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070523142211.2E2E26600B@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3281 Modified Files: swank-sbcl.lisp Log Message: (*auto-flush-interval*): New variable controlling how often streams are flushed. (*auto-flush-lock*): New lock guarding access to the shared variable *auto-flush-streams*. (make-stream-interactive): Wrapped access to *auto-flush-streams* in a call-with-recursive-lock-held. (flush-streams): Wrapped in call-with-recursive-lock-held. --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2007/04/12 19:00:09 1.177 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2007/05/23 14:22:06 1.178 @@ -1193,29 +1193,40 @@ mutex)))))))) -;;; Auto-flush streams + ;; Auto-flush streams - ;; XXX race conditions - (defvar *auto-flush-streams* '()) + (defvar *auto-flush-interval* 0.15 + "How often to flush interactive streams. This valu is passed + directly to cl:sleep.") + + (defvar *auto-flush-lock* (make-recursive-lock :name "auto flush")) (defvar *auto-flush-thread* nil) + (defvar *auto-flush-streams* '()) + (defimplementation make-stream-interactive (stream) - (setq *auto-flush-streams* (adjoin stream *auto-flush-streams*)) - (unless *auto-flush-thread* - (setq *auto-flush-thread* - (sb-thread:make-thread #'flush-streams - :name "auto-flush-thread")))) + (call-with-recursive-lock-held + *auto-flush-lock* + (lambda () + (pushnew stream *auto-flush-streams*) + (unless *auto-flush-thread* + (setq *auto-flush-thread* + (sb-thread:make-thread #'flush-streams + :name "auto-flush-thread")))))) (defun flush-streams () (loop - (setq *auto-flush-streams* - (remove-if (lambda (x) - (not (and (open-stream-p x) - (output-stream-p x)))) - *auto-flush-streams*)) - (mapc #'finish-output *auto-flush-streams*) - (sleep 0.15))) + (call-with-recursive-lock-held + *auto-flush-lock* + (lambda () + (setq *auto-flush-streams* + (remove-if (lambda (x) + (not (and (open-stream-p x) + (output-stream-p x)))) + *auto-flush-streams*)) + (mapc #'finish-output *auto-flush-streams*))) + (sleep *auto-flush-interval*))) ) From mbaringer at common-lisp.net Wed May 23 14:22:52 2007 From: mbaringer at common-lisp.net (mbaringer) Date: Wed, 23 May 2007 10:22:52 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070523142252.3F7F756008@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3699 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2007/05/17 16:52:31 1.1133 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/23 14:22:46 1.1134 @@ -1,3 +1,15 @@ +2007-05-23 Marco Baringer + + Fix handing of auto-flushing on sbcl. + + * swank-sbcl.lisp (*auto-flush-interval*): New variable + controlling how often streams are flushed. + (*auto-flush-lock*): New lock guarding access to the shared + variable *auto-flush-streams*. + (make-stream-interactive): Wrapped access to *auto-flush-streams* + in a call-with-recursive-lock-held. + (flush-streams): Wrapped in call-with-recursive-lock-held. + 2007-05-17 Martin Simmons * swank-lispworks.lisp (lispworks-inspect): Fix hanging caused by From mbaringer at common-lisp.net Wed May 23 14:26:03 2007 From: mbaringer at common-lisp.net (mbaringer) Date: Wed, 23 May 2007 10:26:03 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070523142603.9473450049@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv4546 Modified Files: ChangeLog Log Message: --- /project/slime/cvsroot/slime/ChangeLog 2007/05/23 14:22:46 1.1134 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/23 14:26:02 1.1135 @@ -1,6 +1,12 @@ 2007-05-23 Marco Baringer - Fix handing of auto-flushing on sbcl. + * slime.el (def-slime-selector-method): Allow the selector body to + not return a buffer. This means that, instead of being to forced + to signal an error when a choosen buffer can't be found (like + choosing d when there are no debugger buffers) can simply display + a message. + + Fix handing of auto-flushing on sbcl: * swank-sbcl.lisp (*auto-flush-interval*): New variable controlling how often streams are flushed. From mbaringer at common-lisp.net Wed May 23 14:26:15 2007 From: mbaringer at common-lisp.net (mbaringer) Date: Wed, 23 May 2007 10:26:15 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070523142615.8124752021@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv4602 Modified Files: slime.el Log Message: (def-slime-selector-method): Allow the selector body to not return a buffer. This means that, instead of being to forced to signal an error when a choosen buffer can't be found (like choosing d when there are no debugger buffers) can simply display a message. --- /project/slime/cvsroot/slime/slime.el 2007/05/17 15:29:02 1.789 +++ /project/slime/cvsroot/slime/slime.el 2007/05/23 14:26:15 1.790 @@ -9692,17 +9692,24 @@ (defmacro def-slime-selector-method (key description &rest body) "Define a new `slime-select' buffer selection method. + KEY is the key the user will enter to choose this method. -DESCRIPTION is a one-line sentence describing how the method selects a -buffer. -BODY is a series of forms which must return the buffer to be selected." + +DESCRIPTION is a one-line sentence describing how the method +selects a buffer. + +BODY is a series of forms which are evaluated when the selector +is chosen. If they return a buffer that buffer is selected with +switch-to-buffer." `(setq slime-selector-methods (sort* (cons (list ,key ,description - (lambda () (switch-to-buffer (progn , at body)))) + (lambda () + (let ((new-buffer (progn , at body))) + (when (bufferp new-buffer) + (switch-to-buffer new-buffer))))) (remove* ,key slime-selector-methods :key #'car)) #'< :key #'car))) - (def-slime-selector-method ?? "Selector help buffer." (ignore-errors (kill-buffer "*Select Help*")) (with-current-buffer (get-buffer-create "*Select Help*") @@ -9744,9 +9751,8 @@ (def-slime-selector-method ?d "*sldb* buffer for the current connection." - (unless (sldb-get-default-buffer) - (error "No debugger buffer")) - (sldb-get-default-buffer)) + (or (sldb-get-default-buffer) + (message "No debugger buffer"))) (def-slime-selector-method ?e "most recently visited emacs-lisp-mode buffer." From trittweiler at common-lisp.net Thu May 24 19:23:24 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 24 May 2007 15:23:24 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070524192324.E613D5001@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3093 Modified Files: ChangeLog Log Message: * swank.lisp: Fixed regression in completion: "swank[TAB]" would previously be completed to "swank-backend:"; "get-internal[TAB]" would be completed to "get-internal-r-time" (instead of simply "get-internal-r"); and "custom:*comp[TAB]" would be completed to "custom:*compiled-" on CLISP, even though there's a "custom:*complile-". Thanks to Ken Causey for helping me find the first two. (completions): Revert changes from 2007-05-11. (longest-compound-prefix): Fixed to properly generate a compound _prefix_. --- /project/slime/cvsroot/slime/ChangeLog 2007/05/23 14:26:02 1.1135 +++ /project/slime/cvsroot/slime/ChangeLog 2007/05/24 19:23:24 1.1136 @@ -1,3 +1,18 @@ +2007-05-24 Tobias C. Rittweiler + + * swank.lisp: Fixed regression in completion: "swank[TAB]" would + previously be completed to "swank-backend:"; "get-internal[TAB]" + would be completed to "get-internal-r-time" (instead of simply + "get-internal-r"); and "custom:*comp[TAB]" would be completed to + "custom:*compiled-" on CLISP, even though there's a + "custom:*complile-". + + Thanks to Ken Causey for helping me find the first two. + + (completions): Revert changes from 2007-05-11. + (longest-compound-prefix): Fixed to properly generate a compound + _prefix_. + 2007-05-23 Marco Baringer * slime.el (def-slime-selector-method): Allow the selector body to @@ -6,7 +21,7 @@ choosing d when there are no debugger buffers) can simply display a message. - Fix handing of auto-flushing on sbcl: + Fix handling of auto-flushing on sbcl: * swank-sbcl.lisp (*auto-flush-interval*): New variable controlling how often streams are flushed. From trittweiler at common-lisp.net Thu May 24 19:23:37 2007 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 24 May 2007 15:23:37 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20070524192337.52A8B1D0CC@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3176 Modified Files: swank.lisp Log Message: * swank.lisp: Fixed regression in completion: "swank[TAB]" would previously be completed to "swank-backend:"; "get-internal[TAB]" would be completed to "get-internal-r-time" (instead of simply "get-internal-r"); and "custom:*comp[TAB]" would be completed to "custom:*compiled-" on CLISP, even though there's a "custom:*complile-". Thanks to Ken Causey for helping me find the first two. (completions): Revert changes from 2007-05-11. (longest-compound-prefix): Fixed to properly generate a compound _prefix_. --- /project/slime/cvsroot/slime/swank.lisp 2007/05/17 14:31:26 1.488 +++ /project/slime/cvsroot/slime/swank.lisp 2007/05/24 19:23:36 1.489 @@ -3260,18 +3260,7 @@ (let ((completion-set (completion-set string default-package-name #'compound-prefix-match))) (when completion-set - (list completion-set - ;; We strip off the package identifier, and compute the - ;; longest compound prefix of the symbol identifiers only, - ;; because the package identifier is fixed anyway, so that - ;; LONGEST-COMPOUND-PREFIX will not think it found a prefix, - ;; even though all it found was the common package identifier. - (multiple-value-bind (_ package-identifier internalp) - (tokenize-symbol (first completion-set)) - (declare (ignore _)) - (untokenize-symbol package-identifier internalp - (longest-compound-prefix - (mapcar #'tokenize-symbol completion-set)))))))) + (list completion-set (longest-compound-prefix completion-set))))) (defslimefun simple-completions (string default-package-name) @@ -3564,12 +3553,12 @@ "Return the longest compound _prefix_ for all COMPLETIONS." (flet ((tokenizer (string) (tokenize-completion string delimeter))) (untokenize-completion - (loop for sub-prefix in (mapcar #'longest-common-prefix - (transpose-lists (mapcar #'tokenizer completions))) - if (string= sub-prefix "") - collect sub-prefix and do (loop-finish) ; Collect the "" so that - else collect sub-prefix)))) ; UNTOKENIZE-COMPLETION - ; appends a hyphen. + (loop for token-list in (transpose-lists (mapcar #'tokenizer completions)) + if (notevery #'string= token-list (rest token-list)) + collect (longest-common-prefix token-list) ; Note that we possibly collect + and do (loop-finish) ; the "" here as well, so that + else collect (first token-list))))) ; UNTOKENIZE-COMPLETION will + ; append a hyphen for us. (defun tokenize-completion (string delimeter) "Return all substrings of STRING delimited by DELIMETER." (loop with end