Changeset 6105 in project
- Timestamp:
- 09/21/07 14:46:02 (13 years ago)
- Location:
- chicken/trunk
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/trunk/README
r6083 r6105 3 3 (c)2000-2007 Felix L. Winkelmann 4 4 5 Version 2.71 05 Version 2.711 6 6 7 7 -
chicken/trunk/buildversion
r6080 r6105 1 2.71 01 2.711 -
chicken/trunk/csi.scm
r5968 r6105 771 771 (write-char #\. out) ) ) ) 772 772 (##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 s786 (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 s795 (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 s805 (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 s816 (loop (if (string-search re-string (symbol->string s))817 (cons s lst)818 lst))819 lst) ) ) ) )820 773 821 774 -
chicken/trunk/hen.el
r6005 r6105 319 319 (define-derived-mode hen-mode scheme-mode "Hen" 320 320 "Mode for editing chicken Scheme code. 321 \\[hen-complete-symbol] completes symbol base on the text at point.322 321 \\[hen-csi-eval-last-sexp] evaluates the sexp at/preceding point in csi. 323 322 \\[hen-csi-eval-region] evaluates the region in csi. 324 323 \\[hen-csi-eval-buffer] evaluates current buffer in csi. 325 324 \\[hen-csi-eval-definition] evaluates the toplevel definition at point in csi. 326 \\[hen-csi-apropos] lists the csi's symbols matching a regex.327 325 \\[hen-csi-send] reads a sexp from the user and evaluates it csi. 328 326 \\[hen-csi-proc-delete] terminates csi subprocess. … … 335 333 (setq local-abbrev-table scheme-mode-abbrev-table) 336 334 337 (define-key hen-mode-map (kbd "M-TAB") 'hen-complete-symbol)338 335 (define-key hen-mode-map (kbd "C-c C-e") 'hen-csi-eval-last-sexp) 339 336 (define-key hen-mode-map (kbd "C-c C-r") 'hen-csi-eval-region) 340 337 (define-key hen-mode-map (kbd "C-c C-b") 'hen-csi-eval-buffer) 341 338 (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)343 339 (define-key hen-mode-map (kbd "C-c C-l") 'hen-build-unit) 344 340 (define-key hen-mode-map (kbd "C-c C-x") 'hen-csi-send) … … 353 349 (define-key hen-mode-map [menu-bar scheme build-as-extension] 354 350 '("Compile File as Extension" . hen-build-extension)) 355 (define-key hen-mode-map [menu-bar scheme apropos] '("Symbol Apropos" . hen-csi-apropos))356 351 (define-key hen-mode-map [menu-bar scheme eval-buffer] '("Eval Buffer" . hen-csi-eval-buffer)) 357 352 (define-key hen-mode-map [menu-bar scheme eval-region] '("Eval Region" . hen-csi-eval-region)) … … 568 563 do (insert ")")))) 569 564 570 (defun hen-csi-completions-alist (prefix)571 (read (hen-csi-send572 (concat "(pp (map list (delete-duplicates (##csi#name-of-symbols-starting-with \""573 prefix574 "\"))))"))))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 opcode609 ('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-table617 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 641 565 (provide 'hen) 642 566 (run-hooks 'hen-load-hook) -
chicken/trunk/version.scm
r6080 r6105 1 (define-constant +build-version+ "2.71 0")1 (define-constant +build-version+ "2.711")
Note: See TracChangeset
for help on using the changeset viewer.