Changeset 8290 in project


Ignore:
Timestamp:
02/08/08 11:42:29 (12 years ago)
Author:
Alex Shinn
Message:

releasing 0.8

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/scheme-complete.el

    r7774 r8290  
    3939
    4040;;; History:
     41;;;   0.8: 2008/02/08 - several parsing bugfixes on unclosed parenthesis
     42;;;                       (thanks to Kazushi NODA)
     43;;;                     filename completion works properly on absolute paths
     44;;;                     eldoc works properly on dotted lambdas
    4145;;;   0.7: 2008/01/18 - handles higher-order types (for apply, map, etc.)
    4246;;;                     smarter string completion (hostname, username, etc.)
     
    28222826         (if ,buf
    28232827             (switch-to-buffer ,buf)
    2824            (find-file ,path))
     2828           (switch-to-buffer (find-file-noselect ,path t t)))
    28252829         (let ((,res (save-excursion ,@body)))
    28262830           (unless ,buf (kill-buffer (current-buffer)))
     
    29132917    (or (ignore-errors (end-of-defun) (end-of-defun)
    29142918                       (beginning-of-defun)
    2915                        (not (eq here (point))))
     2919                       (< here (point)))
    29162920        (progn (forward-char) (re-search-forward "^(" nil t))
    29172921        (goto-char (point-max)))))
     
    29492953
    29502954(defun let-vars-at-point (&optional env)
    2951   (let ((end (save-excursion (forward-sexp) (point)))
     2955  (let ((end (or (ignore-errors
     2956                   (save-excursion (forward-sexp) (point)))
     2957                 (point-min)))
    29522958        (vars '()))
    29532959    (forward-char 1)
     
    29622968                             (sexp-type-at-point env))))
    29632969                (push (if type (list sym type) (list sym)) vars)))))
    2964       (or (ignore-errors (progn (beginning-of-next-sexp) t))
    2965           (goto-char end)))
     2970      (unless (ignore-errors (let ((here (point)))
     2971                               (beginning-of-next-sexp)
     2972                               (> (point) here)))
     2973        (goto-char end)))
    29662974    (reverse vars)))
    29672975
     
    30773085                                          (flatten (extract-match-vars
    30783086                                                    (nth-sexp-at-point 1))))
    3079                                  vars)))
     3087                                  vars)))
    30803088              ((let let* letrec letrec* let-syntax letrec-syntax and-let* do)
    3081                (save-excursion
    3082                  (beginning-of-next-sexp)
    3083                  (if (and (eq sym 'let)
    3084                           (eq ?w (char-syntax (char-after (point)))))
    3085                      ;; named let
    3086                      (let* ((sym (scheme-symbol-at-point))
    3087                             (args (progn
    3088                                     (beginning-of-next-sexp)
    3089                                     (let-vars-at-point env))))
    3090                        (setq vars (cons `(,sym (lambda ,(mapcar #'car args)))
    3091                                         (append args vars))))
    3092                    (setq vars (append (let-vars-at-point env) vars)))))
     3089               (or
     3090                (ignore-errors
     3091                  (save-excursion
     3092                    (beginning-of-next-sexp)
     3093                    (if (and (eq sym 'let)
     3094                             (eq ?w (char-syntax (char-after (point)))))
     3095                        ;; named let
     3096                        (let* ((sym (scheme-symbol-at-point))
     3097                               (args (progn
     3098                                       (beginning-of-next-sexp)
     3099                                       (let-vars-at-point env))))
     3100                          (setq vars (cons `(,sym (lambda ,(mapcar #'car args)))
     3101                                           (append args vars))))
     3102                      (setq vars (append (let-vars-at-point env) vars)))
     3103                    t))
     3104                (goto-char limit)))
    30933105              ((let-values let*-values)
    30943106               (setq vars
     
    33313343      (while (not (eobp))
    33323344        (setq globals
    3333               (append (scheme-extract-definitions) globals))
     3345              (append (ignore-errors (scheme-extract-definitions)) globals))
    33343346        (goto-next-top-level)))
    33353347    globals))
     
    33413353    (save-excursion
    33423354      (while (< (point) end)
    3343         (let ((new-defs (scheme-extract-definitions)))
     3355        (let ((here (point))
     3356              (new-defs (scheme-extract-definitions)))
    33443357          (cond
    33453358           (new-defs
    33463359             (setq defs (append new-defs defs))
    3347              (or (ignore-errors (beginning-of-next-sexp) t)
     3360             (or (ignore-errors (beginning-of-next-sexp)
     3361                                (> (point) here))
    33483362                 (goto-char end)))
    33493363           (t ;; non-definition form, stop scanning
     
    35043518    (aref (read-key-sequence nil) 0)))
    35053519
     3520(defun string-prefix-p (pref str)
     3521  (let ((p-len (length pref))
     3522        (s-len (length str)))
     3523    (and (<= p-len s-len)
     3524         (equal pref (substring str 0 p-len)))))
     3525
    35063526(defun do-completion (str coll &optional strs pred)
    35073527  (let* ((coll (mapcar #'(lambda (x)
     
    35253545      (ding))
    35263546     ((not (string= str completion))
    3527       (unless (equal completion completion1)
    3528         (save-excursion
    3529           (backward-char (length str))
    3530           (insert "\"")))
    3531       (insert (substring completion (length str)))
    3532       (unless (equal completion completion1)
    3533         (insert "\"")
    3534         (backward-char)))
     3547      (let ((prefix-p (string-prefix-p completion completion1)))
     3548        (unless prefix-p
     3549          (save-excursion
     3550            (backward-char (length str))
     3551            (insert "\"")))
     3552        (insert (substring completion (length str)))
     3553        (unless prefix-p
     3554          (insert "\"")
     3555          (backward-char))))
    35353556     (t
    35363557      (let ((win-config (current-window-configuration))
     
    35783599      (if base (push base env)))
    35793600    ;; imports
    3580     (let ((imports (current-scheme-imports)))
     3601    (let ((imports (ignore-errors (current-scheme-imports))))
    35813602      (if imports (push imports env)))
    35823603    ;; top-level defs
    3583     (let ((top (current-scheme-globals)))
     3604    (let ((top (ignore-errors (current-scheme-globals))))
    35843605      (if top (push top env)))
    35853606    ;; current local vars
    3586     (let ((locals (current-local-vars env)))
     3607    (let ((locals (ignore-errors (current-local-vars env))))
    35873608      (if locals (push locals env)))
    35883609    env))
     
    37003721   (file->lines file)))
    37013722
    3702 (defun complete-user-name (sym)
     3723(defun complete-user-name (trans sym)
    37033724  (if (string-match "apple" (emacs-version))
    37043725      (append (passwd-file-names "/etc/passwd" "^[^_].*")
     
    37063727    (passwd-file-names "/etc/passwd")))
    37073728
    3708 (defun complete-host-name (sym)
     3729(defun complete-host-name (trans sym)
    37093730  (append (host-file-names "/etc/hosts")
    37103731          (ssh-known-hosts-file-names "~/.ssh/known_hosts")
     
    37123733
    37133734;; my /etc/services is 14k lines, so we try to optimize this
    3714 (defun complete-port-name (sym)
     3735(defun complete-port-name (trans sym)
    37153736  (and (file-readable-p "/etc/services")
    37163737       (with-find-file "/etc/services"
     
    37303751           res))))
    37313752
    3732 (defun complete-file-name (sym)
    3733   (let ((file (file-name-nondirectory sym))
    3734         (dir (or (file-name-directory sym) ".")))
    3735     (file-name-all-completions file dir)))
    3736 
    3737 (defun complete-directory-name (sym)
    3738   (let ((file (file-name-nondirectory sym))
    3739         (dir (or (file-name-directory sym) ".")))
    3740     (remove-if-not
    3741      #'(lambda (x) (file-directory-p (concat dir "/" x)))
    3742      (file-name-all-completions file dir))))
     3753(defun complete-file-name (trans sym)
     3754  (let* ((file (file-name-nondirectory sym))
     3755         (dir (file-name-directory sym))
     3756         (res (file-name-all-completions file (or dir "."))))
     3757    (if dir
     3758        (mapcar #'(lambda (f) (concat dir f)) res)
     3759      res)))
     3760
     3761(defun complete-directory-name (trans sym)
     3762  (let* ((file (file-name-nondirectory sym))
     3763         (dir (file-name-directory sym))
     3764         (res (file-name-all-completions file (or dir ".")))
     3765         (res2 (if dir (mapcar #'(lambda (f) (concat dir f)) res) res)))
     3766    (remove-if-not #'file-directory-p res2)))
    37433767
    37443768(defun scheme-string-completer (type)
     
    37673791  (let ((func (if (consp cmpl) (car cmpl) cmpl))
    37683792        (trans (and (consp cmpl) (cadr cmpl))))
    3769     (funcall func (if trans (funcall trans sym) sym))))
     3793    (funcall func trans sym)))
    37703794
    37713795(defun scheme-smart-complete (&optional arg)
     
    38023826                            '(complete-file-name file-name-nondirectory))))
    38033827        (do-completion
    3804          (if (consp completer) (funcall (cadr completer) sym) sym)
     3828         ;;(if (consp completer) (funcall (cadr completer) sym) sym)
     3829         sym
    38053830         (scheme-apply-string-completer completer sym))))
    38063831     ;; outer special
     
    39173942;; optional eldoc function
    39183943
     3944(defun translate-dot-to-optional (ls)
     3945  (let ((res '()))
     3946    (while (consp ls)
     3947      (setq res (cons (car ls) res))
     3948      (setq ls (cdr ls)))
     3949    (if (not (null ls))
     3950        (setq res (cons ls (cons :optional res))))
     3951    (reverse res)))
     3952
    39193953(defun scheme-optional-in-brackets (ls)
    39203954  ;; stupid xemacs won't allow ... as a symbol
     
    39674001                (cons (car spec)
    39684002                      (scheme-optional-in-brackets
    3969                        (mapcar #'scheme-base-type (cadr type)))))
     4003                       (mapcar #'scheme-base-type
     4004                               (translate-dot-to-optional (cadr type))))))
    39704005               (if (and (consp (cddr type))
    39714006                        (not (memq (caddr type) '(obj object))))
Note: See TracChangeset for help on using the changeset viewer.