home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / browser2.zip / br-compl.el < prev    next >
Lisp/Scheme  |  1995-02-17  |  6KB  |  153 lines
  1. ;;; CLASS BROWSER FOR C++
  2. ;;; $Id: br-compl.el,v 3.1 1995/02/17 18:19:36 mmann Exp $
  3. ;;;
  4. ;;; **********************************************************************
  5. ;;; Copyright (C) 1993, 1994 Gerd Moellmann. All rights reserved.
  6. ;;; Altenbergstr. 6, D-40235 Duesseldorf, Germany
  7. ;;; 100025.3303@COMPUSERVE.COM
  8. ;;; Suggestions, comments and requests for improvements are welcome.
  9. ;;; **********************************************************************
  10. ;;;
  11. ;;; This version works with both Emacs version 18 and 19, and I want
  12. ;;; to keep it that way. It requires the CL-19 Common Lisp compatibility
  13. ;;; package for Emacs 18 and 19.
  14. ;;;
  15. ;;; This file contains the code to perform symbol completion.
  16. ;;; 
  17.  
  18. ;; This file may be made part of the Emacs distribution at the option
  19. ;; of the FSF.
  20.  
  21. ;; This code is distributed in the hope that it will be useful,
  22. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  23. ;; accepts responsibility to anyone for the consequences of using it
  24. ;; or for whether it serves any particular purpose or works at all,
  25. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  26. ;; License for full details.
  27.  
  28. ;; Everyone is granted permission to copy, modify and redistribute
  29. ;; this code, but only under the conditions described in the
  30. ;; GNU Emacs General Public License.   A copy of this license is
  31. ;; supposed to have been given to you along with GNU Emacs so you
  32. ;; can know your rights and responsibilities.  It should be in a
  33. ;; file named COPYING.  Among other things, the copyright notice
  34. ;; and this notice must be preserved on all copies.
  35.  
  36. (require 'cl-19 "cl")
  37. (require 'backquote)
  38. (require 'br-macro)
  39. (require 'br-struc)
  40.  
  41. (defvar browse-last-completion nil
  42.   "A buffer-local variable that contains the text inserted by the
  43. last completion operation.")
  44.  
  45. (defvar browse-last-completion-start nil
  46.   "A buffer-local variable containing the string which was the basis
  47. for the last completion operation.")
  48.  
  49. (defvar browse-last-completion-location nil
  50.   "A buffer-local variable containing the buffer position at which
  51. the last completion operation was initiated.")
  52.  
  53. (defvar browse-last-completion-obarray nil
  54.   "A buffer-local variable containing the member obarray used for the
  55. last completion operation.")
  56.  
  57. (make-variable-buffer-local 'browse-last-completion-obarray)
  58. (make-variable-buffer-local 'browse-last-completion-location)
  59. (make-variable-buffer-local 'browse-last-completion)
  60. (make-variable-buffer-local 'browse-last-completion-start)
  61.  
  62.  
  63. ;;;
  64. ;;; Get some obarray to base the symbol completion on. If more
  65. ;;; than one choice exists, ask the user which to use.
  66. ;;; 
  67.  
  68. (defun browse-some-member-obarray ()
  69.   (let* ((buffers (browse-different-tree-buffers))
  70.      (buffer (cond ((and (first buffers) (not (second buffers)))
  71.             (first buffers))
  72.                (t (or (browse-electric-choose-tree)
  73.                   (error "No tree buffer.")))))
  74.      (header (browse-@value '@header buffer)))
  75.     (browse-member-obarray header)))
  76.  
  77. ;;;
  78. ;;; If ITEM is an element of LIST, return the element following
  79. ;;; ITEM in the list. If ITEM is the last element, return the
  80. ;;; first element as successor.
  81. ;;; 
  82.  
  83. (defun browse-cyclic-successor (string list)
  84.   (or (nth (1+ (position string list :test 'string=)) list)
  85.       (first list)))
  86.  
  87. ;;;
  88. ;;; Perform symbol completion. This function is usually bound to
  89. ;;; some key in C++ buffers.
  90. ;;; 
  91. ;;;###autoload
  92.  
  93. (defun* browse-complete-symbol (prefix)
  94.   "Perform completion on the C++ symbol preceding point. A second call
  95. of this function without changing point inserts the next match. 
  96. A call with prefix reads the symbol to insert from the minibuffer with
  97. completion."
  98.   (interactive "P")
  99.   (let* ((end (point))
  100.      (begin (save-excursion (skip-chars-backward "a-zA-Z_0-9") (point)))
  101.      (pattern (buffer-substring begin end))
  102.      list completion)
  103.     (cond
  104.      ;; With prefix, read name from minibuffer with completion.
  105.  
  106.      (prefix
  107.       (let* ((members (browse-some-member-obarray))
  108.          (completion (completing-read "Insert member: "
  109.                       members nil t pattern)))
  110.     (when completion
  111.       (setf browse-last-completion-location nil)
  112.       (delete-region begin end)
  113.       (insert completion))))
  114.  
  115.      ;; If this function is called at the same point the last expansion
  116.      ;; ended, insert the next expansion.
  117.  
  118.      ((eq (point) browse-last-completion-location)
  119.       (setf list (all-completions browse-last-completion-start
  120.                   browse-last-completion-obarray)
  121.         completion (browse-cyclic-successor browse-last-completion list))
  122.       (cond ((null completion)
  123.          (error "No completion."))
  124.         ((string= completion pattern)
  125.          (error "No further completion."))
  126.         (t
  127.          (delete-region begin end)
  128.          (insert completion)
  129.          (setf browse-last-completion completion
  130.            browse-last-completion-location (point)))))
  131.  
  132.      ;; First time the function is called at some position in
  133.      ;; the buffer: Start new completion.
  134.  
  135.      (t
  136.       (let* ((members (browse-some-member-obarray))
  137.          (completion (first (all-completions pattern members nil))))
  138.     (cond ((eq completion t))
  139.           ((null completion)
  140.            (error "Can't find completion for `%s'." pattern))
  141.           (t
  142.            (delete-region begin end)
  143.            (insert completion)
  144.           
  145.            (setf browse-last-completion-location (point)
  146.              browse-last-completion-start pattern
  147.              browse-last-completion completion
  148.              browse-last-completion-obarray members))))))))
  149.  
  150. (provide 'br-compl)
  151.  
  152. ;; end of `br-compl.el'.
  153.