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

Diff of /slime/swank.lisp

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

revision 1.40 by dbarlow, Mon Oct 20 13:56:50 2003 UTC revision 1.41 by lgorrie, Mon Oct 20 17:36:22 2003 UTC
# Line 314  result list will also be qualified.  If Line 314  result list will also be qualified.  If
314  result strings are also not qualified and are considered relative to  result strings are also not qualified and are considered relative to
315  DEFAULT-PACKAGE-NAME.  All symbols accessible in the package are  DEFAULT-PACKAGE-NAME.  All symbols accessible in the package are
316  considered."  considered."
317    (flet ((parse-designator (string)    (multiple-value-bind (name package-name internal-p)
318             (values (let ((pos (position #\: string :from-end t)))        (parse-symbol-designator string)
319                       (if pos (subseq string (1+ pos)) string))      (let ((completions nil)
320                     (let ((pos (position #\: string)))            (package (find-package
321                       (if pos (subseq string 0 pos) nil))                      (string-upcase (cond ((equal package-name "") "KEYWORD")
322                     (search "::" string))))                                           (package-name)
323      (multiple-value-bind (name package-name internal) (parse-designator string)                                           (default-package-name))))))
324        (let ((completions nil)        (flet ((package-matches (symbol-package)
325              (package (find-package                 ;; True if SYMBOL-PACKAGE is valid for the completion.
326                        (string-upcase (cond ((equal package-name "") "KEYWORD")                 ;; When the designator includes an explicit package
327                                             (package-name)                 ;; prefix, only symbols in that package are considered.
328                                             (default-package-name))))))                 (or (null package-name)
329          (when package                     (eq symbol-package package)))
330            (do-symbols (symbol package)               (visible-p (symbol)
331              (when (and (string-prefix-p name (symbol-name symbol))                 ;; True if SYMBOL is visible for this completion.
332                         (or internal                 (or internal-p
333                             (not package-name)                     (symbol-external-p symbol))))
334                             (symbol-external-p symbol)))          (when package
335                (push symbol completions))))            (do-symbols (symbol package)
336          (let ((*print-case* (if (find-if #'upper-case-p string)              (when (and (string-prefix-p name (symbol-name symbol))
337                                  :upcase :downcase))                         (package-matches (symbol-package symbol))
338                (*package* package))                         (visible-p symbol))
339            (mapcar (lambda (s)                (push symbol completions)))))
340                      (cond (internal (format nil "~A::~A" package-name s))        (let ((*print-case* (if (find-if #'upper-case-p string)
341                            (package-name (format nil "~A:~A" package-name s))                                :upcase :downcase))
342                            (t (format nil "~A" s))))              (*package* package))
343                    completions))))))          (mapcar (lambda (s)
344                      (cond (internal-p (format nil "~A::~A" package-name s))
345                            (package-name (format nil "~A:~A" package-name s))
346                            (t (format nil "~A" s))))
347                    completions)))))
348    
349  (defun symbol-external-p (s)  (defun parse-symbol-designator (string)
350      "Parse STRING as a symbol designator.
351    Return three values:
352     SYMBOL-NAME
353     PACKAGE-NAME, or nil if the designator does not include an explicit package.
354     INTERNAL-P, if the symbol is qualified with `::'."
355      (values (let ((pos (position #\: string :from-end t)))
356                (if pos (subseq string (1+ pos)) string))
357              (let ((pos (position #\: string)))
358                (if pos (subseq string 0 pos) nil))
359              (search "::" string)))
360    
361    (defun symbol-external-p (symbol)
362      "True if SYMBOL is external in its home package."
363    (multiple-value-bind (_ status)    (multiple-value-bind (_ status)
364        (find-symbol (symbol-name s) (symbol-package s))        (find-symbol (symbol-name symbol) (symbol-package symbol))
365      (declare (ignore _))      (declare (ignore _))
366      (eq status :external)))      (eq status :external)))
367    

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.41

  ViewVC Help
Powered by ViewVC 1.1.5