comparison lisp/progmodes/pascal.el @ 10534:38b5efae433a

(pascal-*-completion, pascal-comp-defun) (pascal-complete-word, pascal-completion-response, pascal-completion) (pascal-get-completion-decl): Rename some internal variables to start with 'pascal-'. (pascal-str, pascal-all, pascal-pred, pascal-flag) (pascal-buffer-to use): New dummy variables.

10533:52b954844444



;;;
;;; Completion
;;;
(defun pascal-string-diff (str1 str2)
  "Return index of first letter where STR1 and STR2 differs."
  (catch 'done
    (let ((diff 0))
      (while t

;; completions for procedures if argument is `procedure' or both functions and
;; procedures otherwise.

(defun pascal-func-completion (type)
  ;; Build regular expression for function/procedure names
  (if (string= str "")
      (setq str "[a-zA-Z_]"))
  (let ((str (concat (cond ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
			   ((eq type 'function) "\\<\\(function\\)\\s +")
			   (t "\\<\\(function\\|procedure\\)\\s +"))
		     "\\<\\(" str "[a-zA-Z0-9_.]*\\)\\>"))
	match)
  
    (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
	(re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
    (forward-char 1)

    ;; Search through all reachable functions
    (while (pascal-beg-of-defun)
      (if (re-search-forward str (pascal-get-end-of-line) t)
	  (progn (setq match (buffer-substring (match-beginning 2)
					       (match-end 2)))
		 (if (or (null predicate)
			 (funcall prdicate match))
		     (setq all (cons match all)))))
      (goto-char (match-beginning 0)))))

(defun pascal-get-completion-decl ()
  ;; Macro for searching through current declaration (var, type or const)
  ;; for matches of `str' and adding the occurence tp `all'

		       (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" 
			       pascal-symbol-re)
		       (pascal-get-beg-of-line) t)
		      (not (match-end 1)))
	    (setq match (buffer-substring (match-beginning 0) (match-end 0)))
	    (if (string-match (concat "\\<" str) match)
		(if (or (null predicate)
			(funcall predicate match))
		    (setq all (cons match all))))))
      (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
	  (pascal-declaration-end)
	(forward-line 1)))))

(defun pascal-type-completion ()

(defun pascal-keyword-completion (keyword-list)
  "Give list of all possible completions of keywords in KEYWORD-LIST."
  (mapcar '(lambda (s) 
	     (if (string-match (concat "\\<" str) s)
		 (if (or (null predicate)
			 (funcall predicate s))
		     (setq all (cons s all)))))
	  keyword-list))

;; Function passed to completing-read, try-completion or
;; all-completions to get completion on STR. If predicate is non-nil,
;; it must be a function to be called for every match to check if this

;; of all possible completions. If it is nil it returns a string, the
;; longest possible completion, or t if STR is an exact match. If flag
;; is 'lambda, the function returns t if STR is an exact match, nil
;; otherwise.

(defun pascal-completion (str predicate flag)
  (save-excursion
    (let ((all nil))
      ;; Set buffer to use for searching labels. This should be set
      ;; within functins which use pascal-completions
      (set-buffer buffer-to-use)

      ;; Determine what should be completed
      (let ((state (car (pascal-calculate-indent))))
	(cond (;--Within a declaration or parameterlist
	       (or (eq state 'declaration) (eq state 'paramlist)

      
      ;; Now we have built a list of all matches. Give response to caller
      (pascal-completion-response))))

(defun pascal-completion-response ()
  (cond ((or (equal flag 'lambda) (null flag))
	 ;; This was not called by all-completions
	 (if (null all)
	     ;; Return nil if there was no matching label
	     nil
	   ;; Get longest string common in the labels
	   (let* ((elm (cdr all))
		  (match (car all))
		  (min (length match))
		  exact tmp)
	     (if (string= match str)
		 ;; Return t if first match was an exact match
		 (setq match t)
	       (while (not (null elm))
		 ;; Find longest common string
		 (if (< (setq tmp (pascal-string-diff match (car elm))) min)
		     (progn
		       (setq min tmp)
		       (setq match (substring match 0 min))))
		 ;; Terminate with match=t if this is an exact match
		 (if (string= (car elm) str)
		     (progn
		       (setq match t)
		       (setq elm nil))
		   (setq elm (cdr elm)))))
	     ;; If this is a test just for exact match, return nil ot t
	     (if (and (equal flag 'lambda) (not (equal match 't)))
		 nil
	       match))))
	;; If flag is t, this was called by all-completions. Return
	;; list of all possible completions
	(flag
	 all)))

(defvar pascal-last-word-numb 0)
(defvar pascal-last-word-shown nil)
(defvar pascal-last-completions nil)

\(See also `pascal-toggle-completions', `pascal-type-keywords',
`pascal-start-keywords' and `pascal-separator-keywords'.)"
  (interactive)
  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
	 (str (buffer-substring b e))
	 ;; The following variable is used in pascal-completion
	 (buffer-to-use (current-buffer))
	 (allcomp (if (and pascal-toggle-completions
			   (string= pascal-last-word-shown str))
		      pascal-last-completions
		    (all-completions str 'pascal-completion)))
	 (match (if pascal-toggle-completions
		    "" (try-completion
			str (mapcar '(lambda (elm) (cons elm 0)) allcomp)))))
    ;; Delete old string
    (delete-region b e)

    ;; Toggle-completions inserts whole labels
    (if pascal-toggle-completions

		  (1+ pascal-last-word-numb)))
	  (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
	  ;; Display next match or same string if no match was found
	  (if (not (null allcomp))
	      (insert "" pascal-last-word-shown)
	    (insert "" str)
	    (message "(No match)")))
      ;; The other form of completion does not necessarly do that.

      ;; Insert match if found, or the original string if no match
      (if (or (null match) (equal match 't))
	  (progn (insert "" str)
		 (message "(No match)"))
	(insert "" match))
      ;; Give message about current status of completion
      (cond ((equal match 't)
	     (if (not (null (cdr allcomp)))
		 (message "(Complete but not unique)")
	       (message "(Sole completion)")))
	    ;; Display buffer if the current completion didn't help 
	    ;; on completing the label.
	    ((and (not (null (cdr allcomp))) (= (length str) (length match)))
	     (with-output-to-temp-buffer "*Completions*"
	       (display-completion-list allcomp))
	     ;; Wait for a keypress. Then delete *Completion*  window
	     (momentary-string-display "" (point))
	     (delete-window (get-buffer-window (get-buffer "*Completions*")))

(defun pascal-show-completions ()
  "Show all possible completions at current point."
  (interactive)
  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
	 (str (buffer-substring b e))
	 ;; The following variable is used in pascal-completion
	 (buffer-to-use (current-buffer))
	 (allcomp (if (and pascal-toggle-completions
			   (string= pascal-last-word-shown str))
		      pascal-last-completions
		    (all-completions str 'pascal-completion))))
    ;; Show possible completions in a temporary buffer.
    (with-output-to-temp-buffer "*Completions*"
      (display-completion-list allcomp))
    ;; Wait for a keypress. Then delete *Completion*  window
    (momentary-string-display "" (point))

;; function returns a list of all possible completions. If it is nil
;; it returns a string, the longest possible completion, or t if STR
;; is an exact match. If flag is 'lambda, the function returns t if
;; STR is an exact match, nil otherwise.

(defun pascal-comp-defun (str predicate flag)
  (save-excursion
    (let ((all nil)
	  match)

      ;; Set buffer to use for searching labels. This should be set
      ;; within functins which use pascal-completions
      (set-buffer buffer-to-use)

      (let ((str str))
	;; Build regular expression for functions
	(if (string= str "")
	    (setq str (pascal-build-defun-re "[a-zA-Z_]"))
	  (setq str (pascal-build-defun-re str)))
	(goto-char (point-min))
      
	;; Build a list of all possible completions
	(while (re-search-forward str nil t)
	  (setq match (buffer-substring (match-beginning 2) (match-end 2)))
	  (if (or (null predicate)
		  (funcall predicate match))
	      (setq all (cons match all)))))

      ;; Now we have built a list of all matches. Give response to caller
      (pascal-completion-response))))

(defun pascal-goto-defun ()
  "Move to specified Pascal function/procedure.
The default is a name found in the buffer around point."
  (interactive)
  (let* ((default (pascal-get-default-symbol))
	 ;; The following variable is used in pascal-comp-function
	 (buffer-to-use (current-buffer))
	 (default (if (pascal-comp-defun default nil 'lambda)
		      default ""))
	 (label (if (not (string= default ""))
		    ;; Do completion with default
		    (completing-read (concat "Label: (default " default ") ")

    (progn
      (setq selective-display nil)
      (pascal-show-all)
      (use-local-map pascal-mode-map))))

(defun pascal-outline-change (b e flag)
  (let ((modp (buffer-modified-p)))
    (unwind-protect
	(subst-char-in-region b e (if (= flag ?\n) ?\^M ?\n) flag)
      (set-buffer-modified-p modp))))

(defun pascal-show-all ()
  "Show all of the text in the buffer."
  (interactive)

10534:38b5efae433a



;;;
;;; Completion
;;;
(defvar pascal-str nil)
(defvar pascal-all nil)
(defvar pascal-pred nil)
(defvar pascal-buffer-to-use nil)
(defvar pascal-flag nil)

(defun pascal-string-diff (str1 str2)
  "Return index of first letter where STR1 and STR2 differs."
  (catch 'done
    (let ((diff 0))
      (while t

;; completions for procedures if argument is `procedure' or both functions and
;; procedures otherwise.

(defun pascal-func-completion (type)
  ;; Build regular expression for function/procedure names
  (if (string= pascal-str "")
      (setq pascal-str "[a-zA-Z_]"))
  (let ((pascal-str (concat (cond
			     ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
			     ((eq type 'function) "\\<\\(function\\)\\s +")
			     (t "\\<\\(function\\|procedure\\)\\s +"))
			    "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
	match)
    
    (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
	(re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
    (forward-char 1)

    ;; Search through all reachable functions
    (while (pascal-beg-of-defun)
      (if (re-search-forward pascal-str (pascal-get-end-of-line) t)
	  (progn (setq match (buffer-substring (match-beginning 2)
					       (match-end 2)))
		 (if (or (null pascal-pred)
			 (funcall pascal-pred match))
		     (setq pascal-all (cons match pascal-all)))))
      (goto-char (match-beginning 0)))))

(defun pascal-get-completion-decl ()
  ;; Macro for searching through current declaration (var, type or const)
  ;; for matches of `str' and adding the occurence tp `all'

		       (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" 
			       pascal-symbol-re)
		       (pascal-get-beg-of-line) t)
		      (not (match-end 1)))
	    (setq match (buffer-substring (match-beginning 0) (match-end 0)))
	    (if (string-match (concat "\\<" pascal-str) match)
		(if (or (null pascal-pred)
			(funcall pascal-pred match))
		    (setq pascal-all (cons match pascal-all))))))
      (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
	  (pascal-declaration-end)
	(forward-line 1)))))

(defun pascal-type-completion ()

(defun pascal-keyword-completion (keyword-list)
  "Give list of all possible completions of keywords in KEYWORD-LIST."
  (mapcar '(lambda (s) 
	     (if (string-match (concat "\\<" pascal-str) s)
		 (if (or (null pascal-pred)
			 (funcall pascal-pred s))
		     (setq pascal-all (cons s pascal-all)))))
	  keyword-list))

;; Function passed to completing-read, try-completion or
;; all-completions to get completion on STR. If predicate is non-nil,
;; it must be a function to be called for every match to check if this

;; of all possible completions. If it is nil it returns a string, the
;; longest possible completion, or t if STR is an exact match. If flag
;; is 'lambda, the function returns t if STR is an exact match, nil
;; otherwise.

(defun pascal-completion (pascal-str pascal-pred pascal-flag)
  (save-excursion
    (let ((pascal-all nil))
      ;; Set buffer to use for searching labels. This should be set
      ;; within functins which use pascal-completions
      (set-buffer pascal-buffer-to-use)

      ;; Determine what should be completed
      (let ((state (car (pascal-calculate-indent))))
	(cond (;--Within a declaration or parameterlist
	       (or (eq state 'declaration) (eq state 'paramlist)

      
      ;; Now we have built a list of all matches. Give response to caller
      (pascal-completion-response))))

(defun pascal-completion-response ()
  (cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
	 ;; This was not called by all-completions
	 (if (null pascal-all)
	     ;; Return nil if there was no matching label
	     nil
	   ;; Get longest string common in the labels
	   (let* ((elm (cdr pascal-all))
		  (match (car pascal-all))
		  (min (length match))
		  exact tmp)
	     (if (string= match pascal-str)
		 ;; Return t if first match was an exact match
		 (setq match t)
	       (while (not (null elm))
		 ;; Find longest common string
		 (if (< (setq tmp (pascal-string-diff match (car elm))) min)
		     (progn
		       (setq min tmp)
		       (setq match (substring match 0 min))))
		 ;; Terminate with match=t if this is an exact match
		 (if (string= (car elm) pascal-str)
		     (progn
		       (setq match t)
		       (setq elm nil))
		   (setq elm (cdr elm)))))
	     ;; If this is a test just for exact match, return nil ot t
	     (if (and (equal pascal-flag 'lambda) (not (equal match 't)))
		 nil
	       match))))
	;; If flag is t, this was called by all-completions. Return
	;; list of all possible completions
	(pascal-flag
	 pascal-all)))

(defvar pascal-last-word-numb 0)
(defvar pascal-last-word-shown nil)
(defvar pascal-last-completions nil)

\(See also `pascal-toggle-completions', `pascal-type-keywords',
`pascal-start-keywords' and `pascal-separator-keywords'.)"
  (interactive)
  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
	 (pascal-str (buffer-substring b e))
	 ;; The following variable is used in pascal-completion
	 (pascal-buffer-to-use (current-buffer))
	 (allcomp (if (and pascal-toggle-completions
			   (string= pascal-last-word-shown pascal-str))
		      pascal-last-completions
		    (all-completions pascal-str 'pascal-completion)))
	 (match (if pascal-toggle-completions
		    "" (try-completion
			pascal-str (mapcar '(lambda (elm)
					      (cons elm 0)) allcomp)))))
    ;; Delete old string
    (delete-region b e)

    ;; Toggle-completions inserts whole labels
    (if pascal-toggle-completions

		  (1+ pascal-last-word-numb)))
	  (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
	  ;; Display next match or same string if no match was found
	  (if (not (null allcomp))
	      (insert "" pascal-last-word-shown)
	    (insert "" pascal-str)
	    (message "(No match)")))
      ;; The other form of completion does not necessarly do that.

      ;; Insert match if found, or the original string if no match
      (if (or (null match) (equal match 't))
	  (progn (insert "" pascal-str)
		 (message "(No match)"))
	(insert "" match))
      ;; Give message about current status of completion
      (cond ((equal match 't)
	     (if (not (null (cdr allcomp)))
		 (message "(Complete but not unique)")
	       (message "(Sole completion)")))
	    ;; Display buffer if the current completion didn't help 
	    ;; on completing the label.
	    ((and (not (null (cdr allcomp))) (= (length pascal-str)
						(length match)))
	     (with-output-to-temp-buffer "*Completions*"
	       (display-completion-list allcomp))
	     ;; Wait for a keypress. Then delete *Completion*  window
	     (momentary-string-display "" (point))
	     (delete-window (get-buffer-window (get-buffer "*Completions*")))

(defun pascal-show-completions ()
  "Show all possible completions at current point."
  (interactive)
  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
	 (pascal-str (buffer-substring b e))
	 ;; The following variable is used in pascal-completion
	 (pascal-buffer-to-use (current-buffer))
	 (allcomp (if (and pascal-toggle-completions
			   (string= pascal-last-word-shown pascal-str))
		      pascal-last-completions
		    (all-completions pascal-str 'pascal-completion))))
    ;; Show possible completions in a temporary buffer.
    (with-output-to-temp-buffer "*Completions*"
      (display-completion-list allcomp))
    ;; Wait for a keypress. Then delete *Completion*  window
    (momentary-string-display "" (point))

;; function returns a list of all possible completions. If it is nil
;; it returns a string, the longest possible completion, or t if STR
;; is an exact match. If flag is 'lambda, the function returns t if
;; STR is an exact match, nil otherwise.

(defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
  (save-excursion
    (let ((pascal-all nil)
	  match)

      ;; Set buffer to use for searching labels. This should be set
      ;; within functins which use pascal-completions
      (set-buffer pascal-buffer-to-use)

      (let ((pascal-str pascal-str))
	;; Build regular expression for functions
	(if (string= pascal-str "")
	    (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]"))
	  (setq pascal-str (pascal-build-defun-re pascal-str)))
	(goto-char (point-min))
      
	;; Build a list of all possible completions
	(while (re-search-forward pascal-str nil t)
	  (setq match (buffer-substring (match-beginning 2) (match-end 2)))
	  (if (or (null pascal-pred)
		  (funcall pascal-pred match))
	      (setq pascal-all (cons match pascal-all)))))

      ;; Now we have built a list of all matches. Give response to caller
      (pascal-completion-response))))

(defun pascal-goto-defun ()
  "Move to specified Pascal function/procedure.
The default is a name found in the buffer around point."
  (interactive)
  (let* ((default (pascal-get-default-symbol))
	 ;; The following variable is used in pascal-comp-function
	 (pascal-buffer-to-use (current-buffer))
	 (default (if (pascal-comp-defun default nil 'lambda)
		      default ""))
	 (label (if (not (string= default ""))
		    ;; Do completion with default
		    (completing-read (concat "Label: (default " default ") ")

    (progn
      (setq selective-display nil)
      (pascal-show-all)
      (use-local-map pascal-mode-map))))

(defun pascal-outline-change (b e pascal-flag)
  (let ((modp (buffer-modified-p)))
    (unwind-protect
	(subst-char-in-region b e (if (= pascal-flag ?\n) 
				      ?\^M ?\n) pascal-flag)
      (set-buffer-modified-p modp))))

(defun pascal-show-all ()
  "Show all of the text in the buffer."
  (interactive)