Changeset 6105 in project


Ignore:
Timestamp:
09/21/07 14:46:02 (13 years ago)
Author:
felix winkelmann
Message:

2.711: removed old oblist access (intended for hen), removed completion from hen.el

Location:
chicken/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/README

    r6083 r6105  
    33  (c)2000-2007 Felix L. Winkelmann
    44
    5   Version 2.710
     5  Version 2.711
    66
    77
  • chicken/trunk/buildversion

    r6080 r6105  
    1 2.710
     12.711
  • chicken/trunk/csi.scm

    r5968 r6105  
    771771                (write-char #\. out) ) ) )
    772772        (##sys#write-char-0 #\newline out) ) ) ) )
    773 
    774 
    775 ;;; emacs interface (suggested by Linh Dang)
    776 
    777 (define ##csi#find-symbol-table (foreign-lambda c-pointer "C_find_symbol_table" c-string))
    778 (define ##csi#enum-symbols! (foreign-lambda scheme-object "C_enumerate_symbols" c-pointer scheme-object))
    779 
    780 (define (##csi#oblist)
    781   (let ([it (cons -1 '())]
    782         [ns (##csi#find-symbol-table ".")] )
    783     (let loop ([lst '()])
    784       (let ([s (##csi#enum-symbols! ns it)])
    785         (if s
    786             (loop (cons s lst))
    787             lst) ) ) ) )
    788 
    789 (define (##csi#oblist->strings)
    790   (let ([it (cons -1 '())]
    791         [ns (##csi#find-symbol-table ".")] )
    792     (let loop ([lst '()])
    793       (let ([s (##csi#enum-symbols! ns it)])
    794         (if s
    795             (loop (cons (->string s) lst))
    796             lst) ) ) ) )
    797 
    798 (define (##csi#name-of-symbols-starting-with prefix)
    799   (let ([it (cons -1 '())]
    800         [ns (##csi#find-symbol-table ".")]
    801         [re (string-append "^" prefix)] )
    802     (let loop ([lst '()])
    803       (let ([s (##csi#enum-symbols! ns it)])
    804         (if s
    805             (loop (if (string-search re (symbol->string s))
    806                       (cons (symbol->string s) lst)
    807                       lst))
    808             lst) ) ) ) )
    809 
    810 (define (##csi#symbols-matching re-string)
    811   (let ([it (cons -1 '())]
    812         [ns (##csi#find-symbol-table ".")] )
    813     (let loop ([lst '()])
    814       (let ([s (##csi#enum-symbols! ns it)])
    815         (if s
    816             (loop (if (string-search re-string (symbol->string s))
    817                       (cons s lst)
    818                       lst))
    819             lst) ) ) ) )
    820773
    821774
  • chicken/trunk/hen.el

    r6005 r6105  
    319319(define-derived-mode hen-mode scheme-mode "Hen"
    320320 "Mode for editing chicken Scheme code.
    321 \\[hen-complete-symbol] completes symbol base on the text at point.
    322321\\[hen-csi-eval-last-sexp] evaluates the sexp at/preceding point in csi.
    323322\\[hen-csi-eval-region] evaluates the region in csi.
    324323\\[hen-csi-eval-buffer] evaluates current buffer in csi.
    325324\\[hen-csi-eval-definition] evaluates the toplevel definition at point in csi.
    326 \\[hen-csi-apropos] lists the csi's symbols matching a regex.
    327325\\[hen-csi-send] reads a sexp from the user and evaluates it csi.
    328326\\[hen-csi-proc-delete] terminates csi subprocess.
     
    335333 (setq local-abbrev-table scheme-mode-abbrev-table)
    336334
    337   (define-key hen-mode-map (kbd "M-TAB")   'hen-complete-symbol)
    338335  (define-key hen-mode-map (kbd "C-c C-e") 'hen-csi-eval-last-sexp)
    339336  (define-key hen-mode-map (kbd "C-c C-r") 'hen-csi-eval-region)
    340337  (define-key hen-mode-map (kbd "C-c C-b") 'hen-csi-eval-buffer)
    341338  (define-key hen-mode-map (kbd "C-c C-d") 'hen-csi-eval-definition)
    342   (define-key hen-mode-map (kbd "C-c C-a") 'hen-csi-apropos)
    343339  (define-key hen-mode-map (kbd "C-c C-l") 'hen-build-unit)
    344340  (define-key hen-mode-map (kbd "C-c C-x") 'hen-csi-send)
     
    353349  (define-key hen-mode-map [menu-bar scheme build-as-extension]
    354350    '("Compile File as Extension" . hen-build-extension))
    355   (define-key hen-mode-map [menu-bar scheme apropos] '("Symbol Apropos" . hen-csi-apropos))
    356351  (define-key hen-mode-map [menu-bar scheme eval-buffer] '("Eval Buffer" . hen-csi-eval-buffer))
    357352  (define-key hen-mode-map [menu-bar scheme eval-region] '("Eval Region" . hen-csi-eval-region))
     
    568563          do (insert ")"))))
    569564
    570 (defun hen-csi-completions-alist (prefix)
    571  (read (hen-csi-send
    572         (concat "(pp (map list (delete-duplicates (##csi#name-of-symbols-starting-with \""
    573                 prefix
    574                 "\"))))"))))
    575 
    576 (defun hen-complete-symbol (thing)
    577  "Complete symbol at point in Hen mode. THING is used as the prefix."
    578  (interactive (list (hen-identifier-at-point)))
    579  (let* ((matching-names-alist (hen-csi-completions-alist thing))
    580         (completion (try-completion thing matching-names-alist))
    581         (show-box #'(lambda ()
    582                       (message "Making completion list...")
    583                       (with-output-to-temp-buffer "*Completions*"
    584                         (display-completion-list (all-completions thing matching-names-alist))))))
    585    (cond ((eq completion t) (message "exact match"))
    586          ((null completion)
    587           (error "Can't find completion for \"%s\"" thing))
    588          ((not (string= thing completion))
    589           (delete-region (progn (backward-sexp 1) (point))
    590                          (progn (forward-sexp 1) (point)))
    591           (insert completion)
    592           (if (null (cdr matching-names-alist)) (message "")
    593             (funcall show-box)))
    594          (t (funcall show-box)))))
    595 
    596 ;(defun hen-csi-try-complete (string ignore1 &optional ignore2)
    597 ;  (let ((matches (hen-csi-get-completions-alist string)))
    598 ;    (cond ((null matches) nil)
    599 ;          ((and (= (length matches) 1)
    600 ;                (string-equal (caar matches) string))
    601 ;           t)
    602 ;          (t (try-completion string matches)))))
    603 
    604 (defun hen-csi-completion-table (str pred opcode)
    605 
    606  (let ((coll (if (equal str "") '() ; producing a list of everything would take too long.
    607                (hen-csi-completions-alist str))))
    608    (case opcode
    609      ('nil (try-completion str coll pred))
    610      ('t (all-completions str coll pred))
    611      ('lambda (and (or (null pred) (funcall pred str)) (assoc str coll)))
    612      (t (error "invalid opcode (%S) in read-completion" opcode)))))
    613 
    614 (defvar hen-lookup-history nil)
    615 (defsubst hen-csi-symbol-completing-read (prompt)
    616  (list (completing-read prompt 'hen-csi-completion-table
    617                         nil nil nil 'hen-lookup-history (hen-identifier-at-point))))
    618 
    619 (defun hen-csi-apropos (regex)
    620  "List the symbols matching REGEX."
    621  (interactive "sApropos (chicken's global symbols): ")
    622  (with-current-buffer (get-buffer-create "*Chicken Apropos*")
    623    (widen)
    624    (erase-buffer)
    625    (let* ((query (concat "(pp (map\n"
    626                          "  (lambda (sym) (cons (->string sym)\n"
    627                          "      (->string (if (##sys#symbol-has-toplevel-binding? sym)\n "
    628                          "                 (##sys#slot sym 0) '<unbound> ))))\n"
    629                          "  (delete-duplicates! (##csi#symbols-matching \"" regex  "\"))))"))
    630           (results-alist (read (hen-csi-send query))))
    631      (dolist (item results-alist)
    632        (let ((name (car item))
    633              (obj (cdr item)))
    634          (insert (car item) " ")
    635          (indent-to-column 40)
    636          (insert (cdr item) "\n")))
    637 
    638      (apropos-mode)))
    639  (pop-to-buffer "*Chicken Apropos*" t))
    640 
    641565(provide 'hen)
    642566(run-hooks 'hen-load-hook)
  • chicken/trunk/version.scm

    r6080 r6105  
    1 (define-constant +build-version+ "2.710")
     1(define-constant +build-version+ "2.711")
Note: See TracChangeset for help on using the changeset viewer.