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

Diff of /slime/swank.lisp

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

revision 1.68 by heller, Fri Nov 28 12:02:29 2003 UTC revision 1.69 by lgorrie, Fri Nov 28 19:54:15 2003 UTC
# Line 485  format. The cases are as follows: Line 485  format. The cases are as follows:
485        (let ((*print-case* (if (find-if #'upper-case-p string)        (let ((*print-case* (if (find-if #'upper-case-p string)
486                                :upcase :downcase))                                :upcase :downcase))
487              (*package* package))              (*package* package))
488          (mapcar (lambda (s)          (let* ((completion-set
489                    (cond (internal-p (format nil "~A::~A" package-name s))                  (mapcar (lambda (s)
490                          (package-name (format nil "~A:~A" package-name s))                            (cond (internal-p (format nil "~A::~A" package-name s))
491                          (t (format nil "~A" s))))                                  (package-name (format nil "~A:~A" package-name s))
492                  ;; DO-SYMBOLS can consider the same symbol more than                                  (t (format nil "~A" s))))
493                  ;; once, so remove duplicates.                          ;; DO-SYMBOLS can consider the same symbol more than
494                  (remove-duplicates (sort completions #'string<                          ;; once, so remove duplicates.
495                                           :key #'symbol-name)))))))                          (remove-duplicates (sort completions #'string<
496                                                     :key #'symbol-name)))))
497              (list completion-set (longest-completion completion-set)))))))
498    
499  (defun parse-symbol-designator (string)  (defun parse-symbol-designator (string)
500    "Parse STRING as a symbol designator.    "Parse STRING as a symbol designator.
# Line 530  If PACKAGE is not specified, the home pa Line 532  If PACKAGE is not specified, the home pa
532      (declare (ignore _))      (declare (ignore _))
533      (eq status :external)))      (eq status :external)))
534    
535  (defun string-prefix-p (s1 s2)  
536    "Return true iff the string S1 is a prefix of S2.  ;;;; Subword-word matching
 \(This includes the case where S1 is equal to S2.)"  
   (and (<= (length s1) (length s2))  
        (string-equal s1 s2 :end2 (length s1))))  
537    
538  (defun subword-prefix-p (s1 s2 &key (start1 0) end1 (start2 0))  (defun subword-prefix-p (s1 s2 &key (start1 0) end1 (start2 0))
539    "Return true if the subsequence in S1 bounded by START1 and END1    "Return true if the subsequence in S1 bounded by START1 and END1
# Line 571  Examples: Line 570  Examples:
570                                         :end1 (and end1 (1- end1))                                         :end1 (and end1 (1- end1))
571                                         :start2 start2))))))                                         :start2 start2))))))
572    
573    
574    ;;;; Extending the input string by completion
575    
576    (defun longest-completion (completions)
577      "Return the longest prefix for all COMPLETIONS."
578      (untokenize-completion
579       (mapcar #'longest-common-prefix
580               (transpose-matrix (mapcar #'completion-tokens completions)))))
581    
582    (defun completion-tokens (string)
583      "Return all substrings of STRING delimited by #\-."
584      (loop for start = 0 then (1+ end)
585            until (> start (length string))
586            for end = (or (position #\- string :start start) (length string))
587            collect (subseq string start end)))
588    
589    (defun untokenize-completion (tokens)
590      (format nil "~{~A~^-~}" tokens))
591    
592    (defun longest-common-prefix (strings)
593      "Return the longest string that is a common prefix of STRINGS."
594      (if (null strings)
595          ""
596          (flet ((common-prefix (s1 s2)
597                   (let ((diff-pos (mismatch s1 s2)))
598                     (if diff-pos (subseq s1 0 diff-pos) s1))))
599            (reduce #'common-prefix strings))))
600    
601    (defun transpose-matrix (matrix)
602      "Turn a matrix (of any sequence type) on its side."
603      ;; A cute function from PAIP p.574
604      (if matrix (apply #'mapcar #'list matrix)))
605    
606    
607  ;;;; Documentation  ;;;; Documentation

Legend:
Removed from v.1.68  
changed lines
  Added in v.1.69

  ViewVC Help
Powered by ViewVC 1.1.5