aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2000-11-21 22:41:20 +0000
committerStefan Monnier2000-11-21 22:41:20 +0000
commit36144b26b592421c99f9141168823542da3cfe7d (patch)
tree558afcbd74f415b6f812e8251d4a437b36dce18c
parentcd913aae535a9884f0aab6481b57db4b97e44d2d (diff)
downloademacs-36144b26b592421c99f9141168823542da3cfe7d.tar.gz
emacs-36144b26b592421c99f9141168823542da3cfe7d.zip
(ada-mode): `set '' -> `setq'.
-rw-r--r--lisp/progmodes/ada-mode.el380
1 files changed, 190 insertions, 190 deletions
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index b8739159477..b7099244be5 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -6,7 +6,7 @@
6;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> 6;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
7;; Emmanuel Briot <briot@gnat.com> 7;; Emmanuel Briot <briot@gnat.com>
8;; Maintainer: Emmanuel Briot <briot@gnat.com> 8;; Maintainer: Emmanuel Briot <briot@gnat.com>
9;; Ada Core Technologies's version: $Revision: 1.33 $ 9;; Ada Core Technologies's version: $Revision: 1.34 $
10;; Keywords: languages ada 10;; Keywords: languages ada
11 11
12;; This file is not part of GNU Emacs 12;; This file is not part of GNU Emacs
@@ -654,7 +654,7 @@ both file locations can be clicked on and jumped to."
654 "./")) 654 "./"))
655 (if (stringp line) 655 (if (stringp line)
656 (goto-line (string-to-number line))) 656 (goto-line (string-to-number line)))
657 (set 'source (point-marker)))) 657 (setq source (point-marker))))
658 (funcall (symbol-function 'compilation-goto-locus) 658 (funcall (symbol-function 'compilation-goto-locus)
659 (cons source error-pos)) 659 (cons source error-pos))
660 )) 660 ))
@@ -701,7 +701,7 @@ both file locations can be clicked on and jumped to."
701The standard table declares `_' as a symbol constituent, the second one 701The standard table declares `_' as a symbol constituent, the second one
702declares it as a word constituent." 702declares it as a word constituent."
703 (interactive) 703 (interactive)
704 (set 'ada-mode-syntax-table (make-syntax-table)) 704 (setq ada-mode-syntax-table (make-syntax-table))
705 (set-syntax-table ada-mode-syntax-table) 705 (set-syntax-table ada-mode-syntax-table)
706 706
707 ;; define string brackets (`%' is alternative string bracket, but 707 ;; define string brackets (`%' is alternative string bracket, but
@@ -749,7 +749,7 @@ declares it as a word constituent."
749 (modify-syntax-entry ?\( "()" ada-mode-syntax-table) 749 (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
750 (modify-syntax-entry ?\) ")(" ada-mode-syntax-table) 750 (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
751 751
752 (set 'ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table)) 752 (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
753 (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table) 753 (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
754 ) 754 )
755 755
@@ -766,14 +766,14 @@ declares it as a word constituent."
766 (save-excursion 766 (save-excursion
767 (goto-char from) 767 (goto-char from)
768 (while (re-search-forward "'\\([(\")#]\\)'" to t) 768 (while (re-search-forward "'\\([(\")#]\\)'" to t)
769 (set 'change (cons (list (match-beginning 1) 769 (setq change (cons (list (match-beginning 1)
770 1 770 1
771 (match-string 1)) 771 (match-string 1))
772 change)) 772 change))
773 (replace-match "'A'")) 773 (replace-match "'A'"))
774 (goto-char from) 774 (goto-char from)
775 (while (re-search-forward "\\(#[0-9a-fA-F]*#\\)" to t) 775 (while (re-search-forward "\\(#[0-9a-fA-F]*#\\)" to t)
776 (set 'change (cons (list (match-beginning 1) 776 (setq change (cons (list (match-beginning 1)
777 (length (match-string 1)) 777 (length (match-string 1))
778 (match-string 1)) 778 (match-string 1))
779 change)) 779 change))
@@ -784,7 +784,7 @@ declares it as a word constituent."
784 (goto-char (caar change)) 784 (goto-char (caar change))
785 (delete-char (cadar change)) 785 (delete-char (cadar change))
786 (insert (caddar change)) 786 (insert (caddar change))
787 (set 'change (cdr change))))))) 787 (setq change (cdr change)))))))
788 788
789(defun ada-deactivate-properties () 789(defun ada-deactivate-properties ()
790 "Deactivate ada-mode's properties handling. 790 "Deactivate ada-mode's properties handling.
@@ -852,7 +852,7 @@ If parse-result is non-nil, use is instead of calling parse-partial-sexp."
852 852
853(defsubst ada-in-string-or-comment-p (&optional parse-result) 853(defsubst ada-in-string-or-comment-p (&optional parse-result)
854 "Returns t if inside a comment or string." 854 "Returns t if inside a comment or string."
855 (set 'parse-result (or parse-result 855 (setq parse-result (or parse-result
856 (parse-partial-sexp 856 (parse-partial-sexp
857 (save-excursion (beginning-of-line) (point)) (point)))) 857 (save-excursion (beginning-of-line) (point)) (point))))
858 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result))) 858 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
@@ -887,7 +887,7 @@ where the mouse button was clicked."
887 ;; in the contextual menu does not hide the region in 887 ;; in the contextual menu does not hide the region in
888 ;; transient-mark-mode. 888 ;; transient-mark-mode.
889 (let ((deactivate-mark nil)) 889 (let ((deactivate-mark nil))
890 (set 'ada-contextual-menu-last-point 890 (setq ada-contextual-menu-last-point
891 (list (point) (current-buffer))) 891 (list (point) (current-buffer)))
892 (mouse-set-point last-input-event) 892 (mouse-set-point last-input-event)
893 893
@@ -901,9 +901,9 @@ where the mouse button was clicked."
901 )) 901 ))
902 (let (choice) 902 (let (choice)
903 (if ada-xemacs 903 (if ada-xemacs
904 (set 'choice (funcall (symbol-function 'popup-menu) 904 (setq choice (funcall (symbol-function 'popup-menu)
905 ada-contextual-menu)) 905 ada-contextual-menu))
906 (set 'choice (x-popup-menu position ada-contextual-menu))) 906 (setq choice (x-popup-menu position ada-contextual-menu)))
907 (if choice 907 (if choice
908 (funcall (lookup-key ada-contextual-menu (vector (car choice)))))) 908 (funcall (lookup-key ada-contextual-menu (vector (car choice))))))
909 (set-buffer (cadr ada-contextual-menu-last-point)) 909 (set-buffer (cadr ada-contextual-menu-last-point))
@@ -1003,8 +1003,8 @@ If you use ada-xref.el:
1003 1003
1004 (make-local-variable 'comment-start) 1004 (make-local-variable 'comment-start)
1005 (if ada-fill-comment-prefix 1005 (if ada-fill-comment-prefix
1006 (set 'comment-start ada-fill-comment-prefix) 1006 (setq comment-start ada-fill-comment-prefix)
1007 (set 'comment-start "-- ")) 1007 (setq comment-start "-- "))
1008 1008
1009 ;; Set the paragraph delimiters so that one can select a whole block 1009 ;; Set the paragraph delimiters so that one can select a whole block
1010 ;; simply with M-h 1010 ;; simply with M-h
@@ -1044,9 +1044,9 @@ If you use ada-xref.el:
1044 (set (make-local-variable 'parse-sexp-lookup-properties) t) 1044 (set (make-local-variable 'parse-sexp-lookup-properties) t)
1045 )) 1045 ))
1046 1046
1047 (set 'case-fold-search t) 1047 (setq case-fold-search t)
1048 (if (boundp 'imenu-case-fold-search) 1048 (if (boundp 'imenu-case-fold-search)
1049 (set 'imenu-case-fold-search t)) 1049 (setq imenu-case-fold-search t))
1050 1050
1051 (set (make-local-variable 'fill-paragraph-function) 1051 (set (make-local-variable 'fill-paragraph-function)
1052 'ada-fill-comment-paragraph) 1052 'ada-fill-comment-paragraph)
@@ -1058,7 +1058,7 @@ If you use ada-xref.el:
1058 ;; We just substitute our own functions to go to the error. 1058 ;; We just substitute our own functions to go to the error.
1059 (add-hook 'compilation-mode-hook 1059 (add-hook 'compilation-mode-hook
1060 (lambda() 1060 (lambda()
1061 (set 'compile-auto-highlight 40) 1061 (setq compile-auto-highlight 40)
1062 (define-key compilation-minor-mode-map [mouse-2] 1062 (define-key compilation-minor-mode-map [mouse-2]
1063 'ada-compile-mouse-goto-error) 1063 'ada-compile-mouse-goto-error)
1064 (define-key compilation-minor-mode-map "\C-c\C-c" 1064 (define-key compilation-minor-mode-map "\C-c\C-c"
@@ -1106,7 +1106,7 @@ If you use ada-xref.el:
1106 "\\(body[ \t]+\\)?" 1106 "\\(body[ \t]+\\)?"
1107 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is")) 1107 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
1108 (lambda () 1108 (lambda ()
1109 (set 'fname (ff-get-file 1109 (setq fname (ff-get-file
1110 ada-search-directories 1110 ada-search-directories
1111 (ada-make-filename-from-adaname 1111 (ada-make-filename-from-adaname
1112 (match-string 3)) 1112 (match-string 3))
@@ -1116,7 +1116,7 @@ If you use ada-xref.el:
1116 (add-to-list 'ff-special-constructs 1116 (add-to-list 'ff-special-constructs
1117 (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))" 1117 (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
1118 (lambda () 1118 (lambda ()
1119 (set 'fname (ff-get-file 1119 (setq fname (ff-get-file
1120 ada-search-directories 1120 ada-search-directories
1121 (ada-make-filename-from-adaname 1121 (ada-make-filename-from-adaname
1122 (match-string 1)) 1122 (match-string 1))
@@ -1131,7 +1131,7 @@ If you use ada-xref.el:
1131 (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs)) 1131 (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs))
1132 (new-cdr 1132 (new-cdr
1133 (lambda () 1133 (lambda ()
1134 (set 'fname (ff-get-file 1134 (setq fname (ff-get-file
1135 ada-search-directories 1135 ada-search-directories
1136 (ada-make-filename-from-adaname 1136 (ada-make-filename-from-adaname
1137 (match-string 1)) 1137 (match-string 1))
@@ -1148,7 +1148,7 @@ If you use ada-xref.el:
1148 (set (make-local-variable 'outline-level) 'ada-outline-level) 1148 (set (make-local-variable 'outline-level) 'ada-outline-level)
1149 1149
1150 ;; Support for imenu : We want a sorted index 1150 ;; Support for imenu : We want a sorted index
1151 (set 'imenu-sort-function 'imenu--sort-by-name) 1151 (setq imenu-sort-function 'imenu--sort-by-name)
1152 1152
1153 ;; Support for which-function-mode is provided in ada-support (support 1153 ;; Support for which-function-mode is provided in ada-support (support
1154 ;; for nested subprograms) 1154 ;; for nested subprograms)
@@ -1159,14 +1159,14 @@ If you use ada-xref.el:
1159 1159
1160 ;; Support for Abbreviations (the user still need to "M-x abbrev-mode" 1160 ;; Support for Abbreviations (the user still need to "M-x abbrev-mode"
1161 (define-abbrev-table 'ada-mode-abbrev-table ()) 1161 (define-abbrev-table 'ada-mode-abbrev-table ())
1162 (set 'local-abbrev-table ada-mode-abbrev-table) 1162 (setq local-abbrev-table ada-mode-abbrev-table)
1163 1163
1164 ;; Support for indent-new-comment-line (Especially for XEmacs) 1164 ;; Support for indent-new-comment-line (Especially for XEmacs)
1165 (set 'comment-multi-line nil) 1165 (setq comment-multi-line nil)
1166 (defconst comment-indent-function (lambda () comment-column)) 1166 (defconst comment-indent-function (lambda () comment-column))
1167 1167
1168 (set 'major-mode 'ada-mode) 1168 (setq major-mode 'ada-mode)
1169 (set 'mode-name "Ada") 1169 (setq mode-name "Ada")
1170 1170
1171 (use-local-map ada-mode-map) 1171 (use-local-map ada-mode-map)
1172 1172
@@ -1200,9 +1200,9 @@ If you use ada-xref.el:
1200 ;; inside the hook (MH) 1200 ;; inside the hook (MH)
1201 1201
1202 (cond ((eq ada-language-version 'ada83) 1202 (cond ((eq ada-language-version 'ada83)
1203 (set 'ada-keywords ada-83-keywords)) 1203 (setq ada-keywords ada-83-keywords))
1204 ((eq ada-language-version 'ada95) 1204 ((eq ada-language-version 'ada95)
1205 (set 'ada-keywords ada-95-keywords))) 1205 (setq ada-keywords ada-95-keywords)))
1206 1206
1207 (if ada-auto-case 1207 (if ada-auto-case
1208 (ada-activate-keys-for-case))) 1208 (ada-activate-keys-for-case)))
@@ -1234,9 +1234,9 @@ The standard casing rules will no longer apply to this word."
1234 ) 1234 )
1235 1235
1236 (cond ((stringp ada-case-exception-file) 1236 (cond ((stringp ada-case-exception-file)
1237 (set 'file-name ada-case-exception-file)) 1237 (setq file-name ada-case-exception-file))
1238 ((listp ada-case-exception-file) 1238 ((listp ada-case-exception-file)
1239 (set 'file-name (car ada-case-exception-file))) 1239 (setq file-name (car ada-case-exception-file)))
1240 (t 1240 (t
1241 (error "No exception file specified"))) 1241 (error "No exception file specified")))
1242 1242
@@ -1244,7 +1244,7 @@ The standard casing rules will no longer apply to this word."
1244 (unless word 1244 (unless word
1245 (save-excursion 1245 (save-excursion
1246 (skip-syntax-backward "w") 1246 (skip-syntax-backward "w")
1247 (set 'word (buffer-substring-no-properties 1247 (setq word (buffer-substring-no-properties
1248 (point) (save-excursion (forward-word 1) (point)))))) 1248 (point) (save-excursion (forward-word 1) (point))))))
1249 1249
1250 ;; Reread the exceptions file, in case it was modified by some other, 1250 ;; Reread the exceptions file, in case it was modified by some other,
@@ -1323,7 +1323,7 @@ The standard casing rules will no longer apply to this word."
1323 (interactive) 1323 (interactive)
1324 1324
1325 ;; Reinitialize the casing exception list 1325 ;; Reinitialize the casing exception list
1326 (set 'ada-case-exception '()) 1326 (setq ada-case-exception '())
1327 1327
1328 (cond ((stringp ada-case-exception-file) 1328 (cond ((stringp ada-case-exception-file)
1329 (ada-case-read-exceptions-from-file ada-case-exception-file)) 1329 (ada-case-read-exceptions-from-file ada-case-exception-file))
@@ -1347,7 +1347,7 @@ the exceptions defined in `ada-case-exception-file'."
1347 (point))) 1347 (point)))
1348 match) 1348 match)
1349 ;; If we have an exception, replace the word by the correct casing 1349 ;; If we have an exception, replace the word by the correct casing
1350 (if (set 'match (assoc-ignore-case (buffer-substring start end) 1350 (if (setq match (assoc-ignore-case (buffer-substring start end)
1351 ada-case-exception)) 1351 ada-case-exception))
1352 1352
1353 (progn 1353 (progn
@@ -1448,8 +1448,8 @@ ARG is the prefix the user entered with \C-u."
1448 ;; when casing is activated. 1448 ;; when casing is activated.
1449 ;; The 'or ...' is there to be sure that the value will not 1449 ;; The 'or ...' is there to be sure that the value will not
1450 ;; be changed again when Ada mode is called more than once 1450 ;; be changed again when Ada mode is called more than once
1451 (or ada-ret-binding (set 'ada-ret-binding (key-binding "\C-M"))) 1451 (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M")))
1452 (or ada-lfd-binding (set 'ada-lfd-binding (key-binding "\C-j"))) 1452 (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j")))
1453 1453
1454 ;; Call case modifying function after certain keys. 1454 ;; Call case modifying function after certain keys.
1455 (mapcar (function (lambda(key) (define-key 1455 (mapcar (function (lambda(key) (define-key
@@ -1471,7 +1471,7 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only."
1471 (while (and (or first (search-forward "_" end t)) 1471 (while (and (or first (search-forward "_" end t))
1472 (< (point) end)) 1472 (< (point) end))
1473 (and first 1473 (and first
1474 (set 'first nil)) 1474 (setq first nil))
1475 (insert-char (upcase (following-char)) 1) 1475 (insert-char (upcase (following-char)) 1)
1476 (delete-char 1))))) 1476 (delete-char 1)))))
1477 1477
@@ -1512,12 +1512,12 @@ Attention: This function might take very long for big regions !"
1512 ;; loop: look for all identifiers, keywords, and attributes 1512 ;; loop: look for all identifiers, keywords, and attributes
1513 ;; 1513 ;;
1514 (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) 1514 (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
1515 (set 'end (match-end 1)) 1515 (setq end (match-end 1))
1516 (set 'attribp 1516 (setq attribp
1517 (and (> (point) from) 1517 (and (> (point) from)
1518 (save-excursion 1518 (save-excursion
1519 (forward-char -1) 1519 (forward-char -1)
1520 (set 'attribp (looking-at "'.[^']"))))) 1520 (setq attribp (looking-at "'.[^']")))))
1521 (or 1521 (or
1522 ;; do nothing if it is a string or comment 1522 ;; do nothing if it is a string or comment
1523 (ada-in-string-or-comment-p) 1523 (ada-in-string-or-comment-p)
@@ -1525,8 +1525,8 @@ Attention: This function might take very long for big regions !"
1525 ;; 1525 ;;
1526 ;; get the identifier or keyword or attribute 1526 ;; get the identifier or keyword or attribute
1527 ;; 1527 ;;
1528 (set 'begin (point)) 1528 (setq begin (point))
1529 (set 'keywordp (looking-at ada-keywords)) 1529 (setq keywordp (looking-at ada-keywords))
1530 (goto-char end) 1530 (goto-char end)
1531 ;; 1531 ;;
1532 ;; casing according to user-option 1532 ;; casing according to user-option
@@ -1584,20 +1584,20 @@ ATTENTION: This function might take very long for big buffers !"
1584 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) 1584 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
1585 (down-list 1) 1585 (down-list 1)
1586 (backward-char 1) 1586 (backward-char 1)
1587 (set 'begin (point)) 1587 (setq begin (point))
1588 1588
1589 ;; find end of parameter-list 1589 ;; find end of parameter-list
1590 (forward-sexp 1) 1590 (forward-sexp 1)
1591 (set 'delend (point)) 1591 (setq delend (point))
1592 (delete-char -1) 1592 (delete-char -1)
1593 (insert "\n") 1593 (insert "\n")
1594 1594
1595 ;; find end of last parameter-declaration 1595 ;; find end of last parameter-declaration
1596 (forward-comment -1000) 1596 (forward-comment -1000)
1597 (set 'end (point)) 1597 (setq end (point))
1598 1598
1599 ;; build a list of all elements of the parameter-list 1599 ;; build a list of all elements of the parameter-list
1600 (set 'paramlist (ada-scan-paramlist (1+ begin) end)) 1600 (setq paramlist (ada-scan-paramlist (1+ begin) end))
1601 1601
1602 ;; delete the original parameter-list 1602 ;; delete the original parameter-list
1603 (delete-region begin delend) 1603 (delete-region begin delend)
@@ -1628,26 +1628,26 @@ Returns the equivalent internal parameter list."
1628 1628
1629 ;; find first character of parameter-declaration 1629 ;; find first character of parameter-declaration
1630 (ada-goto-next-non-ws) 1630 (ada-goto-next-non-ws)
1631 (set 'apos (point)) 1631 (setq apos (point))
1632 1632
1633 ;; find last character of parameter-declaration 1633 ;; find last character of parameter-declaration
1634 (if (set 'match-cons 1634 (if (setq match-cons
1635 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t)) 1635 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
1636 (progn 1636 (progn
1637 (set 'epos (car match-cons)) 1637 (setq epos (car match-cons))
1638 (set 'semipos (cdr match-cons))) 1638 (setq semipos (cdr match-cons)))
1639 (set 'epos end)) 1639 (setq epos end))
1640 1640
1641 ;; read name(s) of parameter(s) 1641 ;; read name(s) of parameter(s)
1642 (goto-char apos) 1642 (goto-char apos)
1643 (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]") 1643 (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]")
1644 1644
1645 (set 'param (list (match-string 1))) 1645 (setq param (list (match-string 1)))
1646 (ada-search-ignore-string-comment ":" nil epos t 'search-forward) 1646 (ada-search-ignore-string-comment ":" nil epos t 'search-forward)
1647 1647
1648 ;; look for 'in' 1648 ;; look for 'in'
1649 (set 'apos (point)) 1649 (setq apos (point))
1650 (set 'param 1650 (setq param
1651 (append param 1651 (append param
1652 (list 1652 (list
1653 (consp 1653 (consp
@@ -1656,7 +1656,7 @@ Returns the equivalent internal parameter list."
1656 1656
1657 ;; look for 'out' 1657 ;; look for 'out'
1658 (goto-char apos) 1658 (goto-char apos)
1659 (set 'param 1659 (setq param
1660 (append param 1660 (append param
1661 (list 1661 (list
1662 (consp 1662 (consp
@@ -1665,7 +1665,7 @@ Returns the equivalent internal parameter list."
1665 1665
1666 ;; look for 'access' 1666 ;; look for 'access'
1667 (goto-char apos) 1667 (goto-char apos)
1668 (set 'param 1668 (setq param
1669 (append param 1669 (append param
1670 (list 1670 (list
1671 (consp 1671 (consp
@@ -1683,27 +1683,27 @@ Returns the equivalent internal parameter list."
1683 ;; We accept spaces in the name, since some software like Rose 1683 ;; We accept spaces in the name, since some software like Rose
1684 ;; generates something like: "A : B 'Class" 1684 ;; generates something like: "A : B 'Class"
1685 (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>") 1685 (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>")
1686 (set 'param 1686 (setq param
1687 (append param 1687 (append param
1688 (list (match-string 0)))) 1688 (list (match-string 0))))
1689 1689
1690 ;; read default-expression, if there is one 1690 ;; read default-expression, if there is one
1691 (goto-char (set 'apos (match-end 0))) 1691 (goto-char (setq apos (match-end 0)))
1692 (set 'param 1692 (setq param
1693 (append param 1693 (append param
1694 (list 1694 (list
1695 (if (set 'match-cons 1695 (if (setq match-cons
1696 (ada-search-ignore-string-comment 1696 (ada-search-ignore-string-comment
1697 ":=" nil epos t 'search-forward)) 1697 ":=" nil epos t 'search-forward))
1698 (buffer-substring (car match-cons) epos) 1698 (buffer-substring (car match-cons) epos)
1699 nil)))) 1699 nil))))
1700 1700
1701 ;; add this parameter-declaration to the list 1701 ;; add this parameter-declaration to the list
1702 (set 'paramlist (append paramlist (list param))) 1702 (setq paramlist (append paramlist (list param)))
1703 1703
1704 ;; check if it was the last parameter 1704 ;; check if it was the last parameter
1705 (if (eq epos end) 1705 (if (eq epos end)
1706 (set 'notend nil) 1706 (setq notend nil)
1707 (goto-char semipos)) 1707 (goto-char semipos))
1708 ) 1708 )
1709 (reverse paramlist))) 1709 (reverse paramlist)))
@@ -1721,22 +1721,22 @@ Returns the equivalent internal parameter list."
1721 1721
1722 ;; loop until last parameter 1722 ;; loop until last parameter
1723 (while (not (zerop i)) 1723 (while (not (zerop i))
1724 (set 'i (1- i)) 1724 (setq i (1- i))
1725 1725
1726 ;; get max length of parameter-name 1726 ;; get max length of parameter-name
1727 (set 'parlen (max parlen (length (nth 0 (nth i paramlist))))) 1727 (setq parlen (max parlen (length (nth 0 (nth i paramlist)))))
1728 1728
1729 ;; get max length of type-name 1729 ;; get max length of type-name
1730 (set 'typlen (max typlen (length (nth 4 (nth i paramlist))))) 1730 (setq typlen (max typlen (length (nth 4 (nth i paramlist)))))
1731 1731
1732 ;; is there any 'in' ? 1732 ;; is there any 'in' ?
1733 (set 'inp (or inp (nth 1 (nth i paramlist)))) 1733 (setq inp (or inp (nth 1 (nth i paramlist))))
1734 1734
1735 ;; is there any 'out' ? 1735 ;; is there any 'out' ?
1736 (set 'outp (or outp (nth 2 (nth i paramlist)))) 1736 (setq outp (or outp (nth 2 (nth i paramlist))))
1737 1737
1738 ;; is there any 'access' ? 1738 ;; is there any 'access' ?
1739 (set 'accessp (or accessp (nth 3 (nth i paramlist)))) 1739 (setq accessp (or accessp (nth 3 (nth i paramlist))))
1740 ) 1740 )
1741 1741
1742 ;; does paramlist already start on a separate line ? 1742 ;; does paramlist already start on a separate line ?
@@ -1763,19 +1763,19 @@ Returns the equivalent internal parameter list."
1763 (insert "(") 1763 (insert "(")
1764 (ada-indent-current) 1764 (ada-indent-current)
1765 1765
1766 (set 'firstcol (current-column)) 1766 (setq firstcol (current-column))
1767 (set 'i (length paramlist)) 1767 (setq i (length paramlist))
1768 1768
1769 ;; loop until last parameter 1769 ;; loop until last parameter
1770 (while (not (zerop i)) 1770 (while (not (zerop i))
1771 (set 'i (1- i)) 1771 (setq i (1- i))
1772 (set 'column firstcol) 1772 (setq column firstcol)
1773 1773
1774 ;; insert parameter-name, space and colon 1774 ;; insert parameter-name, space and colon
1775 (insert (nth 0 (nth i paramlist))) 1775 (insert (nth 0 (nth i paramlist)))
1776 (indent-to (+ column parlen 1)) 1776 (indent-to (+ column parlen 1))
1777 (insert ": ") 1777 (insert ": ")
1778 (set 'column (current-column)) 1778 (setq column (current-column))
1779 1779
1780 ;; insert 'in' or space 1780 ;; insert 'in' or space
1781 (if (nth 1 (nth i paramlist)) 1781 (if (nth 1 (nth i paramlist))
@@ -1799,7 +1799,7 @@ Returns the equivalent internal parameter list."
1799 (if (nth 3 (nth i paramlist)) 1799 (if (nth 3 (nth i paramlist))
1800 (insert "access ")) 1800 (insert "access "))
1801 1801
1802 (set 'column (current-column)) 1802 (setq column (current-column))
1803 1803
1804 ;; insert type-name and, if necessary, space and default-expression 1804 ;; insert type-name and, if necessary, space and default-expression
1805 (insert (nth 4 (nth i paramlist))) 1805 (insert (nth 4 (nth i paramlist)))
@@ -1928,7 +1928,7 @@ command like:
1928 (ada-indent-region (point-min) (point-max)) 1928 (ada-indent-region (point-min) (point-max))
1929 (ada-adjust-case-buffer) 1929 (ada-adjust-case-buffer)
1930 (write-file source)) 1930 (write-file source))
1931 (set 'command-line-args-left (cdr command-line-args-left))) 1931 (setq command-line-args-left (cdr command-line-args-left)))
1932 (message "Done") 1932 (message "Done")
1933 (kill-emacs 0)) 1933 (kill-emacs 0))
1934 1934
@@ -1957,7 +1957,7 @@ offset."
1957 (ad-activate 'parse-partial-sexp t)) 1957 (ad-activate 'parse-partial-sexp t))
1958 1958
1959 (save-excursion 1959 (save-excursion
1960 (set 'cur-indent 1960 (setq cur-indent
1961 1961
1962 ;; Not First line in the buffer ? 1962 ;; Not First line in the buffer ?
1963 (if (save-excursion (zerop (forward-line -1))) 1963 (if (save-excursion (zerop (forward-line -1)))
@@ -1979,11 +1979,11 @@ offset."
1979 (while (not (null tmp-indent)) 1979 (while (not (null tmp-indent))
1980 (cond 1980 (cond
1981 ((numberp (car tmp-indent)) 1981 ((numberp (car tmp-indent))
1982 (set 'prev-indent (+ prev-indent (car tmp-indent)))) 1982 (setq prev-indent (+ prev-indent (car tmp-indent))))
1983 (t 1983 (t
1984 (set 'prev-indent (+ prev-indent (eval (car tmp-indent))))) 1984 (setq prev-indent (+ prev-indent (eval (car tmp-indent)))))
1985 ) 1985 )
1986 (set 'tmp-indent (cdr tmp-indent))) 1986 (setq tmp-indent (cdr tmp-indent)))
1987 1987
1988 ;; only re-indent if indentation is different then the current 1988 ;; only re-indent if indentation is different then the current
1989 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent) 1989 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent)
@@ -2019,7 +2019,7 @@ offset."
2019 (forward-line 1) 2019 (forward-line 1)
2020 (point)))) 2020 (point))))
2021 2021
2022 (set 'result 2022 (setq result
2023 (cond 2023 (cond
2024 2024
2025 ;;----------------------------- 2025 ;;-----------------------------
@@ -2028,7 +2028,7 @@ offset."
2028 2028
2029 ((and ada-indent-to-open-paren 2029 ((and ada-indent-to-open-paren
2030 (not (ada-in-paramlist-p)) 2030 (not (ada-in-paramlist-p))
2031 (set 'column (ada-in-open-paren-p))) 2031 (setq column (ada-in-open-paren-p)))
2032 2032
2033 ;; check if we have something like this (Table_Component_Type => 2033 ;; check if we have something like this (Table_Component_Type =>
2034 ;; Source_File_Record) 2034 ;; Source_File_Record)
@@ -2073,10 +2073,10 @@ offset."
2073 (looking-at ".+\\<loop\\>")) 2073 (looking-at ".+\\<loop\\>"))
2074 (progn 2074 (progn
2075 (save-excursion 2075 (save-excursion
2076 (set 'limit (car (ada-search-ignore-string-comment ";" t)))) 2076 (setq limit (car (ada-search-ignore-string-comment ";" t))))
2077 (if (save-excursion 2077 (if (save-excursion
2078 (and 2078 (and
2079 (set 'match-cons 2079 (setq match-cons
2080 (ada-search-ignore-string-comment ada-loop-start-re t limit)) 2080 (ada-search-ignore-string-comment ada-loop-start-re t limit))
2081 (not (looking-at "\\<loop\\>")))) 2081 (not (looking-at "\\<loop\\>"))))
2082 (progn 2082 (progn
@@ -2084,7 +2084,7 @@ offset."
2084 (save-excursion 2084 (save-excursion
2085 (beginning-of-line) 2085 (beginning-of-line)
2086 (if (looking-at ada-named-block-re) 2086 (if (looking-at ada-named-block-re)
2087 (set 'label (- ada-label-indent)))))))) 2087 (setq label (- ada-label-indent))))))))
2088 2088
2089 (list (+ (save-excursion (back-to-indentation) (point)) label) 0)))) 2089 (list (+ (save-excursion (back-to-indentation) (point)) label) 0))))
2090 2090
@@ -2147,7 +2147,7 @@ offset."
2147 2147
2148 ((and (= (char-after) ?l) 2148 ((and (= (char-after) ?l)
2149 (looking-at "loop\\>")) 2149 (looking-at "loop\\>"))
2150 (set 'pos (point)) 2150 (setq pos (point))
2151 (save-excursion 2151 (save-excursion
2152 (goto-char (match-end 0)) 2152 (goto-char (match-end 0))
2153 (ada-goto-stmt-start) 2153 (ada-goto-stmt-start)
@@ -2218,11 +2218,11 @@ offset."
2218 (if (looking-at "renames") 2218 (if (looking-at "renames")
2219 (let (pos) 2219 (let (pos)
2220 (save-excursion 2220 (save-excursion
2221 (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t))) 2221 (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
2222 (if (and pos 2222 (if (and pos
2223 (= (char-after (car pos)) ?r)) 2223 (= (char-after (car pos)) ?r))
2224 (goto-char (car pos))) 2224 (goto-char (car pos)))
2225 (set 'var 'ada-indent-renames))) 2225 (setq var 'ada-indent-renames)))
2226 2226
2227 (forward-comment -1000) 2227 (forward-comment -1000)
2228 (if (= (char-before) ?\)) 2228 (if (= (char-before) ?\))
@@ -2239,7 +2239,7 @@ offset."
2239 (looking-at "function\\>")) 2239 (looking-at "function\\>"))
2240 (progn 2240 (progn
2241 (backward-word 1) 2241 (backward-word 1)
2242 (set 'num-back 2) 2242 (setq num-back 2)
2243 (looking-at "function\\>"))))) 2243 (looking-at "function\\>")))))
2244 2244
2245 ;; The indentation depends of the value of ada-indent-return 2245 ;; The indentation depends of the value of ada-indent-return
@@ -2306,7 +2306,7 @@ offset."
2306 (end-of-line) (point)) 2306 (end-of-line) (point))
2307 t)) 2307 t))
2308 (unless (ada-in-string-p) 2308 (unless (ada-in-string-p)
2309 (set 'pos (point)))) 2309 (setq pos (point))))
2310 pos)) 2310 pos))
2311 (list (- pos 2) 0) 2311 (list (- pos 2) 0)
2312 2312
@@ -2359,7 +2359,7 @@ offset."
2359 ;; avoid "with procedure"... in generic parts 2359 ;; avoid "with procedure"... in generic parts
2360 (save-excursion 2360 (save-excursion
2361 (forward-word -1) 2361 (forward-word -1)
2362 (set 'found (not (looking-at "with")))))) 2362 (setq found (not (looking-at "with"))))))
2363 2363
2364 (if (looking-at "generic") 2364 (if (looking-at "generic")
2365 (list (progn (back-to-indentation) (point)) 0) 2365 (list (progn (back-to-indentation) (point)) 0)
@@ -2527,7 +2527,7 @@ ORGPOINT is the limit position used in the calculation."
2527 ;; a named block end 2527 ;; a named block end
2528 ;; 2528 ;;
2529 ((looking-at ada-ident-re) 2529 ((looking-at ada-ident-re)
2530 (set 'defun-name (match-string 0)) 2530 (setq defun-name (match-string 0))
2531 (save-excursion 2531 (save-excursion
2532 (ada-goto-matching-start 0) 2532 (ada-goto-matching-start 0)
2533 (ada-check-defun-name defun-name)) 2533 (ada-check-defun-name defun-name))
@@ -2540,7 +2540,7 @@ ORGPOINT is the limit position used in the calculation."
2540 (ada-goto-matching-start 0) 2540 (ada-goto-matching-start 0)
2541 (if (looking-at "\\<begin\\>") 2541 (if (looking-at "\\<begin\\>")
2542 (progn 2542 (progn
2543 (set 'indent (list (point) 0)) 2543 (setq indent (list (point) 0))
2544 (if (ada-goto-matching-decl-start t) 2544 (if (ada-goto-matching-decl-start t)
2545 (list (progn (back-to-indentation) (point)) 0) 2545 (list (progn (back-to-indentation) (point)) 0)
2546 indent))))) 2546 indent)))))
@@ -2564,7 +2564,7 @@ ORGPOINT is the limit position used in the calculation."
2564 ;; case..is..when..=> 2564 ;; case..is..when..=>
2565 ;; 2565 ;;
2566 ((save-excursion 2566 ((save-excursion
2567 (set 'match-cons (and 2567 (setq match-cons (and
2568 ;; the `=>' must be after the keyword `is'. 2568 ;; the `=>' must be after the keyword `is'.
2569 (ada-search-ignore-string-comment 2569 (ada-search-ignore-string-comment
2570 "is" nil orgpoint nil 'word-search-forward) 2570 "is" nil orgpoint nil 'word-search-forward)
@@ -2579,7 +2579,7 @@ ORGPOINT is the limit position used in the calculation."
2579 ;; case..is..when 2579 ;; case..is..when
2580 ;; 2580 ;;
2581 ((save-excursion 2581 ((save-excursion
2582 (set 'match-cons (ada-search-ignore-string-comment 2582 (setq match-cons (ada-search-ignore-string-comment
2583 "when" nil orgpoint nil 'word-search-forward))) 2583 "when" nil orgpoint nil 'word-search-forward)))
2584 (goto-char (cdr match-cons)) 2584 (goto-char (cdr match-cons))
2585 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) 2585 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
@@ -2587,7 +2587,7 @@ ORGPOINT is the limit position used in the calculation."
2587 ;; case..is 2587 ;; case..is
2588 ;; 2588 ;;
2589 ((save-excursion 2589 ((save-excursion
2590 (set 'match-cons (ada-search-ignore-string-comment 2590 (setq match-cons (ada-search-ignore-string-comment
2591 "is" nil orgpoint nil 'word-search-forward))) 2591 "is" nil orgpoint nil 'word-search-forward)))
2592 (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent)) 2592 (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent))
2593 ;; 2593 ;;
@@ -2613,7 +2613,7 @@ ORGPOINT is the limit position used in the calculation."
2613 ;; 2613 ;;
2614 ;; Move to the correct then (ignore all "and then") 2614 ;; Move to the correct then (ignore all "and then")
2615 ;; 2615 ;;
2616 (while (and (set 'match-cons (ada-search-ignore-string-comment 2616 (while (and (setq match-cons (ada-search-ignore-string-comment
2617 "\\<\\(then\\|and[ \t]*then\\)\\>" 2617 "\\<\\(then\\|and[ \t]*then\\)\\>"
2618 nil orgpoint)) 2618 nil orgpoint))
2619 (= (char-after (car match-cons)) ?a))) 2619 (= (char-after (car match-cons)) ?a)))
@@ -2628,7 +2628,7 @@ ORGPOINT is the limit position used in the calculation."
2628 (if (save-excursion 2628 (if (save-excursion
2629 (back-to-indentation) 2629 (back-to-indentation)
2630 (looking-at "\\<then\\>")) 2630 (looking-at "\\<then\\>"))
2631 (set 'cur-indent (save-excursion (back-to-indentation) (point)))) 2631 (setq cur-indent (save-excursion (back-to-indentation) (point))))
2632 ;; skip 'then' 2632 ;; skip 'then'
2633 (forward-word 1) 2633 (forward-word 1)
2634 (list cur-indent 'ada-indent)) 2634 (list cur-indent 'ada-indent))
@@ -2642,7 +2642,7 @@ ORGPOINT is the limit position used in the calculation."
2642 (cond 2642 (cond
2643 ((save-excursion 2643 ((save-excursion
2644 (forward-word 1) 2644 (forward-word 1)
2645 (set 'pos (ada-goto-next-non-ws orgpoint))) 2645 (setq pos (ada-goto-next-non-ws orgpoint)))
2646 (goto-char pos) 2646 (goto-char pos)
2647 (save-excursion 2647 (save-excursion
2648 (ada-indent-on-previous-lines t orgpoint))) 2648 (ada-indent-on-previous-lines t orgpoint)))
@@ -2661,14 +2661,14 @@ ORGPOINT is the limit position used in the calculation."
2661 ;; is there an 'is' in front of point ? 2661 ;; is there an 'is' in front of point ?
2662 ;; 2662 ;;
2663 (if (save-excursion 2663 (if (save-excursion
2664 (set 'match-cons 2664 (setq match-cons
2665 (ada-search-ignore-string-comment 2665 (ada-search-ignore-string-comment
2666 "\\<\\(is\\|do\\)\\>" nil orgpoint))) 2666 "\\<\\(is\\|do\\)\\>" nil orgpoint)))
2667 ;; 2667 ;;
2668 ;; yes, then skip to its end 2668 ;; yes, then skip to its end
2669 ;; 2669 ;;
2670 (progn 2670 (progn
2671 (set 'foundis t) 2671 (setq foundis t)
2672 (goto-char (cdr match-cons))) 2672 (goto-char (cdr match-cons)))
2673 ;; 2673 ;;
2674 ;; no, then goto next non-ws, if there is one in front of point 2674 ;; no, then goto next non-ws, if there is one in front of point
@@ -2693,7 +2693,7 @@ ORGPOINT is the limit position used in the calculation."
2693 ((and 2693 ((and
2694 foundis 2694 foundis
2695 (save-excursion 2695 (save-excursion
2696 (set 'match-cons 2696 (setq match-cons
2697 (ada-search-ignore-string-comment 2697 (ada-search-ignore-string-comment
2698 "\\<\\(separate\\|new\\|abstract\\)\\>" 2698 "\\<\\(separate\\|new\\|abstract\\)\\>"
2699 nil orgpoint)))) 2699 nil orgpoint))))
@@ -2705,7 +2705,7 @@ ORGPOINT is the limit position used in the calculation."
2705 ;; 2705 ;;
2706 ((and 2706 ((and
2707 foundis 2707 foundis
2708 (save-excursion (set 'match-cons (ada-goto-next-non-ws orgpoint))) 2708 (save-excursion (setq match-cons (ada-goto-next-non-ws orgpoint)))
2709 (goto-char match-cons) 2709 (goto-char match-cons)
2710 (ada-indent-on-previous-lines t orgpoint))) 2710 (ada-indent-on-previous-lines t orgpoint)))
2711 ;; 2711 ;;
@@ -2746,20 +2746,20 @@ ORGPOINT is the limit position used in the calculation."
2746 ;; top level 2746 ;; top level
2747 (t 2747 (t
2748 (if (looking-at ada-named-block-re) 2748 (if (looking-at ada-named-block-re)
2749 (set 'label (- ada-label-indent)) 2749 (setq label (- ada-label-indent))
2750 2750
2751 (let (p) 2751 (let (p)
2752 2752
2753 ;; "with private" or "null record" cases 2753 ;; "with private" or "null record" cases
2754 (if (or (save-excursion 2754 (if (or (save-excursion
2755 (and (ada-search-ignore-string-comment "\\<private\\>" nil orgpoint) 2755 (and (ada-search-ignore-string-comment "\\<private\\>" nil orgpoint)
2756 (set 'p (point)) 2756 (setq p (point))
2757 (save-excursion (forward-char -7);; skip back "private" 2757 (save-excursion (forward-char -7);; skip back "private"
2758 (ada-goto-previous-word) 2758 (ada-goto-previous-word)
2759 (looking-at "with")))) 2759 (looking-at "with"))))
2760 (save-excursion 2760 (save-excursion
2761 (and (ada-search-ignore-string-comment "\\<record\\>" nil orgpoint) 2761 (and (ada-search-ignore-string-comment "\\<record\\>" nil orgpoint)
2762 (set 'p (point)) 2762 (setq p (point))
2763 (save-excursion (forward-char -6);; skip back "record" 2763 (save-excursion (forward-char -6);; skip back "record"
2764 (ada-goto-previous-word) 2764 (ada-goto-previous-word)
2765 (looking-at "null"))))) 2765 (looking-at "null")))))
@@ -2783,14 +2783,14 @@ ORGPOINT is the limit position used in the calculation."
2783 (cond 2783 (cond
2784 ;; loop label 2784 ;; loop label
2785 ((save-excursion 2785 ((save-excursion
2786 (set 'match-cons (ada-search-ignore-string-comment 2786 (setq match-cons (ada-search-ignore-string-comment
2787 ada-loop-start-re nil orgpoint))) 2787 ada-loop-start-re nil orgpoint)))
2788 (goto-char (car match-cons)) 2788 (goto-char (car match-cons))
2789 (ada-get-indent-loop orgpoint)) 2789 (ada-get-indent-loop orgpoint))
2790 2790
2791 ;; declare label 2791 ;; declare label
2792 ((save-excursion 2792 ((save-excursion
2793 (set 'match-cons (ada-search-ignore-string-comment 2793 (setq match-cons (ada-search-ignore-string-comment
2794 "\\<declare\\|begin\\>" nil orgpoint))) 2794 "\\<declare\\|begin\\>" nil orgpoint)))
2795 (goto-char (car match-cons)) 2795 (goto-char (car match-cons))
2796 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) 2796 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
@@ -2832,7 +2832,7 @@ ORGPOINT is the limit position used in the calculation."
2832 ;; simple loop 2832 ;; simple loop
2833 ;; 2833 ;;
2834 ((looking-at "loop\\>") 2834 ((looking-at "loop\\>")
2835 (set 'pos (ada-get-indent-block-start orgpoint)) 2835 (setq pos (ada-get-indent-block-start orgpoint))
2836 (if (equal label 0) 2836 (if (equal label 0)
2837 pos 2837 pos
2838 (list (+ (car pos) label) (cdr pos)))) 2838 (list (+ (car pos) label) (cdr pos))))
@@ -2857,7 +2857,7 @@ ORGPOINT is the limit position used in the calculation."
2857 ;; check if there is a 'record' before point 2857 ;; check if there is a 'record' before point
2858 ;; 2858 ;;
2859 (progn 2859 (progn
2860 (set 'match-cons (ada-search-ignore-string-comment 2860 (setq match-cons (ada-search-ignore-string-comment
2861 "record" nil orgpoint nil 'word-search-forward)) 2861 "record" nil orgpoint nil 'word-search-forward))
2862 t))) 2862 t)))
2863 (if match-cons 2863 (if match-cons
@@ -2867,7 +2867,7 @@ ORGPOINT is the limit position used in the calculation."
2867 ;; for..loop 2867 ;; for..loop
2868 ;; 2868 ;;
2869 ((save-excursion 2869 ((save-excursion
2870 (set 'match-cons (ada-search-ignore-string-comment 2870 (setq match-cons (ada-search-ignore-string-comment
2871 "loop" nil orgpoint nil 'word-search-forward))) 2871 "loop" nil orgpoint nil 'word-search-forward)))
2872 (goto-char (car match-cons)) 2872 (goto-char (car match-cons))
2873 ;; 2873 ;;
@@ -2895,7 +2895,7 @@ ORGPOINT is the limit position used in the calculation."
2895 ;; while..loop ? 2895 ;; while..loop ?
2896 ;; 2896 ;;
2897 (if (save-excursion 2897 (if (save-excursion
2898 (set 'match-cons (ada-search-ignore-string-comment 2898 (setq match-cons (ada-search-ignore-string-comment
2899 "loop" nil orgpoint nil 'word-search-forward))) 2899 "loop" nil orgpoint nil 'word-search-forward)))
2900 2900
2901 (progn 2901 (progn
@@ -2924,7 +2924,7 @@ ORGPOINT is the limit position used in the calculation."
2924 ;; 2924 ;;
2925 ((save-excursion 2925 ((save-excursion
2926 (and 2926 (and
2927 (set 'match-dat (ada-search-ignore-string-comment 2927 (setq match-dat (ada-search-ignore-string-comment
2928 "end" nil orgpoint nil 'word-search-forward)) 2928 "end" nil orgpoint nil 'word-search-forward))
2929 (ada-goto-next-non-ws) 2929 (ada-goto-next-non-ws)
2930 (looking-at "\\<record\\>") 2930 (looking-at "\\<record\\>")
@@ -2937,7 +2937,7 @@ ORGPOINT is the limit position used in the calculation."
2937 ;; record type 2937 ;; record type
2938 ;; 2938 ;;
2939 ((save-excursion 2939 ((save-excursion
2940 (set 'match-dat (ada-search-ignore-string-comment 2940 (setq match-dat (ada-search-ignore-string-comment
2941 "record" nil orgpoint nil 'word-search-forward))) 2941 "record" nil orgpoint nil 'word-search-forward)))
2942 (goto-char (car match-dat)) 2942 (goto-char (car match-dat))
2943 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) 2943 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
@@ -2977,7 +2977,7 @@ open parenthesis."
2977 (let ((match-dat nil) 2977 (let ((match-dat nil)
2978 (orgpoint (point))) 2978 (orgpoint (point)))
2979 2979
2980 (set 'match-dat (ada-search-prev-end-stmt)) 2980 (setq match-dat (ada-search-prev-end-stmt))
2981 (if match-dat 2981 (if match-dat
2982 2982
2983 ;; 2983 ;;
@@ -2992,7 +2992,7 @@ open parenthesis."
2992 ;; nothing follows => it's the end-statement directly in 2992 ;; nothing follows => it's the end-statement directly in
2993 ;; front of point => search again 2993 ;; front of point => search again
2994 ;; 2994 ;;
2995 (set 'match-dat (ada-search-prev-end-stmt))) 2995 (setq match-dat (ada-search-prev-end-stmt)))
2996 ;; 2996 ;;
2997 ;; if found the correct end-statement => goto next non-ws 2997 ;; if found the correct end-statement => goto next non-ws
2998 ;; 2998 ;;
@@ -3026,7 +3026,7 @@ match."
3026 (while 3026 (while
3027 (and 3027 (and
3028 (not found) 3028 (not found)
3029 (set 'match-dat (ada-search-ignore-string-comment 3029 (setq match-dat (ada-search-ignore-string-comment
3030 ada-end-stmt-re t))) 3030 ada-end-stmt-re t)))
3031 3031
3032 (goto-char (car match-dat)) 3032 (goto-char (car match-dat))
@@ -3049,7 +3049,7 @@ match."
3049 (regexp-opt '("separate" "access" "array" 3049 (regexp-opt '("separate" "access" "array"
3050 "abstract" "new") t) 3050 "abstract" "new") t)
3051 "\\>\\|("))) 3051 "\\>\\|(")))
3052 (set 'found t)))) 3052 (setq found t))))
3053 )) 3053 ))
3054 3054
3055 (if found 3055 (if found
@@ -3062,7 +3062,7 @@ match."
3062Stop the search at LIMIT. 3062Stop the search at LIMIT.
3063Do not call this function from within a string." 3063Do not call this function from within a string."
3064 (unless limit 3064 (unless limit
3065 (set 'limit (point-max))) 3065 (setq limit (point-max)))
3066 (while (and (<= (point) limit) 3066 (while (and (<= (point) limit)
3067 (progn (forward-comment 10000) 3067 (progn (forward-comment 10000)
3068 (if (and (not (eobp)) 3068 (if (and (not (eobp))
@@ -3094,7 +3094,7 @@ Returns the new position of point or nil if not found."
3094 (modify-syntax-entry ?_ "w") 3094 (modify-syntax-entry ?_ "w")
3095 (unless backward 3095 (unless backward
3096 (skip-syntax-forward "w")) 3096 (skip-syntax-forward "w"))
3097 (if (set 'match-cons 3097 (if (setq match-cons
3098 (if backward 3098 (if backward
3099 (ada-search-ignore-string-comment "\\w" t nil t) 3099 (ada-search-ignore-string-comment "\\w" t nil t)
3100 (ada-search-ignore-string-comment "\\w" nil nil t))) 3100 (ada-search-ignore-string-comment "\\w" nil nil t)))
@@ -3182,7 +3182,7 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3182 ;; begin ... 3182 ;; begin ...
3183 ;; exception ... ) 3183 ;; exception ... )
3184 (if (looking-at "begin") 3184 (if (looking-at "begin")
3185 (set 'stop-at-when t)) 3185 (setq stop-at-when t))
3186 3186
3187 (if (or 3187 (if (or
3188 (looking-at "\\<\\(package\\|procedure\\|function\\)\\>") 3188 (looking-at "\\<\\(package\\|procedure\\|function\\)\\>")
@@ -3190,7 +3190,7 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3190 (ada-search-ignore-string-comment 3190 (ada-search-ignore-string-comment
3191 "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t) 3191 "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t)
3192 (looking-at "generic"))) 3192 (looking-at "generic")))
3193 (set 'count-generic t)) 3193 (setq count-generic t))
3194 3194
3195 ;; search backward for interesting keywords 3195 ;; search backward for interesting keywords
3196 (while (and 3196 (while (and
@@ -3229,30 +3229,30 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3229 (if (looking-at "end") 3229 (if (looking-at "end")
3230 (ada-goto-matching-decl-start noerror t) 3230 (ada-goto-matching-decl-start noerror t)
3231 3231
3232 (set 'loop-again nil) 3232 (setq loop-again nil)
3233 (unless (looking-at "begin") 3233 (unless (looking-at "begin")
3234 (set 'nest-count (1+ nest-count)))) 3234 (setq nest-count (1+ nest-count))))
3235 )) 3235 ))
3236 ))) 3236 )))
3237 ;; 3237 ;;
3238 ((looking-at "generic") 3238 ((looking-at "generic")
3239 (if count-generic 3239 (if count-generic
3240 (progn 3240 (progn
3241 (set 'first nil) 3241 (setq first nil)
3242 (set 'nest-count (1- nest-count))))) 3242 (setq nest-count (1- nest-count)))))
3243 ;; 3243 ;;
3244 ((looking-at "if") 3244 ((looking-at "if")
3245 (save-excursion 3245 (save-excursion
3246 (forward-word -1) 3246 (forward-word -1)
3247 (unless (looking-at "\\<end[ \t\n]*if\\>") 3247 (unless (looking-at "\\<end[ \t\n]*if\\>")
3248 (progn 3248 (progn
3249 (set 'nest-count (1- nest-count)) 3249 (setq nest-count (1- nest-count))
3250 (set 'first nil))))) 3250 (setq first nil)))))
3251 3251
3252 ;; 3252 ;;
3253 ((looking-at "declare\\|generic") 3253 ((looking-at "declare\\|generic")
3254 (set 'nest-count (1- nest-count)) 3254 (setq nest-count (1- nest-count))
3255 (set 'first nil)) 3255 (setq first nil))
3256 ;; 3256 ;;
3257 ((looking-at "is") 3257 ((looking-at "is")
3258 ;; check if it is only a type definition, but not a protected 3258 ;; check if it is only a type definition, but not a protected
@@ -3281,8 +3281,8 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3281 )) ; end of `or' 3281 )) ; end of `or'
3282 (goto-char (match-beginning 0)) 3282 (goto-char (match-beginning 0))
3283 (progn 3283 (progn
3284 (set 'nest-count (1- nest-count)) 3284 (setq nest-count (1- nest-count))
3285 (set 'first nil)))) 3285 (setq first nil))))
3286 3286
3287 ;; 3287 ;;
3288 ((looking-at "new") 3288 ((looking-at "new")
@@ -3293,16 +3293,16 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3293 ;; 3293 ;;
3294 ((and first 3294 ((and first
3295 (looking-at "begin")) 3295 (looking-at "begin"))
3296 (set 'nest-count 0)) 3296 (setq nest-count 0))
3297 ;; 3297 ;;
3298 ((looking-at "when") 3298 ((looking-at "when")
3299 (if stop-at-when 3299 (if stop-at-when
3300 (set 'nest-count (1- nest-count))) 3300 (setq nest-count (1- nest-count)))
3301 (set 'first nil)) 3301 (setq first nil))
3302 ;; 3302 ;;
3303 (t 3303 (t
3304 (set 'nest-count (1+ nest-count)) 3304 (setq nest-count (1+ nest-count))
3305 (set 'first nil))) 3305 (setq first nil)))
3306 3306
3307 );; end of loop 3307 );; end of loop
3308 3308
@@ -3344,12 +3344,12 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
3344 (cond 3344 (cond
3345 ;; found block end => increase nest depth 3345 ;; found block end => increase nest depth
3346 ((looking-at "end") 3346 ((looking-at "end")
3347 (set 'nest-count (1+ nest-count))) 3347 (setq nest-count (1+ nest-count)))
3348 3348
3349 ;; found loop/select/record/case/if => check if it starts or 3349 ;; found loop/select/record/case/if => check if it starts or
3350 ;; ends a block 3350 ;; ends a block
3351 ((looking-at "loop\\|select\\|record\\|case\\|if") 3351 ((looking-at "loop\\|select\\|record\\|case\\|if")
3352 (set 'pos (point)) 3352 (setq pos (point))
3353 (save-excursion 3353 (save-excursion
3354 ;; 3354 ;;
3355 ;; check if keyword follows 'end' 3355 ;; check if keyword follows 'end'
@@ -3358,10 +3358,10 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
3358 (if (looking-at "\\<end\\>[ \t]*[^;]") 3358 (if (looking-at "\\<end\\>[ \t]*[^;]")
3359 ;; it ends a block => increase nest depth 3359 ;; it ends a block => increase nest depth
3360 (progn 3360 (progn
3361 (set 'nest-count (1+ nest-count)) 3361 (setq nest-count (1+ nest-count))
3362 (set 'pos (point))) 3362 (setq pos (point)))
3363 ;; it starts a block => decrease nest depth 3363 ;; it starts a block => decrease nest depth
3364 (set 'nest-count (1- nest-count)))) 3364 (setq nest-count (1- nest-count))))
3365 (goto-char pos)) 3365 (goto-char pos))
3366 3366
3367 ;; found package start => check if it really is a block 3367 ;; found package start => check if it really is a block
@@ -3384,7 +3384,7 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
3384 (ada-goto-next-non-ws) 3384 (ada-goto-next-non-ws)
3385 ;; ignore it if it is only a declaration with 'new' 3385 ;; ignore it if it is only a declaration with 'new'
3386 (if (not (looking-at "\\<\\(new\\|separate\\)\\>")) 3386 (if (not (looking-at "\\<\\(new\\|separate\\)\\>"))
3387 (set 'nest-count (1- nest-count))))))) 3387 (setq nest-count (1- nest-count)))))))
3388 ;; found task start => check if it has a body 3388 ;; found task start => check if it has a body
3389 ((looking-at "task") 3389 ((looking-at "task")
3390 (save-excursion 3390 (save-excursion
@@ -3410,20 +3410,20 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
3410 (progn 3410 (progn
3411 (goto-char (car tmp)) 3411 (goto-char (car tmp))
3412 (if (looking-at "is") 3412 (if (looking-at "is")
3413 (set 'nest-count (1- nest-count))))))))) 3413 (setq nest-count (1- nest-count)))))))))
3414 (t 3414 (t
3415 ;; Check if that task declaration had a block attached to 3415 ;; Check if that task declaration had a block attached to
3416 ;; it (i.e do nothing if we have just "task name;") 3416 ;; it (i.e do nothing if we have just "task name;")
3417 (unless (progn (forward-word 1) 3417 (unless (progn (forward-word 1)
3418 (looking-at "[ \t]*;")) 3418 (looking-at "[ \t]*;"))
3419 (set 'nest-count (1- nest-count))))))) 3419 (setq nest-count (1- nest-count)))))))
3420 ;; all the other block starts 3420 ;; all the other block starts
3421 (t 3421 (t
3422 (set 'nest-count (1- nest-count)))) ; end of 'cond' 3422 (setq nest-count (1- nest-count)))) ; end of 'cond'
3423 3423
3424 ;; match is found, if nest-depth is zero 3424 ;; match is found, if nest-depth is zero
3425 ;; 3425 ;;
3426 (set 'found (zerop nest-count))))) ; end of loop 3426 (setq found (zerop nest-count))))) ; end of loop
3427 3427
3428 (if found 3428 (if found
3429 ;; 3429 ;;
@@ -3484,7 +3484,7 @@ If NOERROR is non-nil, it only returns nil if found no matching start."
3484 (cond 3484 (cond
3485 ;; found block end => decrease nest depth 3485 ;; found block end => decrease nest depth
3486 ((looking-at "\\<end\\>") 3486 ((looking-at "\\<end\\>")
3487 (set 'nest-count (1- nest-count)) 3487 (setq nest-count (1- nest-count))
3488 ;; skip the following keyword 3488 ;; skip the following keyword
3489 (if (progn 3489 (if (progn
3490 (skip-chars-forward "end") 3490 (skip-chars-forward "end")
@@ -3499,15 +3499,15 @@ If NOERROR is non-nil, it only returns nil if found no matching start."
3499 ;; ignore and skip it if it is only a 'new' package 3499 ;; ignore and skip it if it is only a 'new' package
3500 (if (looking-at "\\<new\\>") 3500 (if (looking-at "\\<new\\>")
3501 (goto-char (match-end 0)) 3501 (goto-char (match-end 0))
3502 (set 'nest-count (1+ nest-count)))) 3502 (setq nest-count (1+ nest-count))))
3503 ;; all the other block starts 3503 ;; all the other block starts
3504 (t 3504 (t
3505 (set 'nest-count (1+ nest-count)) 3505 (setq nest-count (1+ nest-count))
3506 (forward-word 1))) ; end of 'cond' 3506 (forward-word 1))) ; end of 'cond'
3507 3507
3508 ;; match is found, if nest-depth is zero 3508 ;; match is found, if nest-depth is zero
3509 ;; 3509 ;;
3510 (set 'found (zerop nest-count))) ; end of loop 3510 (setq found (zerop nest-count))) ; end of loop
3511 3511
3512 (if found 3512 (if found
3513 t 3513 t
@@ -3534,7 +3534,7 @@ Point is moved at the beginning of the search-re."
3534 (previous-syntax-table (syntax-table))) 3534 (previous-syntax-table (syntax-table)))
3535 3535
3536 (unless search-func 3536 (unless search-func
3537 (set 'search-func (if backward 're-search-backward 're-search-forward))) 3537 (setq search-func (if backward 're-search-backward 're-search-forward)))
3538 3538
3539 ;; 3539 ;;
3540 ;; search until found or end-of-buffer 3540 ;; search until found or end-of-buffer
@@ -3546,10 +3546,10 @@ Point is moved at the beginning of the search-re."
3546 (or (and backward (<= limit (point))) 3546 (or (and backward (<= limit (point)))
3547 (>= limit (point)))) 3547 (>= limit (point))))
3548 (funcall search-func search-re limit 1)) 3548 (funcall search-func search-re limit 1))
3549 (set 'begin (match-beginning 0)) 3549 (setq begin (match-beginning 0))
3550 (set 'end (match-end 0)) 3550 (setq end (match-end 0))
3551 3551
3552 (set 'parse-result (parse-partial-sexp 3552 (setq parse-result (parse-partial-sexp
3553 (save-excursion (beginning-of-line) (point)) 3553 (save-excursion (beginning-of-line) (point))
3554 (point))) 3554 (point)))
3555 3555
@@ -3598,7 +3598,7 @@ Point is moved at the beginning of the search-re."
3598 ;; found what we were looking for 3598 ;; found what we were looking for
3599 ;; 3599 ;;
3600 (t 3600 (t
3601 (set 'found t)))) ; end of loop 3601 (setq found t)))) ; end of loop
3602 3602
3603 (set-syntax-table previous-syntax-table) 3603 (set-syntax-table previous-syntax-table)
3604 3604
@@ -3690,7 +3690,7 @@ Returns nil if the private is part of the package name, as in
3690 "Like `ada-search-ignore-string-comment', except that it also ignores 3690 "Like `ada-search-ignore-string-comment', except that it also ignores
3691boolean expressions 'and then' and 'or else'." 3691boolean expressions 'and then' and 'or else'."
3692 (let (result) 3692 (let (result)
3693 (while (and (set 'result (ada-search-ignore-string-comment regexp backwardp)) 3693 (while (and (setq result (ada-search-ignore-string-comment regexp backwardp))
3694 (save-excursion (forward-word -1) 3694 (save-excursion (forward-word -1)
3695 (looking-at "and then\\|or else")))) 3695 (looking-at "and then\\|or else"))))
3696 result)) 3696 result))
@@ -3857,7 +3857,7 @@ of the region. Otherwise, operates only on the current line."
3857 (or (looking-at "[ \t]*\\<end\\>") 3857 (or (looking-at "[ \t]*\\<end\\>")
3858 (error "not on end ...;"))) 3858 (error "not on end ...;")))
3859 (ada-goto-matching-start 1) 3859 (ada-goto-matching-start 1)
3860 (set 'pos (point)) 3860 (setq pos (point))
3861 3861
3862 ;; 3862 ;;
3863 ;; on 'begin' => go on, according to user option 3863 ;; on 'begin' => go on, according to user option
@@ -3865,7 +3865,7 @@ of the region. Otherwise, operates only on the current line."
3865 ada-move-to-declaration 3865 ada-move-to-declaration
3866 (looking-at "\\<begin\\>") 3866 (looking-at "\\<begin\\>")
3867 (ada-goto-matching-decl-start) 3867 (ada-goto-matching-decl-start)
3868 (set 'pos (point)))) 3868 (setq pos (point))))
3869 3869
3870 ) ; end of save-excursion 3870 ) ; end of save-excursion
3871 3871
@@ -3929,7 +3929,7 @@ Moves to 'begin' if in a declarative part."
3929 ;; (hopefully ;-) everything else 3929 ;; (hopefully ;-) everything else
3930 (t 3930 (t
3931 (ada-goto-matching-end 1))) 3931 (ada-goto-matching-end 1)))
3932 (set 'pos (point)) 3932 (setq pos (point))
3933 ) 3933 )
3934 3934
3935 ;; now really move to the position found 3935 ;; now really move to the position found
@@ -4069,17 +4069,17 @@ can add its own items."
4069 ) 4069 )
4070 4070
4071 ;; Option menu present only if in Ada mode 4071 ;; Option menu present only if in Ada mode
4072 (set 'm (append m (list (append (list "Options" 4072 (setq m (append m (list (append (list "Options"
4073 (if ada-xemacs :included :visible) 4073 (if ada-xemacs :included :visible)
4074 '(string= mode-name "Ada")) 4074 '(string= mode-name "Ada"))
4075 option)))) 4075 option))))
4076 4076
4077 ;; Customize menu always present 4077 ;; Customize menu always present
4078 (set 'm (append m '(["Customize" (customize-group 'ada) 4078 (setq m (append m '(["Customize" (customize-group 'ada)
4079 (>= emacs-major-version 20)]))) 4079 (>= emacs-major-version 20)])))
4080 4080
4081 ;; Goto and Edit menus present only if in Ada mode 4081 ;; Goto and Edit menus present only if in Ada mode
4082 (set 'm (append m (list (append (list "Goto" 4082 (setq m (append m (list (append (list "Goto"
4083 (if ada-xemacs :included :visible) 4083 (if ada-xemacs :included :visible)
4084 '(string= mode-name "Ada")) 4084 '(string= mode-name "Ada"))
4085 goto) 4085 goto)
@@ -4093,7 +4093,7 @@ can add its own items."
4093 (progn 4093 (progn
4094 (easy-menu-add ada-mode-menu ada-mode-map) 4094 (easy-menu-add ada-mode-menu ada-mode-map)
4095 (define-key ada-mode-map [menu-bar] ada-mode-menu) 4095 (define-key ada-mode-map [menu-bar] ada-mode-menu)
4096 (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))) 4096 (setq mode-popup-menu (cons "Ada mode" ada-mode-menu)))
4097 ) 4097 )
4098 )) 4098 ))
4099 4099
@@ -4180,7 +4180,7 @@ The paragraph is indented on the first line."
4180 (insert "\n") 4180 (insert "\n")
4181 (back-to-indentation))) 4181 (back-to-indentation)))
4182 (beginning-of-line) 4182 (beginning-of-line)
4183 (set 'to (point-marker)) 4183 (setq to (point-marker))
4184 (goto-char opos) 4184 (goto-char opos)
4185 4185
4186 ;; Find beginning of paragraph 4186 ;; Find beginning of paragraph
@@ -4194,11 +4194,11 @@ The paragraph is indented on the first line."
4194 (unless (bobp) 4194 (unless (bobp)
4195 (forward-line 1)) 4195 (forward-line 1))
4196 (beginning-of-line) 4196 (beginning-of-line)
4197 (set 'from (point-marker)) 4197 (setq from (point-marker))
4198 4198
4199 ;; Calculate the indentation we will need for the paragraph 4199 ;; Calculate the indentation we will need for the paragraph
4200 (back-to-indentation) 4200 (back-to-indentation)
4201 (set 'indent (current-column)) 4201 (setq indent (current-column))
4202 ;; unindent the first line of the paragraph 4202 ;; unindent the first line of the paragraph
4203 (delete-region from (point)) 4203 (delete-region from (point))
4204 4204
@@ -4215,13 +4215,13 @@ The paragraph is indented on the first line."
4215 (replace-match " ")) 4215 (replace-match " "))
4216 4216
4217 (goto-char (1- to)) 4217 (goto-char (1- to))
4218 (set 'to (point-marker)) 4218 (setq to (point-marker))
4219 4219
4220 ;; Indent and justify the paragraph 4220 ;; Indent and justify the paragraph
4221 (set 'fill-prefix ada-fill-comment-prefix) 4221 (setq fill-prefix ada-fill-comment-prefix)
4222 (set-left-margin from to indent) 4222 (set-left-margin from to indent)
4223 (if postfix 4223 (if postfix
4224 (set 'fill-column (- fill-column (length ada-fill-comment-postfix)))) 4224 (setq fill-column (- fill-column (length ada-fill-comment-postfix))))
4225 4225
4226 (fill-region-as-paragraph from to justify) 4226 (fill-region-as-paragraph from to justify)
4227 4227
@@ -4269,7 +4269,7 @@ The paragraph is indented on the first line."
4269 "Determine the filename in which ADANAME is found. 4269 "Determine the filename in which ADANAME is found.
4270This is a generic function, independent from any compiler." 4270This is a generic function, independent from any compiler."
4271 (while (string-match "\\." adaname) 4271 (while (string-match "\\." adaname)
4272 (set 'adaname (replace-match "-" t t adaname))) 4272 (setq adaname (replace-match "-" t t adaname)))
4273 (downcase adaname) 4273 (downcase adaname)
4274 ) 4274 )
4275 4275
@@ -4291,17 +4291,17 @@ otherwise."
4291 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name) 4291 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
4292 (setq is-spec t 4292 (setq is-spec t
4293 name (match-string 1 name))) 4293 name (match-string 1 name)))
4294 (set 'suffixes (cdr suffixes))) 4294 (setq suffixes (cdr suffixes)))
4295 4295
4296 (if (not is-spec) 4296 (if (not is-spec)
4297 (progn 4297 (progn
4298 (set 'suffixes ada-body-suffixes) 4298 (setq suffixes ada-body-suffixes)
4299 (while (and (not is-body) 4299 (while (and (not is-body)
4300 suffixes) 4300 suffixes)
4301 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name) 4301 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
4302 (setq is-body t 4302 (setq is-body t
4303 name (match-string 1 name))) 4303 name (match-string 1 name)))
4304 (set 'suffixes (cdr suffixes))))) 4304 (setq suffixes (cdr suffixes)))))
4305 4305
4306 ;; If this wasn't in either list, return name itself 4306 ;; If this wasn't in either list, return name itself
4307 (if (not (or is-spec is-body)) 4307 (if (not (or is-spec is-body))
@@ -4309,26 +4309,26 @@ otherwise."
4309 4309
4310 ;; Else find the other possible names 4310 ;; Else find the other possible names
4311 (if is-spec 4311 (if is-spec
4312 (set 'suffixes ada-body-suffixes) 4312 (setq suffixes ada-body-suffixes)
4313 (set 'suffixes ada-spec-suffixes)) 4313 (setq suffixes ada-spec-suffixes))
4314 (set 'is-spec name) 4314 (setq is-spec name)
4315 4315
4316 (while suffixes 4316 (while suffixes
4317 (if (file-exists-p (concat name (car suffixes))) 4317 (if (file-exists-p (concat name (car suffixes)))
4318 (set 'is-spec (concat name (car suffixes)))) 4318 (setq is-spec (concat name (car suffixes))))
4319 (set 'suffixes (cdr suffixes))) 4319 (setq suffixes (cdr suffixes)))
4320 4320
4321 is-spec))) 4321 is-spec)))
4322 4322
4323(defun ada-which-function-are-we-in () 4323(defun ada-which-function-are-we-in ()
4324 "Return the name of the function whose definition/declaration point is in. 4324 "Return the name of the function whose definition/declaration point is in.
4325Redefines the function `ff-which-function-are-we-in'." 4325Redefines the function `ff-which-function-are-we-in'."
4326 (set 'ff-function-name nil) 4326 (setq ff-function-name nil)
4327 (save-excursion 4327 (save-excursion
4328 (end-of-line);; make sure we get the complete name 4328 (end-of-line);; make sure we get the complete name
4329 (if (or (re-search-backward ada-procedure-start-regexp nil t) 4329 (if (or (re-search-backward ada-procedure-start-regexp nil t)
4330 (re-search-backward ada-package-start-regexp nil t)) 4330 (re-search-backward ada-package-start-regexp nil t))
4331 (set 'ff-function-name (match-string 0))) 4331 (setq ff-function-name (match-string 0)))
4332 )) 4332 ))
4333 4333
4334 4334
@@ -4375,7 +4375,7 @@ Since the search can be long, the results are cached."
4375 4375
4376 (while (and (not found) 4376 (while (and (not found)
4377 (re-search-backward ada-imenu-subprogram-menu-re nil t)) 4377 (re-search-backward ada-imenu-subprogram-menu-re nil t))
4378 (set 'func-name (match-string 2)) 4378 (setq func-name (match-string 2))
4379 (if (and (not (ada-in-comment-p)) 4379 (if (and (not (ada-in-comment-p))
4380 (not (save-excursion 4380 (not (save-excursion
4381 (goto-char (match-end 0)) 4381 (goto-char (match-end 0))
@@ -4383,10 +4383,10 @@ Since the search can be long, the results are cached."
4383 (save-excursion 4383 (save-excursion
4384 (if (ada-search-ignore-string-comment 4384 (if (ada-search-ignore-string-comment
4385 (concat "end[ \t]+" func-name "[ \t]*;")) 4385 (concat "end[ \t]+" func-name "[ \t]*;"))
4386 (set 'end-pos (point)) 4386 (setq end-pos (point))
4387 (set 'end-pos (point-max))) 4387 (setq end-pos (point-max)))
4388 (if (>= end-pos pos) 4388 (if (>= end-pos pos)
4389 (set 'found func-name)))) 4389 (setq found func-name))))
4390 ) 4390 )
4391 (setq ada-last-which-function-line line 4391 (setq ada-last-which-function-line line
4392 ada-last-which-function-subprog found) 4392 ada-last-which-function-subprog found)
@@ -4414,7 +4414,7 @@ If SPEC-NAME is nil, returns the body for the current package.
4414Returns nil if no body was found." 4414Returns nil if no body was found."
4415 (interactive) 4415 (interactive)
4416 4416
4417 (unless spec-name (set 'spec-name (buffer-file-name))) 4417 (unless spec-name (setq spec-name (buffer-file-name)))
4418 4418
4419 ;; If find-file.el was available, use its functions 4419 ;; If find-file.el was available, use its functions
4420 (if (functionp 'ff-get-file) 4420 (if (functionp 'ff-get-file)
@@ -4560,11 +4560,11 @@ for ada-procedure-start-regexp."
4560 (let (func-found procname functype) 4560 (let (func-found procname functype)
4561 (cond 4561 (cond
4562 ((or (looking-at "^[ \t]*procedure") 4562 ((or (looking-at "^[ \t]*procedure")
4563 (set 'func-found (looking-at "^[ \t]*function"))) 4563 (setq func-found (looking-at "^[ \t]*function")))
4564 ;; treat it as a proc/func 4564 ;; treat it as a proc/func
4565 (forward-word 2) 4565 (forward-word 2)
4566 (forward-word -1) 4566 (forward-word -1)
4567 (set 'procname (buffer-substring (point) (cdr match))) ; store proc name 4567 (setq procname (buffer-substring (point) (cdr match))) ; store proc name
4568 4568
4569 ;; goto end of procname 4569 ;; goto end of procname
4570 (goto-char (cdr match)) 4570 (goto-char (cdr match))
@@ -4578,7 +4578,7 @@ for ada-procedure-start-regexp."
4578 (progn 4578 (progn
4579 (forward-word 1) 4579 (forward-word 1)
4580 (skip-chars-forward " \t\n") 4580 (skip-chars-forward " \t\n")
4581 (set 'functype (buffer-substring (point) 4581 (setq functype (buffer-substring (point)
4582 (progn 4582 (progn
4583 (skip-chars-forward 4583 (skip-chars-forward
4584 "a-zA-Z0-9_\.") 4584 "a-zA-Z0-9_\.")
@@ -4633,19 +4633,19 @@ This function typically is to be hooked into `ff-file-created-hooks'."
4633 (ada-mode) 4633 (ada-mode)
4634 4634
4635 (let (found ada-procedure-or-package-start-regexp) 4635 (let (found ada-procedure-or-package-start-regexp)
4636 (if (set 'found 4636 (if (setq found
4637 (ada-search-ignore-string-comment ada-package-start-regexp nil)) 4637 (ada-search-ignore-string-comment ada-package-start-regexp nil))
4638 (progn (goto-char (cdr found)) 4638 (progn (goto-char (cdr found))
4639 (insert " body") 4639 (insert " body")
4640 ) 4640 )
4641 (error "No package")) 4641 (error "No package"))
4642 4642
4643 (set 'ada-procedure-or-package-start-regexp 4643 (setq ada-procedure-or-package-start-regexp
4644 (concat ada-procedure-start-regexp 4644 (concat ada-procedure-start-regexp
4645 "\\|" 4645 "\\|"
4646 ada-package-start-regexp)) 4646 ada-package-start-regexp))
4647 4647
4648 (while (set 'found 4648 (while (setq found
4649 (ada-search-ignore-string-comment 4649 (ada-search-ignore-string-comment
4650 ada-procedure-or-package-start-regexp nil)) 4650 ada-procedure-or-package-start-regexp nil))
4651 (progn 4651 (progn
@@ -4670,10 +4670,10 @@ This function typically is to be hooked into `ff-file-created-hooks'."
4670 (progn 4670 (progn
4671 (ada-search-ignore-string-comment ")" nil) 4671 (ada-search-ignore-string-comment ")" nil)
4672 (ada-search-ignore-string-comment ";" nil))) 4672 (ada-search-ignore-string-comment ";" nil)))
4673 (set 'spec (buffer-substring spec (point))) 4673 (setq spec (buffer-substring spec (point)))
4674 4674
4675 ;; If find-file.el was available, use its functions 4675 ;; If find-file.el was available, use its functions
4676 (set 'body-file (ada-get-body-name)) 4676 (setq body-file (ada-get-body-name))
4677 (if body-file 4677 (if body-file
4678 (find-file body-file) 4678 (find-file body-file)
4679 (error "No body found for the package. Create it first.")) 4679 (error "No body found for the package. Create it first."))