aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaroly Lorentey2006-12-03 12:36:08 +0000
committerKaroly Lorentey2006-12-03 12:36:08 +0000
commitd0104e754a241cf83811fef30195d41201de533c (patch)
tree6a5a31760801bd70649d0f9b132f61c46fac8445
parent19739b34866e6a4789d842961470123b50158612 (diff)
parentab785936c82ac81edb8b20ac27c0558bc04797e5 (diff)
downloademacs-d0104e754a241cf83811fef30195d41201de533c.tar.gz
emacs-d0104e754a241cf83811fef30195d41201de533c.zip
Merged from emacs@sv.gnu.org.
Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-486 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-487 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-488 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-489 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/gnus--rel--5.10--patch-156 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-157 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-158 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-159 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-160 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-587
Diffstat
-rw-r--r--AUTHORS2
-rw-r--r--ChangeLog27
-rw-r--r--admin/ChangeLog5
-rwxr-xr-xadmin/make-announcement3
-rwxr-xr-xconfigure1
-rw-r--r--configure.in1
-rw-r--r--etc/NEWS4
-rw-r--r--lisp/ChangeLog31
-rw-r--r--lisp/calendar/cal-html.el445
-rw-r--r--lisp/calendar/calendar.el14
-rw-r--r--lisp/emacs-lisp/authors.el1
-rw-r--r--lisp/gnus/ChangeLog28
-rw-r--r--lisp/gnus/gnus-agent.el12
-rw-r--r--lisp/gnus/gnus-sum.el11
-rw-r--r--lisp/gnus/mm-util.el141
-rw-r--r--lisp/gnus/mm-view.el2
-rw-r--r--lisp/net/tramp.el21
-rw-r--r--lisp/progmodes/ada-mode.el2842
-rw-r--r--lisp/url/ChangeLog9
-rw-r--r--lisp/url/url-gw.el2
-rw-r--r--lisp/url/url-http.el4
-rw-r--r--lispintro/ChangeLog7
-rw-r--r--lispintro/Makefile.in4
-rw-r--r--lispintro/makefile.w32-in4
-rw-r--r--lispref/ChangeLog7
-rw-r--r--lispref/Makefile.in4
-rw-r--r--lispref/makefile.w32-in4
-rwxr-xr-xmake-dist6
-rw-r--r--man/ChangeLog9
-rw-r--r--man/ack.texi3
-rw-r--r--man/calendar.texi48
-rw-r--r--man/emacs.texi2
-rw-r--r--nt/ChangeLog9
-rw-r--r--nt/runemacs.c26
-rw-r--r--src/ChangeLog17
-rw-r--r--src/m/amdx86-64.h9
-rw-r--r--src/ralloc.c2
-rw-r--r--src/window.c2
38 files changed, 2264 insertions, 1505 deletions
diff --git a/AUTHORS b/AUTHORS
index 845cf9633a9..29bae408e00 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -152,6 +152,8 @@ Andy Norman: wrote ange-ftp.el
152 152
153Andy Petrusenco: changed w32term.c 153Andy Petrusenco: changed w32term.c
154 154
155Anna M. Bigatti: wrote cal-html.el
156
155Ari Roponen: changed atimer.c startup.el 157Ari Roponen: changed atimer.c startup.el
156 158
157Arisawa Akihiro: changed mm-decode.el mm-view.el ps-print.el time.el 159Arisawa Akihiro: changed mm-decode.el mm-view.el ps-print.el time.el
diff --git a/ChangeLog b/ChangeLog
index b777b1e820c..34c6743ae4e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
12006-10-29 Chong Yidong <cyd@stupidchicken.com>
2
3 * configure: Regenerate using autoconf 2.59.
4
52006-10-29 Jeramey Crawford <jeramey@jeramey.com>
6
7 * configure.in: Enable x86-64 OpenBSD compilation.
8
92006-10-28 Glenn Morris <rgm@gnu.org>
10
11 * AUTHORS: Add cal-html.el author.
12
132006-10-28 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
14
15 * make-dist: Make links to mac/make-package and
16 mac/Emacs.app/Contents/Resources/Emacs.icns.
17
12006-10-27 Chong Yidong <cyd@stupidchicken.com> 182006-10-27 Chong Yidong <cyd@stupidchicken.com>
2 19
3 * README: Bump version number to 22.0.90. 20 * README: Bump version number to 22.0.90.
@@ -7,15 +24,15 @@
7 * configure: Regenerate. 24 * configure: Regenerate.
8 25
92006-10-23 Michael Kifer <kifer@cs.stonybrook.edu> 262006-10-23 Michael Kifer <kifer@cs.stonybrook.edu>
10 27
11 * viper-cmd.el (viper-prefix-arg-com): define gg as G0 28 * viper-cmd.el (viper-prefix-arg-com): define gg as G0
12 29
13 * viper-ex.el (ex-read): quote file argument. 30 * viper-ex.el (ex-read): quote file argument.
14 31
15 * ediff-diff.el (ediff-same-file-contents): expand file names. 32 * ediff-diff.el (ediff-same-file-contents): expand file names.
16 33
17 * ediff-mult.el (ediff-append-custom-diff): quote shell file arguments. 34 * ediff-mult.el (ediff-append-custom-diff): quote shell file arguments.
18 35
192006-10-23 Andreas Schwab <schwab@suse.de> 362006-10-23 Andreas Schwab <schwab@suse.de>
20 37
21 * configure.in: Make sure x_default_search_path is always set even 38 * configure.in: Make sure x_default_search_path is always set even
diff --git a/admin/ChangeLog b/admin/ChangeLog
index ea3016b07ee..f31e58bab9c 100644
--- a/admin/ChangeLog
+++ b/admin/ChangeLog
@@ -1,3 +1,8 @@
12006-10-28 Chong Yidong <cyd@stupidchicken.com>
2
3 * make-announcement (OLD): Remove LEIM references in announcement
4 since it is now built-in.
5
12006-10-15 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> 62006-10-15 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
2 7
3 * admin.el (set-version): Set version numbers in "mac" subdirectory. 8 * admin.el (set-version): Set version numbers in "mac" subdirectory.
diff --git a/admin/make-announcement b/admin/make-announcement
index dd55efe360b..992808a514d 100755
--- a/admin/make-announcement
+++ b/admin/make-announcement
@@ -34,18 +34,15 @@ cat <<EOF
34There is a new pretest available in 34There is a new pretest available in
35 35
36 <ftp://alpha.gnu.org/gnu/emacs/pretest/emacs-$NEW.tar.gz> 36 <ftp://alpha.gnu.org/gnu/emacs/pretest/emacs-$NEW.tar.gz>
37 <ftp://alpha.gnu.org/gnu/emacs/pretest/leim-$NEW.tar.gz>
38 37
39Please report results from compiling and running the pretest to 38Please report results from compiling and running the pretest to
40<emacs-pretest-bug@gnu.org>. Your feedback is necessary for us 39<emacs-pretest-bug@gnu.org>. Your feedback is necessary for us
41to know on which platforms the pretest has been tried. 40to know on which platforms the pretest has been tried.
42Please say whether you built with LEIM or not.
43 41
44If you have the tars from the previous pretest, and you have the 42If you have the tars from the previous pretest, and you have the
45\`xdelta' utility, you can instead download the much smaller 43\`xdelta' utility, you can instead download the much smaller
46 44
47 <ftp://alpha.gnu.org/gnu/emacs/pretest/emacs-$OLD-$NEW.xdelta> 45 <ftp://alpha.gnu.org/gnu/emacs/pretest/emacs-$OLD-$NEW.xdelta>
48 <ftp://alpha.gnu.org/gnu/emacs/pretest/leim-$OLD-$NEW.xdelta>
49 46
50You can use a command like 47You can use a command like
51 48
diff --git a/configure b/configure
index f8089fc2b23..a070b7c90d1 100755
--- a/configure
+++ b/configure
@@ -2238,6 +2238,7 @@ _ACEOF
2238 case "${canonical}" in 2238 case "${canonical}" in
2239 alpha*-*-openbsd*) machine=alpha ;; 2239 alpha*-*-openbsd*) machine=alpha ;;
2240 i386-*-openbsd*) machine=intel386 ;; 2240 i386-*-openbsd*) machine=intel386 ;;
2241 x86_64-*-openbsd*) machine=amdx86-64 ;;
2241 m68k-*-openbsd*) machine=hp9000s300 ;; 2242 m68k-*-openbsd*) machine=hp9000s300 ;;
2242 mipsel-*-openbsd*) machine=pmax ;; 2243 mipsel-*-openbsd*) machine=pmax ;;
2243 ns32k-*-openbsd*) machine=ns32000 ;; 2244 ns32k-*-openbsd*) machine=ns32000 ;;
diff --git a/configure.in b/configure.in
index 58f396466b0..01e5cedb40c 100644
--- a/configure.in
+++ b/configure.in
@@ -275,6 +275,7 @@ dnl see the `changequote' comment above.
275 case "${canonical}" in 275 case "${canonical}" in
276 alpha*-*-openbsd*) machine=alpha ;; 276 alpha*-*-openbsd*) machine=alpha ;;
277 i386-*-openbsd*) machine=intel386 ;; 277 i386-*-openbsd*) machine=intel386 ;;
278 x86_64-*-openbsd*) machine=amdx86-64 ;;
278 m68k-*-openbsd*) machine=hp9000s300 ;; 279 m68k-*-openbsd*) machine=hp9000s300 ;;
279 mipsel-*-openbsd*) machine=pmax ;; 280 mipsel-*-openbsd*) machine=pmax ;;
280 ns32k-*-openbsd*) machine=ns32000 ;; 281 ns32k-*-openbsd*) machine=ns32000 ;;
diff --git a/etc/NEWS b/etc/NEWS
index 0b747d90594..94458c1aa30 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3293,6 +3293,10 @@ the calendar left or right. (The old key bindings still work too.)
3293convert Emacs diary entries to/from the iCalendar format. 3293convert Emacs diary entries to/from the iCalendar format.
3294 3294
3295+++ 3295+++
3296*** The new package cal-html.el writes HTML files with calendar and
3297diary entries.
3298
3299+++
3296*** Diary sexp entries can have custom marking in the calendar. 3300*** Diary sexp entries can have custom marking in the calendar.
3297Diary sexp functions which only apply to certain days (such as 3301Diary sexp functions which only apply to certain days (such as
3298`diary-block' or `diary-cyclic') now take an optional parameter MARK, 3302`diary-block' or `diary-cyclic') now take an optional parameter MARK,
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 896fec114bb..0ae22128fe1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,34 @@
12006-10-29 Stephen Leake <stephen_leake@stephe_leake.org>
2
3 * progmodes/ada-mode.el: Change maintainer, apply
4 whitespace-clean, checkdoc. Minor improvements to many doc
5 strings.
6 (ada-mode-version): New function.
7 (ada-create-menu): Menu operations are available for all supported
8 compilers.
9
102006-10-29 Lars Hansen <larsh@soem.dk>
11 * net/tramp.el (with-parsed-tramp-file-name): Correct debug
12 spec. Highlight as keyword.
13 (tramp-do-copy-or-rename-file): Correct data for 'file-already-exists.
14 Don't call tramp-method-out-of-band-p for local files.
15 (tramp-touch): Quote file name.
16
172006-10-28 Glenn Morris <rgm@gnu.org>
18
19 * calendar/calendar.el (cal-html-cursor-month)
20 (cal-html-cursor-year): Add autoloads for this new package.
21 (calendar-mode-map): Bind cal-html-cursor-month,
22 cal-html-cursor-year.
23
242006-10-28 Anna Bigatti <bigatti@dima.unige.it>
25
26 * calendar/cal-html.el: New file.
27
282006-10-28 Chong Yidong <cyd@stupidchicken.com>
29
30 * emacs-lisp/authors.el (authors-aliases): Update.
31
12006-10-27 Chong Yidong <cyd@stupidchicken.com> 322006-10-27 Chong Yidong <cyd@stupidchicken.com>
2 33
3 * version.el (emacs-version): Bump version number to 22.0.90. 34 * version.el (emacs-version): Bump version number to 22.0.90.
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
new file mode 100644
index 00000000000..f5d08d18c17
--- /dev/null
+++ b/lisp/calendar/cal-html.el
@@ -0,0 +1,445 @@
1;;; cal-html.el --- functions for printing HTML calendars
2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
4
5;; Author: Anna M. Bigatti <bigatti@dima.unige.it>
6;; Keywords: calendar
7;; Human-Keywords: calendar, diary, HTML
8;; Created: 23 Aug 2002
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
26
27;;; Commentary:
28
29;; This package writes HTML calendar files using the user's diary
30;; file. See the Emacs manual for details.
31
32
33;;; Code:
34
35(require 'calendar)
36
37
38(defgroup calendar-html nil
39 "Options for HTML calendars."
40 :prefix "cal-html-"
41 :group 'calendar)
42
43(defcustom cal-html-directory "~/public_html"
44 "Directory for HTML pages generated by cal-html."
45 :type 'string
46 :group 'calendar-html)
47
48(defcustom cal-html-print-day-number-flag nil
49 "Non-nil means print the day-of-the-year number in the monthly cal-html page."
50 :type 'boolean
51 :group 'calendar-html)
52
53(defcustom cal-html-year-index-cols 3
54 "Number of columns in the cal-html yearly index page."
55 :type 'integer
56 :group 'calendar-html)
57
58(defcustom cal-html-day-abbrev-array
59 (calendar-abbrev-construct calendar-day-abbrev-array
60 calendar-day-name-array)
61 "Array of seven strings for abbreviated day names (starting with Sunday)."
62 :type '(vector string string string string string string string)
63 :group 'calendar-html)
64
65(defcustom cal-html-css-default
66 (concat
67 "<STYLE TYPE=\"text/css\">\n"
68 " BODY { background: #bde; }\n"
69 " H1 { text-align: center; }\n"
70 " TABLE { padding: 2pt; }\n"
71 " TH { background: #dee; }\n"
72 " TABLE.year { width: 100%; }\n"
73 " TABLE.agenda { width: 100%; }\n"
74 " TABLE.header { width: 100%; text-align: center; }\n"
75 " TABLE.minical TD { background: white; text-align: center; }\n"
76 " TABLE.agenda TD { background: white; text-align: left; }\n"
77 " TABLE.agenda TH { text-align: left; width: 20%; }\n"
78 " SPAN.NO-YEAR { color: #0b3; font-weight: bold; }\n"
79 " SPAN.ANN { color: #0bb; font-weight: bold; }\n"
80 " SPAN.BLOCK { color: #048; font-style: italic; }\n"
81 "</STYLE>\n\n")
82 "Default cal-html css style. You can override this with a \"cal.css\" file."
83 :type 'string
84 :group 'calendar-html)
85
86;;; End customizable variables.
87
88
89;;; HTML and CSS code constants.
90
91(defconst cal-html-e-document-string "<BR><BR>\n</BODY>\n</HTML>"
92 "HTML code for end of page.")
93
94(defconst cal-html-b-tablerow-string "<TR>\n"
95 "HTML code for beginning of table row.")
96
97(defconst cal-html-e-tablerow-string "</TR>\n"
98 "HTML code for end of table row.")
99
100(defconst cal-html-b-tabledata-string " <TD>"
101 "HTML code for beginning of table data.")
102
103(defconst cal-html-e-tabledata-string " </TD>\n"
104 "HTML code for end of table data.")
105
106(defconst cal-html-b-tableheader-string " <TH>"
107 "HTML code for beginning of table header.")
108
109(defconst cal-html-e-tableheader-string " </TH>\n"
110 "HTML code for end of table header.")
111
112(defconst cal-html-e-table-string
113 "</TABLE>\n<!-- ================================================== -->\n"
114 "HTML code for end of table.")
115
116(defconst cal-html-minical-day-format " <TD><a href=%s#%d>%d</TD>\n"
117 "HTML code for a day in the minical - links NUM to month-page#NUM.")
118
119(defconst cal-html-b-document-string
120 (concat
121 "<HTML>\n"
122 "<HEAD>\n"
123 "<TITLE>Calendar</TITLE>\n"
124 "<!--This buffer was produced by cal-html.el-->\n\n"
125 cal-html-css-default
126 "<LINK REL=\"stylesheet\" TYPE=\"text/css\" HREF=\"cal.css\">\n"
127 "</HEAD>\n\n"
128 "<BODY>\n\n")
129 "Initial block for html page.")
130
131(defconst cal-html-html-subst-list
132 '(("&" . "&amp;")
133 ("\n" . "<BR>\n"))
134 "Alist of symbols and their HTML replacements.")
135
136
137
138(defun cal-html-comment (string)
139 "Return STRING as html comment."
140 (format "<!-- ====== %s ====== -->\n"
141 (replace-regexp-in-string "--" "++" string)))
142
143(defun cal-html-href (link string)
144 "Return a hyperlink to url LINK with text STRING."
145 (format "<A HREF=\"%s\">%s</A>" link string))
146
147(defun cal-html-h3 (string)
148 "Return STRING as html header h3."
149 (format "\n <H3>%s</H3>\n" string))
150
151(defun cal-html-h1 (string)
152 "Return STRING as html header h1."
153 (format "\n <H1>%s</H1>\n" string))
154
155(defun cal-html-th (string)
156 "Return STRING as html table header."
157 (format "%s%s%s" cal-html-b-tableheader-string string
158 cal-html-e-tableheader-string))
159
160(defun cal-html-b-table (arg)
161 "Return table tag with attribute ARG."
162 (format "\n<TABLE %s>\n" arg))
163
164(defun cal-html-monthpage-name (month year)
165 "Return name of html page for numeric MONTH and four-digit YEAR.
166For example, \"2006-08.html\" for 8 2006."
167 (format "%d-%.2d.html" year month))
168
169
170(defun cal-html-insert-link-monthpage (month year &optional change-dir)
171 "Insert a link to the html page for numeric MONTH and four-digit YEAR.
172If optional argument CHANGE-DIR is non-nil and MONTH is 1 or 2,
173the link points to a different year and so has a directory part."
174 (insert (cal-html-h3
175 (cal-html-href
176 (concat (and change-dir
177 (member month '(1 12))
178 (format "../%d/" year))
179 (cal-html-monthpage-name month year))
180 (calendar-month-name month)))))
181
182
183(defun cal-html-insert-link-yearpage (month year)
184 "Insert a link to index page for four-digit YEAR, tagged using MONTH name."
185 (insert (cal-html-h1
186 (format "%s %s"
187 (calendar-month-name month)
188 (cal-html-href "index.html" (number-to-string year))))))
189
190
191(defun cal-html-year-dir-ask-user (year)
192 "Prompt for the html calendar output directory for four-digit YEAR.
193Return the expanded directory name, which is based on
194`cal-html-directory' by default."
195 (expand-file-name (read-directory-name
196 "Enter HTML calendar directory name: "
197 (expand-file-name (format "%d" year)
198 cal-html-directory))))
199
200;;------------------------------------------------------------
201;; page header
202;;------------------------------------------------------------
203(defun cal-html-insert-month-header (month year)
204 "Insert the header for the numeric MONTH page for four-digit YEAR.
205Contains links to previous and next month and year, and current minical."
206 (insert (cal-html-b-table "class=header"))
207 (insert cal-html-b-tablerow-string)
208 (insert cal-html-b-tabledata-string) ; month links
209 (increment-calendar-month month year -1) ; previous month
210 (cal-html-insert-link-monthpage month year t) ; t --> change-dir
211 (increment-calendar-month month year 1) ; current month
212 (cal-html-insert-link-yearpage month year)
213 (increment-calendar-month month year 1) ; next month
214 (cal-html-insert-link-monthpage month year t) ; t --> change-dir
215 (insert cal-html-e-tabledata-string)
216 (insert cal-html-b-tabledata-string) ; minical
217 (increment-calendar-month month year -1)
218 (cal-html-insert-minical month year)
219 (insert cal-html-e-tabledata-string)
220 (insert cal-html-e-tablerow-string) ; end
221 (insert cal-html-e-table-string))
222
223;;------------------------------------------------------------
224;; minical: a small month calendar with links
225;;------------------------------------------------------------
226(defun cal-html-insert-minical (month year)
227 "Insert a minical for numeric MONTH of YEAR."
228 (let* ((blank-days ; at start of month
229 (mod (- (calendar-day-of-week (list month 1 year))
230 calendar-week-start-day)
231 7))
232 (last (calendar-last-day-of-month month year))
233 (end-blank-days ; at end of month
234 (mod (- 6 (- (calendar-day-of-week (list month last year))
235 calendar-week-start-day))
236 7))
237 (monthpage-name (cal-html-monthpage-name month year))
238 date)
239 ;; Start writing table.
240 (insert (cal-html-comment "MINICAL")
241 (cal-html-b-table "class=minical border=1 align=center"))
242 ;; Weekdays row.
243 (insert cal-html-b-tablerow-string)
244 (dotimes (i 7)
245 (insert (cal-html-th
246 (aref cal-html-day-abbrev-array
247 (mod (+ i calendar-week-start-day) 7)))))
248 (insert cal-html-e-tablerow-string)
249 ;; Initial empty slots.
250 (insert cal-html-b-tablerow-string)
251 (dotimes (i blank-days)
252 (insert
253 cal-html-b-tabledata-string
254 cal-html-e-tabledata-string))
255 ;; Numbers.
256 (dotimes (i last)
257 (insert (format cal-html-minical-day-format monthpage-name i (1+ i)))
258 ;; New row?
259 (if (and (zerop (mod (+ i 1 blank-days) 7))
260 (/= (1+ i) last))
261 (insert cal-html-e-tablerow-string
262 cal-html-b-tablerow-string)))
263 ;; End empty slots (for some browsers like konqueror).
264 (dotimes (i end-blank-days)
265 (insert
266 cal-html-b-tabledata-string
267 cal-html-e-tabledata-string)))
268 (insert cal-html-e-tablerow-string
269 cal-html-e-table-string
270 (cal-html-comment "MINICAL end")))
271
272
273;;------------------------------------------------------------
274;; year index page with minicals
275;;------------------------------------------------------------
276(defun cal-html-insert-year-minicals (year cols)
277 "Make a one page yearly mini-calendar for four-digit YEAR.
278There are 12/cols rows of COLS months each."
279 (insert cal-html-b-document-string)
280 (insert (cal-html-h1 (number-to-string year)))
281 (insert (cal-html-b-table "class=year")
282 cal-html-b-tablerow-string)
283 (dotimes (i 12)
284 (insert cal-html-b-tabledata-string)
285 (cal-html-insert-link-monthpage (1+ i) year)
286 (cal-html-insert-minical (1+ i) year)
287 (insert cal-html-e-tabledata-string)
288 (if (zerop (mod (1+ i) cols))
289 (insert cal-html-e-tablerow-string
290 cal-html-b-tablerow-string)))
291 (insert cal-html-e-tablerow-string
292 cal-html-e-table-string
293 cal-html-e-document-string))
294
295
296;;------------------------------------------------------------
297;; HTMLify
298;;------------------------------------------------------------
299
300(defun cal-html-htmlify-string (string)
301 "Protect special characters in STRING from HTML.
302Characters are replaced according to `cal-html-html-subst-list'."
303 (if (stringp string)
304 (replace-regexp-in-string
305 (regexp-opt (mapcar 'car cal-html-html-subst-list))
306 (lambda (x)
307 (cdr (assoc x cal-html-html-subst-list)))
308 string)
309 ""))
310
311
312(defun cal-html-htmlify-entry (entry)
313 "Convert a diary entry ENTRY to html with the appropriate class specifier."
314 (let ((start
315 (cond
316 ((string-match "block" (car (cddr entry))) "BLOCK")
317 ((string-match "anniversary" (car (cddr entry))) "ANN")
318 ((not (string-match
319 (number-to-string (car (cddr (car entry))))
320 (car (cddr entry))))
321 "NO-YEAR")
322 (t "NORMAL"))))
323 (format "<span class=%s>%s</span>" start
324 (cal-html-htmlify-string (cadr entry)))))
325
326
327(defun cal-html-htmlify-list (date-list date)
328 "Return a string of concatenated, HTMLified diary entries.
329DATE-LIST is a list of diary entries. Return only those matching DATE."
330 (mapconcat (lambda (x) (cal-html-htmlify-entry x))
331 (let (result)
332 (dolist (p date-list (reverse result))
333 (and (car p)
334 (calendar-date-equal date (car p))
335 (setq result (cons p result)))))
336 "<BR>\n "))
337
338
339;;------------------------------------------------------------
340;; Monthly calendar
341;;------------------------------------------------------------
342
343(autoload 'diary-list-entries "diary-lib" nil t)
344
345(defun cal-html-list-diary-entries (d1 d2)
346 "Generate a list of all diary-entries from absolute date D1 to D2."
347 (let (diary-display-hook)
348 (diary-list-entries
349 (calendar-gregorian-from-absolute d1)
350 (1+ (- d2 d1)))))
351
352
353(defun cal-html-insert-agenda-days (month year diary-list)
354 "Insert HTML commands for a range of days in monthly calendars.
355HTML commands are inserted for the days of the numeric MONTH in
356four-digit YEAR. Diary entries in DIARY-LIST are included."
357 (let ((blank-days ; at start of month
358 (mod (- (calendar-day-of-week (list month 1 year))
359 calendar-week-start-day)
360 7))
361 (last (calendar-last-day-of-month month year))
362 date)
363 (insert "<a name=0>\n")
364 (insert (cal-html-b-table "class=agenda border=1"))
365 (dotimes (i last)
366 (setq date (list month (1+ i) year))
367 (insert
368 (format "<a name=%d></a>\n" (1+ i)) ; link
369 cal-html-b-tablerow-string
370 ;; Number & day name.
371 cal-html-b-tableheader-string
372 (if cal-html-print-day-number-flag
373 (format "<em>%d</em>&nbsp;&nbsp;"
374 (calendar-day-number date))
375 "")
376 (format "%d&nbsp;%s" (1+ i)
377 (aref calendar-day-name-array
378 (calendar-day-of-week date)))
379 cal-html-e-tableheader-string
380 ;; Diary entries.
381 cal-html-b-tabledata-string
382 (cal-html-htmlify-list diary-list date)
383 cal-html-e-tabledata-string
384 cal-html-e-tablerow-string)
385 ;; If end of week and not end of month, make new table.
386 (if (and (zerop (mod (+ i 1 blank-days) 7))
387 (/= (1+ i) last))
388 (insert cal-html-e-table-string
389 (cal-html-b-table
390 "class=agenda border=1")))))
391 (insert cal-html-e-table-string))
392
393
394(defun cal-html-one-month (month year dir)
395 "Write an HTML calendar file for numeric MONTH of YEAR in directory DIR."
396 (let ((diary-list (cal-html-list-diary-entries
397 (calendar-absolute-from-gregorian (list month 1 year))
398 (calendar-absolute-from-gregorian
399 (list month
400 (calendar-last-day-of-month month year)
401 year)))))
402 (with-temp-buffer
403 (insert cal-html-b-document-string)
404 (cal-html-insert-month-header month year)
405 (cal-html-insert-agenda-days month year diary-list)
406 (insert cal-html-e-document-string)
407 (write-file (expand-file-name
408 (cal-html-monthpage-name month year) dir)))))
409
410
411;;; User commands.
412
413(defun cal-html-cursor-month (month year dir)
414 "Write an HTML calendar file for numeric MONTH of four-digit YEAR.
415The output directory DIR is created if necessary. Interactively,
416MONTH and YEAR are taken from the calendar cursor position. Note
417that any existing output files are overwritten."
418 (interactive (let* ((date (calendar-cursor-to-date t))
419 (month (extract-calendar-month date))
420 (year (extract-calendar-year date)))
421 (list month year (cal-html-year-dir-ask-user year))))
422 (make-directory dir t)
423 (cal-html-one-month month year dir))
424
425(defun cal-html-cursor-year (year dir)
426 "Write HTML calendar files (index and monthly pages) for four-digit YEAR.
427The output directory DIR is created if necessary. Interactively,
428YEAR is taken from the calendar cursor position. Note that any
429existing output files are overwritten."
430 (interactive (let ((year (extract-calendar-year
431 (calendar-cursor-to-date t))))
432 (list year (cal-html-year-dir-ask-user year))))
433 (make-directory dir t)
434 (with-temp-buffer
435 (cal-html-insert-year-minicals year cal-html-year-index-cols)
436 (write-file (expand-file-name "index.html" dir)))
437 (dotimes (i 12)
438 (cal-html-one-month (1+ i) year dir)))
439
440
441(provide 'cal-html)
442
443
444;; arch-tag: 4e73377d-d2c1-46ea-a103-02c111da5f57
445;;; cal-html.el ends here
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 6fc18d05837..c5e7f85f51b 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -2012,6 +2012,18 @@ Optional prefix argument specifies number of years." t)
2012 "Make a buffer with LaTeX commands for a year's calendar (Filofax). 2012 "Make a buffer with LaTeX commands for a year's calendar (Filofax).
2013Optional prefix argument specifies number of years." t) 2013Optional prefix argument specifies number of years." t)
2014 2014
2015(autoload 'cal-html-cursor-month "cal-html"
2016 "Write an HTML calendar file for numeric MONTH of four-digit YEAR.
2017The output directory DIR is created if necessary. Interactively,
2018MONTH and YEAR are taken from the calendar cursor position. Note
2019that any existing output files are overwritten." t)
2020
2021(autoload 'cal-html-cursor-year "cal-html"
2022 "Write HTML calendar files (index and monthly pages) for four-digit YEAR.
2023The output directory DIR is created if necessary. Interactively,
2024YEAR is taken from the calendar cursor position. Note that any
2025existing output files are overwritten." t)
2026
2015(autoload 'mark-calendar-holidays "holidays" 2027(autoload 'mark-calendar-holidays "holidays"
2016 "Mark notable days in the calendar window." 2028 "Mark notable days in the calendar window."
2017 t) 2029 t)
@@ -2288,6 +2300,8 @@ movement commands will not work correctly."
2288 (define-key map "iBm" 'insert-monthly-bahai-diary-entry) 2300 (define-key map "iBm" 'insert-monthly-bahai-diary-entry)
2289 (define-key map "iBy" 'insert-yearly-bahai-diary-entry) 2301 (define-key map "iBy" 'insert-yearly-bahai-diary-entry)
2290 (define-key map "?" 'calendar-goto-info-node) 2302 (define-key map "?" 'calendar-goto-info-node)
2303 (define-key map "Hm" 'cal-html-cursor-month)
2304 (define-key map "Hy" 'cal-html-cursor-year)
2291 (define-key map "tm" 'cal-tex-cursor-month) 2305 (define-key map "tm" 'cal-tex-cursor-month)
2292 (define-key map "tM" 'cal-tex-cursor-month-landscape) 2306 (define-key map "tM" 'cal-tex-cursor-month-landscape)
2293 (define-key map "td" 'cal-tex-cursor-day) 2307 (define-key map "td" 'cal-tex-cursor-day)
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index d1710dba7a4..db8c3d5d21a 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -105,6 +105,7 @@ files.")
105 ("Matt Swift" "Matthew Swift") 105 ("Matt Swift" "Matthew Swift")
106 ("Michael R. Mauger" "Michael Mauger") 106 ("Michael R. Mauger" "Michael Mauger")
107 ("Michael D. Ernst" "Michael Ernst") 107 ("Michael D. Ernst" "Michael Ernst")
108 ("Micha,Ak(Bl Cadilhac" "Michael Cadilhac")
108 ("Michael I. Bushnell" "Michael I Bushnell" "Michael I. Bushnell, P/Bsg") 109 ("Michael I. Bushnell" "Michael I Bushnell" "Michael I. Bushnell, P/Bsg")
109 ("Mikio Nakajima" "Nakajima Mikio") 110 ("Mikio Nakajima" "Nakajima Mikio")
110 ("Paul Eggert" "eggert") 111 ("Paul Eggert" "eggert")
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 766a92c1dbd..fd9de602fb0 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,30 @@
12006-10-29 Reiner Steib <Reiner.Steib@gmx.de>
2
3 * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): New
4 variables.
5 (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions.
6 (mm-charset-synonym-alist): Move some entries to
7 mm-codepage-iso-8859-list.
8 (mm-charset-synonym-alist, mm-charset-override-alist): Add
9 iso-8859-8/windows-1255 and iso-8859-9/windows-1254.
10
112006-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
12
13 * gnus-sum.el (gnus-set-mode-line): Quote % in group name.
14
152006-10-28 Reiner Steib <Reiner.Steib@gmx.de>
16
17 * gnus-agent.el (gnus-agent-make-mode-line-string): Make it compatible
18 with Emacs 21 and XEmacs.
19
202006-10-26 Reiner Steib <Reiner.Steib@gmx.de>
21
22 * mm-view.el: Add interactive arg to html2text autoload.
23
242006-10-25 Katsumi Yamaoka <yamaoka@jpl.org>
25
26 * gnus-sum.el (gnus-summary-move-article): Use no-encode for `B B'.
27
12006-10-20 Katsumi Yamaoka <yamaoka@jpl.org> 282006-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
2 29
3 * gnus-group.el (gnus-group-make-doc-group): Work for non-ASCII group 30 * gnus-group.el (gnus-group-make-doc-group): Work for non-ASCII group
@@ -12,6 +39,7 @@
122006-10-19 Reiner Steib <Reiner.Steib@gmx.de> 392006-10-19 Reiner Steib <Reiner.Steib@gmx.de>
13 40
14 * gnus.el (gnus-mime): Remove unused custom group. 41 * gnus.el (gnus-mime): Remove unused custom group.
42 (gnus-getenv-nntpserver, gnus-select-method): Autoload.
15 43
162006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 442006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
17 45
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index f4e9f2e3dc9..733b7533cc1 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -577,7 +577,17 @@ manipulated as follows:
577 (fboundp 'make-mode-line-mouse-map)) 577 (fboundp 'make-mode-line-mouse-map))
578 (propertize string 'local-map 578 (propertize string 'local-map
579 (make-mode-line-mouse-map mouse-button mouse-func) 579 (make-mode-line-mouse-map mouse-button mouse-func)
580 'mouse-face 'mode-line-highlight) 580 'mouse-face
581 (cond ((and (featurep 'xemacs)
582 ;; XEmacs' `facep' only checks for a face
583 ;; object, not for a face name, so it's useless
584 ;; to check with `facep'.
585 (find-face 'modeline))
586 'modeline)
587 ((facep 'mode-line-highlight) ;; Emacs 22
588 'mode-line-highlight)
589 ((facep 'mode-line) ;; Emacs 21
590 'mode-line)) )
581 string)) 591 string))
582 592
583(defun gnus-agent-toggle-plugged (set-to) 593(defun gnus-agent-toggle-plugged (set-to)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index fb0ef25c916..7d0b7203654 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5711,8 +5711,9 @@ If WHERE is `summary', the summary mode line format will be used."
5711 (let* ((mformat (symbol-value 5711 (let* ((mformat (symbol-value
5712 (intern 5712 (intern
5713 (format "gnus-%s-mode-line-format-spec" where)))) 5713 (format "gnus-%s-mode-line-format-spec" where))))
5714 (gnus-tmp-group-name (gnus-group-decoded-name 5714 (gnus-tmp-group-name (gnus-mode-string-quote
5715 gnus-newsgroup-name)) 5715 (gnus-group-decoded-name
5716 gnus-newsgroup-name)))
5716 (gnus-tmp-article-number (or gnus-current-article 0)) 5717 (gnus-tmp-article-number (or gnus-current-article 0))
5717 (gnus-tmp-unread gnus-newsgroup-unreads) 5718 (gnus-tmp-unread gnus-newsgroup-unreads)
5718 (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) 5719 (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
@@ -9153,7 +9154,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9153 (gnus-request-article-this-buffer article gnus-newsgroup-name) 9154 (gnus-request-article-this-buffer article gnus-newsgroup-name)
9154 (when (consp (setq art-group 9155 (when (consp (setq art-group
9155 (gnus-request-accept-article 9156 (gnus-request-accept-article
9156 to-newsgroup select-method (not articles)))) 9157 to-newsgroup select-method (not articles) t)))
9157 (setq new-xref (concat new-xref " " (car art-group) 9158 (setq new-xref (concat new-xref " " (car art-group)
9158 ":" 9159 ":"
9159 (number-to-string (cdr art-group)))) 9160 (number-to-string (cdr art-group))))
@@ -9161,7 +9162,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9161 ;; it and replace the new article. 9162 ;; it and replace the new article.
9162 (nnheader-replace-header "Xref" new-xref) 9163 (nnheader-replace-header "Xref" new-xref)
9163 (gnus-request-replace-article 9164 (gnus-request-replace-article
9164 (cdr art-group) to-newsgroup (current-buffer)) 9165 (cdr art-group) to-newsgroup (current-buffer) t)
9165 art-group)))))) 9166 art-group))))))
9166 (cond 9167 (cond
9167 ((not art-group) 9168 ((not art-group)
@@ -9259,7 +9260,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9259 (gnus-request-article-this-buffer article gnus-newsgroup-name) 9260 (gnus-request-article-this-buffer article gnus-newsgroup-name)
9260 (nnheader-replace-header "Xref" new-xref) 9261 (nnheader-replace-header "Xref" new-xref)
9261 (gnus-request-replace-article 9262 (gnus-request-replace-article
9262 article gnus-newsgroup-name (current-buffer)))) 9263 article gnus-newsgroup-name (current-buffer) t)))
9263 9264
9264 ;; run the move/copy/crosspost/respool hook 9265 ;; run the move/copy/crosspost/respool hook
9265 (run-hook-with-args 'gnus-summary-article-move-hook 9266 (run-hook-with-args 'gnus-summary-article-move-hook
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index e75f2ef6d5f..05c37a54e74 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -205,39 +205,140 @@ the alias. Else windows-NUMBER is used."
205 ;; Not in XEmacs, but it's not a proper MIME charset anyhow. 205 ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
206 ,@(unless (mm-coding-system-p 'x-ctext) 206 ,@(unless (mm-coding-system-p 'x-ctext)
207 '((x-ctext . ctext))) 207 '((x-ctext . ctext)))
208 ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_! 208 ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_ in 8
209 ;; positions!
209 ,@(unless (mm-coding-system-p 'iso-8859-15) 210 ,@(unless (mm-coding-system-p 'iso-8859-15)
210 '((iso-8859-15 . iso-8859-1))) 211 '((iso-8859-15 . iso-8859-1)))
211 ;; BIG-5HKSCS is similar to, but different than, BIG-5. 212 ;; BIG-5HKSCS is similar to, but different than, BIG-5.
212 ,@(unless (mm-coding-system-p 'big5-hkscs) 213 ,@(unless (mm-coding-system-p 'big5-hkscs)
213 '((big5-hkscs . big5))) 214 '((big5-hkscs . big5)))
214 ;; Windows-1252 is actually a superset of Latin-1. See also
215 ;; `gnus-article-dumbquotes-map'.
216 ,@(unless (mm-coding-system-p 'windows-1252)
217 (if (mm-coding-system-p 'cp1252)
218 '((windows-1252 . cp1252))
219 '((windows-1252 . iso-8859-1))))
220 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
221 ;; Outlook users in Czech republic. Use this to allow reading of their
222 ;; e-mails. cp1250 should be defined by M-x codepage-setup.
223 ,@(if (and (not (mm-coding-system-p 'windows-1250))
224 (mm-coding-system-p 'cp1250))
225 '((windows-1250 . cp1250)))
226 ;; A Microsoft misunderstanding. 215 ;; A Microsoft misunderstanding.
227 ,@(if (and (not (mm-coding-system-p 'unicode)) 216 ,@(when (and (not (mm-coding-system-p 'unicode))
228 (mm-coding-system-p 'utf-16-le)) 217 (mm-coding-system-p 'utf-16-le))
229 '((unicode . utf-16-le))) 218 '((unicode . utf-16-le)))
230 ;; A Microsoft misunderstanding. 219 ;; A Microsoft misunderstanding.
231 ,@(unless (mm-coding-system-p 'ks_c_5601-1987) 220 ,@(unless (mm-coding-system-p 'ks_c_5601-1987)
232 (if (mm-coding-system-p 'cp949) 221 (if (mm-coding-system-p 'cp949)
233 '((ks_c_5601-1987 . cp949)) 222 '((ks_c_5601-1987 . cp949))
234 '((ks_c_5601-1987 . euc-kr)))) 223 '((ks_c_5601-1987 . euc-kr))))
235 ;; Windows-31J is Windows Codepage 932. 224 ;; Windows-31J is Windows Codepage 932.
236 ,@(if (and (not (mm-coding-system-p 'windows-31j)) 225 ,@(when (and (not (mm-coding-system-p 'windows-31j))
237 (mm-coding-system-p 'cp932)) 226 (mm-coding-system-p 'cp932))
238 '((windows-31j . cp932))) 227 '((windows-31j . cp932)))
239 ) 228 )
240 "A mapping from unknown or invalid charset names to the real charset names.") 229 "A mapping from unknown or invalid charset names to the real charset names.
230
231See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.")
232
233(defcustom mm-codepage-iso-8859-list
234 (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
235 ;; Outlook users in Czech republic. Use this to allow reading of
236 ;; their e-mails. cp1250 should be defined by M-x codepage-setup
237 ;; (Emacs 21).
238 '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West
239 ;; Europe). See also `gnus-article-dumbquotes-map'.
240 '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish).
241 '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew).
242 "A list of Windows codepage numbers and iso-8859 charset numbers.
243
244If an element is a number corresponding to a supported windows
245codepage, appropriate entries to `mm-charset-synonym-alist' are
246added by `mm-setup-codepage-iso-8859'. An element may also be a
247cons cell where the car is a codepage number and the cdr is the
248corresponding number of an iso-8859 charset."
249 :type '(list (set :inline t
250 (const 1250 :tag "Central and East European")
251 (const (1252 . 1) :tag "West European")
252 (const (1254 . 9) :tag "Turkish")
253 (const (1255 . 8) :tag "Hebrew"))
254 (repeat :inline t
255 :tag "Other options"
256 (choice
257 (integer :tag "Windows codepage number")
258 (cons (integer :tag "Windows codepage number")
259 (integer :tag "iso-8859 charset number")))))
260 :version "22.1" ;; Gnus 5.10.9
261 :group 'mime)
262
263(defcustom mm-codepage-ibm-list
264 (list 437 ;; (US etc.)
265 860 ;; (Portugal)
266 861 ;; (Iceland)
267 862 ;; (Israel)
268 863 ;; (Canadian French)
269 865 ;; (Nordic)
270 852 ;;
271 850 ;; (Latin 1)
272 855 ;; (Cyrillic)
273 866 ;; (Cyrillic - Russian)
274 857 ;; (Turkish)
275 864 ;; (Arabic)
276 869 ;; (Greek)
277 874);; (Thai)
278 ;; In Emacs 23 (unicode), cp... and ibm... are aliases.
279 ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de
280 "List of IBM codepage numbers.
281
282The codepage mappings slighly differ between IBM and other vendors.
283See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\".
284
285If an element is a number corresponding to a supported windows
286codepage, appropriate entries to `mm-charset-synonym-alist' are
287added by `mm-setup-codepage-ibm'."
288 :type '(list (set :inline t
289 (const 437 :tag "US etc.")
290 (const 860 :tag "Portugal")
291 (const 861 :tag "Iceland")
292 (const 862 :tag "Israel")
293 (const 863 :tag "Canadian French")
294 (const 865 :tag "Nordic")
295 (const 852)
296 (const 850 :tag "Latin 1")
297 (const 855 :tag "Cyrillic")
298 (const 866 :tag "Cyrillic - Russian")
299 (const 857 :tag "Turkish")
300 (const 864 :tag "Arabic")
301 (const 869 :tag "Greek")
302 (const 874 :tag "Thai"))
303 (repeat :inline t
304 :tag "Other options"
305 (integer :tag "Codepage number")))
306 :version "22.1" ;; Gnus 5.10.9
307 :group 'mime)
308
309(defun mm-setup-codepage-iso-8859 (&optional list)
310 "Add appropriate entries to `mm-charset-synonym-alist'.
311Unless LIST is given, `mm-codepage-iso-8859-list' is used."
312 (unless list
313 (setq list mm-codepage-iso-8859-list))
314 (dolist (i list)
315 (let (cp windows iso)
316 (if (consp i)
317 (setq cp (intern (format "cp%d" (car i)))
318 windows (intern (format "windows-%d" (car i)))
319 iso (intern (format "iso-8859-%d" (cdr i))))
320 (setq cp (intern (format "cp%d" i))
321 windows (intern (format "windows-%d" i))))
322 (unless (mm-coding-system-p windows)
323 (if (mm-coding-system-p cp)
324 (add-to-list 'mm-charset-synonym-alist (cons windows cp))
325 (add-to-list 'mm-charset-synonym-alist (cons windows iso)))))))
326
327(defun mm-setup-codepage-ibm (&optional list)
328 "Add appropriate entries to `mm-charset-synonym-alist'.
329Unless LIST is given, `mm-codepage-ibm-list' is used."
330 (unless list
331 (setq list mm-codepage-ibm-list))
332 (dolist (number list)
333 (let ((ibm (intern (format "ibm%d" number)))
334 (cp (intern (format "cp%d" number))))
335 (when (and (not (mm-coding-system-p ibm))
336 (mm-coding-system-p cp))
337 (add-to-list 'mm-charset-synonym-alist (cons ibm cp))))))
338
339;; Initialize:
340(mm-setup-codepage-iso-8859)
341(mm-setup-codepage-ibm)
241 342
242(defcustom mm-charset-override-alist 343(defcustom mm-charset-override-alist
243 `((iso-8859-1 . windows-1252)) 344 `((iso-8859-1 . windows-1252))
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 5972a0681a6..8b6d3e8e795 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -36,7 +36,7 @@
36 (autoload 'vcard-parse-string "vcard") 36 (autoload 'vcard-parse-string "vcard")
37 (autoload 'vcard-format-string "vcard") 37 (autoload 'vcard-format-string "vcard")
38 (autoload 'fill-flowed "flow-fill") 38 (autoload 'fill-flowed "flow-fill")
39 (autoload 'html2text "html2text") 39 (autoload 'html2text "html2text" nil t)
40 (unless (fboundp 'diff-mode) 40 (unless (fboundp 'diff-mode)
41 (autoload 'diff-mode "diff-mode" "" t nil))) 41 (autoload 'diff-mode "diff-mode" "" t nil)))
42 42
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 97b08e7e704..0b914a811d1 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2018,11 +2018,10 @@ If VAR is nil, then we bind `v' to the structure and `multi-method',
2018 ,@body)) 2018 ,@body))
2019 2019
2020(put 'with-parsed-tramp-file-name 'lisp-indent-function 2) 2020(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
2021;; To be activated for debugging containing this macro 2021;; Enable debugging.
2022;; It works only when VAR is nil. Otherwise, it can be deactivated by 2022(def-edebug-spec with-parsed-tramp-file-name (form symbolp body))
2023;; (put 'with-parsed-tramp-file-name 'edebug-form-spec 0) 2023;; Highlight as keyword.
2024;; I'm too stupid to write a precise SPEC for it. 2024(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
2025(put 'with-parsed-tramp-file-name 'edebug-form-spec t)
2026 2025
2027(defmacro tramp-let-maybe (variable value &rest body) 2026(defmacro tramp-let-maybe (variable value &rest body)
2028 "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete. 2027 "Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
@@ -2905,7 +2904,7 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
2905 (unless ok-if-already-exists 2904 (unless ok-if-already-exists
2906 (when (file-exists-p newname) 2905 (when (file-exists-p newname)
2907 (signal 'file-already-exists 2906 (signal 'file-already-exists
2908 (list newname)))) 2907 (list "File already exists" newname))))
2909 (let ((t1 (tramp-tramp-file-p filename)) 2908 (let ((t1 (tramp-tramp-file-p filename))
2910 (t2 (tramp-tramp-file-p newname)) 2909 (t2 (tramp-tramp-file-p newname))
2911 v1-multi-method v1-method v1-user v1-host v1-localname 2910 v1-multi-method v1-method v1-user v1-host v1-localname
@@ -2978,10 +2977,10 @@ and `rename'. FILENAME and NEWNAME must be absolute file names."
2978 ;; copy-program can be invoked. 2977 ;; copy-program can be invoked.
2979 (if (and (not v1-multi-method) 2978 (if (and (not v1-multi-method)
2980 (not v2-multi-method) 2979 (not v2-multi-method)
2981 (or (tramp-method-out-of-band-p 2980 (or (and t1 (tramp-method-out-of-band-p
2982 v1-multi-method v1-method v1-user v1-host) 2981 v1-multi-method v1-method v1-user v1-host))
2983 (tramp-method-out-of-band-p 2982 (and t2 (tramp-method-out-of-band-p
2984 v2-multi-method v2-method v2-user v2-host))) 2983 v2-multi-method v2-method v2-user v2-host))))
2985 (tramp-do-copy-or-rename-file-out-of-band 2984 (tramp-do-copy-or-rename-file-out-of-band
2986 op filename newname keep-date) 2985 op filename newname keep-date)
2987 ;; Use the generic method via a Tramp buffer. 2986 ;; Use the generic method via a Tramp buffer.
@@ -5045,7 +5044,7 @@ TIME is an Emacs internal time value as returned by `current-time'."
5045 multi-method method user host 5044 multi-method method user host
5046 (format "TZ=UTC; export TZ; touch -t %s %s" 5045 (format "TZ=UTC; export TZ; touch -t %s %s"
5047 touch-time 5046 touch-time
5048 localname) 5047 (tramp-shell-quote-argument localname))
5049 t)) 5048 t))
5050 (pop-to-buffer buf) 5049 (pop-to-buffer buf)
5051 (error "tramp-touch: touch failed, see buffer `%s' for details" 5050 (error "tramp-touch: touch failed, see buffer `%s' for details"
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index d60746c5de8..7015a24ac01 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -6,8 +6,7 @@
6;; Author: Rolf Ebert <ebert@inf.enst.fr> 6;; Author: Rolf Ebert <ebert@inf.enst.fr>
7;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> 7;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
8;; Emmanuel Briot <briot@gnat.com> 8;; Emmanuel Briot <briot@gnat.com>
9;; Maintainer: Emmanuel Briot <briot@gnat.com> 9;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
10;; Ada Core Technologies's version: Revision: 1.188
11;; Keywords: languages ada 10;; Keywords: languages ada
12 11
13;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
@@ -30,7 +29,7 @@
30;;; Commentary: 29;;; Commentary:
31;;; This mode is a major mode for editing Ada83 and Ada95 source code. 30;;; This mode is a major mode for editing Ada83 and Ada95 source code.
32;;; This is a major rewrite of the file packaged with Emacs-20. The 31;;; This is a major rewrite of the file packaged with Emacs-20. The
33;;; ada-mode is composed of four lisp files, ada-mode.el, ada-xref.el, 32;;; ada-mode is composed of four Lisp files, ada-mode.el, ada-xref.el,
34;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is 33;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is
35;;; completely independent from the GNU Ada compiler Gnat, distributed 34;;; completely independent from the GNU Ada compiler Gnat, distributed
36;;; by Ada Core Technologies. All the other files rely heavily on 35;;; by Ada Core Technologies. All the other files rely heavily on
@@ -79,14 +78,14 @@
79;;; to his version. 78;;; to his version.
80;;; 79;;;
81;;; A complete rewrite for Emacs-20 / Gnat-3.11 has been done by Ada Core 80;;; A complete rewrite for Emacs-20 / Gnat-3.11 has been done by Ada Core
82;;; Technologies. Please send bugs to briot@gnat.com 81;;; Technologies.
83 82
84;;; Credits: 83;;; Credits:
85;;; Many thanks to John McCabe <john@assen.demon.co.uk> for sending so 84;;; Many thanks to John McCabe <john@assen.demon.co.uk> for sending so
86;;; many patches included in this package. 85;;; many patches included in this package.
87;;; Christian Egli <Christian.Egli@hcsd.hac.com>: 86;;; Christian Egli <Christian.Egli@hcsd.hac.com>:
88;;; ada-imenu-generic-expression 87;;; ada-imenu-generic-expression
89;;; Many thanks also to the following persons that have contributed one day 88;;; Many thanks also to the following persons that have contributed
90;;; to the ada-mode 89;;; to the ada-mode
91;;; Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular, 90;;; Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
92;;; woodruff@stc.llnl.gov (John Woodruff) 91;;; woodruff@stc.llnl.gov (John Woodruff)
@@ -142,12 +141,12 @@
142 "Return t if Emacs's version is greater or equal to MAJOR.MINOR. 141 "Return t if Emacs's version is greater or equal to MAJOR.MINOR.
143If IS-XEMACS is non-nil, check for XEmacs instead of Emacs." 142If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
144 (let ((xemacs-running (or (string-match "Lucid" emacs-version) 143 (let ((xemacs-running (or (string-match "Lucid" emacs-version)
145 (string-match "XEmacs" emacs-version)))) 144 (string-match "XEmacs" emacs-version))))
146 (and (or (and is-xemacs xemacs-running) 145 (and (or (and is-xemacs xemacs-running)
147 (not (or is-xemacs xemacs-running))) 146 (not (or is-xemacs xemacs-running)))
148 (or (> emacs-major-version major) 147 (or (> emacs-major-version major)
149 (and (= emacs-major-version major) 148 (and (= emacs-major-version major)
150 (>= emacs-minor-version minor))))))) 149 (>= emacs-minor-version minor)))))))
151 150
152 151
153;; This call should not be made in the release that is done for the 152;; This call should not be made in the release that is done for the
@@ -155,6 +154,14 @@ If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
155;;(if (not (ada-check-emacs-version 21 1)) 154;;(if (not (ada-check-emacs-version 21 1))
156;; (require 'ada-support)) 155;; (require 'ada-support))
157 156
157(defun ada-mode-version ()
158 "Return Ada mode version."
159 (interactive)
160 (let ((version-string "3.5"))
161 (if (interactive-p)
162 (message version-string)
163 version-string)))
164
158(defvar ada-mode-hook nil 165(defvar ada-mode-hook nil
159 "*List of functions to call when Ada mode is invoked. 166 "*List of functions to call when Ada mode is invoked.
160This hook is automatically executed after the `ada-mode' is 167This hook is automatically executed after the `ada-mode' is
@@ -162,7 +169,7 @@ fully loaded.
162This is a good place to add Ada environment specific bindings.") 169This is a good place to add Ada environment specific bindings.")
163 170
164(defgroup ada nil 171(defgroup ada nil
165 "Major mode for editing Ada source in Emacs." 172 "Major mode for editing and compiling Ada source in Emacs."
166 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) 173 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
167 :group 'languages) 174 :group 'languages)
168 175
@@ -178,7 +185,7 @@ and `ada-case-attribute'."
178An example is : 185An example is :
179 declare 186 declare
180 A, 187 A,
181 >>>>>B : Integer; -- from ada-broken-decl-indent" 188 >>>>>B : Integer;"
182 :type 'integer :group 'ada) 189 :type 'integer :group 'ada)
183 190
184(defcustom ada-broken-indent 2 191(defcustom ada-broken-indent 2
@@ -186,7 +193,7 @@ An example is :
186 193
187An example is : 194An example is :
188 My_Var : My_Type := (Field1 => 195 My_Var : My_Type := (Field1 =>
189 >>>>>>>>>Value); -- from ada-broken-indent" 196 >>>>>>>>>Value);"
190 :type 'integer :group 'ada) 197 :type 'integer :group 'ada)
191 198
192(defcustom ada-continuation-indent ada-broken-indent 199(defcustom ada-continuation-indent ada-broken-indent
@@ -194,7 +201,7 @@ An example is :
194 201
195An example is : 202An example is :
196 Func (Param1, 203 Func (Param1,
197 >>>>>Param2);" 204 >>>>>Param2);"
198 :type 'integer :group 'ada) 205 :type 'integer :group 'ada)
199 206
200(defcustom ada-case-attribute 'ada-capitalize-word 207(defcustom ada-case-attribute 'ada-capitalize-word
@@ -202,10 +209,10 @@ An example is :
202It may be `downcase-word', `upcase-word', `ada-loose-case-word', 209It may be `downcase-word', `upcase-word', `ada-loose-case-word',
203`ada-capitalize-word' or `ada-no-auto-case'." 210`ada-capitalize-word' or `ada-no-auto-case'."
204 :type '(choice (const downcase-word) 211 :type '(choice (const downcase-word)
205 (const upcase-word) 212 (const upcase-word)
206 (const ada-capitalize-word) 213 (const ada-capitalize-word)
207 (const ada-loose-case-word) 214 (const ada-loose-case-word)
208 (const ada-no-auto-case)) 215 (const ada-no-auto-case))
209 :group 'ada) 216 :group 'ada)
210 217
211(defcustom ada-case-exception-file 218(defcustom ada-case-exception-file
@@ -228,10 +235,10 @@ by a comment."
228It may be `downcase-word', `upcase-word', `ada-loose-case-word' or 235It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
229`ada-capitalize-word'." 236`ada-capitalize-word'."
230 :type '(choice (const downcase-word) 237 :type '(choice (const downcase-word)
231 (const upcase-word) 238 (const upcase-word)
232 (const ada-capitalize-word) 239 (const ada-capitalize-word)
233 (const ada-loose-case-word) 240 (const ada-loose-case-word)
234 (const ada-no-auto-case)) 241 (const ada-no-auto-case))
235 :group 'ada) 242 :group 'ada)
236 243
237(defcustom ada-case-identifier 'ada-loose-case-word 244(defcustom ada-case-identifier 'ada-loose-case-word
@@ -239,10 +246,10 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
239It may be `downcase-word', `upcase-word', `ada-loose-case-word' or 246It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
240`ada-capitalize-word'." 247`ada-capitalize-word'."
241 :type '(choice (const downcase-word) 248 :type '(choice (const downcase-word)
242 (const upcase-word) 249 (const upcase-word)
243 (const ada-capitalize-word) 250 (const ada-capitalize-word)
244 (const ada-loose-case-word) 251 (const ada-loose-case-word)
245 (const ada-no-auto-case)) 252 (const ada-no-auto-case))
246 :group 'ada) 253 :group 'ada)
247 254
248(defcustom ada-clean-buffer-before-saving t 255(defcustom ada-clean-buffer-before-saving t
@@ -255,7 +262,7 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
255An example is : 262An example is :
256procedure Foo is 263procedure Foo is
257begin 264begin
258>>>>>>>>>>null; -- from ada-indent" 265>>>>>>>>>>null;"
259 :type 'integer :group 'ada) 266 :type 'integer :group 'ada)
260 267
261(defcustom ada-indent-after-return t 268(defcustom ada-indent-after-return t
@@ -269,7 +276,7 @@ Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
269 276
270For instance: 277For instance:
271 A := 1; -- A multi-line comment 278 A := 1; -- A multi-line comment
272 -- aligned if ada-indent-align-comments is t" 279 -- aligned if ada-indent-align-comments is t"
273 :type 'boolean :group 'ada) 280 :type 'boolean :group 'ada)
274 281
275(defcustom ada-indent-comment-as-code t 282(defcustom ada-indent-comment-as-code t
@@ -308,7 +315,7 @@ type A is
308 315
309An example is: 316An example is:
310 type A is 317 type A is
311 >>>>>>>>>>>record -- from ada-indent-record-rel-type" 318 >>>>>>>>>>>record"
312 :type 'integer :group 'ada) 319 :type 'integer :group 'ada)
313 320
314(defcustom ada-indent-renames ada-broken-indent 321(defcustom ada-indent-renames ada-broken-indent
@@ -318,8 +325,8 @@ the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
318 325
319An example is: 326An example is:
320 function A (B : Integer) 327 function A (B : Integer)
321 return C; -- from ada-indent-return 328 return C;
322 >>>renames Foo; -- from ada-indent-renames" 329 >>>renames Foo;"
323 :type 'integer :group 'ada) 330 :type 'integer :group 'ada)
324 331
325(defcustom ada-indent-return 0 332(defcustom ada-indent-return 0
@@ -329,7 +336,7 @@ the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
329 336
330An example is: 337An example is:
331 function A (B : Integer) 338 function A (B : Integer)
332 >>>>>return C; -- from ada-indent-return" 339 >>>>>return C;"
333 :type 'integer :group 'ada) 340 :type 'integer :group 'ada)
334 341
335(defcustom ada-indent-to-open-paren t 342(defcustom ada-indent-to-open-paren t
@@ -353,7 +360,7 @@ Used by `ada-fill-comment-paragraph-postfix'."
353An example is: 360An example is:
354procedure Foo is 361procedure Foo is
355begin 362begin
356>>>>>>>>>>>>Label: -- from ada-label-indent 363>>>>Label:
357 364
358This is also used for <<..>> labels" 365This is also used for <<..>> labels"
359 :type 'integer :group 'ada) 366 :type 'integer :group 'ada)
@@ -363,8 +370,7 @@ This is also used for <<..>> labels"
363 :type '(choice (const ada83) (const ada95)) :group 'ada) 370 :type '(choice (const ada83) (const ada95)) :group 'ada)
364 371
365(defcustom ada-move-to-declaration nil 372(defcustom ada-move-to-declaration nil
366 "*Non-nil means `ada-move-to-start' moves point to the subprogram declaration, 373 "*Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
367not to 'begin'."
368 :type 'boolean :group 'ada) 374 :type 'boolean :group 'ada)
369 375
370(defcustom ada-popup-key '[down-mouse-3] 376(defcustom ada-popup-key '[down-mouse-3]
@@ -378,13 +384,12 @@ If nil, no contextual menu is available."
378 (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":") 384 (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
379 '("/usr/adainclude" "/usr/local/adainclude" 385 '("/usr/adainclude" "/usr/local/adainclude"
380 "/opt/gnu/adainclude")) 386 "/opt/gnu/adainclude"))
381 "*List of directories to search for Ada files. 387 "*Default list of directories to search for Ada files.
382See the description for the `ff-search-directories' variable. This variable 388See the description for the `ff-search-directories' variable. This variable
383is the initial value of this variable, and is copied and modified in 389is the initial value of `ada-search-directories-internal'."
384`ada-search-directories-internal'."
385 :type '(repeat (choice :tag "Directory" 390 :type '(repeat (choice :tag "Directory"
386 (const :tag "default" nil) 391 (const :tag "default" nil)
387 (directory :format "%v"))) 392 (directory :format "%v")))
388 :group 'ada) 393 :group 'ada)
389 394
390(defvar ada-search-directories-internal ada-search-directories 395(defvar ada-search-directories-internal ada-search-directories
@@ -398,7 +403,7 @@ and the standard runtime location, and the value of the user-defined
398 403
399An example is: 404An example is:
400 if A = B 405 if A = B
401 >>>>>>>>>>>then -- from ada-stmt-end-indent" 406 >>>>then"
402 :type 'integer :group 'ada) 407 :type 'integer :group 'ada)
403 408
404(defcustom ada-tab-policy 'indent-auto 409(defcustom ada-tab-policy 'indent-auto
@@ -406,10 +411,10 @@ An example is:
406Must be one of : 411Must be one of :
407`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line. 412`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line.
408`indent-auto' : use indentation functions in this file. 413`indent-auto' : use indentation functions in this file.
409`always-tab' : do indent-relative." 414`always-tab' : do `indent-relative'."
410 :type '(choice (const indent-auto) 415 :type '(choice (const indent-auto)
411 (const indent-rigidly) 416 (const indent-rigidly)
412 (const always-tab)) 417 (const always-tab))
413 :group 'ada) 418 :group 'ada)
414 419
415(defcustom ada-use-indent ada-broken-indent 420(defcustom ada-use-indent ada-broken-indent
@@ -417,7 +422,7 @@ Must be one of :
417 422
418An example is: 423An example is:
419 use Ada.Text_IO, 424 use Ada.Text_IO,
420 >>>>>Ada.Numerics; -- from ada-use-indent" 425 >>>>Ada.Numerics;"
421 :type 'integer :group 'ada) 426 :type 'integer :group 'ada)
422 427
423(defcustom ada-when-indent 3 428(defcustom ada-when-indent 3
@@ -425,7 +430,7 @@ An example is:
425 430
426An example is: 431An example is:
427 case A is 432 case A is
428 >>>>>>>>when B => -- from ada-when-indent" 433 >>>>when B =>"
429 :type 'integer :group 'ada) 434 :type 'integer :group 'ada)
430 435
431(defcustom ada-with-indent ada-broken-indent 436(defcustom ada-with-indent ada-broken-indent
@@ -433,7 +438,7 @@ An example is:
433 438
434An example is: 439An example is:
435 with Ada.Text_IO, 440 with Ada.Text_IO,
436 >>>>>Ada.Numerics; -- from ada-with-indent" 441 >>>>Ada.Numerics;"
437 :type 'integer :group 'ada) 442 :type 'integer :group 'ada)
438 443
439(defcustom ada-which-compiler 'gnat 444(defcustom ada-which-compiler 'gnat
@@ -444,7 +449,7 @@ The possible choices are:
444 features. 449 features.
445`generic': Use a generic compiler." 450`generic': Use a generic compiler."
446 :type '(choice (const gnat) 451 :type '(choice (const gnat)
447 (const generic)) 452 (const generic))
448 :group 'ada) 453 :group 'ada)
449 454
450 455
@@ -511,7 +516,7 @@ See `ff-other-file-alist'.")
511 ("[^=]\\(\\s-+\\)=[^=]" 1 t) 516 ("[^=]\\(\\s-+\\)=[^=]" 1 t)
512 ("\\(\\s-*\\)use\\s-" 1) 517 ("\\(\\s-*\\)use\\s-" 1)
513 ("\\(\\s-*\\)--" 1)) 518 ("\\(\\s-*\\)--" 1))
514 "Ada support for align.el <= 2.2 519 "Ada support for align.el <= 2.2.
515This variable provides regular expressions on which to align different lines. 520This variable provides regular expressions on which to align different lines.
516See `align-mode-alist' for more information.") 521See `align-mode-alist' for more information.")
517 522
@@ -566,10 +571,10 @@ This variable defines several rules to use to align different lines.")
566(defconst ada-95-keywords 571(defconst ada-95-keywords
567 (eval-when-compile 572 (eval-when-compile
568 (concat "\\<" (regexp-opt 573 (concat "\\<" (regexp-opt
569 (append 574 (append
570 '("abstract" "aliased" "protected" "requeue" 575 '("abstract" "aliased" "protected" "requeue"
571 "tagged" "until") 576 "tagged" "until")
572 ada-83-string-keywords) t) "\\>")) 577 ada-83-string-keywords) t) "\\>"))
573 "Regular expression for looking at Ada95 keywords.") 578 "Regular expression for looking at Ada95 keywords.")
574 579
575(defvar ada-keywords ada-95-keywords 580(defvar ada-keywords ada-95-keywords
@@ -605,42 +610,42 @@ This variable defines several rules to use to align different lines.")
605(defvar ada-block-start-re 610(defvar ada-block-start-re
606 (eval-when-compile 611 (eval-when-compile
607 (concat "\\<\\(" (regexp-opt '("begin" "declare" "else" 612 (concat "\\<\\(" (regexp-opt '("begin" "declare" "else"
608 "exception" "generic" "loop" "or" 613 "exception" "generic" "loop" "or"
609 "private" "select" )) 614 "private" "select" ))
610 "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>")) 615 "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>"))
611 "Regexp for keywords starting Ada blocks.") 616 "Regexp for keywords starting Ada blocks.")
612 617
613(defvar ada-end-stmt-re 618(defvar ada-end-stmt-re
614 (eval-when-compile 619 (eval-when-compile
615 (concat "\\(" 620 (concat "\\("
616 ";" "\\|" 621 ";" "\\|"
617 "=>[ \t]*$" "\\|" 622 "=>[ \t]*$" "\\|"
618 "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|" 623 "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|"
619 "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic" 624 "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
620 "loop" "private" "record" "select" 625 "loop" "private" "record" "select"
621 "then abort" "then") t) "\\>" "\\|" 626 "then abort" "then") t) "\\>" "\\|"
622 "^[ \t]*" (regexp-opt '("function" "package" "procedure") 627 "^[ \t]*" (regexp-opt '("function" "package" "procedure")
623 t) "\\>\\(\\sw\\|[ \t_.]\\)+\\<is\\>" "\\|" 628 t) "\\>\\(\\sw\\|[ \t_.]\\)+\\<is\\>" "\\|"
624 "^[ \t]*exception\\>" 629 "^[ \t]*exception\\>"
625 "\\)") ) 630 "\\)") )
626 "Regexp of possible ends for a non-broken statement. 631 "Regexp of possible ends for a non-broken statement.
627A new statement starts after these.") 632A new statement starts after these.")
628 633
629(defvar ada-matching-start-re 634(defvar ada-matching-start-re
630 (eval-when-compile 635 (eval-when-compile
631 (concat "\\<" 636 (concat "\\<"
632 (regexp-opt 637 (regexp-opt
633 '("end" "loop" "select" "begin" "case" "do" 638 '("end" "loop" "select" "begin" "case" "do"
634 "if" "task" "package" "record" "protected") t) 639 "if" "task" "package" "record" "protected") t)
635 "\\>")) 640 "\\>"))
636 "Regexp used in `ada-goto-matching-start'.") 641 "Regexp used in `ada-goto-matching-start'.")
637 642
638(defvar ada-matching-decl-start-re 643(defvar ada-matching-decl-start-re
639 (eval-when-compile 644 (eval-when-compile
640 (concat "\\<" 645 (concat "\\<"
641 (regexp-opt 646 (regexp-opt
642 '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t) 647 '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
643 "\\>")) 648 "\\>"))
644 "Regexp used in `ada-goto-matching-decl-start'.") 649 "Regexp used in `ada-goto-matching-decl-start'.")
645 650
646(defvar ada-loop-start-re 651(defvar ada-loop-start-re
@@ -650,7 +655,7 @@ A new statement starts after these.")
650(defvar ada-subprog-start-re 655(defvar ada-subprog-start-re
651 (eval-when-compile 656 (eval-when-compile
652 (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure" 657 (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure"
653 "protected" "task") t) "\\>")) 658 "protected" "task") t) "\\>"))
654 "Regexp for the start of a subprogram.") 659 "Regexp for the start of a subprogram.")
655 660
656(defvar ada-named-block-re 661(defvar ada-named-block-re
@@ -706,13 +711,13 @@ displaying the menu if point was on an identifier."
706 (list 711 (list
707 (list nil ada-imenu-subprogram-menu-re 2) 712 (list nil ada-imenu-subprogram-menu-re 2)
708 (list "*Specs*" 713 (list "*Specs*"
709 (concat 714 (concat
710 "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)" 715 "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
711 "\\(" 716 "\\("
712 "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)" 717 "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
713 ada-imenu-comment-re "\\)";; parameter list or simple space 718 ada-imenu-comment-re "\\)";; parameter list or simple space
714 "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?" 719 "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?"
715 "\\)?;") 2) 720 "\\)?;") 2)
716 '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2) 721 '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
717 '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2) 722 '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
718 '("*Protected*" 723 '("*Protected*"
@@ -738,9 +743,10 @@ each type of entity that can be found in an Ada file.")
738 "Replace `compile-goto-error' from compile.el. 743 "Replace `compile-goto-error' from compile.el.
739If POS is on a file and line location, go to this position. It adds 744If POS is on a file and line location, go to this position. It adds
740to compile.el the capacity to go to a reference in an error message. 745to compile.el the capacity to go to a reference in an error message.
741For instance, on this line: 746For instance, on these lines:
742 foo.adb:61:11: [...] in call to size declared at foo.ads:11 747 foo.adb:61:11: [...] in call to size declared at foo.ads:11
743both file locations can be clicked on and jumped to." 748 foo.adb:61:11: [...] in call to local declared at line 20
749the 4 file locations can be clicked on and jumped to."
744 (interactive "d") 750 (interactive "d")
745 (goto-char pos) 751 (goto-char pos)
746 752
@@ -748,34 +754,34 @@ both file locations can be clicked on and jumped to."
748 (cond 754 (cond
749 ;; special case: looking at a filename:line not at the beginning of a line 755 ;; special case: looking at a filename:line not at the beginning of a line
750 ((and (not (bolp)) 756 ((and (not (bolp))
751 (looking-at 757 (looking-at
752 "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?")) 758 "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"))
753 (let ((line (match-string 2)) 759 (let ((line (match-string 2))
754 file 760 file
755 (error-pos (point-marker)) 761 (error-pos (point-marker))
756 source) 762 source)
757 (save-excursion 763 (save-excursion
758 (save-restriction 764 (save-restriction
759 (widen) 765 (widen)
760 ;; Use funcall so as to prevent byte-compiler warnings 766 ;; Use funcall so as to prevent byte-compiler warnings
761 ;; `ada-find-file' is not defined if ada-xref wasn't loaded. But 767 ;; `ada-find-file' is not defined if ada-xref wasn't loaded. But
762 ;; if we can find it, we should use it instead of 768 ;; if we can find it, we should use it instead of
763 ;; `compilation-find-file', since the latter doesn't know anything 769 ;; `compilation-find-file', since the latter doesn't know anything
764 ;; about source path. 770 ;; about source path.
765 771
766 (if (functionp 'ada-find-file) 772 (if (functionp 'ada-find-file)
767 (setq file (funcall (symbol-function 'ada-find-file) 773 (setq file (funcall (symbol-function 'ada-find-file)
768 (match-string 1))) 774 (match-string 1)))
769 (setq file (funcall (symbol-function 'compilation-find-file) 775 (setq file (funcall (symbol-function 'compilation-find-file)
770 (point-marker) (match-string 1) 776 (point-marker) (match-string 1)
771 "./"))) 777 "./")))
772 (set-buffer file) 778 (set-buffer file)
773 779
774 (if (stringp line) 780 (if (stringp line)
775 (goto-line (string-to-number line))) 781 (goto-line (string-to-number line)))
776 (setq source (point-marker)))) 782 (setq source (point-marker))))
777 (funcall (symbol-function 'compilation-goto-locus) 783 (funcall (symbol-function 'compilation-goto-locus)
778 (cons source error-pos)) 784 (cons source error-pos))
779 )) 785 ))
780 786
781 ;; otherwise, default behavior 787 ;; otherwise, default behavior
@@ -879,31 +885,31 @@ declares it as a word constituent."
879 (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants) 885 (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
880 "Handles special character constants and gnatprep statements." 886 "Handles special character constants and gnatprep statements."
881 (let (change) 887 (let (change)
882 (if (< to from) 888 (if (< to from)
883 (let ((tmp from)) 889 (let ((tmp from))
884 (setq from to to tmp))) 890 (setq from to to tmp)))
885 (save-excursion 891 (save-excursion
886 (goto-char from) 892 (goto-char from)
887 (while (re-search-forward "'\\([(\")#]\\)'" to t) 893 (while (re-search-forward "'\\([(\")#]\\)'" to t)
888 (setq change (cons (list (match-beginning 1) 894 (setq change (cons (list (match-beginning 1)
889 1 895 1
890 (match-string 1)) 896 (match-string 1))
891 change)) 897 change))
892 (replace-match "'A'")) 898 (replace-match "'A'"))
893 (goto-char from) 899 (goto-char from)
894 (while (re-search-forward "\\(#[0-9a-fA-F]*#\\)" to t) 900 (while (re-search-forward "\\(#[0-9a-fA-F]*#\\)" to t)
895 (setq change (cons (list (match-beginning 1) 901 (setq change (cons (list (match-beginning 1)
896 (length (match-string 1)) 902 (length (match-string 1))
897 (match-string 1)) 903 (match-string 1))
898 change)) 904 change))
899 (replace-match (make-string (length (match-string 1)) ?@)))) 905 (replace-match (make-string (length (match-string 1)) ?@))))
900 ad-do-it 906 ad-do-it
901 (save-excursion 907 (save-excursion
902 (while change 908 (while change
903 (goto-char (caar change)) 909 (goto-char (caar change))
904 (delete-char (cadar change)) 910 (delete-char (cadar change))
905 (insert (caddar change)) 911 (insert (caddar change))
906 (setq change (cdr change))))))) 912 (setq change (cdr change)))))))
907 913
908(defun ada-deactivate-properties () 914(defun ada-deactivate-properties ()
909 "Deactivate Ada mode's properties handling. 915 "Deactivate Ada mode's properties handling.
@@ -919,12 +925,12 @@ as numbers instead of gnatprep comments."
919 (widen) 925 (widen)
920 (goto-char (point-min)) 926 (goto-char (point-min))
921 (while (re-search-forward "'.'" nil t) 927 (while (re-search-forward "'.'" nil t)
922 (add-text-properties (match-beginning 0) (match-end 0) 928 (add-text-properties (match-beginning 0) (match-end 0)
923 '(syntax-table ("'" . ?\")))) 929 '(syntax-table ("'" . ?\"))))
924 (goto-char (point-min)) 930 (goto-char (point-min))
925 (while (re-search-forward "^[ \t]*#" nil t) 931 (while (re-search-forward "^[ \t]*#" nil t)
926 (add-text-properties (match-beginning 0) (match-end 0) 932 (add-text-properties (match-beginning 0) (match-end 0)
927 '(syntax-table (11 . 10)))) 933 '(syntax-table (11 . 10))))
928 (set-buffer-modified-p nil) 934 (set-buffer-modified-p nil)
929 935
930 ;; Setting this only if font-lock is not set won't work 936 ;; Setting this only if font-lock is not set won't work
@@ -937,41 +943,43 @@ as numbers instead of gnatprep comments."
937 "Called when the region between BEG and END was changed in the buffer. 943 "Called when the region between BEG and END was changed in the buffer.
938OLD-LEN indicates what the length of the replaced text was." 944OLD-LEN indicates what the length of the replaced text was."
939 (let ((inhibit-point-motion-hooks t) 945 (let ((inhibit-point-motion-hooks t)
940 (eol (point))) 946 (eol (point)))
941 (save-excursion 947 (save-excursion
942 (save-match-data 948 (save-match-data
943 (beginning-of-line) 949 (beginning-of-line)
944 (remove-text-properties (point) eol '(syntax-table nil)) 950 (remove-text-properties (point) eol '(syntax-table nil))
945 (while (re-search-forward "'.'" eol t) 951 (while (re-search-forward "'.'" eol t)
946 (add-text-properties (match-beginning 0) (match-end 0) 952 (add-text-properties (match-beginning 0) (match-end 0)
947 '(syntax-table ("'" . ?\")))) 953 '(syntax-table ("'" . ?\"))))
948 (beginning-of-line) 954 (beginning-of-line)
949 (if (looking-at "^[ \t]*#") 955 (if (looking-at "^[ \t]*#")
950 (add-text-properties (match-beginning 0) (match-end 0) 956 (add-text-properties (match-beginning 0) (match-end 0)
951 '(syntax-table (11 . 10)))))))) 957 '(syntax-table (11 . 10))))))))
952 958
953;;------------------------------------------------------------------ 959;;------------------------------------------------------------------
954;; Testing the grammatical context 960;; Testing the grammatical context
955;;------------------------------------------------------------------ 961;;------------------------------------------------------------------
956 962
957(defsubst ada-in-comment-p (&optional parse-result) 963(defsubst ada-in-comment-p (&optional parse-result)
958 "Return t if inside a comment." 964 "Return t if inside a comment.
965If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
959 (nth 4 (or parse-result 966 (nth 4 (or parse-result
960 (parse-partial-sexp 967 (parse-partial-sexp
961 (line-beginning-position) (point))))) 968 (line-beginning-position) (point)))))
962 969
963(defsubst ada-in-string-p (&optional parse-result) 970(defsubst ada-in-string-p (&optional parse-result)
964 "Return t if point is inside a string. 971 "Return t if point is inside a string.
965If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'." 972If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
966 (nth 3 (or parse-result 973 (nth 3 (or parse-result
967 (parse-partial-sexp 974 (parse-partial-sexp
968 (line-beginning-position) (point))))) 975 (line-beginning-position) (point)))))
969 976
970(defsubst ada-in-string-or-comment-p (&optional parse-result) 977(defsubst ada-in-string-or-comment-p (&optional parse-result)
971 "Return t if inside a comment or string." 978 "Return t if inside a comment or string.
979If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
972 (setq parse-result (or parse-result 980 (setq parse-result (or parse-result
973 (parse-partial-sexp 981 (parse-partial-sexp
974 (line-beginning-position) (point)))) 982 (line-beginning-position) (point))))
975 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result))) 983 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
976 984
977 985
@@ -990,7 +998,7 @@ It forces Emacs to change the cursor position."
990 (interactive) 998 (interactive)
991 (funcall function) 999 (funcall function)
992 (setq ada-contextual-menu-last-point 1000 (setq ada-contextual-menu-last-point
993 (list (point) (current-buffer)))) 1001 (list (point) (current-buffer))))
994 1002
995(defun ada-popup-menu (position) 1003(defun ada-popup-menu (position)
996 "Pops up a contextual menu, depending on where the user clicked. 1004 "Pops up a contextual menu, depending on where the user clicked.
@@ -1005,23 +1013,23 @@ point is where the mouse button was clicked."
1005 ;; transient-mark-mode. 1013 ;; transient-mark-mode.
1006 (let ((deactivate-mark nil)) 1014 (let ((deactivate-mark nil))
1007 (setq ada-contextual-menu-last-point 1015 (setq ada-contextual-menu-last-point
1008 (list (point) (current-buffer))) 1016 (list (point) (current-buffer)))
1009 (mouse-set-point last-input-event) 1017 (mouse-set-point last-input-event)
1010 1018
1011 (setq ada-contextual-menu-on-identifier 1019 (setq ada-contextual-menu-on-identifier
1012 (and (char-after) 1020 (and (char-after)
1013 (or (= (char-syntax (char-after)) ?w) 1021 (or (= (char-syntax (char-after)) ?w)
1014 (= (char-after) ?_)) 1022 (= (char-after) ?_))
1015 (not (ada-in-string-or-comment-p)) 1023 (not (ada-in-string-or-comment-p))
1016 (save-excursion (skip-syntax-forward "w") 1024 (save-excursion (skip-syntax-forward "w")
1017 (not (ada-after-keyword-p))) 1025 (not (ada-after-keyword-p)))
1018 )) 1026 ))
1019 (if (fboundp 'popup-menu) 1027 (if (fboundp 'popup-menu)
1020 (funcall (symbol-function 'popup-menu) ada-contextual-menu) 1028 (funcall (symbol-function 'popup-menu) ada-contextual-menu)
1021 (let (choice) 1029 (let (choice)
1022 (setq choice (x-popup-menu position ada-contextual-menu)) 1030 (setq choice (x-popup-menu position ada-contextual-menu))
1023 (if choice 1031 (if choice
1024 (funcall (lookup-key ada-contextual-menu (vector (car choice))))))) 1032 (funcall (lookup-key ada-contextual-menu (vector (car choice)))))))
1025 1033
1026 (set-buffer (cadr ada-contextual-menu-last-point)) 1034 (set-buffer (cadr ada-contextual-menu-last-point))
1027 (goto-char (car ada-contextual-menu-last-point)) 1035 (goto-char (car ada-contextual-menu-last-point))
@@ -1040,15 +1048,15 @@ extensions.
1040SPEC and BODY are two regular expressions that must match against 1048SPEC and BODY are two regular expressions that must match against
1041the file name." 1049the file name."
1042 (let* ((reg (concat (regexp-quote body) "$")) 1050 (let* ((reg (concat (regexp-quote body) "$"))
1043 (tmp (assoc reg ada-other-file-alist))) 1051 (tmp (assoc reg ada-other-file-alist)))
1044 (if tmp 1052 (if tmp
1045 (setcdr tmp (list (cons spec (cadr tmp)))) 1053 (setcdr tmp (list (cons spec (cadr tmp))))
1046 (add-to-list 'ada-other-file-alist (list reg (list spec))))) 1054 (add-to-list 'ada-other-file-alist (list reg (list spec)))))
1047 1055
1048 (let* ((reg (concat (regexp-quote spec) "$")) 1056 (let* ((reg (concat (regexp-quote spec) "$"))
1049 (tmp (assoc reg ada-other-file-alist))) 1057 (tmp (assoc reg ada-other-file-alist)))
1050 (if tmp 1058 (if tmp
1051 (setcdr tmp (list (cons body (cadr tmp)))) 1059 (setcdr tmp (list (cons body (cadr tmp))))
1052 (add-to-list 'ada-other-file-alist (list reg (list body))))) 1060 (add-to-list 'ada-other-file-alist (list reg (list body)))))
1053 1061
1054 (add-to-list 'auto-mode-alist 1062 (add-to-list 'auto-mode-alist
@@ -1063,10 +1071,10 @@ the file name."
1063 ;; speedbar) 1071 ;; speedbar)
1064 (if (fboundp 'speedbar-add-supported-extension) 1072 (if (fboundp 'speedbar-add-supported-extension)
1065 (progn 1073 (progn
1066 (funcall (symbol-function 'speedbar-add-supported-extension) 1074 (funcall (symbol-function 'speedbar-add-supported-extension)
1067 spec) 1075 spec)
1068 (funcall (symbol-function 'speedbar-add-supported-extension) 1076 (funcall (symbol-function 'speedbar-add-supported-extension)
1069 body))) 1077 body)))
1070 ) 1078 )
1071 1079
1072 1080
@@ -1105,14 +1113,14 @@ If you use imenu.el:
1105 1113
1106If you use find-file.el: 1114If you use find-file.el:
1107 Switch to other file (Body <-> Spec) '\\[ff-find-other-file]' 1115 Switch to other file (Body <-> Spec) '\\[ff-find-other-file]'
1108 or '\\[ff-mouse-find-other-file] 1116 or '\\[ff-mouse-find-other-file]
1109 Switch to other file in other window '\\[ada-ff-other-window]' 1117 Switch to other file in other window '\\[ada-ff-other-window]'
1110 or '\\[ff-mouse-find-other-file-other-window] 1118 or '\\[ff-mouse-find-other-file-other-window]
1111 If you use this function in a spec and no body is available, it gets created with body stubs. 1119 If you use this function in a spec and no body is available, it gets created with body stubs.
1112 1120
1113If you use ada-xref.el: 1121If you use ada-xref.el:
1114 Goto declaration: '\\[ada-point-and-xref]' on the identifier 1122 Goto declaration: '\\[ada-point-and-xref]' on the identifier
1115 or '\\[ada-goto-declaration]' with point on the identifier 1123 or '\\[ada-goto-declaration]' with point on the identifier
1116 Complete identifier: '\\[ada-complete-identifier]'." 1124 Complete identifier: '\\[ada-complete-identifier]'."
1117 1125
1118 (interactive) 1126 (interactive)
@@ -1139,7 +1147,7 @@ If you use ada-xref.el:
1139 ;; aligned under the latest parameter, not under the declaration start). 1147 ;; aligned under the latest parameter, not under the declaration start).
1140 (set (make-local-variable 'comment-line-break-function) 1148 (set (make-local-variable 'comment-line-break-function)
1141 (lambda (&optional soft) (let ((fill-prefix nil)) 1149 (lambda (&optional soft) (let ((fill-prefix nil))
1142 (indent-new-comment-line soft)))) 1150 (indent-new-comment-line soft))))
1143 1151
1144 (set (make-local-variable 'indent-line-function) 1152 (set (make-local-variable 'indent-line-function)
1145 'ada-indent-current-function) 1153 'ada-indent-current-function)
@@ -1152,9 +1160,9 @@ If you use ada-xref.el:
1152 (unless (featurep 'xemacs) 1160 (unless (featurep 'xemacs)
1153 (progn 1161 (progn
1154 (if (ada-check-emacs-version 20 3) 1162 (if (ada-check-emacs-version 20 3)
1155 (progn 1163 (progn
1156 (set (make-local-variable 'parse-sexp-ignore-comments) t) 1164 (set (make-local-variable 'parse-sexp-ignore-comments) t)
1157 (set (make-local-variable 'comment-padding) 0))) 1165 (set (make-local-variable 'comment-padding) 0)))
1158 (set (make-local-variable 'parse-sexp-lookup-properties) t) 1166 (set (make-local-variable 'parse-sexp-lookup-properties) t)
1159 )) 1167 ))
1160 1168
@@ -1171,7 +1179,7 @@ If you use ada-xref.el:
1171 ;; Support for compile.el 1179 ;; Support for compile.el
1172 ;; We just substitute our own functions to go to the error. 1180 ;; We just substitute our own functions to go to the error.
1173 (add-hook 'compilation-mode-hook 1181 (add-hook 'compilation-mode-hook
1174 (lambda() 1182 (lambda()
1175 (set (make-local-variable 'compile-auto-highlight) 40) 1183 (set (make-local-variable 'compile-auto-highlight) 40)
1176 ;; FIXME: This has global impact! -stef 1184 ;; FIXME: This has global impact! -stef
1177 (define-key compilation-minor-mode-map [mouse-2] 1185 (define-key compilation-minor-mode-map [mouse-2]
@@ -1188,15 +1196,15 @@ If you use ada-xref.el:
1188 (if (featurep 'xemacs) 1196 (if (featurep 'xemacs)
1189 ;; XEmacs 1197 ;; XEmacs
1190 (put 'ada-mode 'font-lock-defaults 1198 (put 'ada-mode 'font-lock-defaults
1191 '(ada-font-lock-keywords 1199 '(ada-font-lock-keywords
1192 nil t ((?\_ . "w") (?# . ".")) beginning-of-line)) 1200 nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
1193 ;; Emacs 1201 ;; Emacs
1194 (set (make-local-variable 'font-lock-defaults) 1202 (set (make-local-variable 'font-lock-defaults)
1195 '(ada-font-lock-keywords 1203 '(ada-font-lock-keywords
1196 nil t 1204 nil t
1197 ((?\_ . "w") (?# . ".")) 1205 ((?\_ . "w") (?# . "."))
1198 beginning-of-line 1206 beginning-of-line
1199 (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords))) 1207 (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
1200 ) 1208 )
1201 1209
1202 ;; Set up support for find-file.el. 1210 ;; Set up support for find-file.el.
@@ -1205,39 +1213,39 @@ If you use ada-xref.el:
1205 (set (make-local-variable 'ff-search-directories) 1213 (set (make-local-variable 'ff-search-directories)
1206 'ada-search-directories-internal) 1214 'ada-search-directories-internal)
1207 (setq ff-post-load-hook 'ada-set-point-accordingly 1215 (setq ff-post-load-hook 'ada-set-point-accordingly
1208 ff-file-created-hook 'ada-make-body) 1216 ff-file-created-hook 'ada-make-body)
1209 (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in) 1217 (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in)
1210 1218
1211 ;; Some special constructs for find-file.el. 1219 ;; Some special constructs for find-file.el.
1212 (make-local-variable 'ff-special-constructs) 1220 (make-local-variable 'ff-special-constructs)
1213 (mapc (lambda (pair) 1221 (mapc (lambda (pair)
1214 (add-to-list 'ff-special-constructs pair)) 1222 (add-to-list 'ff-special-constructs pair))
1215 `( 1223 `(
1216 ;; Go to the parent package. 1224 ;; Go to the parent package.
1217 (,(eval-when-compile 1225 (,(eval-when-compile
1218 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+" 1226 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
1219 "\\(body[ \t]+\\)?" 1227 "\\(body[ \t]+\\)?"
1220 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is")) 1228 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
1221 . ,(lambda () 1229 . ,(lambda ()
1222 (ff-get-file 1230 (ff-get-file
1223 ada-search-directories-internal 1231 ada-search-directories-internal
1224 (ada-make-filename-from-adaname (match-string 3)) 1232 (ada-make-filename-from-adaname (match-string 3))
1225 ada-spec-suffixes))) 1233 ada-spec-suffixes)))
1226 ;; A "separate" clause. 1234 ;; A "separate" clause.
1227 ("^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))" 1235 ("^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
1228 . ,(lambda () 1236 . ,(lambda ()
1229 (ff-get-file 1237 (ff-get-file
1230 ada-search-directories-internal 1238 ada-search-directories-internal
1231 (ada-make-filename-from-adaname (match-string 1)) 1239 (ada-make-filename-from-adaname (match-string 1))
1232 ada-spec-suffixes))) 1240 ada-spec-suffixes)))
1233 ;; A "with" clause. 1241 ;; A "with" clause.
1234 ("^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" 1242 ("^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
1235 . ,(lambda () 1243 . ,(lambda ()
1236 (ff-get-file 1244 (ff-get-file
1237 ada-search-directories-internal 1245 ada-search-directories-internal
1238 (ada-make-filename-from-adaname (match-string 1)) 1246 (ada-make-filename-from-adaname (match-string 1))
1239 ada-spec-suffixes))) 1247 ada-spec-suffixes)))
1240 )) 1248 ))
1241 1249
1242 ;; Support for outline-minor-mode 1250 ;; Support for outline-minor-mode
1243 (set (make-local-variable 'outline-regexp) 1251 (set (make-local-variable 'outline-regexp)
@@ -1336,11 +1344,11 @@ If you use ada-xref.el:
1336 1344
1337 (if ada-clean-buffer-before-saving 1345 (if ada-clean-buffer-before-saving
1338 (progn 1346 (progn
1339 ;; remove all spaces at the end of lines in the whole buffer. 1347 ;; remove all spaces at the end of lines in the whole buffer.
1340 (add-hook 'local-write-file-hooks 'delete-trailing-whitespace) 1348 (add-hook 'local-write-file-hooks 'delete-trailing-whitespace)
1341 ;; convert all tabs to the correct number of spaces. 1349 ;; convert all tabs to the correct number of spaces.
1342 (add-hook 'local-write-file-hooks 1350 (add-hook 'local-write-file-hooks
1343 (lambda () (untabify (point-min) (point-max)))))) 1351 (lambda () (untabify (point-min) (point-max))))))
1344 1352
1345 (set (make-local-variable 'skeleton-further-elements) 1353 (set (make-local-variable 'skeleton-further-elements)
1346 '((< '(backward-delete-char-untabify 1354 '((< '(backward-delete-char-untabify
@@ -1366,12 +1374,12 @@ If you use ada-xref.el:
1366 1374
1367 ;; the following has to be done after running the ada-mode-hook 1375 ;; the following has to be done after running the ada-mode-hook
1368 ;; because users might want to set the values of these variable 1376 ;; because users might want to set the values of these variable
1369 ;; inside the hook (MH) 1377 ;; inside the hook
1370 1378
1371 (cond ((eq ada-language-version 'ada83) 1379 (cond ((eq ada-language-version 'ada83)
1372 (setq ada-keywords ada-83-keywords)) 1380 (setq ada-keywords ada-83-keywords))
1373 ((eq ada-language-version 'ada95) 1381 ((eq ada-language-version 'ada95)
1374 (setq ada-keywords ada-95-keywords))) 1382 (setq ada-keywords ada-95-keywords)))
1375 1383
1376 (if ada-auto-case 1384 (if ada-auto-case
1377 (ada-activate-keys-for-case))) 1385 (ada-activate-keys-for-case)))
@@ -1408,18 +1416,16 @@ If you use ada-xref.el:
1408;;----------------------------------------------------------------- 1416;;-----------------------------------------------------------------
1409 1417
1410(defun ada-save-exceptions-to-file (file-name) 1418(defun ada-save-exceptions-to-file (file-name)
1411 "Save the exception lists `ada-case-exception' and 1419 "Save the casing exception lists to the file FILE-NAME.
1412`ada-case-exception-substring' to the file FILE-NAME." 1420Casing exception lists are `ada-case-exception' and `ada-case-exception-substring'."
1413
1414 ;; Save the list in the file
1415 (find-file (expand-file-name file-name)) 1421 (find-file (expand-file-name file-name))
1416 (erase-buffer) 1422 (erase-buffer)
1417 (mapcar (lambda (x) (insert (car x) "\n")) 1423 (mapcar (lambda (x) (insert (car x) "\n"))
1418 (sort (copy-sequence ada-case-exception) 1424 (sort (copy-sequence ada-case-exception)
1419 (lambda(a b) (string< (car a) (car b))))) 1425 (lambda(a b) (string< (car a) (car b)))))
1420 (mapcar (lambda (x) (insert "*" (car x) "\n")) 1426 (mapcar (lambda (x) (insert "*" (car x) "\n"))
1421 (sort (copy-sequence ada-case-exception-substring) 1427 (sort (copy-sequence ada-case-exception-substring)
1422 (lambda(a b) (string< (car a) (car b))))) 1428 (lambda(a b) (string< (car a) (car b)))))
1423 (save-buffer) 1429 (save-buffer)
1424 (kill-buffer nil) 1430 (kill-buffer nil)
1425 ) 1431 )
@@ -1431,23 +1437,23 @@ The new words is added to the first file in `ada-case-exception-file'.
1431The standard casing rules will no longer apply to this word." 1437The standard casing rules will no longer apply to this word."
1432 (interactive) 1438 (interactive)
1433 (let ((previous-syntax-table (syntax-table)) 1439 (let ((previous-syntax-table (syntax-table))
1434 file-name 1440 file-name
1435 ) 1441 )
1436 1442
1437 (cond ((stringp ada-case-exception-file) 1443 (cond ((stringp ada-case-exception-file)
1438 (setq file-name ada-case-exception-file)) 1444 (setq file-name ada-case-exception-file))
1439 ((listp ada-case-exception-file) 1445 ((listp ada-case-exception-file)
1440 (setq file-name (car ada-case-exception-file))) 1446 (setq file-name (car ada-case-exception-file)))
1441 (t 1447 (t
1442 (error (concat "No exception file specified. " 1448 (error (concat "No exception file specified. "
1443 "See variable ada-case-exception-file")))) 1449 "See variable ada-case-exception-file"))))
1444 1450
1445 (set-syntax-table ada-mode-symbol-syntax-table) 1451 (set-syntax-table ada-mode-symbol-syntax-table)
1446 (unless word 1452 (unless word
1447 (save-excursion 1453 (save-excursion
1448 (skip-syntax-backward "w") 1454 (skip-syntax-backward "w")
1449 (setq word (buffer-substring-no-properties 1455 (setq word (buffer-substring-no-properties
1450 (point) (save-excursion (forward-word 1) (point)))))) 1456 (point) (save-excursion (forward-word 1) (point))))))
1451 (set-syntax-table previous-syntax-table) 1457 (set-syntax-table previous-syntax-table)
1452 1458
1453 ;; Reread the exceptions file, in case it was modified by some other, 1459 ;; Reread the exceptions file, in case it was modified by some other,
@@ -1456,8 +1462,8 @@ The standard casing rules will no longer apply to this word."
1456 ;; If the word is already in the list, even with a different casing 1462 ;; If the word is already in the list, even with a different casing
1457 ;; we simply want to replace it. 1463 ;; we simply want to replace it.
1458 (if (and (not (equal ada-case-exception '())) 1464 (if (and (not (equal ada-case-exception '()))
1459 (assoc-string word ada-case-exception t)) 1465 (assoc-string word ada-case-exception t))
1460 (setcar (assoc-string word ada-case-exception t) word) 1466 (setcar (assoc-string word ada-case-exception t) word)
1461 (add-to-list 'ada-case-exception (cons word t)) 1467 (add-to-list 'ada-case-exception (cons word t))
1462 ) 1468 )
1463 1469
@@ -1509,8 +1515,8 @@ word itself has a special casing."
1509 ;; If the word is already in the list, even with a different casing 1515 ;; If the word is already in the list, even with a different casing
1510 ;; we simply want to replace it. 1516 ;; we simply want to replace it.
1511 (if (and (not (equal ada-case-exception-substring '())) 1517 (if (and (not (equal ada-case-exception-substring '()))
1512 (assoc-string word ada-case-exception-substring t)) 1518 (assoc-string word ada-case-exception-substring t))
1513 (setcar (assoc-string word ada-case-exception-substring t) word) 1519 (setcar (assoc-string word ada-case-exception-substring t) word)
1514 (add-to-list 'ada-case-exception-substring (cons word t)) 1520 (add-to-list 'ada-case-exception-substring (cons word t))
1515 ) 1521 )
1516 1522
@@ -1522,17 +1528,17 @@ word itself has a special casing."
1522 "Read the content of the casing exception file FILE-NAME." 1528 "Read the content of the casing exception file FILE-NAME."
1523 (if (file-readable-p (expand-file-name file-name)) 1529 (if (file-readable-p (expand-file-name file-name))
1524 (let ((buffer (current-buffer))) 1530 (let ((buffer (current-buffer)))
1525 (find-file (expand-file-name file-name)) 1531 (find-file (expand-file-name file-name))
1526 (set-syntax-table ada-mode-symbol-syntax-table) 1532 (set-syntax-table ada-mode-symbol-syntax-table)
1527 (widen) 1533 (widen)
1528 (goto-char (point-min)) 1534 (goto-char (point-min))
1529 (while (not (eobp)) 1535 (while (not (eobp))
1530 1536
1531 ;; If the item is already in the list, even with an other casing, 1537 ;; If the item is already in the list, even with an other casing,
1532 ;; do not add it again. This way, the user can easily decide which 1538 ;; do not add it again. This way, the user can easily decide which
1533 ;; priority should be applied to each casing exception 1539 ;; priority should be applied to each casing exception
1534 (let ((word (buffer-substring-no-properties 1540 (let ((word (buffer-substring-no-properties
1535 (point) (save-excursion (forward-word 1) (point))))) 1541 (point) (save-excursion (forward-word 1) (point)))))
1536 1542
1537 ;; Handling a substring ? 1543 ;; Handling a substring ?
1538 (if (char-equal (string-to-char word) ?*) 1544 (if (char-equal (string-to-char word) ?*)
@@ -1543,9 +1549,9 @@ word itself has a special casing."
1543 (unless (assoc-string word ada-case-exception t) 1549 (unless (assoc-string word ada-case-exception t)
1544 (add-to-list 'ada-case-exception (cons word t))))) 1550 (add-to-list 'ada-case-exception (cons word t)))))
1545 1551
1546 (forward-line 1)) 1552 (forward-line 1))
1547 (kill-buffer nil) 1553 (kill-buffer nil)
1548 (set-buffer buffer))) 1554 (set-buffer buffer)))
1549 ) 1555 )
1550 1556
1551(defun ada-case-read-exceptions () 1557(defun ada-case-read-exceptions ()
@@ -1557,11 +1563,11 @@ word itself has a special casing."
1557 ada-case-exception-substring '()) 1563 ada-case-exception-substring '())
1558 1564
1559 (cond ((stringp ada-case-exception-file) 1565 (cond ((stringp ada-case-exception-file)
1560 (ada-case-read-exceptions-from-file ada-case-exception-file)) 1566 (ada-case-read-exceptions-from-file ada-case-exception-file))
1561 1567
1562 ((listp ada-case-exception-file) 1568 ((listp ada-case-exception-file)
1563 (mapcar 'ada-case-read-exceptions-from-file 1569 (mapcar 'ada-case-read-exceptions-from-file
1564 ada-case-exception-file)))) 1570 ada-case-exception-file))))
1565 1571
1566(defun ada-adjust-case-substring () 1572(defun ada-adjust-case-substring ()
1567 "Adjust case of substrings in the previous word." 1573 "Adjust case of substrings in the previous word."
@@ -1597,26 +1603,26 @@ The auto-casing is done according to the value of `ada-case-identifier'
1597and the exceptions defined in `ada-case-exception-file'." 1603and the exceptions defined in `ada-case-exception-file'."
1598 (interactive) 1604 (interactive)
1599 (if (or (equal ada-case-exception '()) 1605 (if (or (equal ada-case-exception '())
1600 (equal (char-after) ?_)) 1606 (equal (char-after) ?_))
1601 (progn 1607 (progn
1602 (funcall ada-case-identifier -1) 1608 (funcall ada-case-identifier -1)
1603 (ada-adjust-case-substring)) 1609 (ada-adjust-case-substring))
1604 1610
1605 (progn 1611 (progn
1606 (let ((end (point)) 1612 (let ((end (point))
1607 (start (save-excursion (skip-syntax-backward "w") 1613 (start (save-excursion (skip-syntax-backward "w")
1608 (point))) 1614 (point)))
1609 match) 1615 match)
1610 ;; If we have an exception, replace the word by the correct casing 1616 ;; If we have an exception, replace the word by the correct casing
1611 (if (setq match (assoc-string (buffer-substring start end) 1617 (if (setq match (assoc-string (buffer-substring start end)
1612 ada-case-exception t)) 1618 ada-case-exception t))
1613 1619
1614 (progn 1620 (progn
1615 (delete-region start end) 1621 (delete-region start end)
1616 (insert (car match))) 1622 (insert (car match)))
1617 1623
1618 ;; Else simply re-case the word 1624 ;; Else simply re-case the word
1619 (funcall ada-case-identifier -1) 1625 (funcall ada-case-identifier -1)
1620 (ada-adjust-case-substring)))))) 1626 (ada-adjust-case-substring))))))
1621 1627
1622(defun ada-after-keyword-p () 1628(defun ada-after-keyword-p ()
@@ -1624,9 +1630,9 @@ and the exceptions defined in `ada-case-exception-file'."
1624 (save-excursion 1630 (save-excursion
1625 (forward-word -1) 1631 (forward-word -1)
1626 (and (not (and (char-before) 1632 (and (not (and (char-before)
1627 (or (= (char-before) ?_) 1633 (or (= (char-before) ?_)
1628 (= (char-before) ?'))));; unless we have a _ or ' 1634 (= (char-before) ?'))));; unless we have a _ or '
1629 (looking-at (concat ada-keywords "[^_]"))))) 1635 (looking-at (concat ada-keywords "[^_]")))))
1630 1636
1631(defun ada-adjust-case (&optional force-identifier) 1637(defun ada-adjust-case (&optional force-identifier)
1632 "Adjust the case of the word before the character just typed. 1638 "Adjust the case of the word before the character just typed.
@@ -1665,7 +1671,7 @@ ARG is the prefix the user entered with \\[universal-argument]."
1665 1671
1666 (if ada-auto-case 1672 (if ada-auto-case
1667 (let ((lastk last-command-char) 1673 (let ((lastk last-command-char)
1668 (previous-syntax-table (syntax-table))) 1674 (previous-syntax-table (syntax-table)))
1669 1675
1670 (unwind-protect 1676 (unwind-protect
1671 (progn 1677 (progn
@@ -1685,7 +1691,7 @@ ARG is the prefix the user entered with \\[universal-argument]."
1685 (funcall ada-ret-binding)))) 1691 (funcall ada-ret-binding))))
1686 ((eq lastk ?\C-i) (ada-tab)) 1692 ((eq lastk ?\C-i) (ada-tab))
1687 ;; Else just insert the character 1693 ;; Else just insert the character
1688 ((self-insert-command (prefix-numeric-value arg)))) 1694 ((self-insert-command (prefix-numeric-value arg))))
1689 ;; if there is a keyword in front of the underscore 1695 ;; if there is a keyword in front of the underscore
1690 ;; then it should be part of an identifier (MH) 1696 ;; then it should be part of an identifier (MH)
1691 (if (eq lastk ?_) 1697 (if (eq lastk ?_)
@@ -1694,7 +1700,7 @@ ARG is the prefix the user entered with \\[universal-argument]."
1694 ) 1700 )
1695 ;; Restore the syntax table 1701 ;; Restore the syntax table
1696 (set-syntax-table previous-syntax-table)) 1702 (set-syntax-table previous-syntax-table))
1697 ) 1703 )
1698 1704
1699 ;; Else, no auto-casing 1705 ;; Else, no auto-casing
1700 (cond 1706 (cond
@@ -1718,11 +1724,11 @@ ARG is the prefix the user entered with \\[universal-argument]."
1718 1724
1719 ;; Call case modifying function after certain keys. 1725 ;; Call case modifying function after certain keys.
1720 (mapcar (function (lambda(key) (define-key 1726 (mapcar (function (lambda(key) (define-key
1721 ada-mode-map 1727 ada-mode-map
1722 (char-to-string key) 1728 (char-to-string key)
1723 'ada-adjust-case-interactive))) 1729 'ada-adjust-case-interactive)))
1724 '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+ 1730 '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+
1725 ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))) 1731 ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r )))
1726 1732
1727(defun ada-loose-case-word (&optional arg) 1733(defun ada-loose-case-word (&optional arg)
1728 "Upcase first letter and letters following `_' in the following word. 1734 "Upcase first letter and letters following `_' in the following word.
@@ -1731,18 +1737,18 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only."
1731 (interactive) 1737 (interactive)
1732 (save-excursion 1738 (save-excursion
1733 (let ((end (save-excursion (skip-syntax-forward "w") (point))) 1739 (let ((end (save-excursion (skip-syntax-forward "w") (point)))
1734 (first t)) 1740 (first t))
1735 (skip-syntax-backward "w") 1741 (skip-syntax-backward "w")
1736 (while (and (or first (search-forward "_" end t)) 1742 (while (and (or first (search-forward "_" end t))
1737 (< (point) end)) 1743 (< (point) end))
1738 (and first 1744 (and first
1739 (setq first nil)) 1745 (setq first nil))
1740 (insert-char (upcase (following-char)) 1) 1746 (insert-char (upcase (following-char)) 1)
1741 (delete-char 1))))) 1747 (delete-char 1)))))
1742 1748
1743(defun ada-no-auto-case (&optional arg) 1749(defun ada-no-auto-case (&optional arg)
1744 "Do nothing. 1750 "Do nothing. ARG is ignored.
1745This function can be used for the auto-casing variables in the Ada mode, to 1751This function can be used for the auto-casing variables in Ada mode, to
1746adapt to unusal auto-casing schemes. Since it does nothing, you can for 1752adapt to unusal auto-casing schemes. Since it does nothing, you can for
1747instance use it for `ada-case-identifier' if you don't want any special 1753instance use it for `ada-case-identifier' if you don't want any special
1748auto-casing for identifiers, whereas keywords have to be lower-cased. 1754auto-casing for identifiers, whereas keywords have to be lower-cased.
@@ -1754,7 +1760,7 @@ See also `ada-auto-case' to disable auto casing altogether."
1754ARG is ignored, and is there for compatibility with `capitalize-word' only." 1760ARG is ignored, and is there for compatibility with `capitalize-word' only."
1755 (interactive) 1761 (interactive)
1756 (let ((end (save-excursion (skip-syntax-forward "w") (point))) 1762 (let ((end (save-excursion (skip-syntax-forward "w") (point)))
1757 (begin (save-excursion (skip-syntax-backward "w") (point)))) 1763 (begin (save-excursion (skip-syntax-backward "w") (point))))
1758 (modify-syntax-entry ?_ "_") 1764 (modify-syntax-entry ?_ "_")
1759 (capitalize-region begin end) 1765 (capitalize-region begin end)
1760 (modify-syntax-entry ?_ "w"))) 1766 (modify-syntax-entry ?_ "w")))
@@ -1764,45 +1770,45 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only."
1764Attention: This function might take very long for big regions!" 1770Attention: This function might take very long for big regions!"
1765 (interactive "*r") 1771 (interactive "*r")
1766 (let ((begin nil) 1772 (let ((begin nil)
1767 (end nil) 1773 (end nil)
1768 (keywordp nil) 1774 (keywordp nil)
1769 (attribp nil) 1775 (attribp nil)
1770 (previous-syntax-table (syntax-table))) 1776 (previous-syntax-table (syntax-table)))
1771 (message "Adjusting case ...") 1777 (message "Adjusting case ...")
1772 (unwind-protect 1778 (unwind-protect
1773 (save-excursion 1779 (save-excursion
1774 (set-syntax-table ada-mode-symbol-syntax-table) 1780 (set-syntax-table ada-mode-symbol-syntax-table)
1775 (goto-char to) 1781 (goto-char to)
1776 ;; 1782 ;;
1777 ;; loop: look for all identifiers, keywords, and attributes 1783 ;; loop: look for all identifiers, keywords, and attributes
1778 ;; 1784 ;;
1779 (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) 1785 (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
1780 (setq end (match-end 1)) 1786 (setq end (match-end 1))
1781 (setq attribp 1787 (setq attribp
1782 (and (> (point) from) 1788 (and (> (point) from)
1783 (save-excursion 1789 (save-excursion
1784 (forward-char -1) 1790 (forward-char -1)
1785 (setq attribp (looking-at "'.[^']"))))) 1791 (setq attribp (looking-at "'.[^']")))))
1786 (or 1792 (or
1787 ;; do nothing if it is a string or comment 1793 ;; do nothing if it is a string or comment
1788 (ada-in-string-or-comment-p) 1794 (ada-in-string-or-comment-p)
1789 (progn 1795 (progn
1790 ;; 1796 ;;
1791 ;; get the identifier or keyword or attribute 1797 ;; get the identifier or keyword or attribute
1792 ;; 1798 ;;
1793 (setq begin (point)) 1799 (setq begin (point))
1794 (setq keywordp (looking-at ada-keywords)) 1800 (setq keywordp (looking-at ada-keywords))
1795 (goto-char end) 1801 (goto-char end)
1796 ;; 1802 ;;
1797 ;; casing according to user-option 1803 ;; casing according to user-option
1798 ;; 1804 ;;
1799 (if attribp 1805 (if attribp
1800 (funcall ada-case-attribute -1) 1806 (funcall ada-case-attribute -1)
1801 (if keywordp 1807 (if keywordp
1802 (funcall ada-case-keyword -1) 1808 (funcall ada-case-keyword -1)
1803 (ada-adjust-case-identifier))) 1809 (ada-adjust-case-identifier)))
1804 (goto-char begin)))) 1810 (goto-char begin))))
1805 (message "Adjusting case ... Done")) 1811 (message "Adjusting case ... Done"))
1806 (set-syntax-table previous-syntax-table)))) 1812 (set-syntax-table previous-syntax-table))))
1807 1813
1808(defun ada-adjust-case-buffer () 1814(defun ada-adjust-case-buffer ()
@@ -1832,44 +1838,44 @@ ATTENTION: This function might take very long for big buffers!"
1832 "Reformat the parameter list point is in." 1838 "Reformat the parameter list point is in."
1833 (interactive) 1839 (interactive)
1834 (let ((begin nil) 1840 (let ((begin nil)
1835 (end nil) 1841 (end nil)
1836 (delend nil) 1842 (delend nil)
1837 (paramlist nil) 1843 (paramlist nil)
1838 (previous-syntax-table (syntax-table))) 1844 (previous-syntax-table (syntax-table)))
1839 (unwind-protect 1845 (unwind-protect
1840 (progn 1846 (progn
1841 (set-syntax-table ada-mode-symbol-syntax-table) 1847 (set-syntax-table ada-mode-symbol-syntax-table)
1842
1843 ;; check if really inside parameter list
1844 (or (ada-in-paramlist-p)
1845 (error "Not in parameter list"))
1846 1848
1847 ;; find start of current parameter-list 1849 ;; check if really inside parameter list
1848 (ada-search-ignore-string-comment 1850 (or (ada-in-paramlist-p)
1849 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) 1851 (error "Not in parameter list"))
1850 (down-list 1)
1851 (backward-char 1)
1852 (setq begin (point))
1853 1852
1854 ;; find end of parameter-list 1853 ;; find start of current parameter-list
1855 (forward-sexp 1) 1854 (ada-search-ignore-string-comment
1856 (setq delend (point)) 1855 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
1857 (delete-char -1) 1856 (down-list 1)
1858 (insert "\n") 1857 (backward-char 1)
1858 (setq begin (point))
1859
1860 ;; find end of parameter-list
1861 (forward-sexp 1)
1862 (setq delend (point))
1863 (delete-char -1)
1864 (insert "\n")
1859 1865
1860 ;; find end of last parameter-declaration 1866 ;; find end of last parameter-declaration
1861 (forward-comment -1000) 1867 (forward-comment -1000)
1862 (setq end (point)) 1868 (setq end (point))
1863 1869
1864 ;; build a list of all elements of the parameter-list 1870 ;; build a list of all elements of the parameter-list
1865 (setq paramlist (ada-scan-paramlist (1+ begin) end)) 1871 (setq paramlist (ada-scan-paramlist (1+ begin) end))
1866 1872
1867 ;; delete the original parameter-list 1873 ;; delete the original parameter-list
1868 (delete-region begin delend) 1874 (delete-region begin delend)
1869 1875
1870 ;; insert the new parameter-list 1876 ;; insert the new parameter-list
1871 (goto-char begin) 1877 (goto-char begin)
1872 (ada-insert-paramlist paramlist)) 1878 (ada-insert-paramlist paramlist))
1873 1879
1874 ;; restore syntax-table 1880 ;; restore syntax-table
1875 (set-syntax-table previous-syntax-table) 1881 (set-syntax-table previous-syntax-table)
@@ -1879,12 +1885,12 @@ ATTENTION: This function might take very long for big buffers!"
1879 "Scan the parameter list found in between BEGIN and END. 1885 "Scan the parameter list found in between BEGIN and END.
1880Return the equivalent internal parameter list." 1886Return the equivalent internal parameter list."
1881 (let ((paramlist (list)) 1887 (let ((paramlist (list))
1882 (param (list)) 1888 (param (list))
1883 (notend t) 1889 (notend t)
1884 (apos nil) 1890 (apos nil)
1885 (epos nil) 1891 (epos nil)
1886 (semipos nil) 1892 (semipos nil)
1887 (match-cons nil)) 1893 (match-cons nil))
1888 1894
1889 (goto-char begin) 1895 (goto-char begin)
1890 1896
@@ -1897,11 +1903,11 @@ Return the equivalent internal parameter list."
1897 1903
1898 ;; find last character of parameter-declaration 1904 ;; find last character of parameter-declaration
1899 (if (setq match-cons 1905 (if (setq match-cons
1900 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t)) 1906 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
1901 (progn 1907 (progn
1902 (setq epos (car match-cons)) 1908 (setq epos (car match-cons))
1903 (setq semipos (cdr match-cons))) 1909 (setq semipos (cdr match-cons)))
1904 (setq epos end)) 1910 (setq epos end))
1905 1911
1906 ;; read name(s) of parameter(s) 1912 ;; read name(s) of parameter(s)
1907 (goto-char apos) 1913 (goto-char apos)
@@ -1913,76 +1919,76 @@ Return the equivalent internal parameter list."
1913 ;; look for 'in' 1919 ;; look for 'in'
1914 (setq apos (point)) 1920 (setq apos (point))
1915 (setq param 1921 (setq param
1916 (append param 1922 (append param
1917 (list 1923 (list
1918 (consp 1924 (consp
1919 (ada-search-ignore-string-comment 1925 (ada-search-ignore-string-comment
1920 "in" nil epos t 'word-search-forward))))) 1926 "in" nil epos t 'word-search-forward)))))
1921 1927
1922 ;; look for 'out' 1928 ;; look for 'out'
1923 (goto-char apos) 1929 (goto-char apos)
1924 (setq param 1930 (setq param
1925 (append param 1931 (append param
1926 (list 1932 (list
1927 (consp 1933 (consp
1928 (ada-search-ignore-string-comment 1934 (ada-search-ignore-string-comment
1929 "out" nil epos t 'word-search-forward))))) 1935 "out" nil epos t 'word-search-forward)))))
1930 1936
1931 ;; look for 'access' 1937 ;; look for 'access'
1932 (goto-char apos) 1938 (goto-char apos)
1933 (setq param 1939 (setq param
1934 (append param 1940 (append param
1935 (list 1941 (list
1936 (consp 1942 (consp
1937 (ada-search-ignore-string-comment 1943 (ada-search-ignore-string-comment
1938 "access" nil epos t 'word-search-forward))))) 1944 "access" nil epos t 'word-search-forward)))))
1939 1945
1940 ;; skip 'in'/'out'/'access' 1946 ;; skip 'in'/'out'/'access'
1941 (goto-char apos) 1947 (goto-char apos)
1942 (ada-goto-next-non-ws) 1948 (ada-goto-next-non-ws)
1943 (while (looking-at "\\<\\(in\\|out\\|access\\)\\>") 1949 (while (looking-at "\\<\\(in\\|out\\|access\\)\\>")
1944 (forward-word 1) 1950 (forward-word 1)
1945 (ada-goto-next-non-ws)) 1951 (ada-goto-next-non-ws))
1946 1952
1947 ;; read type of parameter 1953 ;; read type of parameter
1948 ;; We accept spaces in the name, since some software like Rose 1954 ;; We accept spaces in the name, since some software like Rose
1949 ;; generates something like: "A : B 'Class" 1955 ;; generates something like: "A : B 'Class"
1950 (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>") 1956 (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>")
1951 (setq param 1957 (setq param
1952 (append param 1958 (append param
1953 (list (match-string 0)))) 1959 (list (match-string 0))))
1954 1960
1955 ;; read default-expression, if there is one 1961 ;; read default-expression, if there is one
1956 (goto-char (setq apos (match-end 0))) 1962 (goto-char (setq apos (match-end 0)))
1957 (setq param 1963 (setq param
1958 (append param 1964 (append param
1959 (list 1965 (list
1960 (if (setq match-cons 1966 (if (setq match-cons
1961 (ada-search-ignore-string-comment 1967 (ada-search-ignore-string-comment
1962 ":=" nil epos t 'search-forward)) 1968 ":=" nil epos t 'search-forward))
1963 (buffer-substring (car match-cons) epos) 1969 (buffer-substring (car match-cons) epos)
1964 nil)))) 1970 nil))))
1965 1971
1966 ;; add this parameter-declaration to the list 1972 ;; add this parameter-declaration to the list
1967 (setq paramlist (append paramlist (list param))) 1973 (setq paramlist (append paramlist (list param)))
1968 1974
1969 ;; check if it was the last parameter 1975 ;; check if it was the last parameter
1970 (if (eq epos end) 1976 (if (eq epos end)
1971 (setq notend nil) 1977 (setq notend nil)
1972 (goto-char semipos)) 1978 (goto-char semipos))
1973 ) 1979 )
1974 (reverse paramlist))) 1980 (reverse paramlist)))
1975 1981
1976(defun ada-insert-paramlist (paramlist) 1982(defun ada-insert-paramlist (paramlist)
1977 "Insert a formatted PARAMLIST in the buffer." 1983 "Insert a formatted PARAMLIST in the buffer."
1978 (let ((i (length paramlist)) 1984 (let ((i (length paramlist))
1979 (parlen 0) 1985 (parlen 0)
1980 (typlen 0) 1986 (typlen 0)
1981 (inp nil) 1987 (inp nil)
1982 (outp nil) 1988 (outp nil)
1983 (accessp nil) 1989 (accessp nil)
1984 (column nil) 1990 (column nil)
1985 (firstcol nil)) 1991 (firstcol nil))
1986 1992
1987 ;; loop until last parameter 1993 ;; loop until last parameter
1988 (while (not (zerop i)) 1994 (while (not (zerop i))
@@ -2006,23 +2012,23 @@ Return the equivalent internal parameter list."
2006 2012
2007 ;; does paramlist already start on a separate line ? 2013 ;; does paramlist already start on a separate line ?
2008 (if (save-excursion 2014 (if (save-excursion
2009 (re-search-backward "^.\\|[^ \t]" nil t) 2015 (re-search-backward "^.\\|[^ \t]" nil t)
2010 (looking-at "^.")) 2016 (looking-at "^."))
2011 ;; yes => re-indent it 2017 ;; yes => re-indent it
2012 (progn 2018 (progn
2013 (ada-indent-current) 2019 (ada-indent-current)
2014 (save-excursion 2020 (save-excursion
2015 (if (looking-at "\\(is\\|return\\)") 2021 (if (looking-at "\\(is\\|return\\)")
2016 (replace-match " \\1")))) 2022 (replace-match " \\1"))))
2017 2023
2018 ;; no => insert it where we are after removing any whitespace 2024 ;; no => insert it where we are after removing any whitespace
2019 (fixup-whitespace) 2025 (fixup-whitespace)
2020 (save-excursion 2026 (save-excursion
2021 (cond 2027 (cond
2022 ((looking-at "[ \t]*\\(\n\\|;\\)") 2028 ((looking-at "[ \t]*\\(\n\\|;\\)")
2023 (replace-match "\\1")) 2029 (replace-match "\\1"))
2024 ((looking-at "[ \t]*\\(is\\|return\\)") 2030 ((looking-at "[ \t]*\\(is\\|return\\)")
2025 (replace-match " \\1")))) 2031 (replace-match " \\1"))))
2026 (insert " ")) 2032 (insert " "))
2027 2033
2028 (insert "(") 2034 (insert "(")
@@ -2044,42 +2050,42 @@ Return the equivalent internal parameter list."
2044 2050
2045 ;; insert 'in' or space 2051 ;; insert 'in' or space
2046 (if (nth 1 (nth i paramlist)) 2052 (if (nth 1 (nth i paramlist))
2047 (insert "in ") 2053 (insert "in ")
2048 (if (and 2054 (if (and
2049 (or inp 2055 (or inp
2050 accessp) 2056 accessp)
2051 (not (nth 3 (nth i paramlist)))) 2057 (not (nth 3 (nth i paramlist))))
2052 (insert " "))) 2058 (insert " ")))
2053 2059
2054 ;; insert 'out' or space 2060 ;; insert 'out' or space
2055 (if (nth 2 (nth i paramlist)) 2061 (if (nth 2 (nth i paramlist))
2056 (insert "out ") 2062 (insert "out ")
2057 (if (and 2063 (if (and
2058 (or outp 2064 (or outp
2059 accessp) 2065 accessp)
2060 (not (nth 3 (nth i paramlist)))) 2066 (not (nth 3 (nth i paramlist))))
2061 (insert " "))) 2067 (insert " ")))
2062 2068
2063 ;; insert 'access' 2069 ;; insert 'access'
2064 (if (nth 3 (nth i paramlist)) 2070 (if (nth 3 (nth i paramlist))
2065 (insert "access ")) 2071 (insert "access "))
2066 2072
2067 (setq column (current-column)) 2073 (setq column (current-column))
2068 2074
2069 ;; insert type-name and, if necessary, space and default-expression 2075 ;; insert type-name and, if necessary, space and default-expression
2070 (insert (nth 4 (nth i paramlist))) 2076 (insert (nth 4 (nth i paramlist)))
2071 (if (nth 5 (nth i paramlist)) 2077 (if (nth 5 (nth i paramlist))
2072 (progn 2078 (progn
2073 (indent-to (+ column typlen 1)) 2079 (indent-to (+ column typlen 1))
2074 (insert (nth 5 (nth i paramlist))))) 2080 (insert (nth 5 (nth i paramlist)))))
2075 2081
2076 ;; check if it was the last parameter 2082 ;; check if it was the last parameter
2077 (if (zerop i) 2083 (if (zerop i)
2078 (insert ")") 2084 (insert ")")
2079 ;; no => insert ';' and newline and indent 2085 ;; no => insert ';' and newline and indent
2080 (insert ";") 2086 (insert ";")
2081 (newline) 2087 (newline)
2082 (indent-to firstcol)) 2088 (indent-to firstcol))
2083 ) 2089 )
2084 2090
2085 ;; if anything follows, except semicolon, newline, is or return 2091 ;; if anything follows, except semicolon, newline, is or return
@@ -2123,19 +2129,19 @@ Return the equivalent internal parameter list."
2123 (interactive "*r") 2129 (interactive "*r")
2124 (goto-char beg) 2130 (goto-char beg)
2125 (let ((block-done 0) 2131 (let ((block-done 0)
2126 (lines-remaining (count-lines beg end)) 2132 (lines-remaining (count-lines beg end))
2127 (msg (format "%%4d out of %4d lines remaining ..." 2133 (msg (format "%%4d out of %4d lines remaining ..."
2128 (count-lines beg end))) 2134 (count-lines beg end)))
2129 (endmark (copy-marker end))) 2135 (endmark (copy-marker end)))
2130 ;; catch errors while indenting 2136 ;; catch errors while indenting
2131 (while (< (point) endmark) 2137 (while (< (point) endmark)
2132 (if (> block-done 39) 2138 (if (> block-done 39)
2133 (progn 2139 (progn
2134 (setq lines-remaining (- lines-remaining block-done) 2140 (setq lines-remaining (- lines-remaining block-done)
2135 block-done 0) 2141 block-done 0)
2136 (message msg lines-remaining))) 2142 (message msg lines-remaining)))
2137 (if (= (char-after) ?\n) nil 2143 (if (= (char-after) ?\n) nil
2138 (ada-indent-current)) 2144 (ada-indent-current))
2139 (forward-line 1) 2145 (forward-line 1)
2140 (setq block-done (1+ block-done))) 2146 (setq block-done (1+ block-done)))
2141 (message "Indenting ... done"))) 2147 (message "Indenting ... done")))
@@ -2149,8 +2155,7 @@ Return the equivalent internal parameter list."
2149 2155
2150(defun ada-indent-newline-indent-conditional () 2156(defun ada-indent-newline-indent-conditional ()
2151 "Insert a newline and indent it. 2157 "Insert a newline and indent it.
2152The original line is indented first if `ada-indent-after-return' is non-nil. 2158The original line is indented first if `ada-indent-after-return' is non-nil."
2153This function is intended to be bound to the C-m and C-j keys."
2154 (interactive "*") 2159 (interactive "*")
2155 (if ada-indent-after-return (ada-indent-current)) 2160 (if ada-indent-after-return (ada-indent-current))
2156 (newline) 2161 (newline)
@@ -2211,65 +2216,65 @@ Return the calculation that was done, including the reference point and the
2211offset." 2216offset."
2212 (interactive) 2217 (interactive)
2213 (let ((previous-syntax-table (syntax-table)) 2218 (let ((previous-syntax-table (syntax-table))
2214 (orgpoint (point-marker)) 2219 (orgpoint (point-marker))
2215 cur-indent tmp-indent 2220 cur-indent tmp-indent
2216 prev-indent) 2221 prev-indent)
2217 2222
2218 (unwind-protect 2223 (unwind-protect
2219 (progn 2224 (progn
2220 (set-syntax-table ada-mode-symbol-syntax-table) 2225 (set-syntax-table ada-mode-symbol-syntax-table)
2221 2226
2222 ;; This need to be done here so that the advice is not always 2227 ;; This need to be done here so that the advice is not always
2223 ;; activated (this might interact badly with other modes) 2228 ;; activated (this might interact badly with other modes)
2224 (if (featurep 'xemacs) 2229 (if (featurep 'xemacs)
2225 (ad-activate 'parse-partial-sexp t)) 2230 (ad-activate 'parse-partial-sexp t))
2226 2231
2227 (save-excursion 2232 (save-excursion
2228 (setq cur-indent 2233 (setq cur-indent
2229 2234
2230 ;; Not First line in the buffer ? 2235 ;; Not First line in the buffer ?
2231 (if (save-excursion (zerop (forward-line -1))) 2236 (if (save-excursion (zerop (forward-line -1)))
2232 (progn 2237 (progn
2233 (back-to-indentation) 2238 (back-to-indentation)
2234 (ada-get-current-indent)) 2239 (ada-get-current-indent))
2235 2240
2236 ;; first line in the buffer 2241 ;; first line in the buffer
2237 (list (point-min) 0)))) 2242 (list (point-min) 0))))
2238 2243
2239 ;; Evaluate the list to get the column to indent to 2244 ;; Evaluate the list to get the column to indent to
2240 ;; prev-indent contains the column to indent to 2245 ;; prev-indent contains the column to indent to
2241 (if cur-indent 2246 (if cur-indent
2242 (setq prev-indent (save-excursion (goto-char (car cur-indent)) 2247 (setq prev-indent (save-excursion (goto-char (car cur-indent))
2243 (current-column)) 2248 (current-column))
2244 tmp-indent (cdr cur-indent)) 2249 tmp-indent (cdr cur-indent))
2245 (setq prev-indent 0 tmp-indent '())) 2250 (setq prev-indent 0 tmp-indent '()))
2246 2251
2247 (while (not (null tmp-indent)) 2252 (while (not (null tmp-indent))
2248 (cond 2253 (cond
2249 ((numberp (car tmp-indent)) 2254 ((numberp (car tmp-indent))
2250 (setq prev-indent (+ prev-indent (car tmp-indent)))) 2255 (setq prev-indent (+ prev-indent (car tmp-indent))))
2251 (t 2256 (t
2252 (setq prev-indent (+ prev-indent (eval (car tmp-indent))))) 2257 (setq prev-indent (+ prev-indent (eval (car tmp-indent)))))
2253 ) 2258 )
2254 (setq tmp-indent (cdr tmp-indent))) 2259 (setq tmp-indent (cdr tmp-indent)))
2255 2260
2256 ;; only re-indent if indentation is different then the current 2261 ;; only re-indent if indentation is different then the current
2257 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent) 2262 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent)
2258 nil 2263 nil
2259 (beginning-of-line) 2264 (beginning-of-line)
2260 (delete-horizontal-space) 2265 (delete-horizontal-space)
2261 (indent-to prev-indent)) 2266 (indent-to prev-indent))
2262 ;; 2267 ;;
2263 ;; restore position of point 2268 ;; restore position of point
2264 ;; 2269 ;;
2265 (goto-char orgpoint) 2270 (goto-char orgpoint)
2266 (if (< (current-column) (current-indentation)) 2271 (if (< (current-column) (current-indentation))
2267 (back-to-indentation))) 2272 (back-to-indentation)))
2268 2273
2269 ;; restore syntax-table 2274 ;; restore syntax-table
2270 (set-syntax-table previous-syntax-table) 2275 (set-syntax-table previous-syntax-table)
2271 (if (featurep 'xemacs) 2276 (if (featurep 'xemacs)
2272 (ad-deactivate 'parse-partial-sexp)) 2277 (ad-deactivate 'parse-partial-sexp))
2273 ) 2278 )
2274 2279
2275 cur-indent 2280 cur-indent
@@ -2278,14 +2283,14 @@ offset."
2278(defun ada-get-current-indent () 2283(defun ada-get-current-indent ()
2279 "Return the indentation to use for the current line." 2284 "Return the indentation to use for the current line."
2280 (let (column 2285 (let (column
2281 pos 2286 pos
2282 match-cons 2287 match-cons
2283 result 2288 result
2284 (orgpoint (save-excursion 2289 (orgpoint (save-excursion
2285 (beginning-of-line) 2290 (beginning-of-line)
2286 (forward-comment -10000) 2291 (forward-comment -10000)
2287 (forward-line 1) 2292 (forward-line 1)
2288 (point)))) 2293 (point))))
2289 2294
2290 (setq result 2295 (setq result
2291 (cond 2296 (cond
@@ -2411,7 +2416,7 @@ offset."
2411 2416
2412 ((looking-at "else\\>") 2417 ((looking-at "else\\>")
2413 (if (save-excursion (ada-goto-previous-word) 2418 (if (save-excursion (ada-goto-previous-word)
2414 (looking-at "\\<or\\>")) 2419 (looking-at "\\<or\\>"))
2415 (ada-indent-on-previous-lines nil orgpoint orgpoint) 2420 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2416 (save-excursion 2421 (save-excursion
2417 (ada-goto-matching-start 1 nil t) 2422 (ada-goto-matching-start 1 nil t)
@@ -2461,16 +2466,16 @@ offset."
2461 (looking-at "loop\\>")) 2466 (looking-at "loop\\>"))
2462 (setq pos (point)) 2467 (setq pos (point))
2463 (save-excursion 2468 (save-excursion
2464 (goto-char (match-end 0)) 2469 (goto-char (match-end 0))
2465 (ada-goto-stmt-start) 2470 (ada-goto-stmt-start)
2466 (if (looking-at "\\<\\(loop\\|if\\)\\>") 2471 (if (looking-at "\\<\\(loop\\|if\\)\\>")
2467 (ada-indent-on-previous-lines nil orgpoint orgpoint) 2472 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2468 (unless (looking-at ada-loop-start-re) 2473 (unless (looking-at ada-loop-start-re)
2469 (ada-search-ignore-string-comment ada-loop-start-re 2474 (ada-search-ignore-string-comment ada-loop-start-re
2470 nil pos)) 2475 nil pos))
2471 (if (looking-at "\\<loop\\>") 2476 (if (looking-at "\\<loop\\>")
2472 (ada-indent-on-previous-lines nil orgpoint orgpoint) 2477 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2473 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))))) 2478 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))))
2474 2479
2475 ;;---------------------------- 2480 ;;----------------------------
2476 ;; starting with l (limited) or r (record) 2481 ;; starting with l (limited) or r (record)
@@ -2497,9 +2502,9 @@ offset."
2497 ((and (= (downcase (char-after)) ?b) 2502 ((and (= (downcase (char-after)) ?b)
2498 (looking-at "begin\\>")) 2503 (looking-at "begin\\>"))
2499 (save-excursion 2504 (save-excursion
2500 (if (ada-goto-matching-decl-start t) 2505 (if (ada-goto-matching-decl-start t)
2501 (list (progn (back-to-indentation) (point)) 0) 2506 (list (progn (back-to-indentation) (point)) 0)
2502 (ada-indent-on-previous-lines nil orgpoint orgpoint)))) 2507 (ada-indent-on-previous-lines nil orgpoint orgpoint))))
2503 2508
2504 ;;--------------------------- 2509 ;;---------------------------
2505 ;; starting with i (is) 2510 ;; starting with i (is)
@@ -2509,16 +2514,16 @@ offset."
2509 (looking-at "is\\>")) 2514 (looking-at "is\\>"))
2510 2515
2511 (if (and ada-indent-is-separate 2516 (if (and ada-indent-is-separate
2512 (save-excursion 2517 (save-excursion
2513 (goto-char (match-end 0)) 2518 (goto-char (match-end 0))
2514 (ada-goto-next-non-ws (save-excursion (end-of-line) 2519 (ada-goto-next-non-ws (save-excursion (end-of-line)
2515 (point))) 2520 (point)))
2516 (looking-at "\\<abstract\\>\\|\\<separate\\>"))) 2521 (looking-at "\\<abstract\\>\\|\\<separate\\>")))
2517 (save-excursion 2522 (save-excursion
2518 (ada-goto-stmt-start) 2523 (ada-goto-stmt-start)
2519 (list (progn (back-to-indentation) (point)) 'ada-indent)) 2524 (list (progn (back-to-indentation) (point)) 'ada-indent))
2520 (save-excursion 2525 (save-excursion
2521 (ada-goto-stmt-start) 2526 (ada-goto-stmt-start)
2522 (if (looking-at "\\<package\\|procedure\\|function\\>") 2527 (if (looking-at "\\<package\\|procedure\\|function\\>")
2523 (list (progn (back-to-indentation) (point)) 0) 2528 (list (progn (back-to-indentation) (point)) 0)
2524 (list (progn (back-to-indentation) (point)) 'ada-indent))))) 2529 (list (progn (back-to-indentation) (point)) 'ada-indent)))))
@@ -2599,8 +2604,8 @@ offset."
2599 ((and (= (downcase (char-after)) ?d) 2604 ((and (= (downcase (char-after)) ?d)
2600 (looking-at "do\\>")) 2605 (looking-at "do\\>"))
2601 (save-excursion 2606 (save-excursion
2602 (ada-goto-stmt-start) 2607 (ada-goto-stmt-start)
2603 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))) 2608 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))
2604 2609
2605 ;;-------------------------------- 2610 ;;--------------------------------
2606 ;; starting with '-' (comment) 2611 ;; starting with '-' (comment)
@@ -2632,7 +2637,7 @@ offset."
2632 (ada-indent-on-previous-lines nil orgpoint orgpoint))) 2637 (ada-indent-on-previous-lines nil orgpoint orgpoint)))
2633 2638
2634 ;; Else same indentation as the previous line 2639 ;; Else same indentation as the previous line
2635 (list (save-excursion (back-to-indentation) (point)) 0))) 2640 (list (save-excursion (back-to-indentation) (point)) 0)))
2636 2641
2637 ;;-------------------------------- 2642 ;;--------------------------------
2638 ;; starting with '#' (preprocessor line) 2643 ;; starting with '#' (preprocessor line)
@@ -2640,7 +2645,7 @@ offset."
2640 2645
2641 ((and (= (char-after) ?#) 2646 ((and (= (char-after) ?#)
2642 (equal ada-which-compiler 'gnat) 2647 (equal ada-which-compiler 'gnat)
2643 (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)")) 2648 (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)"))
2644 (list (save-excursion (beginning-of-line) (point)) 0)) 2649 (list (save-excursion (beginning-of-line) (point)) 0))
2645 2650
2646 ;;-------------------------------- 2651 ;;--------------------------------
@@ -2649,9 +2654,9 @@ offset."
2649 2654
2650 ((and (not (eobp)) (= (char-after) ?\))) 2655 ((and (not (eobp)) (= (char-after) ?\)))
2651 (save-excursion 2656 (save-excursion
2652 (forward-char 1) 2657 (forward-char 1)
2653 (backward-sexp 1) 2658 (backward-sexp 1)
2654 (list (point) 0))) 2659 (list (point) 0)))
2655 2660
2656 ;;--------------------------------- 2661 ;;---------------------------------
2657 ;; new/abstract/separate 2662 ;; new/abstract/separate
@@ -2689,9 +2694,9 @@ offset."
2689 2694
2690 ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]") 2695 ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
2691 (if (ada-in-decl-p) 2696 (if (ada-in-decl-p)
2692 (ada-indent-on-previous-lines nil orgpoint orgpoint) 2697 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2693 (append (ada-indent-on-previous-lines nil orgpoint orgpoint) 2698 (append (ada-indent-on-previous-lines nil orgpoint orgpoint)
2694 '(ada-label-indent)))) 2699 '(ada-label-indent))))
2695 2700
2696 )) 2701 ))
2697 2702
@@ -2711,60 +2716,60 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
2711 2716
2712 ;; Is inside a parameter-list ? 2717 ;; Is inside a parameter-list ?
2713 (if (ada-in-paramlist-p) 2718 (if (ada-in-paramlist-p)
2714 (ada-get-indent-paramlist) 2719 (ada-get-indent-paramlist)
2715 2720
2716 ;; move to beginning of current statement 2721 ;; move to beginning of current statement
2717 (unless nomove 2722 (unless nomove
2718 (ada-goto-stmt-start)) 2723 (ada-goto-stmt-start))
2719 2724
2720 ;; no beginning found => don't change indentation 2725 ;; no beginning found => don't change indentation
2721 (if (and (eq oldpoint (point)) 2726 (if (and (eq oldpoint (point))
2722 (not nomove)) 2727 (not nomove))
2723 (ada-get-indent-nochange) 2728 (ada-get-indent-nochange)
2724 2729
2725 (cond 2730 (cond
2726 ;; 2731 ;;
2727 ((and 2732 ((and
2728 ada-indent-to-open-paren 2733 ada-indent-to-open-paren
2729 (ada-in-open-paren-p)) 2734 (ada-in-open-paren-p))
2730 (ada-get-indent-open-paren)) 2735 (ada-get-indent-open-paren))
2731 ;; 2736 ;;
2732 ((looking-at "end\\>") 2737 ((looking-at "end\\>")
2733 (ada-get-indent-end orgpoint)) 2738 (ada-get-indent-end orgpoint))
2734 ;; 2739 ;;
2735 ((looking-at ada-loop-start-re) 2740 ((looking-at ada-loop-start-re)
2736 (ada-get-indent-loop orgpoint)) 2741 (ada-get-indent-loop orgpoint))
2737 ;; 2742 ;;
2738 ((looking-at ada-subprog-start-re) 2743 ((looking-at ada-subprog-start-re)
2739 (ada-get-indent-subprog orgpoint)) 2744 (ada-get-indent-subprog orgpoint))
2740 ;; 2745 ;;
2741 ((looking-at ada-block-start-re) 2746 ((looking-at ada-block-start-re)
2742 (ada-get-indent-block-start orgpoint)) 2747 (ada-get-indent-block-start orgpoint))
2743 ;; 2748 ;;
2744 ((looking-at "\\(sub\\)?type\\>") 2749 ((looking-at "\\(sub\\)?type\\>")
2745 (ada-get-indent-type orgpoint)) 2750 (ada-get-indent-type orgpoint))
2746 ;; 2751 ;;
2747 ;; "then" has to be included in the case of "select...then abort" 2752 ;; "then" has to be included in the case of "select...then abort"
2748 ;; statements, since (goto-stmt-start) at the beginning of 2753 ;; statements, since (goto-stmt-start) at the beginning of
2749 ;; the current function would leave the cursor on that position 2754 ;; the current function would leave the cursor on that position
2750 ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\\>") 2755 ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\\>")
2751 (ada-get-indent-if orgpoint)) 2756 (ada-get-indent-if orgpoint))
2752 ;; 2757 ;;
2753 ((looking-at "case\\>") 2758 ((looking-at "case\\>")
2754 (ada-get-indent-case orgpoint)) 2759 (ada-get-indent-case orgpoint))
2755 ;; 2760 ;;
2756 ((looking-at "when\\>") 2761 ((looking-at "when\\>")
2757 (ada-get-indent-when orgpoint)) 2762 (ada-get-indent-when orgpoint))
2758 ;; 2763 ;;
2759 ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]") 2764 ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
2760 (ada-get-indent-label orgpoint)) 2765 (ada-get-indent-label orgpoint))
2761 ;; 2766 ;;
2762 ((looking-at "separate\\>") 2767 ((looking-at "separate\\>")
2763 (ada-get-indent-nochange)) 2768 (ada-get-indent-nochange))
2764 2769
2765 ;; A label 2770 ;; A label
2766 ((looking-at "<<") 2771 ((looking-at "<<")
2767 (list (+ (save-excursion (back-to-indentation) (point)) 2772 (list (+ (save-excursion (back-to-indentation) (point))
2768 (- ada-label-indent)))) 2773 (- ada-label-indent))))
2769 2774
2770 ;; 2775 ;;
@@ -2777,8 +2782,8 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
2777 'ada-with-indent 2782 'ada-with-indent
2778 'ada-use-indent)))) 2783 'ada-use-indent))))
2779 ;; 2784 ;;
2780 (t 2785 (t
2781 (ada-get-indent-noindent orgpoint))))) 2786 (ada-get-indent-noindent orgpoint)))))
2782 )) 2787 ))
2783 2788
2784(defun ada-get-indent-open-paren () 2789(defun ada-get-indent-open-paren ()
@@ -2824,146 +2829,146 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
2824 "Calculate the indentation when point is just before an end statement. 2829 "Calculate the indentation when point is just before an end statement.
2825ORGPOINT is the limit position used in the calculation." 2830ORGPOINT is the limit position used in the calculation."
2826 (let ((defun-name nil) 2831 (let ((defun-name nil)
2827 (indent nil)) 2832 (indent nil))
2828 2833
2829 ;; is the line already terminated by ';' ? 2834 ;; is the line already terminated by ';' ?
2830 (if (save-excursion 2835 (if (save-excursion
2831 (ada-search-ignore-string-comment ";" nil orgpoint nil 2836 (ada-search-ignore-string-comment ";" nil orgpoint nil
2832 'search-forward)) 2837 'search-forward))
2833 2838
2834 ;; yes, look what's following 'end' 2839 ;; yes, look what's following 'end'
2835 (progn 2840 (progn
2836 (forward-word 1) 2841 (forward-word 1)
2837 (ada-goto-next-non-ws) 2842 (ada-goto-next-non-ws)
2838 (cond 2843 (cond
2839 ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>") 2844 ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>")
2840 (save-excursion (ada-check-matching-start (match-string 0))) 2845 (save-excursion (ada-check-matching-start (match-string 0)))
2841 (list (save-excursion (back-to-indentation) (point)) 0)) 2846 (list (save-excursion (back-to-indentation) (point)) 0))
2842 2847
2843 ;; 2848 ;;
2844 ;; loop/select/if/case/record/select 2849 ;; loop/select/if/case/record/select
2845 ;; 2850 ;;
2846 ((looking-at "\\<record\\>") 2851 ((looking-at "\\<record\\>")
2847 (save-excursion 2852 (save-excursion
2848 (ada-check-matching-start (match-string 0)) 2853 (ada-check-matching-start (match-string 0))
2849 ;; we are now looking at the matching "record" statement 2854 ;; we are now looking at the matching "record" statement
2850 (forward-word 1) 2855 (forward-word 1)
2851 (ada-goto-stmt-start) 2856 (ada-goto-stmt-start)
2852 ;; now on the matching type declaration, or use clause 2857 ;; now on the matching type declaration, or use clause
2853 (unless (looking-at "\\(for\\|type\\)\\>") 2858 (unless (looking-at "\\(for\\|type\\)\\>")
2854 (ada-search-ignore-string-comment "\\<type\\>" t)) 2859 (ada-search-ignore-string-comment "\\<type\\>" t))
2855 (list (progn (back-to-indentation) (point)) 0))) 2860 (list (progn (back-to-indentation) (point)) 0)))
2856 ;; 2861 ;;
2857 ;; a named block end 2862 ;; a named block end
2858 ;; 2863 ;;
2859 ((looking-at ada-ident-re) 2864 ((looking-at ada-ident-re)
2860 (setq defun-name (match-string 0)) 2865 (setq defun-name (match-string 0))
2861 (save-excursion 2866 (save-excursion
2862 (ada-goto-matching-start 0) 2867 (ada-goto-matching-start 0)
2863 (ada-check-defun-name defun-name)) 2868 (ada-check-defun-name defun-name))
2864 (list (progn (back-to-indentation) (point)) 0)) 2869 (list (progn (back-to-indentation) (point)) 0))
2865 ;; 2870 ;;
2866 ;; a block-end without name 2871 ;; a block-end without name
2867 ;; 2872 ;;
2868 ((= (char-after) ?\;) 2873 ((= (char-after) ?\;)
2869 (save-excursion 2874 (save-excursion
2870 (ada-goto-matching-start 0) 2875 (ada-goto-matching-start 0)
2871 (if (looking-at "\\<begin\\>") 2876 (if (looking-at "\\<begin\\>")
2872 (progn 2877 (progn
2873 (setq indent (list (point) 0)) 2878 (setq indent (list (point) 0))
2874 (if (ada-goto-matching-decl-start t) 2879 (if (ada-goto-matching-decl-start t)
2875 (list (progn (back-to-indentation) (point)) 0) 2880 (list (progn (back-to-indentation) (point)) 0)
2876 indent)) 2881 indent))
2877 (list (progn (back-to-indentation) (point)) 0) 2882 (list (progn (back-to-indentation) (point)) 0)
2878 ))) 2883 )))
2879 ;; 2884 ;;
2880 ;; anything else - should maybe signal an error ? 2885 ;; anything else - should maybe signal an error ?
2881 ;; 2886 ;;
2882 (t 2887 (t
2883 (list (save-excursion (back-to-indentation) (point)) 2888 (list (save-excursion (back-to-indentation) (point))
2884 'ada-broken-indent)))) 2889 'ada-broken-indent))))
2885 2890
2886 (list (save-excursion (back-to-indentation) (point)) 2891 (list (save-excursion (back-to-indentation) (point))
2887 'ada-broken-indent)))) 2892 'ada-broken-indent))))
2888 2893
2889(defun ada-get-indent-case (orgpoint) 2894(defun ada-get-indent-case (orgpoint)
2890 "Calculate the indentation when point is just before a case statement. 2895 "Calculate the indentation when point is just before a case statement.
2891ORGPOINT is the limit position used in the calculation." 2896ORGPOINT is the limit position used in the calculation."
2892 (let ((match-cons nil) 2897 (let ((match-cons nil)
2893 (opos (point))) 2898 (opos (point)))
2894 (cond 2899 (cond
2895 ;; 2900 ;;
2896 ;; case..is..when..=> 2901 ;; case..is..when..=>
2897 ;; 2902 ;;
2898 ((save-excursion 2903 ((save-excursion
2899 (setq match-cons (and 2904 (setq match-cons (and
2900 ;; the `=>' must be after the keyword `is'. 2905 ;; the `=>' must be after the keyword `is'.
2901 (ada-search-ignore-string-comment 2906 (ada-search-ignore-string-comment
2902 "is" nil orgpoint nil 'word-search-forward) 2907 "is" nil orgpoint nil 'word-search-forward)
2903 (ada-search-ignore-string-comment 2908 (ada-search-ignore-string-comment
2904 "[ \t\n]+=>" nil orgpoint)))) 2909 "[ \t\n]+=>" nil orgpoint))))
2905 (save-excursion 2910 (save-excursion
2906 (goto-char (car match-cons)) 2911 (goto-char (car match-cons))
2907 (unless (ada-search-ignore-string-comment "when" t opos) 2912 (unless (ada-search-ignore-string-comment "when" t opos)
2908 (error "Missing 'when' between 'case' and '=>'")) 2913 (error "Missing 'when' between 'case' and '=>'"))
2909 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))) 2914 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))
2910 ;; 2915 ;;
2911 ;; case..is..when 2916 ;; case..is..when
2912 ;; 2917 ;;
2913 ((save-excursion 2918 ((save-excursion
2914 (setq match-cons (ada-search-ignore-string-comment 2919 (setq match-cons (ada-search-ignore-string-comment
2915 "when" nil orgpoint nil 'word-search-forward))) 2920 "when" nil orgpoint nil 'word-search-forward)))
2916 (goto-char (cdr match-cons)) 2921 (goto-char (cdr match-cons))
2917 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) 2922 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
2918 ;; 2923 ;;
2919 ;; case..is 2924 ;; case..is
2920 ;; 2925 ;;
2921 ((save-excursion 2926 ((save-excursion
2922 (setq match-cons (ada-search-ignore-string-comment 2927 (setq match-cons (ada-search-ignore-string-comment
2923 "is" nil orgpoint nil 'word-search-forward))) 2928 "is" nil orgpoint nil 'word-search-forward)))
2924 (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent)) 2929 (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent))
2925 ;; 2930 ;;
2926 ;; incomplete case 2931 ;; incomplete case
2927 ;; 2932 ;;
2928 (t 2933 (t
2929 (list (save-excursion (back-to-indentation) (point)) 2934 (list (save-excursion (back-to-indentation) (point))
2930 'ada-broken-indent))))) 2935 'ada-broken-indent)))))
2931 2936
2932(defun ada-get-indent-when (orgpoint) 2937(defun ada-get-indent-when (orgpoint)
2933 "Calculate the indentation when point is just before a when statement. 2938 "Calculate the indentation when point is just before a when statement.
2934ORGPOINT is the limit position used in the calculation." 2939ORGPOINT is the limit position used in the calculation."
2935 (let ((cur-indent (save-excursion (back-to-indentation) (point)))) 2940 (let ((cur-indent (save-excursion (back-to-indentation) (point))))
2936 (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint) 2941 (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint)
2937 (list cur-indent 'ada-indent) 2942 (list cur-indent 'ada-indent)
2938 (list cur-indent 'ada-broken-indent)))) 2943 (list cur-indent 'ada-broken-indent))))
2939 2944
2940(defun ada-get-indent-if (orgpoint) 2945(defun ada-get-indent-if (orgpoint)
2941 "Calculate the indentation when point is just before an if statement. 2946 "Calculate the indentation when point is just before an if statement.
2942ORGPOINT is the limit position used in the calculation." 2947ORGPOINT is the limit position used in the calculation."
2943 (let ((cur-indent (save-excursion (back-to-indentation) (point))) 2948 (let ((cur-indent (save-excursion (back-to-indentation) (point)))
2944 (match-cons nil)) 2949 (match-cons nil))
2945 ;; 2950 ;;
2946 ;; Move to the correct then (ignore all "and then") 2951 ;; Move to the correct then (ignore all "and then")
2947 ;; 2952 ;;
2948 (while (and (setq match-cons (ada-search-ignore-string-comment 2953 (while (and (setq match-cons (ada-search-ignore-string-comment
2949 "\\<\\(then\\|and[ \t]*then\\)\\>" 2954 "\\<\\(then\\|and[ \t]*then\\)\\>"
2950 nil orgpoint)) 2955 nil orgpoint))
2951 (= (downcase (char-after (car match-cons))) ?a))) 2956 (= (downcase (char-after (car match-cons))) ?a)))
2952 ;; If "then" was found (we are looking at it) 2957 ;; If "then" was found (we are looking at it)
2953 (if match-cons 2958 (if match-cons
2954 (progn 2959 (progn
2955 ;; 2960 ;;
2956 ;; 'then' first in separate line ? 2961 ;; 'then' first in separate line ?
2957 ;; => indent according to 'then', 2962 ;; => indent according to 'then',
2958 ;; => else indent according to 'if' 2963 ;; => else indent according to 'if'
2959 ;; 2964 ;;
2960 (if (save-excursion 2965 (if (save-excursion
2961 (back-to-indentation) 2966 (back-to-indentation)
2962 (looking-at "\\<then\\>")) 2967 (looking-at "\\<then\\>"))
2963 (setq cur-indent (save-excursion (back-to-indentation) (point)))) 2968 (setq cur-indent (save-excursion (back-to-indentation) (point))))
2964 ;; skip 'then' 2969 ;; skip 'then'
2965 (forward-word 1) 2970 (forward-word 1)
2966 (list cur-indent 'ada-indent)) 2971 (list cur-indent 'ada-indent))
2967 2972
2968 (list cur-indent 'ada-broken-indent)))) 2973 (list cur-indent 'ada-broken-indent))))
2969 2974
@@ -2973,11 +2978,11 @@ ORGPOINT is the limit position used in the calculation."
2973 (let ((pos nil)) 2978 (let ((pos nil))
2974 (cond 2979 (cond
2975 ((save-excursion 2980 ((save-excursion
2976 (forward-word 1) 2981 (forward-word 1)
2977 (setq pos (ada-goto-next-non-ws orgpoint))) 2982 (setq pos (ada-goto-next-non-ws orgpoint)))
2978 (goto-char pos) 2983 (goto-char pos)
2979 (save-excursion 2984 (save-excursion
2980 (ada-indent-on-previous-lines t orgpoint))) 2985 (ada-indent-on-previous-lines t orgpoint)))
2981 2986
2982 ;; Special case for record types, for instance for: 2987 ;; Special case for record types, for instance for:
2983 ;; type A is (B : Integer; 2988 ;; type A is (B : Integer;
@@ -3004,27 +3009,27 @@ ORGPOINT is the limit position used in the calculation."
3004 "Calculate the indentation when point is just before a subprogram. 3009 "Calculate the indentation when point is just before a subprogram.
3005ORGPOINT is the limit position used in the calculation." 3010ORGPOINT is the limit position used in the calculation."
3006 (let ((match-cons nil) 3011 (let ((match-cons nil)
3007 (cur-indent (save-excursion (back-to-indentation) (point))) 3012 (cur-indent (save-excursion (back-to-indentation) (point)))
3008 (foundis nil)) 3013 (foundis nil))
3009 ;; 3014 ;;
3010 ;; is there an 'is' in front of point ? 3015 ;; is there an 'is' in front of point ?
3011 ;; 3016 ;;
3012 (if (save-excursion 3017 (if (save-excursion
3013 (setq match-cons 3018 (setq match-cons
3014 (ada-search-ignore-string-comment 3019 (ada-search-ignore-string-comment
3015 "\\<\\(is\\|do\\)\\>" nil orgpoint))) 3020 "\\<\\(is\\|do\\)\\>" nil orgpoint)))
3016 ;; 3021 ;;
3017 ;; yes, then skip to its end 3022 ;; yes, then skip to its end
3018 ;; 3023 ;;
3019 (progn 3024 (progn
3020 (setq foundis t) 3025 (setq foundis t)
3021 (goto-char (cdr match-cons))) 3026 (goto-char (cdr match-cons)))
3022 ;; 3027 ;;
3023 ;; no, then goto next non-ws, if there is one in front of point 3028 ;; no, then goto next non-ws, if there is one in front of point
3024 ;; 3029 ;;
3025 (progn 3030 (progn
3026 (unless (ada-goto-next-non-ws orgpoint) 3031 (unless (ada-goto-next-non-ws orgpoint)
3027 (goto-char orgpoint)))) 3032 (goto-char orgpoint))))
3028 3033
3029 (cond 3034 (cond
3030 ;; 3035 ;;
@@ -3033,8 +3038,8 @@ ORGPOINT is the limit position used in the calculation."
3033 ((and 3038 ((and
3034 foundis 3039 foundis
3035 (save-excursion 3040 (save-excursion
3036 (not (ada-search-ignore-string-comment 3041 (not (ada-search-ignore-string-comment
3037 "[^ \t\n]" nil orgpoint t)))) 3042 "[^ \t\n]" nil orgpoint t))))
3038 (list cur-indent 'ada-indent)) 3043 (list cur-indent 'ada-indent))
3039 ;; 3044 ;;
3040 ;; is abstract/separate/new ... 3045 ;; is abstract/separate/new ...
@@ -3042,10 +3047,10 @@ ORGPOINT is the limit position used in the calculation."
3042 ((and 3047 ((and
3043 foundis 3048 foundis
3044 (save-excursion 3049 (save-excursion
3045 (setq match-cons 3050 (setq match-cons
3046 (ada-search-ignore-string-comment 3051 (ada-search-ignore-string-comment
3047 "\\<\\(separate\\|new\\|abstract\\)\\>" 3052 "\\<\\(separate\\|new\\|abstract\\)\\>"
3048 nil orgpoint)))) 3053 nil orgpoint))))
3049 (goto-char (car match-cons)) 3054 (goto-char (car match-cons))
3050 (ada-search-ignore-string-comment ada-subprog-start-re t) 3055 (ada-search-ignore-string-comment ada-subprog-start-re t)
3051 (ada-get-indent-noindent orgpoint)) 3056 (ada-get-indent-noindent orgpoint))
@@ -3061,7 +3066,7 @@ ORGPOINT is the limit position used in the calculation."
3061 ;; no 'is' but ';' 3066 ;; no 'is' but ';'
3062 ;; 3067 ;;
3063 ((save-excursion 3068 ((save-excursion
3064 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward)) 3069 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward))
3065 (list cur-indent 0)) 3070 (list cur-indent 0))
3066 ;; 3071 ;;
3067 ;; no 'is' or ';' 3072 ;; no 'is' or ';'
@@ -3082,74 +3087,74 @@ ORGPOINT is the limit position used in the calculation."
3082 ;; subprogram declaration (in that case, we are at this point inside 3087 ;; subprogram declaration (in that case, we are at this point inside
3083 ;; the parameter declaration list) 3088 ;; the parameter declaration list)
3084 ((ada-in-paramlist-p) 3089 ((ada-in-paramlist-p)
3085 (ada-previous-procedure) 3090 (ada-previous-procedure)
3086 (list (save-excursion (back-to-indentation) (point)) 0)) 3091 (list (save-excursion (back-to-indentation) (point)) 0))
3087 3092
3088 ;; This one is called when indenting the second line of a multi-line 3093 ;; This one is called when indenting the second line of a multi-line
3089 ;; declaration section, in a declare block or a record declaration 3094 ;; declaration section, in a declare block or a record declaration
3090 ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$") 3095 ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$")
3091 (list (save-excursion (back-to-indentation) (point)) 3096 (list (save-excursion (back-to-indentation) (point))
3092 'ada-broken-decl-indent)) 3097 'ada-broken-decl-indent))
3093 3098
3094 ;; This one is called in every over case when indenting a line at the 3099 ;; This one is called in every over case when indenting a line at the
3095 ;; top level 3100 ;; top level
3096 (t 3101 (t
3097 (if (looking-at ada-named-block-re) 3102 (if (looking-at ada-named-block-re)
3098 (setq label (- ada-label-indent)) 3103 (setq label (- ada-label-indent))
3099 3104
3100 (let (p) 3105 (let (p)
3101 3106
3102 ;; "with private" or "null record" cases 3107 ;; "with private" or "null record" cases
3103 (if (or (save-excursion 3108 (if (or (save-excursion
3104 (and (ada-search-ignore-string-comment "\\<private\\>" nil orgpoint) 3109 (and (ada-search-ignore-string-comment "\\<private\\>" nil orgpoint)
3105 (setq p (point)) 3110 (setq p (point))
3106 (save-excursion (forward-char -7);; skip back "private" 3111 (save-excursion (forward-char -7);; skip back "private"
3107 (ada-goto-previous-word) 3112 (ada-goto-previous-word)
3108 (looking-at "with")))) 3113 (looking-at "with"))))
3109 (save-excursion 3114 (save-excursion
3110 (and (ada-search-ignore-string-comment "\\<record\\>" nil orgpoint) 3115 (and (ada-search-ignore-string-comment "\\<record\\>" nil orgpoint)
3111 (setq p (point)) 3116 (setq p (point))
3112 (save-excursion (forward-char -6);; skip back "record" 3117 (save-excursion (forward-char -6);; skip back "record"
3113 (ada-goto-previous-word) 3118 (ada-goto-previous-word)
3114 (looking-at "null"))))) 3119 (looking-at "null")))))
3115 (progn 3120 (progn
3116 (goto-char p) 3121 (goto-char p)
3117 (re-search-backward "\\<\\(type\\|subtype\\)\\>" nil t) 3122 (re-search-backward "\\<\\(type\\|subtype\\)\\>" nil t)
3118 (list (save-excursion (back-to-indentation) (point)) 0))))) 3123 (list (save-excursion (back-to-indentation) (point)) 0)))))
3119 (if (save-excursion 3124 (if (save-excursion
3120 (ada-search-ignore-string-comment ";" nil orgpoint nil 3125 (ada-search-ignore-string-comment ";" nil orgpoint nil
3121 'search-forward)) 3126 'search-forward))
3122 (list (+ (save-excursion (back-to-indentation) (point)) label) 0) 3127 (list (+ (save-excursion (back-to-indentation) (point)) label) 0)
3123 (list (+ (save-excursion (back-to-indentation) (point)) label) 3128 (list (+ (save-excursion (back-to-indentation) (point)) label)
3124 'ada-broken-indent))))))) 3129 'ada-broken-indent)))))))
3125 3130
3126(defun ada-get-indent-label (orgpoint) 3131(defun ada-get-indent-label (orgpoint)
3127 "Calculate the indentation when before a label or variable declaration. 3132 "Calculate the indentation when before a label or variable declaration.
3128ORGPOINT is the limit position used in the calculation." 3133ORGPOINT is the limit position used in the calculation."
3129 (let ((match-cons nil) 3134 (let ((match-cons nil)
3130 (cur-indent (save-excursion (back-to-indentation) (point)))) 3135 (cur-indent (save-excursion (back-to-indentation) (point))))
3131 (ada-search-ignore-string-comment ":" nil) 3136 (ada-search-ignore-string-comment ":" nil)
3132 (cond 3137 (cond
3133 ;; loop label 3138 ;; loop label
3134 ((save-excursion 3139 ((save-excursion
3135 (setq match-cons (ada-search-ignore-string-comment 3140 (setq match-cons (ada-search-ignore-string-comment
3136 ada-loop-start-re nil orgpoint))) 3141 ada-loop-start-re nil orgpoint)))
3137 (goto-char (car match-cons)) 3142 (goto-char (car match-cons))
3138 (ada-get-indent-loop orgpoint)) 3143 (ada-get-indent-loop orgpoint))
3139 3144
3140 ;; declare label 3145 ;; declare label
3141 ((save-excursion 3146 ((save-excursion
3142 (setq match-cons (ada-search-ignore-string-comment 3147 (setq match-cons (ada-search-ignore-string-comment
3143 "\\<declare\\|begin\\>" nil orgpoint))) 3148 "\\<declare\\|begin\\>" nil orgpoint)))
3144 (goto-char (car match-cons)) 3149 (goto-char (car match-cons))
3145 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) 3150 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
3146 3151
3147 ;; variable declaration 3152 ;; variable declaration
3148 ((ada-in-decl-p) 3153 ((ada-in-decl-p)
3149 (if (save-excursion 3154 (if (save-excursion
3150 (ada-search-ignore-string-comment ";" nil orgpoint)) 3155 (ada-search-ignore-string-comment ";" nil orgpoint))
3151 (list cur-indent 0) 3156 (list cur-indent 0)
3152 (list cur-indent 'ada-broken-indent))) 3157 (list cur-indent 'ada-broken-indent)))
3153 3158
3154 ;; nothing follows colon 3159 ;; nothing follows colon
3155 (t 3160 (t
@@ -3159,14 +3164,14 @@ ORGPOINT is the limit position used in the calculation."
3159 "Calculate the indentation when just before a loop or a for ... use. 3164 "Calculate the indentation when just before a loop or a for ... use.
3160ORGPOINT is the limit position used in the calculation." 3165ORGPOINT is the limit position used in the calculation."
3161 (let ((match-cons nil) 3166 (let ((match-cons nil)
3162 (pos (point)) 3167 (pos (point))
3163 3168
3164 ;; If looking at a named block, skip the label 3169 ;; If looking at a named block, skip the label
3165 (label (save-excursion 3170 (label (save-excursion
3166 (beginning-of-line) 3171 (beginning-of-line)
3167 (if (looking-at ada-named-block-re) 3172 (if (looking-at ada-named-block-re)
3168 (- ada-label-indent) 3173 (- ada-label-indent)
3169 0)))) 3174 0))))
3170 3175
3171 (cond 3176 (cond
3172 3177
@@ -3174,8 +3179,8 @@ ORGPOINT is the limit position used in the calculation."
3174 ;; statement complete 3179 ;; statement complete
3175 ;; 3180 ;;
3176 ((save-excursion 3181 ((save-excursion
3177 (ada-search-ignore-string-comment ";" nil orgpoint nil 3182 (ada-search-ignore-string-comment ";" nil orgpoint nil
3178 'search-forward)) 3183 'search-forward))
3179 (list (+ (save-excursion (back-to-indentation) (point)) label) 0)) 3184 (list (+ (save-excursion (back-to-indentation) (point)) label) 0))
3180 ;; 3185 ;;
3181 ;; simple loop 3186 ;; simple loop
@@ -3183,8 +3188,8 @@ ORGPOINT is the limit position used in the calculation."
3183 ((looking-at "loop\\>") 3188 ((looking-at "loop\\>")
3184 (setq pos (ada-get-indent-block-start orgpoint)) 3189 (setq pos (ada-get-indent-block-start orgpoint))
3185 (if (equal label 0) 3190 (if (equal label 0)
3186 pos 3191 pos
3187 (list (+ (car pos) label) (cdr pos)))) 3192 (list (+ (car pos) label) (cdr pos))))
3188 3193
3189 ;; 3194 ;;
3190 ;; 'for'- loop (or also a for ... use statement) 3195 ;; 'for'- loop (or also a for ... use statement)
@@ -3195,21 +3200,21 @@ ORGPOINT is the limit position used in the calculation."
3195 ;; for ... use 3200 ;; for ... use
3196 ;; 3201 ;;
3197 ((save-excursion 3202 ((save-excursion
3198 (and 3203 (and
3199 (goto-char (match-end 0)) 3204 (goto-char (match-end 0))
3200 (ada-goto-next-non-ws orgpoint) 3205 (ada-goto-next-non-ws orgpoint)
3201 (forward-word 1) 3206 (forward-word 1)
3202 (if (= (char-after) ?') (forward-word 1) t) 3207 (if (= (char-after) ?') (forward-word 1) t)
3203 (ada-goto-next-non-ws orgpoint) 3208 (ada-goto-next-non-ws orgpoint)
3204 (looking-at "\\<use\\>") 3209 (looking-at "\\<use\\>")
3205 ;; 3210 ;;
3206 ;; check if there is a 'record' before point 3211 ;; check if there is a 'record' before point
3207 ;; 3212 ;;
3208 (progn 3213 (progn
3209 (setq match-cons (ada-search-ignore-string-comment 3214 (setq match-cons (ada-search-ignore-string-comment
3210 "record" nil orgpoint nil 'word-search-forward)) 3215 "record" nil orgpoint nil 'word-search-forward))
3211 t))) 3216 t)))
3212 (if match-cons 3217 (if match-cons
3213 (progn 3218 (progn
3214 (goto-char (car match-cons)) 3219 (goto-char (car match-cons))
3215 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) 3220 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
@@ -3220,25 +3225,25 @@ ORGPOINT is the limit position used in the calculation."
3220 ;; for..loop 3225 ;; for..loop
3221 ;; 3226 ;;
3222 ((save-excursion 3227 ((save-excursion
3223 (setq match-cons (ada-search-ignore-string-comment 3228 (setq match-cons (ada-search-ignore-string-comment
3224 "loop" nil orgpoint nil 'word-search-forward))) 3229 "loop" nil orgpoint nil 'word-search-forward)))
3225 (goto-char (car match-cons)) 3230 (goto-char (car match-cons))
3226 ;; 3231 ;;
3227 ;; indent according to 'loop', if it's first in the line; 3232 ;; indent according to 'loop', if it's first in the line;
3228 ;; otherwise to 'for' 3233 ;; otherwise to 'for'
3229 ;; 3234 ;;
3230 (unless (save-excursion 3235 (unless (save-excursion
3231 (back-to-indentation) 3236 (back-to-indentation)
3232 (looking-at "\\<loop\\>")) 3237 (looking-at "\\<loop\\>"))
3233 (goto-char pos)) 3238 (goto-char pos))
3234 (list (+ (save-excursion (back-to-indentation) (point)) label) 3239 (list (+ (save-excursion (back-to-indentation) (point)) label)
3235 'ada-indent)) 3240 'ada-indent))
3236 ;; 3241 ;;
3237 ;; for-statement is broken 3242 ;; for-statement is broken
3238 ;; 3243 ;;
3239 (t 3244 (t
3240 (list (+ (save-excursion (back-to-indentation) (point)) label) 3245 (list (+ (save-excursion (back-to-indentation) (point)) label)
3241 'ada-broken-indent)))) 3246 'ada-broken-indent))))
3242 3247
3243 ;; 3248 ;;
3244 ;; 'while'-loop 3249 ;; 'while'-loop
@@ -3248,24 +3253,24 @@ ORGPOINT is the limit position used in the calculation."
3248 ;; while..loop ? 3253 ;; while..loop ?
3249 ;; 3254 ;;
3250 (if (save-excursion 3255 (if (save-excursion
3251 (setq match-cons (ada-search-ignore-string-comment 3256 (setq match-cons (ada-search-ignore-string-comment
3252 "loop" nil orgpoint nil 'word-search-forward))) 3257 "loop" nil orgpoint nil 'word-search-forward)))
3253 3258
3254 (progn 3259 (progn
3255 (goto-char (car match-cons)) 3260 (goto-char (car match-cons))
3256 ;; 3261 ;;
3257 ;; indent according to 'loop', if it's first in the line; 3262 ;; indent according to 'loop', if it's first in the line;
3258 ;; otherwise to 'while'. 3263 ;; otherwise to 'while'.
3259 ;; 3264 ;;
3260 (unless (save-excursion 3265 (unless (save-excursion
3261 (back-to-indentation) 3266 (back-to-indentation)
3262 (looking-at "\\<loop\\>")) 3267 (looking-at "\\<loop\\>"))
3263 (goto-char pos)) 3268 (goto-char pos))
3264 (list (+ (save-excursion (back-to-indentation) (point)) label) 3269 (list (+ (save-excursion (back-to-indentation) (point)) label)
3265 'ada-indent)) 3270 'ada-indent))
3266 3271
3267 (list (+ (save-excursion (back-to-indentation) (point)) label) 3272 (list (+ (save-excursion (back-to-indentation) (point)) label)
3268 'ada-broken-indent)))))) 3273 'ada-broken-indent))))))
3269 3274
3270(defun ada-get-indent-type (orgpoint) 3275(defun ada-get-indent-type (orgpoint)
3271 "Calculate the indentation when before a type statement. 3276 "Calculate the indentation when before a type statement.
@@ -3276,46 +3281,46 @@ ORGPOINT is the limit position used in the calculation."
3276 ;; complete record declaration 3281 ;; complete record declaration
3277 ;; 3282 ;;
3278 ((save-excursion 3283 ((save-excursion
3279 (and 3284 (and
3280 (setq match-dat (ada-search-ignore-string-comment 3285 (setq match-dat (ada-search-ignore-string-comment
3281 "end" nil orgpoint nil 'word-search-forward)) 3286 "end" nil orgpoint nil 'word-search-forward))
3282 (ada-goto-next-non-ws) 3287 (ada-goto-next-non-ws)
3283 (looking-at "\\<record\\>") 3288 (looking-at "\\<record\\>")
3284 (forward-word 1) 3289 (forward-word 1)
3285 (ada-goto-next-non-ws) 3290 (ada-goto-next-non-ws)
3286 (= (char-after) ?\;))) 3291 (= (char-after) ?\;)))
3287 (goto-char (car match-dat)) 3292 (goto-char (car match-dat))
3288 (list (save-excursion (back-to-indentation) (point)) 0)) 3293 (list (save-excursion (back-to-indentation) (point)) 0))
3289 ;; 3294 ;;
3290 ;; record type 3295 ;; record type
3291 ;; 3296 ;;
3292 ((save-excursion 3297 ((save-excursion
3293 (setq match-dat (ada-search-ignore-string-comment 3298 (setq match-dat (ada-search-ignore-string-comment
3294 "record" nil orgpoint nil 'word-search-forward))) 3299 "record" nil orgpoint nil 'word-search-forward)))
3295 (goto-char (car match-dat)) 3300 (goto-char (car match-dat))
3296 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)) 3301 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
3297 ;; 3302 ;;
3298 ;; complete type declaration 3303 ;; complete type declaration
3299 ;; 3304 ;;
3300 ((save-excursion 3305 ((save-excursion
3301 (ada-search-ignore-string-comment ";" nil orgpoint nil 3306 (ada-search-ignore-string-comment ";" nil orgpoint nil
3302 'search-forward)) 3307 'search-forward))
3303 (list (save-excursion (back-to-indentation) (point)) 0)) 3308 (list (save-excursion (back-to-indentation) (point)) 0))
3304 ;; 3309 ;;
3305 ;; "type ... is", but not "type ... is ...", which is broken 3310 ;; "type ... is", but not "type ... is ...", which is broken
3306 ;; 3311 ;;
3307 ((save-excursion 3312 ((save-excursion
3308 (and 3313 (and
3309 (ada-search-ignore-string-comment "is" nil orgpoint nil 3314 (ada-search-ignore-string-comment "is" nil orgpoint nil
3310 'word-search-forward) 3315 'word-search-forward)
3311 (not (ada-goto-next-non-ws orgpoint)))) 3316 (not (ada-goto-next-non-ws orgpoint))))
3312 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent)) 3317 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
3313 ;; 3318 ;;
3314 ;; broken statement 3319 ;; broken statement
3315 ;; 3320 ;;
3316 (t 3321 (t
3317 (list (save-excursion (back-to-indentation) (point)) 3322 (list (save-excursion (back-to-indentation) (point))
3318 'ada-broken-indent))))) 3323 'ada-broken-indent)))))
3319 3324
3320 3325
3321;; ----------------------------------------------------------- 3326;; -----------------------------------------------------------
@@ -3328,7 +3333,7 @@ Return the new position of point.
3328As a special case, if we are looking at a closing parenthesis, skip to the 3333As a special case, if we are looking at a closing parenthesis, skip to the
3329open parenthesis." 3334open parenthesis."
3330 (let ((match-dat nil) 3335 (let ((match-dat nil)
3331 (orgpoint (point))) 3336 (orgpoint (point)))
3332 3337
3333 (setq match-dat (ada-search-prev-end-stmt)) 3338 (setq match-dat (ada-search-prev-end-stmt))
3334 (if match-dat 3339 (if match-dat
@@ -3373,14 +3378,14 @@ open parenthesis."
3373Return a cons cell whose car is the beginning and whose cdr 3378Return a cons cell whose car is the beginning and whose cdr
3374is the end of the match." 3379is the end of the match."
3375 (let ((match-dat nil) 3380 (let ((match-dat nil)
3376 (found nil)) 3381 (found nil))
3377 3382
3378 ;; search until found or beginning-of-buffer 3383 ;; search until found or beginning-of-buffer
3379 (while 3384 (while
3380 (and 3385 (and
3381 (not found) 3386 (not found)
3382 (setq match-dat (ada-search-ignore-string-comment 3387 (setq match-dat (ada-search-ignore-string-comment
3383 ada-end-stmt-re t))) 3388 ada-end-stmt-re t)))
3384 3389
3385 (goto-char (car match-dat)) 3390 (goto-char (car match-dat))
3386 (unless (ada-in-open-paren-p) 3391 (unless (ada-in-open-paren-p)
@@ -3395,27 +3400,27 @@ is the end of the match."
3395 3400
3396 ((looking-at "is") 3401 ((looking-at "is")
3397 (setq found 3402 (setq found
3398 (and (save-excursion (ada-goto-previous-word) 3403 (and (save-excursion (ada-goto-previous-word)
3399 (ada-goto-previous-word) 3404 (ada-goto-previous-word)
3400 (not (looking-at "subtype"))) 3405 (not (looking-at "subtype")))
3401 3406
3402 (save-excursion (goto-char (cdr match-dat)) 3407 (save-excursion (goto-char (cdr match-dat))
3403 (ada-goto-next-non-ws) 3408 (ada-goto-next-non-ws)
3404 ;; words that can go after an 'is' 3409 ;; words that can go after an 'is'
3405 (not (looking-at 3410 (not (looking-at
3406 (eval-when-compile 3411 (eval-when-compile
3407 (concat "\\<" 3412 (concat "\\<"
3408 (regexp-opt 3413 (regexp-opt
3409 '("separate" "access" "array" 3414 '("separate" "access" "array"
3410 "abstract" "new") t) 3415 "abstract" "new") t)
3411 "\\>\\|(")))))))) 3416 "\\>\\|("))))))))
3412 3417
3413 (t 3418 (t
3414 (setq found t)) 3419 (setq found t))
3415 ))) 3420 )))
3416 3421
3417 (if found 3422 (if found
3418 match-dat 3423 match-dat
3419 nil))) 3424 nil)))
3420 3425
3421 3426
@@ -3426,11 +3431,11 @@ Do not call this function from within a string."
3426 (unless limit 3431 (unless limit
3427 (setq limit (point-max))) 3432 (setq limit (point-max)))
3428 (while (and (<= (point) limit) 3433 (while (and (<= (point) limit)
3429 (progn (forward-comment 10000) 3434 (progn (forward-comment 10000)
3430 (if (and (not (eobp)) 3435 (if (and (not (eobp))
3431 (save-excursion (forward-char 1) 3436 (save-excursion (forward-char 1)
3432 (ada-in-string-p))) 3437 (ada-in-string-p)))
3433 (progn (forward-sexp 1) t))))) 3438 (progn (forward-sexp 1) t)))))
3434 (if (< (point) limit) 3439 (if (< (point) limit)
3435 (point) 3440 (point)
3436 nil) 3441 nil)
@@ -3451,22 +3456,22 @@ Stop the search at LIMIT."
3451If BACKWARD is non-nil, jump to the beginning of the previous word. 3456If BACKWARD is non-nil, jump to the beginning of the previous word.
3452Return the new position of point or nil if not found." 3457Return the new position of point or nil if not found."
3453 (let ((match-cons nil) 3458 (let ((match-cons nil)
3454 (orgpoint (point)) 3459 (orgpoint (point))
3455 (old-syntax (char-to-string (char-syntax ?_)))) 3460 (old-syntax (char-to-string (char-syntax ?_))))
3456 (modify-syntax-entry ?_ "w") 3461 (modify-syntax-entry ?_ "w")
3457 (unless backward 3462 (unless backward
3458 (skip-syntax-forward "w")) 3463 (skip-syntax-forward "w"))
3459 (if (setq match-cons 3464 (if (setq match-cons
3460 (if backward 3465 (if backward
3461 (ada-search-ignore-string-comment "\\w" t nil t) 3466 (ada-search-ignore-string-comment "\\w" t nil t)
3462 (ada-search-ignore-string-comment "\\w" nil nil t))) 3467 (ada-search-ignore-string-comment "\\w" nil nil t)))
3463 ;; 3468 ;;
3464 ;; move to the beginning of the word found 3469 ;; move to the beginning of the word found
3465 ;; 3470 ;;
3466 (progn 3471 (progn
3467 (goto-char (car match-cons)) 3472 (goto-char (car match-cons))
3468 (skip-syntax-backward "w") 3473 (skip-syntax-backward "w")
3469 (point)) 3474 (point))
3470 ;; 3475 ;;
3471 ;; if not found, restore old position of point 3476 ;; if not found, restore old position of point
3472 ;; 3477 ;;
@@ -3491,8 +3496,8 @@ Moves point to the beginning of the declaration."
3491 3496
3492 ;; named block without a `declare' 3497 ;; named block without a `declare'
3493 (if (save-excursion 3498 (if (save-excursion
3494 (ada-goto-previous-word) 3499 (ada-goto-previous-word)
3495 (looking-at (concat "\\<" defun-name "\\> *:"))) 3500 (looking-at (concat "\\<" defun-name "\\> *:")))
3496 t ; do nothing 3501 t ; do nothing
3497 ;; 3502 ;;
3498 ;; 'accept' or 'package' ? 3503 ;; 'accept' or 'package' ?
@@ -3507,27 +3512,27 @@ Moves point to the beginning of the declaration."
3507 ;; a named 'declare'-block ? 3512 ;; a named 'declare'-block ?
3508 ;; 3513 ;;
3509 (if (looking-at "\\<declare\\>") 3514 (if (looking-at "\\<declare\\>")
3510 (ada-goto-stmt-start) 3515 (ada-goto-stmt-start)
3511 ;; 3516 ;;
3512 ;; no, => 'procedure'/'function'/'task'/'protected' 3517 ;; no, => 'procedure'/'function'/'task'/'protected'
3513 ;; 3518 ;;
3514 (progn 3519 (progn
3515 (forward-word 2) 3520 (forward-word 2)
3516 (backward-word 1) 3521 (backward-word 1)
3517 ;; 3522 ;;
3518 ;; skip 'body' 'type' 3523 ;; skip 'body' 'type'
3519 ;; 3524 ;;
3520 (if (looking-at "\\<\\(body\\|type\\)\\>") 3525 (if (looking-at "\\<\\(body\\|type\\)\\>")
3521 (forward-word 1)) 3526 (forward-word 1))
3522 (forward-sexp 1) 3527 (forward-sexp 1)
3523 (backward-sexp 1))) 3528 (backward-sexp 1)))
3524 ;; 3529 ;;
3525 ;; should be looking-at the correct name 3530 ;; should be looking-at the correct name
3526 ;; 3531 ;;
3527 (unless (looking-at (concat "\\<" defun-name "\\>")) 3532 (unless (looking-at (concat "\\<" defun-name "\\>"))
3528 (error "Matching defun has different name: %s" 3533 (error "Matching defun has different name: %s"
3529 (buffer-substring (point) 3534 (buffer-substring (point)
3530 (progn (forward-sexp 1) (point)))))))) 3535 (progn (forward-sexp 1) (point))))))))
3531 3536
3532(defun ada-goto-matching-decl-start (&optional noerror recursive) 3537(defun ada-goto-matching-decl-start (&optional noerror recursive)
3533 "Move point to the matching declaration start of the current 'begin'. 3538 "Move point to the matching declaration start of the current 'begin'.
@@ -3536,10 +3541,10 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3536 3541
3537 ;; first should be set to t if we should stop at the first 3542 ;; first should be set to t if we should stop at the first
3538 ;; "begin" we encounter. 3543 ;; "begin" we encounter.
3539 (first (not recursive)) 3544 (first (not recursive))
3540 (count-generic nil) 3545 (count-generic nil)
3541 (stop-at-when nil) 3546 (stop-at-when nil)
3542 ) 3547 )
3543 3548
3544 ;; Ignore "when" most of the time, except if we are looking at the 3549 ;; Ignore "when" most of the time, except if we are looking at the
3545 ;; beginning of a block (structure: case .. is 3550 ;; beginning of a block (structure: case .. is
@@ -3547,65 +3552,65 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3547 ;; begin ... 3552 ;; begin ...
3548 ;; exception ... ) 3553 ;; exception ... )
3549 (if (looking-at "begin") 3554 (if (looking-at "begin")
3550 (setq stop-at-when t)) 3555 (setq stop-at-when t))
3551 3556
3552 (if (or 3557 (if (or
3553 (looking-at "\\<\\(package\\|procedure\\|function\\)\\>") 3558 (looking-at "\\<\\(package\\|procedure\\|function\\)\\>")
3554 (save-excursion 3559 (save-excursion
3555 (ada-search-ignore-string-comment 3560 (ada-search-ignore-string-comment
3556 "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t) 3561 "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t)
3557 (looking-at "generic"))) 3562 (looking-at "generic")))
3558 (setq count-generic t)) 3563 (setq count-generic t))
3559 3564
3560 ;; search backward for interesting keywords 3565 ;; search backward for interesting keywords
3561 (while (and 3566 (while (and
3562 (not (zerop nest-count)) 3567 (not (zerop nest-count))
3563 (ada-search-ignore-string-comment ada-matching-decl-start-re t)) 3568 (ada-search-ignore-string-comment ada-matching-decl-start-re t))
3564 ;; 3569 ;;
3565 ;; calculate nest-depth 3570 ;; calculate nest-depth
3566 ;; 3571 ;;
3567 (cond 3572 (cond
3568 ;; 3573 ;;
3569 ((looking-at "end") 3574 ((looking-at "end")
3570 (ada-goto-matching-start 1 noerror) 3575 (ada-goto-matching-start 1 noerror)
3571 3576
3572 ;; In some case, two begin..end block can follow each other closely, 3577 ;; In some case, two begin..end block can follow each other closely,
3573 ;; which we have to detect, as in 3578 ;; which we have to detect, as in
3574 ;; procedure P is 3579 ;; procedure P is
3575 ;; procedure Q is 3580 ;; procedure Q is
3576 ;; begin 3581 ;; begin
3577 ;; end; 3582 ;; end;
3578 ;; begin -- here we should go to procedure, not begin 3583 ;; begin -- here we should go to procedure, not begin
3579 ;; end 3584 ;; end
3580 3585
3581 (if (looking-at "begin") 3586 (if (looking-at "begin")
3582 (let ((loop-again t)) 3587 (let ((loop-again t))
3583 (save-excursion 3588 (save-excursion
3584 (while loop-again 3589 (while loop-again
3585 ;; If begin was just there as the beginning of a block 3590 ;; If begin was just there as the beginning of a block
3586 ;; (with no declare) then do nothing, otherwise just 3591 ;; (with no declare) then do nothing, otherwise just
3587 ;; register that we have to find the statement that 3592 ;; register that we have to find the statement that
3588 ;; required the begin 3593 ;; required the begin
3589 3594
3590 (ada-search-ignore-string-comment 3595 (ada-search-ignore-string-comment
3591 "\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>" 3596 "\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>"
3592 t) 3597 t)
3593 3598
3594 (if (looking-at "end") 3599 (if (looking-at "end")
3595 (ada-goto-matching-start 1 noerror t) 3600 (ada-goto-matching-start 1 noerror t)
3596 ;; (ada-goto-matching-decl-start noerror t) 3601 ;; (ada-goto-matching-decl-start noerror t)
3597 3602
3598 (setq loop-again nil) 3603 (setq loop-again nil)
3599 (unless (looking-at "begin") 3604 (unless (looking-at "begin")
3600 (setq nest-count (1+ nest-count)))) 3605 (setq nest-count (1+ nest-count))))
3601 )) 3606 ))
3602 ))) 3607 )))
3603 ;; 3608 ;;
3604 ((looking-at "generic") 3609 ((looking-at "generic")
3605 (if count-generic 3610 (if count-generic
3606 (progn 3611 (progn
3607 (setq first nil) 3612 (setq first nil)
3608 (setq nest-count (1- nest-count))))) 3613 (setq nest-count (1- nest-count)))))
3609 ;; 3614 ;;
3610 ((looking-at "if") 3615 ((looking-at "if")
3611 (save-excursion 3616 (save-excursion
@@ -3617,49 +3622,49 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3617 3622
3618 ;; 3623 ;;
3619 ((looking-at "declare\\|generic") 3624 ((looking-at "declare\\|generic")
3620 (setq nest-count (1- nest-count)) 3625 (setq nest-count (1- nest-count))
3621 (setq first t)) 3626 (setq first t))
3622 ;; 3627 ;;
3623 ((looking-at "is") 3628 ((looking-at "is")
3624 ;; check if it is only a type definition, but not a protected 3629 ;; check if it is only a type definition, but not a protected
3625 ;; type definition, which should be handled like a procedure. 3630 ;; type definition, which should be handled like a procedure.
3626 (if (or (looking-at "is[ \t]+<>") 3631 (if (or (looking-at "is[ \t]+<>")
3627 (save-excursion 3632 (save-excursion
3628 (forward-comment -10000) 3633 (forward-comment -10000)
3629 (forward-char -1) 3634 (forward-char -1)
3630 3635
3631 ;; Detect if we have a closing parenthesis (Could be 3636 ;; Detect if we have a closing parenthesis (Could be
3632 ;; either the end of subprogram parameters or (<>) 3637 ;; either the end of subprogram parameters or (<>)
3633 ;; in a type definition 3638 ;; in a type definition
3634 (if (= (char-after) ?\)) 3639 (if (= (char-after) ?\))
3635 (progn 3640 (progn
3636 (forward-char 1) 3641 (forward-char 1)
3637 (backward-sexp 1) 3642 (backward-sexp 1)
3638 (forward-comment -10000) 3643 (forward-comment -10000)
3639 )) 3644 ))
3640 (skip-chars-backward "a-zA-Z0-9_.'") 3645 (skip-chars-backward "a-zA-Z0-9_.'")
3641 (ada-goto-previous-word) 3646 (ada-goto-previous-word)
3642 (and 3647 (and
3643 (looking-at "\\<\\(sub\\)?type\\|case\\>") 3648 (looking-at "\\<\\(sub\\)?type\\|case\\>")
3644 (save-match-data 3649 (save-match-data
3645 (ada-goto-previous-word) 3650 (ada-goto-previous-word)
3646 (not (looking-at "\\<protected\\>")))) 3651 (not (looking-at "\\<protected\\>"))))
3647 )) ; end of `or' 3652 )) ; end of `or'
3648 (goto-char (match-beginning 0)) 3653 (goto-char (match-beginning 0))
3649 (progn 3654 (progn
3650 (setq nest-count (1- nest-count)) 3655 (setq nest-count (1- nest-count))
3651 (setq first nil)))) 3656 (setq first nil))))
3652 3657
3653 ;; 3658 ;;
3654 ((looking-at "new") 3659 ((looking-at "new")
3655 (if (save-excursion 3660 (if (save-excursion
3656 (ada-goto-previous-word) 3661 (ada-goto-previous-word)
3657 (looking-at "is")) 3662 (looking-at "is"))
3658 (goto-char (match-beginning 0)))) 3663 (goto-char (match-beginning 0))))
3659 ;; 3664 ;;
3660 ((and first 3665 ((and first
3661 (looking-at "begin")) 3666 (looking-at "begin"))
3662 (setq nest-count 0)) 3667 (setq nest-count 0))
3663 ;; 3668 ;;
3664 ((looking-at "when") 3669 ((looking-at "when")
3665 (save-excursion 3670 (save-excursion
@@ -3674,20 +3679,20 @@ If NOERROR is non-nil, it only returns nil if no match was found."
3674 (setq first nil)) 3679 (setq first nil))
3675 ;; 3680 ;;
3676 (t 3681 (t
3677 (setq nest-count (1+ nest-count)) 3682 (setq nest-count (1+ nest-count))
3678 (setq first nil))) 3683 (setq first nil)))
3679 3684
3680 );; end of loop 3685 );; end of loop
3681 3686
3682 ;; check if declaration-start is really found 3687 ;; check if declaration-start is really found
3683 (if (and 3688 (if (and
3684 (zerop nest-count) 3689 (zerop nest-count)
3685 (if (looking-at "is") 3690 (if (looking-at "is")
3686 (ada-search-ignore-string-comment ada-subprog-start-re t) 3691 (ada-search-ignore-string-comment ada-subprog-start-re t)
3687 (looking-at "declare\\|generic"))) 3692 (looking-at "declare\\|generic")))
3688 t 3693 t
3689 (if noerror nil 3694 (if noerror nil
3690 (error "No matching proc/func/task/declare/package/protected"))) 3695 (error "No matching proc/func/task/declare/package/protected")))
3691 )) 3696 ))
3692 3697
3693(defun ada-goto-matching-start (&optional nest-level noerror gotothen) 3698(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
@@ -3696,110 +3701,103 @@ Which block depends on the value of NEST-LEVEL, which defaults to zero.
3696If NOERROR is non-nil, it only returns nil if no matching start was found. 3701If NOERROR is non-nil, it only returns nil if no matching start was found.
3697If GOTOTHEN is non-nil, point moves to the 'then' following 'if'." 3702If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
3698 (let ((nest-count (if nest-level nest-level 0)) 3703 (let ((nest-count (if nest-level nest-level 0))
3699 (found nil) 3704 (found nil)
3700 (pos nil)) 3705 (pos nil))
3701 3706
3702 ;;
3703 ;; search backward for interesting keywords 3707 ;; search backward for interesting keywords
3704 ;;
3705 (while (and 3708 (while (and
3706 (not found) 3709 (not found)
3707 (ada-search-ignore-string-comment ada-matching-start-re t)) 3710 (ada-search-ignore-string-comment ada-matching-start-re t))
3708 3711
3709 (unless (and (looking-at "\\<record\\>") 3712 (unless (and (looking-at "\\<record\\>")
3710 (save-excursion 3713 (save-excursion
3711 (forward-word -1) 3714 (forward-word -1)
3712 (looking-at "\\<null\\>"))) 3715 (looking-at "\\<null\\>")))
3713 (progn 3716 (progn
3714 ;; 3717 ;; calculate nest-depth
3715 ;; calculate nest-depth 3718 (cond
3716 ;; 3719 ;; found block end => increase nest depth
3717 (cond 3720 ((looking-at "end")
3718 ;; found block end => increase nest depth 3721 (setq nest-count (1+ nest-count)))
3719 ((looking-at "end") 3722
3720 (setq nest-count (1+ nest-count))) 3723 ;; found loop/select/record/case/if => check if it starts or
3721 3724 ;; ends a block
3722 ;; found loop/select/record/case/if => check if it starts or 3725 ((looking-at "loop\\|select\\|record\\|case\\|if")
3723 ;; ends a block 3726 (setq pos (point))
3724 ((looking-at "loop\\|select\\|record\\|case\\|if") 3727 (save-excursion
3725 (setq pos (point)) 3728 ;; check if keyword follows 'end'
3726 (save-excursion 3729 (ada-goto-previous-word)
3727 ;; 3730 (if (looking-at "\\<end\\>[ \t]*[^;]")
3728 ;; check if keyword follows 'end' 3731 ;; it ends a block => increase nest depth
3729 ;;
3730 (ada-goto-previous-word)
3731 (if (looking-at "\\<end\\>[ \t]*[^;]")
3732 ;; it ends a block => increase nest depth
3733 (setq nest-count (1+ nest-count) 3732 (setq nest-count (1+ nest-count)
3734 pos (point)) 3733 pos (point))
3735 3734
3736 ;; it starts a block => decrease nest depth 3735 ;; it starts a block => decrease nest depth
3737 (setq nest-count (1- nest-count)))) 3736 (setq nest-count (1- nest-count))))
3738 (goto-char pos)) 3737 (goto-char pos))
3739 3738
3740 ;; found package start => check if it really is a block 3739 ;; found package start => check if it really is a block
3741 ((looking-at "package") 3740 ((looking-at "package")
3742 (save-excursion 3741 (save-excursion
3743 ;; ignore if this is just a renames statement 3742 ;; ignore if this is just a renames statement
3744 (let ((current (point)) 3743 (let ((current (point))
3745 (pos (ada-search-ignore-string-comment 3744 (pos (ada-search-ignore-string-comment
3746 "\\<\\(is\\|renames\\|;\\)\\>" nil))) 3745 "\\<\\(is\\|renames\\|;\\)\\>" nil)))
3747 (if pos 3746 (if pos
3748 (goto-char (car pos)) 3747 (goto-char (car pos))
3749 (error (concat 3748 (error (concat
3750 "No matching 'is' or 'renames' for 'package' at" 3749 "No matching 'is' or 'renames' for 'package' at"
3751 " line " 3750 " line "
3752 (number-to-string (count-lines 1 (1+ current))))))) 3751 (number-to-string (count-lines 1 (1+ current)))))))
3753 (unless (looking-at "renames") 3752 (unless (looking-at "renames")
3754 (progn 3753 (progn
3755 (forward-word 1) 3754 (forward-word 1)
3756 (ada-goto-next-non-ws) 3755 (ada-goto-next-non-ws)
3757 ;; ignore it if it is only a declaration with 'new' 3756 ;; ignore it if it is only a declaration with 'new'
3758 ;; We could have package Foo is new .... 3757 ;; We could have package Foo is new ....
3759 ;; or package Foo is separate; 3758 ;; or package Foo is separate;
3760 ;; or package Foo is begin null; end Foo 3759 ;; or package Foo is begin null; end Foo
3761 ;; for elaboration code (elaboration) 3760 ;; for elaboration code (elaboration)
3762 (if (not (looking-at "\\<\\(new\\|separate\\|begin\\)\\>")) 3761 (if (not (looking-at "\\<\\(new\\|separate\\|begin\\)\\>"))
3763 (setq nest-count (1- nest-count))))))) 3762 (setq nest-count (1- nest-count)))))))
3764 ;; found task start => check if it has a body 3763 ;; found task start => check if it has a body
3765 ((looking-at "task") 3764 ((looking-at "task")
3766 (save-excursion 3765 (save-excursion
3767 (forward-word 1) 3766 (forward-word 1)
3768 (ada-goto-next-non-ws) 3767 (ada-goto-next-non-ws)
3769 (cond 3768 (cond
3770 ((looking-at "\\<body\\>")) 3769 ((looking-at "\\<body\\>"))
3771 ((looking-at "\\<type\\>") 3770 ((looking-at "\\<type\\>")
3772 ;; In that case, do nothing if there is a "is" 3771 ;; In that case, do nothing if there is a "is"
3773 (forward-word 2);; skip "type" 3772 (forward-word 2);; skip "type"
3774 (ada-goto-next-non-ws);; skip type name 3773 (ada-goto-next-non-ws);; skip type name
3775 3774
3776 ;; Do nothing if we are simply looking at a simple 3775 ;; Do nothing if we are simply looking at a simple
3777 ;; "task type name;" statement with no block 3776 ;; "task type name;" statement with no block
3778 (unless (looking-at ";") 3777 (unless (looking-at ";")
3779 (progn 3778 (progn
3780 ;; Skip the parameters 3779 ;; Skip the parameters
3781 (if (looking-at "(") 3780 (if (looking-at "(")
3782 (ada-search-ignore-string-comment ")" nil)) 3781 (ada-search-ignore-string-comment ")" nil))
3783 (let ((tmp (ada-search-ignore-string-comment 3782 (let ((tmp (ada-search-ignore-string-comment
3784 "\\<\\(is\\|;\\)\\>" nil))) 3783 "\\<\\(is\\|;\\)\\>" nil)))
3785 (if tmp 3784 (if tmp
3786 (progn 3785 (progn
3787 (goto-char (car tmp)) 3786 (goto-char (car tmp))
3788 (if (looking-at "is") 3787 (if (looking-at "is")
3789 (setq nest-count (1- nest-count))))))))) 3788 (setq nest-count (1- nest-count)))))))))
3790 (t 3789 (t
3791 ;; Check if that task declaration had a block attached to 3790 ;; Check if that task declaration had a block attached to
3792 ;; it (i.e do nothing if we have just "task name;") 3791 ;; it (i.e do nothing if we have just "task name;")
3793 (unless (progn (forward-word 1) 3792 (unless (progn (forward-word 1)
3794 (looking-at "[ \t]*;")) 3793 (looking-at "[ \t]*;"))
3795 (setq nest-count (1- nest-count))))))) 3794 (setq nest-count (1- nest-count)))))))
3796 ;; all the other block starts 3795 ;; all the other block starts
3797 (t 3796 (t
3798 (setq nest-count (1- nest-count)))) ; end of 'cond' 3797 (setq nest-count (1- nest-count)))) ; end of 'cond'
3799 3798
3800 ;; match is found, if nest-depth is zero 3799 ;; match is found, if nest-depth is zero
3801 ;; 3800 (setq found (zerop nest-count))))) ; end of loop
3802 (setq found (zerop nest-count))))) ; end of loop
3803 3801
3804 (if (bobp) 3802 (if (bobp)
3805 (point) 3803 (point)
@@ -3850,7 +3848,7 @@ If NOERROR is non-nil, it only returns nil if no matching start found."
3850 "procedure" "function") t) 3848 "procedure" "function") t)
3851 "\\>"))) 3849 "\\>")))
3852 found 3850 found
3853 pos 3851 pos
3854 3852
3855 ;; First is used for subprograms: they are generally handled 3853 ;; First is used for subprograms: they are generally handled
3856 ;; recursively, but of course we do not want to do that the 3854 ;; recursively, but of course we do not want to do that the
@@ -3868,8 +3866,8 @@ If NOERROR is non-nil, it only returns nil if no matching start found."
3868 ;; search forward for interesting keywords 3866 ;; search forward for interesting keywords
3869 ;; 3867 ;;
3870 (while (and 3868 (while (and
3871 (not found) 3869 (not found)
3872 (ada-search-ignore-string-comment regex nil)) 3870 (ada-search-ignore-string-comment regex nil))
3873 3871
3874 ;; 3872 ;;
3875 ;; calculate nest-depth 3873 ;; calculate nest-depth
@@ -3907,9 +3905,9 @@ If NOERROR is non-nil, it only returns nil if no matching start found."
3907 3905
3908 ;; found block end => decrease nest depth 3906 ;; found block end => decrease nest depth
3909 ((looking-at "\\<end\\>") 3907 ((looking-at "\\<end\\>")
3910 (setq nest-count (1- nest-count) 3908 (setq nest-count (1- nest-count)
3911 found (<= nest-count 0)) 3909 found (<= nest-count 0))
3912 ;; skip the following keyword 3910 ;; skip the following keyword
3913 (if (progn 3911 (if (progn
3914 (skip-chars-forward "end") 3912 (skip-chars-forward "end")
3915 (ada-goto-next-non-ws) 3913 (ada-goto-next-non-ws)
@@ -3919,13 +3917,13 @@ If NOERROR is non-nil, it only returns nil if no matching start found."
3919 ;; found package start => check if it really starts a block, and is not 3917 ;; found package start => check if it really starts a block, and is not
3920 ;; in fact a generic instantiation for instance 3918 ;; in fact a generic instantiation for instance
3921 ((looking-at "\\<package\\>") 3919 ((looking-at "\\<package\\>")
3922 (ada-search-ignore-string-comment "is" nil nil nil 3920 (ada-search-ignore-string-comment "is" nil nil nil
3923 'word-search-forward) 3921 'word-search-forward)
3924 (ada-goto-next-non-ws) 3922 (ada-goto-next-non-ws)
3925 ;; ignore and skip it if it is only a 'new' package 3923 ;; ignore and skip it if it is only a 'new' package
3926 (if (looking-at "\\<new\\>") 3924 (if (looking-at "\\<new\\>")
3927 (goto-char (match-end 0)) 3925 (goto-char (match-end 0))
3928 (setq nest-count (1+ nest-count) 3926 (setq nest-count (1+ nest-count)
3929 found (<= nest-count 0)))) 3927 found (<= nest-count 0))))
3930 3928
3931 ;; all the other block starts 3929 ;; all the other block starts
@@ -3933,34 +3931,35 @@ If NOERROR is non-nil, it only returns nil if no matching start found."
3933 (if (not first) 3931 (if (not first)
3934 (setq nest-count (1+ nest-count))) 3932 (setq nest-count (1+ nest-count)))
3935 (setq found (<= nest-count 0)) 3933 (setq found (<= nest-count 0))
3936 (forward-word 1))) ; end of 'cond' 3934 (forward-word 1))) ; end of 'cond'
3937 3935
3938 (setq first nil)) 3936 (setq first nil))
3939 3937
3940 (if found 3938 (if found
3941 t 3939 t
3942 (if noerror 3940 (if noerror
3943 nil 3941 nil
3944 (error "No matching end"))) 3942 (error "No matching end")))
3945 )) 3943 ))
3946 3944
3947 3945
3948(defun ada-search-ignore-string-comment 3946(defun ada-search-ignore-string-comment
3949 (search-re &optional backward limit paramlists search-func) 3947 (search-re &optional backward limit paramlists search-func)
3950 "Regexp-search for SEARCH-RE, ignoring comments, strings. 3948 "Regexp-search for SEARCH-RE, ignoring comments, strings.
3951If PARAMLISTS is nil, ignore parameter lists. Returns a cons cell of 3949Returns a cons cell of begin and end of match data or nil, if not found.
3952begin and end of match data or nil, if not found. 3950If BACKWARD is non-nil, search backward; search forward otherwise.
3953The search is done using SEARCH-FUNC, which should search backward if
3954BACKWARD is non-nil, forward otherwise. SEARCH-FUNC can be optimized
3955in case we are searching for a constant string.
3956The search stops at pos LIMIT. 3951The search stops at pos LIMIT.
3952If PARAMLISTS is nil, ignore parameter lists.
3953The search is done using SEARCH-FUNC. SEARCH-FUNC can be optimized
3954in case we are searching for a constant string.
3957Point is moved at the beginning of the SEARCH-RE." 3955Point is moved at the beginning of the SEARCH-RE."
3958 (let (found 3956 (let (found
3959 begin 3957 begin
3960 end 3958 end
3961 parse-result 3959 parse-result
3962 (previous-syntax-table (syntax-table))) 3960 (previous-syntax-table (syntax-table)))
3963 3961
3962 ;; FIXME: need to pass BACKWARD to search-func!
3964 (unless search-func 3963 (unless search-func
3965 (setq search-func (if backward 're-search-backward 're-search-forward))) 3964 (setq search-func (if backward 're-search-backward 're-search-forward)))
3966 3965
@@ -3970,68 +3969,68 @@ Point is moved at the beginning of the SEARCH-RE."
3970 ;; 3969 ;;
3971 (set-syntax-table ada-mode-symbol-syntax-table) 3970 (set-syntax-table ada-mode-symbol-syntax-table)
3972 (while (and (not found) 3971 (while (and (not found)
3973 (or (not limit) 3972 (or (not limit)
3974 (or (and backward (<= limit (point))) 3973 (or (and backward (<= limit (point)))
3975 (>= limit (point)))) 3974 (>= limit (point))))
3976 (funcall search-func search-re limit 1)) 3975 (funcall search-func search-re limit 1))
3977 (setq begin (match-beginning 0)) 3976 (setq begin (match-beginning 0))
3978 (setq end (match-end 0)) 3977 (setq end (match-end 0))
3979 3978
3980 (setq parse-result (parse-partial-sexp 3979 (setq parse-result (parse-partial-sexp
3981 (save-excursion (beginning-of-line) (point)) 3980 (save-excursion (beginning-of-line) (point))
3982 (point))) 3981 (point)))
3983 3982
3984 (cond 3983 (cond
3985 ;; 3984 ;;
3986 ;; If inside a string, skip it (and the following comments) 3985 ;; If inside a string, skip it (and the following comments)
3987 ;; 3986 ;;
3988 ((ada-in-string-p parse-result) 3987 ((ada-in-string-p parse-result)
3989 (if (featurep 'xemacs) 3988 (if (featurep 'xemacs)
3990 (search-backward "\"" nil t) 3989 (search-backward "\"" nil t)
3991 (goto-char (nth 8 parse-result))) 3990 (goto-char (nth 8 parse-result)))
3992 (unless backward (forward-sexp 1))) 3991 (unless backward (forward-sexp 1)))
3993 ;; 3992 ;;
3994 ;; If inside a comment, skip it (and the following comments) 3993 ;; If inside a comment, skip it (and the following comments)
3995 ;; There is a special code for comments at the end of the file 3994 ;; There is a special code for comments at the end of the file
3996 ;; 3995 ;;
3997 ((ada-in-comment-p parse-result) 3996 ((ada-in-comment-p parse-result)
3998 (if (featurep 'xemacs) 3997 (if (featurep 'xemacs)
3999 (progn 3998 (progn
4000 (forward-line 1) 3999 (forward-line 1)
4001 (beginning-of-line) 4000 (beginning-of-line)
4002 (forward-comment -1)) 4001 (forward-comment -1))
4003 (goto-char (nth 8 parse-result))) 4002 (goto-char (nth 8 parse-result)))
4004 (unless backward 4003 (unless backward
4005 ;; at the end of the file, it is not possible to skip a comment 4004 ;; at the end of the file, it is not possible to skip a comment
4006 ;; so we just go at the end of the line 4005 ;; so we just go at the end of the line
4007 (if (forward-comment 1) 4006 (if (forward-comment 1)
4008 (progn 4007 (progn
4009 (forward-comment 1000) 4008 (forward-comment 1000)
4010 (beginning-of-line)) 4009 (beginning-of-line))
4011 (end-of-line)))) 4010 (end-of-line))))
4012 ;; 4011 ;;
4013 ;; directly in front of a comment => skip it, if searching forward 4012 ;; directly in front of a comment => skip it, if searching forward
4014 ;; 4013 ;;
4015 ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) 4014 ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
4016 (unless backward (progn (forward-char -1) (forward-comment 1000)))) 4015 (unless backward (progn (forward-char -1) (forward-comment 1000))))
4017 4016
4018 ;; 4017 ;;
4019 ;; found a parameter-list but should ignore it => skip it 4018 ;; found a parameter-list but should ignore it => skip it
4020 ;; 4019 ;;
4021 ((and (not paramlists) (ada-in-paramlist-p)) 4020 ((and (not paramlists) (ada-in-paramlist-p))
4022 (if backward 4021 (if backward
4023 (search-backward "(" nil t) 4022 (search-backward "(" nil t)
4024 (search-forward ")" nil t))) 4023 (search-forward ")" nil t)))
4025 ;; 4024 ;;
4026 ;; found what we were looking for 4025 ;; found what we were looking for
4027 ;; 4026 ;;
4028 (t 4027 (t
4029 (setq found t)))) ; end of loop 4028 (setq found t)))) ; end of loop
4030 4029
4031 (set-syntax-table previous-syntax-table) 4030 (set-syntax-table previous-syntax-table)
4032 4031
4033 (if found 4032 (if found
4034 (cons begin end) 4033 (cons begin end)
4035 nil))) 4034 nil)))
4036 4035
4037;; ------------------------------------------------------- 4036;; -------------------------------------------------------
@@ -4043,17 +4042,17 @@ Point is moved at the beginning of the SEARCH-RE."
4043Assumes point to be at the end of a statement." 4042Assumes point to be at the end of a statement."
4044 (or (ada-in-paramlist-p) 4043 (or (ada-in-paramlist-p)
4045 (save-excursion 4044 (save-excursion
4046 (ada-goto-matching-decl-start t)))) 4045 (ada-goto-matching-decl-start t))))
4047 4046
4048 4047
4049(defun ada-looking-at-semi-or () 4048(defun ada-looking-at-semi-or ()
4050 "Return t if looking at an 'or' following a semicolon." 4049 "Return t if looking at an 'or' following a semicolon."
4051 (save-excursion 4050 (save-excursion
4052 (and (looking-at "\\<or\\>") 4051 (and (looking-at "\\<or\\>")
4053 (progn 4052 (progn
4054 (forward-word 1) 4053 (forward-word 1)
4055 (ada-goto-stmt-start) 4054 (ada-goto-stmt-start)
4056 (looking-at "\\<or\\>"))))) 4055 (looking-at "\\<or\\>")))))
4057 4056
4058 4057
4059(defun ada-looking-at-semi-private () 4058(defun ada-looking-at-semi-private ()
@@ -4062,7 +4061,7 @@ Return nil if the private is part of the package name, as in
4062'private package A is...' (this can only happen at top level)." 4061'private package A is...' (this can only happen at top level)."
4063 (save-excursion 4062 (save-excursion
4064 (and (looking-at "\\<private\\>") 4063 (and (looking-at "\\<private\\>")
4065 (not (looking-at "\\<private[ \t]*\\(package\\|generic\\)")) 4064 (not (looking-at "\\<private[ \t]*\\(package\\|generic\\)"))
4066 4065
4067 ;; Make sure this is the start of a private section (ie after 4066 ;; Make sure this is the start of a private section (ie after
4068 ;; a semicolon or just after the package declaration, but not 4067 ;; a semicolon or just after the package declaration, but not
@@ -4093,8 +4092,8 @@ Return nil if the private is part of the package name, as in
4093 (progn 4092 (progn
4094 (skip-chars-backward " \t\n") 4093 (skip-chars-backward " \t\n")
4095 (if (= (char-before) ?\") 4094 (if (= (char-before) ?\")
4096 (backward-char 3) 4095 (backward-char 3)
4097 (backward-word 1)) 4096 (backward-word 1))
4098 t) 4097 t)
4099 4098
4100 ;; and now over the second one 4099 ;; and now over the second one
@@ -4111,17 +4110,17 @@ Return nil if the private is part of the package name, as in
4111 ;; right keyword two words before parenthesis ? 4110 ;; right keyword two words before parenthesis ?
4112 ;; Type is in this list because of discriminants 4111 ;; Type is in this list because of discriminants
4113 (looking-at (eval-when-compile 4112 (looking-at (eval-when-compile
4114 (concat "\\<\\(" 4113 (concat "\\<\\("
4115 "procedure\\|function\\|body\\|" 4114 "procedure\\|function\\|body\\|"
4116 "task\\|entry\\|accept\\|" 4115 "task\\|entry\\|accept\\|"
4117 "access[ \t]+procedure\\|" 4116 "access[ \t]+procedure\\|"
4118 "access[ \t]+function\\|" 4117 "access[ \t]+function\\|"
4119 "pragma\\|" 4118 "pragma\\|"
4120 "type\\)\\>")))))) 4119 "type\\)\\>"))))))
4121 4120
4122(defun ada-search-ignore-complex-boolean (regexp backwardp) 4121(defun ada-search-ignore-complex-boolean (regexp backwardp)
4123 "Like `ada-search-ignore-string-comment', except that it also ignores 4122 "Search for REGEXP, ignoring comments, strings, 'and then', 'or else'.
4124boolean expressions 'and then' and 'or else'." 4123If BACKWARDP is non-nil, search backward; search forward otherwise."
4125 (let (result) 4124 (let (result)
4126 (while (and (setq result (ada-search-ignore-string-comment regexp backwardp)) 4125 (while (and (setq result (ada-search-ignore-string-comment regexp backwardp))
4127 (save-excursion (forward-word -1) 4126 (save-excursion (forward-word -1)
@@ -4129,19 +4128,20 @@ boolean expressions 'and then' and 'or else'."
4129 result)) 4128 result))
4130 4129
4131(defun ada-in-open-paren-p () 4130(defun ada-in-open-paren-p ()
4132 "Return the position of the first non-ws behind the last unclosed 4131 "Non-nil if in an open parenthesis.
4132Return value is the position of the first non-ws behind the last unclosed
4133parenthesis, or nil." 4133parenthesis, or nil."
4134 (save-excursion 4134 (save-excursion
4135 (let ((parse (parse-partial-sexp 4135 (let ((parse (parse-partial-sexp
4136 (point) 4136 (point)
4137 (or (car (ada-search-ignore-complex-boolean 4137 (or (car (ada-search-ignore-complex-boolean
4138 "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>" 4138 "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>"
4139 t)) 4139 t))
4140 (point-min))))) 4140 (point-min)))))
4141 4141
4142 (if (nth 1 parse) 4142 (if (nth 1 parse)
4143 (progn 4143 (progn
4144 (goto-char (1+ (nth 1 parse))) 4144 (goto-char (1+ (nth 1 parse)))
4145 4145
4146 ;; Skip blanks, if they are not followed by a comment 4146 ;; Skip blanks, if they are not followed by a comment
4147 ;; See: 4147 ;; See:
@@ -4152,9 +4152,9 @@ parenthesis, or nil."
4152 4152
4153 (if (or (not ada-indent-handle-comment-special) 4153 (if (or (not ada-indent-handle-comment-special)
4154 (not (looking-at "[ \t]+--"))) 4154 (not (looking-at "[ \t]+--")))
4155 (skip-chars-forward " \t")) 4155 (skip-chars-forward " \t"))
4156 4156
4157 (point)))))) 4157 (point))))))
4158 4158
4159 4159
4160;; ----------------------------------------------------------- 4160;; -----------------------------------------------------------
@@ -4167,20 +4167,21 @@ In Transient Mark mode, if the mark is active, operate on the contents
4167of the region. Otherwise, operate only on the current line." 4167of the region. Otherwise, operate only on the current line."
4168 (interactive) 4168 (interactive)
4169 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard)) 4169 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
4170 ((eq ada-tab-policy 'indent-auto) 4170 ((eq ada-tab-policy 'indent-auto)
4171 (if (ada-region-selected) 4171 (if (ada-region-selected)
4172 (ada-indent-region (region-beginning) (region-end)) 4172 (ada-indent-region (region-beginning) (region-end))
4173 (ada-indent-current))) 4173 (ada-indent-current)))
4174 ((eq ada-tab-policy 'always-tab) (error "Not implemented")) 4174 ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
4175 )) 4175 ))
4176 4176
4177(defun ada-untab (arg) 4177(defun ada-untab (arg)
4178 "Delete leading indenting according to `ada-tab-policy'." 4178 "Delete leading indenting according to `ada-tab-policy'."
4179 ;; FIXME: ARG is ignored
4179 (interactive "P") 4180 (interactive "P")
4180 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard)) 4181 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
4181 ((eq ada-tab-policy 'indent-auto) (error "Not implemented")) 4182 ((eq ada-tab-policy 'indent-auto) (error "Not implemented"))
4182 ((eq ada-tab-policy 'always-tab) (error "Not implemented")) 4183 ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
4183 )) 4184 ))
4184 4185
4185(defun ada-indent-current-function () 4186(defun ada-indent-current-function ()
4186 "Ada mode version of the `indent-line-function'." 4187 "Ada mode version of the `indent-line-function'."
@@ -4189,7 +4190,7 @@ of the region. Otherwise, operate only on the current line."
4189 (beginning-of-line) 4190 (beginning-of-line)
4190 (ada-tab) 4191 (ada-tab)
4191 (if (< (point) starting-point) 4192 (if (< (point) starting-point)
4192 (goto-char starting-point)) 4193 (goto-char starting-point))
4193 (set-marker starting-point nil) 4194 (set-marker starting-point nil)
4194 )) 4195 ))
4195 4196
@@ -4206,7 +4207,7 @@ of the region. Otherwise, operate only on the current line."
4206 "Indent current line to previous tab stop." 4207 "Indent current line to previous tab stop."
4207 (interactive) 4208 (interactive)
4208 (let ((bol (save-excursion (progn (beginning-of-line) (point)))) 4209 (let ((bol (save-excursion (progn (beginning-of-line) (point))))
4209 (eol (save-excursion (progn (end-of-line) (point))))) 4210 (eol (save-excursion (progn (end-of-line) (point)))))
4210 (indent-rigidly bol eol (- 0 ada-indent)))) 4211 (indent-rigidly bol eol (- 0 ada-indent))))
4211 4212
4212 4213
@@ -4223,10 +4224,10 @@ of the region. Otherwise, operate only on the current line."
4223 (save-match-data 4224 (save-match-data
4224 (save-excursion 4225 (save-excursion
4225 (save-restriction 4226 (save-restriction
4226 (widen) 4227 (widen)
4227 (goto-char (point-min)) 4228 (goto-char (point-min))
4228 (while (re-search-forward "[ \t]+$" (point-max) t) 4229 (while (re-search-forward "[ \t]+$" (point-max) t)
4229 (replace-match "" nil nil)))))) 4230 (replace-match "" nil nil))))))
4230 4231
4231(defun ada-gnat-style () 4232(defun ada-gnat-style ()
4232 "Clean up comments, `(' and `,' for GNAT style checking switch." 4233 "Clean up comments, `(' and `,' for GNAT style checking switch."
@@ -4308,40 +4309,40 @@ of the region. Otherwise, operate only on the current line."
4308 "Move point to the matching start of the current Ada structure." 4309 "Move point to the matching start of the current Ada structure."
4309 (interactive) 4310 (interactive)
4310 (let ((pos (point)) 4311 (let ((pos (point))
4311 (previous-syntax-table (syntax-table))) 4312 (previous-syntax-table (syntax-table)))
4312 (unwind-protect 4313 (unwind-protect
4313 (progn 4314 (progn
4314 (set-syntax-table ada-mode-symbol-syntax-table) 4315 (set-syntax-table ada-mode-symbol-syntax-table)
4315 4316
4316 (save-excursion 4317 (save-excursion
4317 ;; 4318 ;;
4318 ;; do nothing if in string or comment or not on 'end ...;' 4319 ;; do nothing if in string or comment or not on 'end ...;'
4319 ;; or if an error occurs during processing 4320 ;; or if an error occurs during processing
4320 ;; 4321 ;;
4321 (or 4322 (or
4322 (ada-in-string-or-comment-p) 4323 (ada-in-string-or-comment-p)
4323 (and (progn 4324 (and (progn
4324 (or (looking-at "[ \t]*\\<end\\>") 4325 (or (looking-at "[ \t]*\\<end\\>")
4325 (backward-word 1)) 4326 (backward-word 1))
4326 (or (looking-at "[ \t]*\\<end\\>") 4327 (or (looking-at "[ \t]*\\<end\\>")
4327 (backward-word 1)) 4328 (backward-word 1))
4328 (or (looking-at "[ \t]*\\<end\\>") 4329 (or (looking-at "[ \t]*\\<end\\>")
4329 (error "Not on end ...;"))) 4330 (error "Not on end ...;")))
4330 (ada-goto-matching-start 1) 4331 (ada-goto-matching-start 1)
4331 (setq pos (point)) 4332 (setq pos (point))
4332 4333
4333 ;; 4334 ;;
4334 ;; on 'begin' => go on, according to user option 4335 ;; on 'begin' => go on, according to user option
4335 ;; 4336 ;;
4336 ada-move-to-declaration 4337 ada-move-to-declaration
4337 (looking-at "\\<begin\\>") 4338 (looking-at "\\<begin\\>")
4338 (ada-goto-matching-decl-start) 4339 (ada-goto-matching-decl-start)
4339 (setq pos (point)))) 4340 (setq pos (point))))
4340 4341
4341 ) ; end of save-excursion 4342 ) ; end of save-excursion
4342 4343
4343 ;; now really move to the found position 4344 ;; now really move to the found position
4344 (goto-char pos)) 4345 (goto-char pos))
4345 4346
4346 ;; restore syntax-table 4347 ;; restore syntax-table
4347 (set-syntax-table previous-syntax-table)))) 4348 (set-syntax-table previous-syntax-table))))
@@ -4352,16 +4353,16 @@ Moves to 'begin' if in a declarative part."
4352 (interactive) 4353 (interactive)
4353 (let ((pos (point)) 4354 (let ((pos (point))
4354 decl-start 4355 decl-start
4355 (previous-syntax-table (syntax-table))) 4356 (previous-syntax-table (syntax-table)))
4356 (unwind-protect 4357 (unwind-protect
4357 (progn 4358 (progn
4358 (set-syntax-table ada-mode-symbol-syntax-table) 4359 (set-syntax-table ada-mode-symbol-syntax-table)
4359 4360
4360 (save-excursion 4361 (save-excursion
4361 4362
4362 (cond 4363 (cond
4363 ;; Go to the beginning of the current word, and check if we are 4364 ;; Go to the beginning of the current word, and check if we are
4364 ;; directly on 'begin' 4365 ;; directly on 'begin'
4365 ((save-excursion 4366 ((save-excursion
4366 (skip-syntax-backward "w") 4367 (skip-syntax-backward "w")
4367 (looking-at "\\<begin\\>")) 4368 (looking-at "\\<begin\\>"))
@@ -4375,31 +4376,31 @@ Moves to 'begin' if in a declarative part."
4375 ((save-excursion 4376 ((save-excursion
4376 (and (skip-syntax-backward "w") 4377 (and (skip-syntax-backward "w")
4377 (looking-at "\\<function\\>\\|\\<procedure\\>" ) 4378 (looking-at "\\<function\\>\\|\\<procedure\\>" )
4378 (ada-search-ignore-string-comment "is\\|;") 4379 (ada-search-ignore-string-comment "is\\|;")
4379 (not (= (char-before) ?\;)) 4380 (not (= (char-before) ?\;))
4380 )) 4381 ))
4381 (skip-syntax-backward "w") 4382 (skip-syntax-backward "w")
4382 (ada-goto-matching-end 0 t)) 4383 (ada-goto-matching-end 0 t))
4383 4384
4384 ;; on first line of task declaration 4385 ;; on first line of task declaration
4385 ((save-excursion 4386 ((save-excursion
4386 (and (ada-goto-stmt-start) 4387 (and (ada-goto-stmt-start)
4387 (looking-at "\\<task\\>" ) 4388 (looking-at "\\<task\\>" )
4388 (forward-word 1) 4389 (forward-word 1)
4389 (ada-goto-next-non-ws) 4390 (ada-goto-next-non-ws)
4390 (looking-at "\\<body\\>"))) 4391 (looking-at "\\<body\\>")))
4391 (ada-search-ignore-string-comment "begin" nil nil nil 4392 (ada-search-ignore-string-comment "begin" nil nil nil
4392 'word-search-forward)) 4393 'word-search-forward))
4393 ;; accept block start 4394 ;; accept block start
4394 ((save-excursion 4395 ((save-excursion
4395 (and (ada-goto-stmt-start) 4396 (and (ada-goto-stmt-start)
4396 (looking-at "\\<accept\\>" ))) 4397 (looking-at "\\<accept\\>" )))
4397 (ada-goto-matching-end 0)) 4398 (ada-goto-matching-end 0))
4398 ;; package start 4399 ;; package start
4399 ((save-excursion 4400 ((save-excursion
4400 (setq decl-start (and (ada-goto-matching-decl-start t) (point))) 4401 (setq decl-start (and (ada-goto-matching-decl-start t) (point)))
4401 (and decl-start (looking-at "\\<package\\>"))) 4402 (and decl-start (looking-at "\\<package\\>")))
4402 (ada-goto-matching-end 1)) 4403 (ada-goto-matching-end 1))
4403 4404
4404 ;; On a "declare" keyword 4405 ;; On a "declare" keyword
4405 ((save-excursion 4406 ((save-excursion
@@ -4407,19 +4408,19 @@ Moves to 'begin' if in a declarative part."
4407 (looking-at "\\<declare\\>")) 4408 (looking-at "\\<declare\\>"))
4408 (ada-goto-matching-end 0 t)) 4409 (ada-goto-matching-end 0 t))
4409 4410
4410 ;; inside a 'begin' ... 'end' block 4411 ;; inside a 'begin' ... 'end' block
4411 (decl-start 4412 (decl-start
4412 (goto-char decl-start) 4413 (goto-char decl-start)
4413 (ada-goto-matching-end 0 t)) 4414 (ada-goto-matching-end 0 t))
4414 4415
4415 ;; (hopefully ;-) everything else 4416 ;; (hopefully ;-) everything else
4416 (t 4417 (t
4417 (ada-goto-matching-end 1))) 4418 (ada-goto-matching-end 1)))
4418 (setq pos (point)) 4419 (setq pos (point))
4419 ) 4420 )
4420 4421
4421 ;; now really move to the position found 4422 ;; now really move to the position found
4422 (goto-char pos)) 4423 (goto-char pos))
4423 4424
4424 ;; restore syntax-table 4425 ;; restore syntax-table
4425 (set-syntax-table previous-syntax-table)))) 4426 (set-syntax-table previous-syntax-table))))
@@ -4511,8 +4512,8 @@ Moves to 'begin' if in a declarative part."
4511 ;; and activated only if the right compiler is used 4512 ;; and activated only if the right compiler is used
4512 (if (featurep 'xemacs) 4513 (if (featurep 'xemacs)
4513 (progn 4514 (progn
4514 (define-key ada-mode-map '(shift button3) 'ada-point-and-xref) 4515 (define-key ada-mode-map '(shift button3) 'ada-point-and-xref)
4515 (define-key ada-mode-map '(control tab) 'ada-complete-identifier)) 4516 (define-key ada-mode-map '(control tab) 'ada-complete-identifier))
4516 (define-key ada-mode-map [C-tab] 'ada-complete-identifier) 4517 (define-key ada-mode-map [C-tab] 'ada-complete-identifier)
4517 (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref)) 4518 (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref))
4518 4519
@@ -4607,15 +4608,13 @@ Moves to 'begin' if in a declarative part."
4607 :included (string-match "gvd" ada-prj-default-debugger)]) 4608 :included (string-match "gvd" ada-prj-default-debugger)])
4608 ["Customize" (customize-group 'ada) 4609 ["Customize" (customize-group 'ada)
4609 :included (fboundp 'customize-group)] 4610 :included (fboundp 'customize-group)]
4610 ["Check file" ada-check-current (eq ada-which-compiler 'gnat)] 4611 ["Check file" ada-check-current t]
4611 ["Compile file" ada-compile-current (eq ada-which-compiler 'gnat)] 4612 ["Compile file" ada-compile-current t]
4612 ["Build" ada-compile-application 4613 ["Build" ada-compile-application t]
4613 (eq ada-which-compiler 'gnat)]
4614 ["Run" ada-run-application t] 4614 ["Run" ada-run-application t]
4615 ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)] 4615 ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)]
4616 ["------" nil nil] 4616 ["------" nil nil]
4617 ("Project" 4617 ("Project"
4618 :included (eq ada-which-compiler 'gnat)
4619 ["Load..." ada-set-default-project-file t] 4618 ["Load..." ada-set-default-project-file t]
4620 ["New..." ada-prj-new t] 4619 ["New..." ada-prj-new t]
4621 ["Edit..." ada-prj-edit t]) 4620 ["Edit..." ada-prj-edit t])
@@ -4678,7 +4677,7 @@ Moves to 'begin' if in a declarative part."
4678 ["----" nil nil] 4677 ["----" nil nil]
4679 ["Make body for subprogram" ada-make-subprogram-body t] 4678 ["Make body for subprogram" ada-make-subprogram-body t]
4680 ["-----" nil nil] 4679 ["-----" nil nil]
4681 ["Narrow to subprogram" ada-narrow-to-defun t]) 4680 ["Narrow to subprogram" ada-narrow-to-defun t])
4682 ("Templates" 4681 ("Templates"
4683 :included (eq major-mode 'ada-mode) 4682 :included (eq major-mode 'ada-mode)
4684 ["Header" ada-header t] 4683 ["Header" ada-header t]
@@ -4741,18 +4740,19 @@ Moves to 'begin' if in a declarative part."
4741 4740
4742(defadvice comment-region (before ada-uncomment-anywhere disable) 4741(defadvice comment-region (before ada-uncomment-anywhere disable)
4743 (if (and arg 4742 (if (and arg
4744 (listp arg) ;; a prefix with \C-u is of the form '(4), whereas 4743 (listp arg) ;; a prefix with \C-u is of the form '(4), whereas
4745 ;; \C-u 2 sets arg to '2' (fixed by S.Leake) 4744 ;; \C-u 2 sets arg to '2' (fixed by S.Leake)
4746 (string= mode-name "Ada")) 4745 (string= mode-name "Ada"))
4747 (save-excursion 4746 (save-excursion
4748 (let ((cs (concat "^[ \t]*" (regexp-quote comment-start)))) 4747 (let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))
4749 (goto-char beg) 4748 (goto-char beg)
4750 (while (re-search-forward cs end t) 4749 (while (re-search-forward cs end t)
4751 (replace-match comment-start)) 4750 (replace-match comment-start))
4752 )))) 4751 ))))
4753 4752
4754(defun ada-uncomment-region (beg end &optional arg) 4753(defun ada-uncomment-region (beg end &optional arg)
4755 "Delete `comment-start' at the beginning of a line in the region." 4754 "Uncomment region BEG .. END.
4755ARG gives number of comment characters."
4756 (interactive "r\nP") 4756 (interactive "r\nP")
4757 4757
4758 ;; This advice is not needed anymore with Emacs21. However, for older 4758 ;; This advice is not needed anymore with Emacs21. However, for older
@@ -4786,18 +4786,18 @@ The paragraph is indented on the first line."
4786 4786
4787 ;; check if inside comment or just in front a comment 4787 ;; check if inside comment or just in front a comment
4788 (if (and (not (ada-in-comment-p)) 4788 (if (and (not (ada-in-comment-p))
4789 (not (looking-at "[ \t]*--"))) 4789 (not (looking-at "[ \t]*--")))
4790 (error "Not inside comment")) 4790 (error "Not inside comment"))
4791 4791
4792 (let* (indent from to 4792 (let* (indent from to
4793 (opos (point-marker)) 4793 (opos (point-marker))
4794 4794
4795 ;; Sets this variable to nil, otherwise it prevents 4795 ;; Sets this variable to nil, otherwise it prevents
4796 ;; fill-region-as-paragraph to work on Emacs <= 20.2 4796 ;; fill-region-as-paragraph to work on Emacs <= 20.2
4797 (parse-sexp-lookup-properties nil) 4797 (parse-sexp-lookup-properties nil)
4798 4798
4799 fill-prefix 4799 fill-prefix
4800 (fill-column (current-fill-column))) 4800 (fill-column (current-fill-column)))
4801 4801
4802 ;; Find end of paragraph 4802 ;; Find end of paragraph
4803 (back-to-indentation) 4803 (back-to-indentation)
@@ -4844,32 +4844,32 @@ The paragraph is indented on the first line."
4844 (setq fill-prefix ada-fill-comment-prefix) 4844 (setq fill-prefix ada-fill-comment-prefix)
4845 (set-left-margin from to indent) 4845 (set-left-margin from to indent)
4846 (if postfix 4846 (if postfix
4847 (setq fill-column (- fill-column (length ada-fill-comment-postfix)))) 4847 (setq fill-column (- fill-column (length ada-fill-comment-postfix))))
4848 4848
4849 (fill-region-as-paragraph from to justify) 4849 (fill-region-as-paragraph from to justify)
4850 4850
4851 ;; Add the postfixes if required 4851 ;; Add the postfixes if required
4852 (if postfix 4852 (if postfix
4853 (save-restriction 4853 (save-restriction
4854 (goto-char from) 4854 (goto-char from)
4855 (narrow-to-region from to) 4855 (narrow-to-region from to)
4856 (while (not (eobp)) 4856 (while (not (eobp))
4857 (end-of-line) 4857 (end-of-line)
4858 (insert-char ? (- fill-column (current-column))) 4858 (insert-char ? (- fill-column (current-column)))
4859 (insert ada-fill-comment-postfix) 4859 (insert ada-fill-comment-postfix)
4860 (forward-line)) 4860 (forward-line))
4861 )) 4861 ))
4862 4862
4863 ;; In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is 4863 ;; In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is
4864 ;; inserted at the end. Delete it 4864 ;; inserted at the end. Delete it
4865 (if (or (featurep 'xemacs) 4865 (if (or (featurep 'xemacs)
4866 (<= emacs-major-version 19) 4866 (<= emacs-major-version 19)
4867 (and (= emacs-major-version 20) 4867 (and (= emacs-major-version 20)
4868 (<= emacs-minor-version 2))) 4868 (<= emacs-minor-version 2)))
4869 (progn 4869 (progn
4870 (goto-char to) 4870 (goto-char to)
4871 (end-of-line) 4871 (end-of-line)
4872 (delete-char 1))) 4872 (delete-char 1)))
4873 4873
4874 (goto-char opos))) 4874 (goto-char opos)))
4875 4875
@@ -4890,7 +4890,8 @@ The paragraph is indented on the first line."
4890;; Overriden when we work with GNAT, to use gnatkrunch 4890;; Overriden when we work with GNAT, to use gnatkrunch
4891(defun ada-make-filename-from-adaname (adaname) 4891(defun ada-make-filename-from-adaname (adaname)
4892 "Determine the filename in which ADANAME is found. 4892 "Determine the filename in which ADANAME is found.
4893This is a generic function, independent from any compiler." 4893This matches the GNAT default naming convention, except for
4894pre-defined units."
4894 (while (string-match "\\." adaname) 4895 (while (string-match "\\." adaname)
4895 (setq adaname (replace-match "-" t t adaname))) 4896 (setq adaname (replace-match "-" t t adaname)))
4896 (downcase adaname) 4897 (downcase adaname)
@@ -4962,8 +4963,8 @@ Redefines the function `ff-which-function-are-we-in'."
4962 (save-excursion 4963 (save-excursion
4963 (end-of-line);; make sure we get the complete name 4964 (end-of-line);; make sure we get the complete name
4964 (if (or (re-search-backward ada-procedure-start-regexp nil t) 4965 (if (or (re-search-backward ada-procedure-start-regexp nil t)
4965 (re-search-backward ada-package-start-regexp nil t)) 4966 (re-search-backward ada-package-start-regexp nil t))
4966 (setq ff-function-name (match-string 0))) 4967 (setq ff-function-name (match-string 0)))
4967 )) 4968 ))
4968 4969
4969 4970
@@ -4982,18 +4983,18 @@ standard Emacs function `which-function' does not.
4982Since the search can be long, the results are cached." 4983Since the search can be long, the results are cached."
4983 4984
4984 (let ((line (count-lines 1 (point))) 4985 (let ((line (count-lines 1 (point)))
4985 (pos (point)) 4986 (pos (point))
4986 end-pos 4987 end-pos
4987 func-name indent 4988 func-name indent
4988 found) 4989 found)
4989 4990
4990 ;; If this is the same line as before, simply return the same result 4991 ;; If this is the same line as before, simply return the same result
4991 (if (= line ada-last-which-function-line) 4992 (if (= line ada-last-which-function-line)
4992 ada-last-which-function-subprog 4993 ada-last-which-function-subprog
4993 4994
4994 (save-excursion 4995 (save-excursion
4995 ;; In case the current line is also the beginning of the body 4996 ;; In case the current line is also the beginning of the body
4996 (end-of-line) 4997 (end-of-line)
4997 4998
4998 ;; Are we looking at "function Foo\n (paramlist)" 4999 ;; Are we looking at "function Foo\n (paramlist)"
4999 (skip-chars-forward " \t\n(") 5000 (skip-chars-forward " \t\n(")
@@ -5009,39 +5010,39 @@ Since the search can be long, the results are cached."
5009 (skip-chars-forward " \t\n") 5010 (skip-chars-forward " \t\n")
5010 (skip-chars-forward "a-zA-Z0-9_'"))) 5011 (skip-chars-forward "a-zA-Z0-9_'")))
5011 5012
5012 ;; Can't simply do forward-word, in case the "is" is not on the 5013 ;; Can't simply do forward-word, in case the "is" is not on the
5013 ;; same line as the closing parenthesis 5014 ;; same line as the closing parenthesis
5014 (skip-chars-forward "is \t\n") 5015 (skip-chars-forward "is \t\n")
5015 5016
5016 ;; No look for the closest subprogram body that has not ended yet. 5017 ;; No look for the closest subprogram body that has not ended yet.
5017 ;; Not that we expect all the bodies to be finished by "end <name>", 5018 ;; Not that we expect all the bodies to be finished by "end <name>",
5018 ;; or a simple "end;" indented in the same column as the start of 5019 ;; or a simple "end;" indented in the same column as the start of
5019 ;; the subprogram. The goal is to be as efficient as possible. 5020 ;; the subprogram. The goal is to be as efficient as possible.
5020 5021
5021 (while (and (not found) 5022 (while (and (not found)
5022 (re-search-backward ada-imenu-subprogram-menu-re nil t)) 5023 (re-search-backward ada-imenu-subprogram-menu-re nil t))
5023 5024
5024 ;; Get the function name, but not the properties, or this changes 5025 ;; Get the function name, but not the properties, or this changes
5025 ;; the face in the modeline on Emacs 21 5026 ;; the face in the modeline on Emacs 21
5026 (setq func-name (match-string-no-properties 2)) 5027 (setq func-name (match-string-no-properties 2))
5027 (if (and (not (ada-in-comment-p)) 5028 (if (and (not (ada-in-comment-p))
5028 (not (save-excursion 5029 (not (save-excursion
5029 (goto-char (match-end 0)) 5030 (goto-char (match-end 0))
5030 (looking-at "[ \t\n]*new")))) 5031 (looking-at "[ \t\n]*new"))))
5031 (save-excursion 5032 (save-excursion
5032 (back-to-indentation) 5033 (back-to-indentation)
5033 (setq indent (current-column)) 5034 (setq indent (current-column))
5034 (if (ada-search-ignore-string-comment 5035 (if (ada-search-ignore-string-comment
5035 (concat "end[ \t]+" func-name "[ \t]*;\\|^" 5036 (concat "end[ \t]+" func-name "[ \t]*;\\|^"
5036 (make-string indent ? ) "end;")) 5037 (make-string indent ? ) "end;"))
5037 (setq end-pos (point)) 5038 (setq end-pos (point))
5038 (setq end-pos (point-max))) 5039 (setq end-pos (point-max)))
5039 (if (>= end-pos pos) 5040 (if (>= end-pos pos)
5040 (setq found func-name)))) 5041 (setq found func-name))))
5041 ) 5042 )
5042 (setq ada-last-which-function-line line 5043 (setq ada-last-which-function-line line
5043 ada-last-which-function-subprog found) 5044 ada-last-which-function-subprog found)
5044 found)))) 5045 found))))
5045 5046
5046(defun ada-ff-other-window () 5047(defun ada-ff-other-window ()
5047 "Find other file in other window using `ff-find-other-file'." 5048 "Find other file in other window using `ff-find-other-file'."
@@ -5050,14 +5051,13 @@ Since the search can be long, the results are cached."
5050 (ff-find-other-file t))) 5051 (ff-find-other-file t)))
5051 5052
5052(defun ada-set-point-accordingly () 5053(defun ada-set-point-accordingly ()
5053 "Move to the function declaration that was set by 5054 "Move to the function declaration that was set by `ff-which-function-are-we-in'."
5054`ff-which-function-are-we-in'."
5055 (if ff-function-name 5055 (if ff-function-name
5056 (progn 5056 (progn
5057 (goto-char (point-min)) 5057 (goto-char (point-min))
5058 (unless (ada-search-ignore-string-comment 5058 (unless (ada-search-ignore-string-comment
5059 (concat ff-function-name "\\b") nil) 5059 (concat ff-function-name "\\b") nil)
5060 (goto-char (point-min)))))) 5060 (goto-char (point-min))))))
5061 5061
5062(defun ada-get-body-name (&optional spec-name) 5062(defun ada-get-body-name (&optional spec-name)
5063 "Return the file name for the body of SPEC-NAME. 5063 "Return the file name for the body of SPEC-NAME.
@@ -5082,15 +5082,15 @@ Return nil if no body was found."
5082 ;; If find-file.el was available, use its functions 5082 ;; If find-file.el was available, use its functions
5083 (if (fboundp 'ff-get-file-name) 5083 (if (fboundp 'ff-get-file-name)
5084 (ff-get-file-name ada-search-directories-internal 5084 (ff-get-file-name ada-search-directories-internal
5085 (ada-make-filename-from-adaname 5085 (ada-make-filename-from-adaname
5086 (file-name-nondirectory 5086 (file-name-nondirectory
5087 (file-name-sans-extension spec-name))) 5087 (file-name-sans-extension spec-name)))
5088 ada-body-suffixes) 5088 ada-body-suffixes)
5089 ;; Else emulate it very simply 5089 ;; Else emulate it very simply
5090 (concat (ada-make-filename-from-adaname 5090 (concat (ada-make-filename-from-adaname
5091 (file-name-nondirectory 5091 (file-name-nondirectory
5092 (file-name-sans-extension spec-name))) 5092 (file-name-sans-extension spec-name)))
5093 ".adb"))) 5093 ".adb")))
5094 5094
5095 5095
5096;; --------------------------------------------------- 5096;; ---------------------------------------------------
@@ -5130,44 +5130,44 @@ Return nil if no body was found."
5130 ;; accept, entry, function, package (body), protected (body|type), 5130 ;; accept, entry, function, package (body), protected (body|type),
5131 ;; pragma, procedure, task (body) plus name. 5131 ;; pragma, procedure, task (body) plus name.
5132 (list (concat 5132 (list (concat
5133 "\\<\\(" 5133 "\\<\\("
5134 "accept\\|" 5134 "accept\\|"
5135 "entry\\|" 5135 "entry\\|"
5136 "function\\|" 5136 "function\\|"
5137 "package[ \t]+body\\|" 5137 "package[ \t]+body\\|"
5138 "package\\|" 5138 "package\\|"
5139 "pragma\\|" 5139 "pragma\\|"
5140 "procedure\\|" 5140 "procedure\\|"
5141 "protected[ \t]+body\\|" 5141 "protected[ \t]+body\\|"
5142 "protected[ \t]+type\\|" 5142 "protected[ \t]+type\\|"
5143 "protected\\|" 5143 "protected\\|"
5144 "task[ \t]+body\\|" 5144 "task[ \t]+body\\|"
5145 "task[ \t]+type\\|" 5145 "task[ \t]+type\\|"
5146 "task" 5146 "task"
5147 "\\)\\>[ \t]*" 5147 "\\)\\>[ \t]*"
5148 "\\(\\sw+\\(\\.\\sw*\\)*\\)?") 5148 "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
5149 '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t)) 5149 '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))
5150 ;; 5150 ;;
5151 ;; Optional keywords followed by a type name. 5151 ;; Optional keywords followed by a type name.
5152 (list (concat ; ":[ \t]*" 5152 (list (concat ; ":[ \t]*"
5153 "\\<\\(access[ \t]+all\\|access[ \t]+constant\\|access\\|constant\\|in[ \t]+reverse\\|\\|in[ \t]+out\\|in\\|out\\)\\>" 5153 "\\<\\(access[ \t]+all\\|access[ \t]+constant\\|access\\|constant\\|in[ \t]+reverse\\|\\|in[ \t]+out\\|in\\|out\\)\\>"
5154 "[ \t]*" 5154 "[ \t]*"
5155 "\\(\\sw+\\(\\.\\sw*\\)*\\)?") 5155 "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
5156 '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t)) 5156 '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
5157 5157
5158 ;; 5158 ;;
5159 ;; Main keywords, except those treated specially below. 5159 ;; Main keywords, except those treated specially below.
5160 (concat "\\<" 5160 (concat "\\<"
5161 (regexp-opt 5161 (regexp-opt
5162 '("abort" "abs" "abstract" "accept" "access" "aliased" "all" 5162 '("abort" "abs" "abstract" "accept" "access" "aliased" "all"
5163 "and" "array" "at" "begin" "case" "declare" "delay" "delta" 5163 "and" "array" "at" "begin" "case" "declare" "delay" "delta"
5164 "digits" "do" "else" "elsif" "entry" "exception" "exit" "for" 5164 "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
5165 "generic" "if" "in" "is" "limited" "loop" "mod" "not" 5165 "generic" "if" "in" "is" "limited" "loop" "mod" "not"
5166 "null" "or" "others" "private" "protected" "raise" 5166 "null" "or" "others" "private" "protected" "raise"
5167 "range" "record" "rem" "renames" "requeue" "return" "reverse" 5167 "range" "record" "rem" "renames" "requeue" "return" "reverse"
5168 "select" "separate" "tagged" "task" "terminate" "then" "until" 5168 "select" "separate" "tagged" "task" "terminate" "then" "until"
5169 "when" "while" "with" "xor") t) 5169 "when" "while" "with" "xor") t)
5170 "\\>") 5170 "\\>")
5171 ;; 5171 ;;
5172 ;; Anything following end and not already fontified is a body name. 5172 ;; Anything following end and not already fontified is a body name.
5173 '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?" 5173 '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?"
@@ -5175,19 +5175,19 @@ Return nil if no body was found."
5175 ;; 5175 ;;
5176 ;; Keywords followed by a type or function name. 5176 ;; Keywords followed by a type or function name.
5177 (list (concat "\\<\\(" 5177 (list (concat "\\<\\("
5178 "new\\|of\\|subtype\\|type" 5178 "new\\|of\\|subtype\\|type"
5179 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?") 5179 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
5180 '(1 font-lock-keyword-face) 5180 '(1 font-lock-keyword-face)
5181 '(2 (if (match-beginning 4) 5181 '(2 (if (match-beginning 4)
5182 font-lock-function-name-face 5182 font-lock-function-name-face
5183 font-lock-type-face) nil t)) 5183 font-lock-type-face) nil t))
5184 ;; 5184 ;;
5185 ;; Keywords followed by a (comma separated list of) reference. 5185 ;; Keywords followed by a (comma separated list of) reference.
5186 ;; Note that font-lock only works on single lines, thus we can not 5186 ;; Note that font-lock only works on single lines, thus we can not
5187 ;; correctly highlight a with_clause that spans multiple lines. 5187 ;; correctly highlight a with_clause that spans multiple lines.
5188 (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)" 5188 (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)"
5189 "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W") 5189 "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W")
5190 '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t)) 5190 '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
5191 5191
5192 ;; 5192 ;;
5193 ;; Goto tags. 5193 ;; Goto tags.
@@ -5233,8 +5233,8 @@ Use \\[widen] to go back to the full visibility for the buffer."
5233 (ada-previous-procedure) 5233 (ada-previous-procedure)
5234 5234
5235 (save-excursion 5235 (save-excursion
5236 (beginning-of-line) 5236 (beginning-of-line)
5237 (setq end (point))) 5237 (setq end (point)))
5238 5238
5239 (ada-move-to-end) 5239 (ada-move-to-end)
5240 (end-of-line) 5240 (end-of-line)
@@ -5260,7 +5260,7 @@ for `ada-procedure-start-regexp'."
5260 (let (func-found procname functype) 5260 (let (func-found procname functype)
5261 (cond 5261 (cond
5262 ((or (looking-at "^[ \t]*procedure") 5262 ((or (looking-at "^[ \t]*procedure")
5263 (setq func-found (looking-at "^[ \t]*function"))) 5263 (setq func-found (looking-at "^[ \t]*function")))
5264 ;; treat it as a proc/func 5264 ;; treat it as a proc/func
5265 (forward-word 2) 5265 (forward-word 2)
5266 (forward-word -1) 5266 (forward-word -1)
@@ -5271,56 +5271,56 @@ for `ada-procedure-start-regexp'."
5271 5271
5272 ;; skip over parameterlist 5272 ;; skip over parameterlist
5273 (unless (looking-at "[ \t\n]*\\(;\\|return\\)") 5273 (unless (looking-at "[ \t\n]*\\(;\\|return\\)")
5274 (forward-sexp)) 5274 (forward-sexp))
5275 5275
5276 ;; if function, skip over 'return' and result type. 5276 ;; if function, skip over 'return' and result type.
5277 (if func-found 5277 (if func-found
5278 (progn 5278 (progn
5279 (forward-word 1) 5279 (forward-word 1)
5280 (skip-chars-forward " \t\n") 5280 (skip-chars-forward " \t\n")
5281 (setq functype (buffer-substring (point) 5281 (setq functype (buffer-substring (point)
5282 (progn 5282 (progn
5283 (skip-chars-forward 5283 (skip-chars-forward
5284 "a-zA-Z0-9_\.") 5284 "a-zA-Z0-9_\.")
5285 (point)))))) 5285 (point))))))
5286 ;; look for next non WS 5286 ;; look for next non WS
5287 (cond 5287 (cond
5288 ((looking-at "[ \t]*;") 5288 ((looking-at "[ \t]*;")
5289 (delete-region (match-beginning 0) (match-end 0));; delete the ';' 5289 (delete-region (match-beginning 0) (match-end 0));; delete the ';'
5290 (ada-indent-newline-indent) 5290 (ada-indent-newline-indent)
5291 (insert "is") 5291 (insert "is")
5292 (ada-indent-newline-indent) 5292 (ada-indent-newline-indent)
5293 (if func-found 5293 (if func-found
5294 (progn 5294 (progn
5295 (insert "Result : " functype ";") 5295 (insert "Result : " functype ";")
5296 (ada-indent-newline-indent))) 5296 (ada-indent-newline-indent)))
5297 (insert "begin") 5297 (insert "begin")
5298 (ada-indent-newline-indent) 5298 (ada-indent-newline-indent)
5299 (if func-found 5299 (if func-found
5300 (insert "return Result;") 5300 (insert "return Result;")
5301 (insert "null;")) 5301 (insert "null;"))
5302 (ada-indent-newline-indent) 5302 (ada-indent-newline-indent)
5303 (insert "end " procname ";") 5303 (insert "end " procname ";")
5304 (ada-indent-newline-indent) 5304 (ada-indent-newline-indent)
5305 ) 5305 )
5306 ;; else 5306 ;; else
5307 ((looking-at "[ \t\n]*is") 5307 ((looking-at "[ \t\n]*is")
5308 ;; do nothing 5308 ;; do nothing
5309 ) 5309 )
5310 ((looking-at "[ \t\n]*rename") 5310 ((looking-at "[ \t\n]*rename")
5311 ;; do nothing 5311 ;; do nothing
5312 ) 5312 )
5313 (t 5313 (t
5314 (message "unknown syntax")))) 5314 (message "unknown syntax"))))
5315 (t 5315 (t
5316 (if (looking-at "^[ \t]*task") 5316 (if (looking-at "^[ \t]*task")
5317 (progn 5317 (progn
5318 (message "Task conversion is not yet implemented") 5318 (message "Task conversion is not yet implemented")
5319 (forward-word 2) 5319 (forward-word 2)
5320 (if (looking-at "[ \t]*;") 5320 (if (looking-at "[ \t]*;")
5321 (forward-line) 5321 (forward-line)
5322 (ada-move-to-end)) 5322 (ada-move-to-end))
5323 )))))) 5323 ))))))
5324 5324
5325(defun ada-make-body () 5325(defun ada-make-body ()
5326 "Create an Ada package body in the current buffer. 5326 "Create an Ada package body in the current buffer.
@@ -5335,63 +5335,63 @@ This function typically is to be hooked into `ff-file-created-hooks'."
5335 5335
5336 (let (found ada-procedure-or-package-start-regexp) 5336 (let (found ada-procedure-or-package-start-regexp)
5337 (if (setq found 5337 (if (setq found
5338 (ada-search-ignore-string-comment ada-package-start-regexp nil)) 5338 (ada-search-ignore-string-comment ada-package-start-regexp nil))
5339 (progn (goto-char (cdr found)) 5339 (progn (goto-char (cdr found))
5340 (insert " body") 5340 (insert " body")
5341 ) 5341 )
5342 (error "No package")) 5342 (error "No package"))
5343 5343
5344 (setq ada-procedure-or-package-start-regexp 5344 (setq ada-procedure-or-package-start-regexp
5345 (concat ada-procedure-start-regexp 5345 (concat ada-procedure-start-regexp
5346 "\\|" 5346 "\\|"
5347 ada-package-start-regexp)) 5347 ada-package-start-regexp))
5348 5348
5349 (while (setq found 5349 (while (setq found
5350 (ada-search-ignore-string-comment 5350 (ada-search-ignore-string-comment
5351 ada-procedure-or-package-start-regexp nil)) 5351 ada-procedure-or-package-start-regexp nil))
5352 (progn 5352 (progn
5353 (goto-char (car found)) 5353 (goto-char (car found))
5354 (if (looking-at ada-package-start-regexp) 5354 (if (looking-at ada-package-start-regexp)
5355 (progn (goto-char (cdr found)) 5355 (progn (goto-char (cdr found))
5356 (insert " body")) 5356 (insert " body"))
5357 (ada-gen-treat-proc found)))))) 5357 (ada-gen-treat-proc found))))))
5358 5358
5359 5359
5360(defun ada-make-subprogram-body () 5360(defun ada-make-subprogram-body ()
5361 "Make one dummy subprogram body from spec surrounding point." 5361 "Make one dummy subprogram body from spec surrounding point."
5362 (interactive) 5362 (interactive)
5363 (let* ((found (re-search-backward ada-procedure-start-regexp nil t)) 5363 (let* ((found (re-search-backward ada-procedure-start-regexp nil t))
5364 (spec (match-beginning 0)) 5364 (spec (match-beginning 0))
5365 body-file) 5365 body-file)
5366 (if found 5366 (if found
5367 (progn 5367 (progn
5368 (goto-char spec) 5368 (goto-char spec)
5369 (if (and (re-search-forward "(\\|;" nil t) 5369 (if (and (re-search-forward "(\\|;" nil t)
5370 (= (char-before) ?\()) 5370 (= (char-before) ?\())
5371 (progn 5371 (progn
5372 (ada-search-ignore-string-comment ")" nil) 5372 (ada-search-ignore-string-comment ")" nil)
5373 (ada-search-ignore-string-comment ";" nil))) 5373 (ada-search-ignore-string-comment ";" nil)))
5374 (setq spec (buffer-substring spec (point))) 5374 (setq spec (buffer-substring spec (point)))
5375 5375
5376 ;; If find-file.el was available, use its functions 5376 ;; If find-file.el was available, use its functions
5377 (setq body-file (ada-get-body-name)) 5377 (setq body-file (ada-get-body-name))
5378 (if body-file 5378 (if body-file
5379 (find-file body-file) 5379 (find-file body-file)
5380 (error "No body found for the package. Create it first")) 5380 (error "No body found for the package. Create it first"))
5381 5381
5382 (save-restriction 5382 (save-restriction
5383 (widen) 5383 (widen)
5384 (goto-char (point-max)) 5384 (goto-char (point-max))
5385 (forward-comment -10000) 5385 (forward-comment -10000)
5386 (re-search-backward "\\<end\\>" nil t) 5386 (re-search-backward "\\<end\\>" nil t)
5387 ;; Move to the beginning of the elaboration part, if any 5387 ;; Move to the beginning of the elaboration part, if any
5388 (re-search-backward "^begin" nil t) 5388 (re-search-backward "^begin" nil t)
5389 (newline) 5389 (newline)
5390 (forward-char -1) 5390 (forward-char -1)
5391 (insert spec) 5391 (insert spec)
5392 (re-search-backward ada-procedure-start-regexp nil t) 5392 (re-search-backward ada-procedure-start-regexp nil t)
5393 (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0))) 5393 (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0)))
5394 )) 5394 ))
5395 (error "Not in subprogram spec")))) 5395 (error "Not in subprogram spec"))))
5396 5396
5397;; -------------------------------------------------------- 5397;; --------------------------------------------------------
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 60d287896dd..e63759f216a 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,12 @@
12006-10-29 Magnus Henoch <mange@freemail.hu>
2
3 * url-gw.el (url-open-stream): Really use asynchronous
4 connections (accidentally disabled during debugging).
5
62006-10-28 Magnus Henoch <mange@freemail.hu>
7
8 * url-http.el (url-http-parse-headers): Fix misplaced paren.
9
12006-10-27 Magnus Henoch <mange@freemail.hu> 102006-10-27 Magnus Henoch <mange@freemail.hu>
2 11
3 * url-http.el (url-http-mark-connection-as-free): Verify that 12 * url-http.el (url-http-mark-connection-as-free): Verify that
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 31e1a629aba..5197d894aa2 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -254,7 +254,7 @@ Might do a non-blocking connection; use `process-status' to check."
254 (make-network-process :name name :buffer buffer 254 (make-network-process :name name :buffer buffer
255 :host host :service service 255 :host host :service service
256 :nowait 256 :nowait
257 (and nil (featurep 'make-network-process '(:nowait t))))) 257 (featurep 'make-network-process '(:nowait t))))
258 (socks 258 (socks
259 (socks-open-network-stream name buffer host service)) 259 (socks-open-network-stream name buffer host service))
260 (telnet 260 (telnet
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index cd09df3cb4c..181a4b8db9a 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -534,8 +534,8 @@ should be shown to the user."
534 (set (make-local-variable 'url-redirect-buffer) 534 (set (make-local-variable 'url-redirect-buffer)
535 (url-retrieve-internal 535 (url-retrieve-internal
536 redirect-uri url-callback-function 536 redirect-uri url-callback-function
537 url-callback-arguments) 537 url-callback-arguments))
538 (url-mark-buffer-as-dead (current-buffer))))))) 538 (url-mark-buffer-as-dead (current-buffer))))))
539 (4 ; Client error 539 (4 ; Client error
540 ;; 400 Bad Request 540 ;; 400 Bad Request
541 ;; 401 Unauthorized 541 ;; 401 Unauthorized
diff --git a/lispintro/ChangeLog b/lispintro/ChangeLog
index 98617568720..48e46e43429 100644
--- a/lispintro/ChangeLog
+++ b/lispintro/ChangeLog
@@ -1,3 +1,10 @@
12006-10-29 Chong Yidong <cyd@stupidchicken.com>
2
3 * Makefile.in: Use relative paths to avoid advertising filesystem
4 contents during compilation.
5
6 * makefile.w32-in: Likewise.
7
12006-08-21 Robert J. Chassell <bob@rattlesnake.com> 82006-08-21 Robert J. Chassell <bob@rattlesnake.com>
2 9
3 * emacs-lisp-intro.texi: deleted in directory copy of texinfo.tex 10 * emacs-lisp-intro.texi: deleted in directory copy of texinfo.tex
diff --git a/lispintro/Makefile.in b/lispintro/Makefile.in
index 8d902f41a64..eacd1546918 100644
--- a/lispintro/Makefile.in
+++ b/lispintro/Makefile.in
@@ -25,7 +25,7 @@ SHELL = @SHELL@
25srcdir = @srcdir@ 25srcdir = @srcdir@
26VPATH = @srcdir@ 26VPATH = @srcdir@
27 27
28infodir = ${srcdir}/../info 28infodir = ../info
29 29
30INFO_SOURCES = ${srcdir}/emacs-lisp-intro.texi 30INFO_SOURCES = ${srcdir}/emacs-lisp-intro.texi
31# The file name eintr must fit within 5 characters, to allow for 31# The file name eintr must fit within 5 characters, to allow for
@@ -45,7 +45,7 @@ info: $(INFO_TARGETS)
45dvi: $(DVI_TARGETS) 45dvi: $(DVI_TARGETS)
46 46
47${infodir}/eintr: ${INFO_SOURCES} 47${infodir}/eintr: ${INFO_SOURCES}
48 $(MAKEINFO) -o $@ $(srcdir)/emacs-lisp-intro.texi 48 cd $(srcdir); $(MAKEINFO) emacs-lisp-intro.texi -o $(infodir)/eintr
49 49
50emacs-lisp-intro.dvi: ${INFO_SOURCES} 50emacs-lisp-intro.dvi: ${INFO_SOURCES}
51 $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-lisp-intro.texi 51 $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-lisp-intro.texi
diff --git a/lispintro/makefile.w32-in b/lispintro/makefile.w32-in
index c0b4b2a7b69..c0ab93432e3 100644
--- a/lispintro/makefile.w32-in
+++ b/lispintro/makefile.w32-in
@@ -21,7 +21,7 @@
21 21
22srcdir = . 22srcdir = .
23 23
24infodir = $(srcdir)/../info 24infodir = ../info
25 25
26INFO_SOURCES = $(srcdir)/emacs-lisp-intro.texi 26INFO_SOURCES = $(srcdir)/emacs-lisp-intro.texi
27# The file name eintr must fit within 5 characters, to allow for 27# The file name eintr must fit within 5 characters, to allow for
@@ -46,7 +46,7 @@ $(infodir)/dir:
46dvi: $(DVI_TARGETS) 46dvi: $(DVI_TARGETS)
47 47
48$(infodir)/eintr: $(INFO_SOURCES) 48$(infodir)/eintr: $(INFO_SOURCES)
49 $(MAKEINFO) -o $@ $(srcdir)/emacs-lisp-intro.texi 49 cd $(srcdir); $(MAKEINFO) emacs-lisp-intro.texi -o $(infodir)/eintr
50 50
51emacs-lisp-intro.dvi: $(INFO_SOURCES) 51emacs-lisp-intro.dvi: $(INFO_SOURCES)
52 $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-lisp-intro.texi 52 $(ENVADD) $(TEXI2DVI) $(srcdir)/emacs-lisp-intro.texi
diff --git a/lispref/ChangeLog b/lispref/ChangeLog
index 4400de92a0d..03359e1cd29 100644
--- a/lispref/ChangeLog
+++ b/lispref/ChangeLog
@@ -1,3 +1,10 @@
12006-10-29 Chong Yidong <cyd@stupidchicken.com>
2
3 * Makefile.in: Use relative paths to avoid advertising filesystem
4 contents during compilation.
5
6 * makefile.w32-in: Likewise.
7
12006-10-23 Kim F. Storm <storm@cua.dk> 82006-10-23 Kim F. Storm <storm@cua.dk>
2 9
3 * commands.texi (Event Input Misc): Update unread-command-events. 10 * commands.texi (Event Input Misc): Update unread-command-events.
diff --git a/lispref/Makefile.in b/lispref/Makefile.in
index 1eea23e122e..e32a99e6e98 100644
--- a/lispref/Makefile.in
+++ b/lispref/Makefile.in
@@ -26,7 +26,7 @@ srcdir = @srcdir@
26# Tell make where to find source files; this is needed for the makefiles. 26# Tell make where to find source files; this is needed for the makefiles.
27VPATH=@srcdir@ 27VPATH=@srcdir@
28 28
29infodir = $(srcdir)/../info 29infodir = ../info
30usermanualdir = $(srcdir)/../man 30usermanualdir = $(srcdir)/../man
31 31
32TEXI2DVI = texi2dvi 32TEXI2DVI = texi2dvi
@@ -101,7 +101,7 @@ srcs = \
101info: $(infodir)/elisp 101info: $(infodir)/elisp
102 102
103$(infodir)/elisp: $(srcs) 103$(infodir)/elisp: $(srcs)
104 $(MAKEINFO) -I. -I$(srcdir) $(srcdir)/elisp.texi -o $(infodir)/elisp 104 cd $(srcdir); $(MAKEINFO) -I. -I$(infodir) elisp.texi -o $(infodir)/elisp
105 105
106elisp.dvi: $(srcs) 106elisp.dvi: $(srcs)
107 $(TEXI2DVI) -I $(srcdir) -I $(usermanualdir) $(srcdir)/elisp.texi 107 $(TEXI2DVI) -I $(srcdir) -I $(usermanualdir) $(srcdir)/elisp.texi
diff --git a/lispref/makefile.w32-in b/lispref/makefile.w32-in
index 7da88058bd5..93bb5ae6d45 100644
--- a/lispref/makefile.w32-in
+++ b/lispref/makefile.w32-in
@@ -22,7 +22,7 @@
22# Standard configure variables. 22# Standard configure variables.
23srcdir = . 23srcdir = .
24 24
25infodir = $(srcdir)/../info 25infodir = ../info
26usermanualdir = $(srcdir)/../man 26usermanualdir = $(srcdir)/../man
27 27
28# Redefine `TEX' if `tex' does not invoke plain TeX. For example: 28# Redefine `TEX' if `tex' does not invoke plain TeX. For example:
@@ -106,7 +106,7 @@ $(infodir)/dir:
106 $(INSTALL_INFO) --info-dir=$(infodir) $(infodir)/elisp 106 $(INSTALL_INFO) --info-dir=$(infodir) $(infodir)/elisp
107 107
108$(infodir)/elisp: $(srcs) 108$(infodir)/elisp: $(srcs)
109 $(MAKEINFO) -I. -I$(srcdir) -o $(infodir)/elisp $(srcdir)/elisp.texi 109 cd $(srcdir); $(MAKEINFO) -I. -I$(infodir) elisp.texi -o $(infodir)/elisp
110 110
111elisp.dvi: $(srcs) 111elisp.dvi: $(srcs)
112 $(texinputdir) $(TEX) -I $(usermanualdir) $(srcdir)/elisp.texi 112 $(texinputdir) $(TEX) -I $(usermanualdir) $(srcdir)/elisp.texi
diff --git a/make-dist b/make-dist
index 0f23a0d3af1..4fa4ab729b4 100755
--- a/make-dist
+++ b/make-dist
@@ -522,7 +522,7 @@ echo "Making links to \`nt/icons'"
522 522
523echo "Making links to \`mac'" 523echo "Making links to \`mac'"
524(cd mac 524(cd mac
525 ln ChangeLog INSTALL README *.xml *.MPW ../${tempdir}/mac) 525 ln ChangeLog INSTALL README make-package *.xml *.MPW ../${tempdir}/mac)
526 526
527echo "Making links to \`mac/inc'" 527echo "Making links to \`mac/inc'"
528(cd mac/inc 528(cd mac/inc
@@ -540,6 +540,10 @@ echo "Making links to \`mac/Emacs.app/Contents'"
540(cd mac/Emacs.app/Contents 540(cd mac/Emacs.app/Contents
541 ln Info.plist PkgInfo ../../../${tempdir}/mac/Emacs.app/Contents) 541 ln Info.plist PkgInfo ../../../${tempdir}/mac/Emacs.app/Contents)
542 542
543echo "Making links to \`mac/Emacs.app/Contents/Resources'"
544(cd mac/Emacs.app/Contents/Resources
545 ln Emacs.icns ../../../../${tempdir}/mac/Emacs.app/Contents/Resources)
546
543echo "Making links to \`mac/Emacs.app/Contents/Resources/English.lproj'" 547echo "Making links to \`mac/Emacs.app/Contents/Resources/English.lproj'"
544(cd mac/Emacs.app/Contents/Resources/English.lproj 548(cd mac/Emacs.app/Contents/Resources/English.lproj
545 ln InfoPlist.strings ../../../../../${tempdir}/mac/Emacs.app/Contents/Resources/English.lproj) 549 ln InfoPlist.strings ../../../../../${tempdir}/mac/Emacs.app/Contents/Resources/English.lproj)
diff --git a/man/ChangeLog b/man/ChangeLog
index c46f1c1161a..34728d0425b 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,3 +1,12 @@
12006-10-28 Glenn Morris <rgm@gnu.org>
2
3 * ack.texi (Acknowledgments): Add cal-html author.
4
5 * calendar.texi (Writing Calendar Files): Rename section (was "LaTeX
6 Calendar"). Describe new package cal-html.
7 * emacs.texi (Top): Rename old node "LaTeX Calendar" to "Writing
8 Calendar Files."
9
12006-10-27 Richard Stallman <rms@gnu.org> 102006-10-27 Richard Stallman <rms@gnu.org>
2 11
3 * woman.texi: Downcase nroff/troff/roff. 12 * woman.texi: Downcase nroff/troff/roff.
diff --git a/man/ack.texi b/man/ack.texi
index 2b76a7073d8..29279c4b4e1 100644
--- a/man/ack.texi
+++ b/man/ack.texi
@@ -75,6 +75,9 @@ contributed ERC, an advanced Internet Relay Chat client.
75Boaz Ben-Zvi wrote @file{profile.el}, to time Emacs Lisp functions. 75Boaz Ben-Zvi wrote @file{profile.el}, to time Emacs Lisp functions.
76 76
77@item 77@item
78Anna M. Bigatti wrote @file{cal-html.el}, which produces HTML calendars.
79
80@item
78Ray Blaak wrote @file{delphi.el}, a major mode for editing Delphi 81Ray Blaak wrote @file{delphi.el}, a major mode for editing Delphi
79(Object Pascal) source code. 82(Object Pascal) source code.
80 83
diff --git a/man/calendar.texi b/man/calendar.texi
index 4c424888baf..8b66cb6113e 100644
--- a/man/calendar.texi
+++ b/man/calendar.texi
@@ -35,7 +35,7 @@ about more specialized features.
35* Scroll Calendar:: Bringing earlier or later months onto the screen. 35* Scroll Calendar:: Bringing earlier or later months onto the screen.
36* Counting Days:: How many days are there between two dates? 36* Counting Days:: How many days are there between two dates?
37* General Calendar:: Exiting or recomputing the calendar. 37* General Calendar:: Exiting or recomputing the calendar.
38* LaTeX Calendar:: Print a calendar using LaTeX. 38* Writing Calendar Files:: Writing calendars to files of various formats.
39* Holidays:: Displaying dates of holidays. 39* Holidays:: Displaying dates of holidays.
40* Sunrise/Sunset:: Displaying local times of sunrise and sunset. 40* Sunrise/Sunset:: Displaying local times of sunrise and sunset.
41* Lunar Phases:: Displaying phases of the moon. 41* Lunar Phases:: Displaying phases of the moon.
@@ -341,11 +341,47 @@ buries all buffers related to the calendar, selecting other buffers.
341(If a frame contains a dedicated calendar window, exiting from the 341(If a frame contains a dedicated calendar window, exiting from the
342calendar iconifies that frame.) 342calendar iconifies that frame.)
343 343
344@node LaTeX Calendar 344@node Writing Calendar Files
345@section LaTeX Calendar 345@section Writing Calendar Files
346@cindex calendar and La@TeX{} 346
347 These packages produce files of various formats containing calendar
348and diary entries, for display purposes.
349
350@cindex calendar and HTML
351 The Calendar HTML commands produce files of HTML code that contain
352calendar and diary entries. Each file applies to one month, and has a
353name of the format @file{@var{yyyy}-@var{mm}.html}, where @var{yyyy} and
354@var{mm} are the four-digit year and two-digit month, respectively. The
355variable @code{cal-html-directory} specifies the default output
356directory for the HTML files.
357
358@vindex cal-html-css-default
359 Diary entries enclosed by @code{<} and @code{>} are interpreted as
360HTML tags (for example: this is a diary entry with <font
361color=''red''>some red text</font>). You can change the overall
362appearance of the displayed HTML pages (for example, the color of
363various page elements, header styles) via a stylesheet @file{cal.css} in
364the directory containing the HTML files (see the value of the variable
365@code{cal-html-css-default} for relevant style settings).
347 366
348 The Calendar La@TeX{} commands produce a buffer of La@TeX{} code that 367@kindex t @r{(Calendar mode)}
368@table @kbd
369@item H m
370Generate a one-month calendar (@code{cal-html-cursor-month}).
371@item H y
372Generate a calendar file for each month of a year, as well as an index
373page (@code{cal-html-cursor-year}). By default, this command writes
374files to a @var{yyyy} subdirectory - if this is altered some hyperlinks
375between years will not work.
376@end table
377
378 If the variable @code{cal-html-print-day-number-flag} is
379non-@code{nil}, then the monthly calendars show the day-of-the-year
380number. The variable @code{cal-html-year-index-cols} specifies the
381number of columns in the yearly index page.
382
383@cindex calendar and La@TeX{}
384 The Calendar La@TeX{} commands produce a buffer of La@TeX{} code that
349prints as a calendar. Depending on the command you use, the printed 385prints as a calendar. Depending on the command you use, the printed
350calendar covers the day, week, month or year that point is in. 386calendar covers the day, week, month or year that point is in.
351 387
@@ -401,7 +437,7 @@ If the variable @code{cal-tex-diary} is non-@code{nil} (the default is
401calendars only). If the variable @code{cal-tex-rules} is non-@code{nil} 437calendars only). If the variable @code{cal-tex-rules} is non-@code{nil}
402(the default is @code{nil}), the calendar displays ruled pages 438(the default is @code{nil}), the calendar displays ruled pages
403in styles that have sufficient room. You can use the variable 439in styles that have sufficient room. You can use the variable
404@code{cal-tex-preamble-extra} to insert extra LaTeX commands in the 440@code{cal-tex-preamble-extra} to insert extra La@TeX{} commands in the
405preamble of the generated document if you need to. 441preamble of the generated document if you need to.
406 442
407@node Holidays 443@node Holidays
diff --git a/man/emacs.texi b/man/emacs.texi
index 838e0c4d512..cb3fa726ed8 100644
--- a/man/emacs.texi
+++ b/man/emacs.texi
@@ -714,7 +714,7 @@ The Calendar and the Diary
714* Scroll Calendar:: Bringing earlier or later months onto the screen. 714* Scroll Calendar:: Bringing earlier or later months onto the screen.
715* Counting Days:: How many days are there between two dates? 715* Counting Days:: How many days are there between two dates?
716* General Calendar:: Exiting or recomputing the calendar. 716* General Calendar:: Exiting or recomputing the calendar.
717* LaTeX Calendar:: Print a calendar using LaTeX. 717* Writing Calendar Files:: Writing calendars to files of various formats.
718* Holidays:: Displaying dates of holidays. 718* Holidays:: Displaying dates of holidays.
719* Sunrise/Sunset:: Displaying local times of sunrise and sunset. 719* Sunrise/Sunset:: Displaying local times of sunrise and sunset.
720* Lunar Phases:: Displaying phases of the moon. 720* Lunar Phases:: Displaying phases of the moon.
diff --git a/nt/ChangeLog b/nt/ChangeLog
index 1283120db0d..ebdbf5b2b23 100644
--- a/nt/ChangeLog
+++ b/nt/ChangeLog
@@ -1,3 +1,8 @@
12006-10-29 Juanma Barranquero <lekktu@gmail.com>
2
3 * runemacs.c (WinMain): Process all recognized arguments, not just
4 the first one. Remove unused variable sec_desc.
5
12006-09-24 Eli Zaretskii <eliz@gnu.org> 62006-09-24 Eli Zaretskii <eliz@gnu.org>
2 7
3 * config.nt (HAVE_LANGINFO_CODESET): Define. 8 * config.nt (HAVE_LANGINFO_CODESET): Define.
@@ -63,7 +68,7 @@
63 68
642005-07-30 Eli Zaretskii <eliz@gnu.org> 692005-07-30 Eli Zaretskii <eliz@gnu.org>
65 70
66 * config.nt: (HAVE_GETOPT_H, HAVE_GETOPT_LONG_ONLY): Undefine. 71 * config.nt (HAVE_GETOPT_H, HAVE_GETOPT_LONG_ONLY): Undefine.
67 72
682005-07-29 Juanma Barranquero <lekktu@gmail.com> 732005-07-29 Juanma Barranquero <lekktu@gmail.com>
69 74
@@ -437,7 +442,7 @@
4372001-03-26 Eli Zaretskii <eliz@is.elta.co.il> 4422001-03-26 Eli Zaretskii <eliz@is.elta.co.il>
438 443
439 * configure.bat: Make the checkw32api* labels be distinct in the 444 * configure.bat: Make the checkw32api* labels be distinct in the
440 first 8 characters. 445 first 8 characters.
441 446
4422001-03-17 Andrew Innes <andrewi@gnu.org> 4472001-03-17 Andrew Innes <andrewi@gnu.org>
443 448
diff --git a/nt/runemacs.c b/nt/runemacs.c
index c43c7b61366..d820a92acbb 100644
--- a/nt/runemacs.c
+++ b/nt/runemacs.c
@@ -33,7 +33,7 @@ Boston, MA 02110-1301, USA. */
33 is running emacs.exe already, you cannot install a newer version. 33 is running emacs.exe already, you cannot install a newer version.
34 By defining CHOOSE_NEWEST_EXE, you can name your new emacs.exe 34 By defining CHOOSE_NEWEST_EXE, you can name your new emacs.exe
35 something else which matches "emacs*.exe", and runemacs will 35 something else which matches "emacs*.exe", and runemacs will
36 automatically select the newest emacs executeable in the bin directory. 36 automatically select the newest emacs executable in the bin directory.
37 (So you'll probably be able to delete the old version some hours/days 37 (So you'll probably be able to delete the old version some hours/days
38 later). 38 later).
39*/ 39*/
@@ -49,7 +49,6 @@ WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow)
49{ 49{
50 STARTUPINFO start; 50 STARTUPINFO start;
51 SECURITY_ATTRIBUTES sec_attrs; 51 SECURITY_ATTRIBUTES sec_attrs;
52 SECURITY_DESCRIPTOR sec_desc;
53 PROCESS_INFORMATION child; 52 PROCESS_INFORMATION child;
54 int wait_for_child = FALSE; 53 int wait_for_child = FALSE;
55 DWORD priority_class = NORMAL_PRIORITY_CLASS; 54 DWORD priority_class = NORMAL_PRIORITY_CLASS;
@@ -85,13 +84,13 @@ WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow)
85 goto error; 84 goto error;
86 do 85 do
87 { 86 {
88 if (wfd.ftLastWriteTime.dwHighDateTime > best_time.dwHighDateTime 87 if (wfd.ftLastWriteTime.dwHighDateTime > best_time.dwHighDateTime
89 || (wfd.ftLastWriteTime.dwHighDateTime == best_time.dwHighDateTime 88 || (wfd.ftLastWriteTime.dwHighDateTime == best_time.dwHighDateTime
90 && wfd.ftLastWriteTime.dwLowDateTime > best_time.dwLowDateTime)) 89 && wfd.ftLastWriteTime.dwLowDateTime > best_time.dwLowDateTime))
91 { 90 {
92 best_time = wfd.ftLastWriteTime; 91 best_time = wfd.ftLastWriteTime;
93 strcpy (best_name, wfd.cFileName); 92 strcpy (best_name, wfd.cFileName);
94 } 93 }
95 } 94 }
96 while (FindNextFile (fh, &wfd)); 95 while (FindNextFile (fh, &wfd));
97 FindClose (fh); 96 FindClose (fh);
@@ -109,9 +108,9 @@ WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow)
109 { 108 {
110 if (strncmp (cmdline+1, "wait", 4) == 0) 109 if (strncmp (cmdline+1, "wait", 4) == 0)
111 { 110 {
112 wait_for_child = TRUE; 111 wait_for_child = TRUE;
113 cmdline += 5; 112 cmdline += 5;
114 } 113 }
115 else if (strncmp (cmdline+1, "high", 4) == 0) 114 else if (strncmp (cmdline+1, "high", 4) == 0)
116 { 115 {
117 priority_class = HIGH_PRIORITY_CLASS; 116 priority_class = HIGH_PRIORITY_CLASS;
@@ -124,7 +123,10 @@ WinMain (HINSTANCE hSelf, HINSTANCE hPrev, LPSTR cmdline, int nShow)
124 } 123 }
125 else 124 else
126 break; 125 break;
126 /* Look for next argument. */
127 while (*++cmdline == ' ');
127 } 128 }
129
128 strcat (new_cmdline, cmdline); 130 strcat (new_cmdline, cmdline);
129 131
130 /* Set emacs_dir variable if runemacs was in "%emacs_dir%\bin". */ 132 /* Set emacs_dir variable if runemacs was in "%emacs_dir%\bin". */
diff --git a/src/ChangeLog b/src/ChangeLog
index 4118fc6f2d8..27a229b0f68 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,16 @@
12006-10-29 Mark Davies <mark@mcs.vuw.ac.nz> (tiny change)
2
3 * ralloc.c (relinquish): Use a long for excess space counter to
4 handle 64-bit case correctly.
5
62006-10-29 Jeramey Crawford <jeramey@jeramey.com>
7
8 * m/amdx86-64.h: Add defines for OpenBSD x86-64.
9
102006-10-29 Juanma Barranquero <lekktu@gmail.com>
11
12 * window.c (Fdisplay_buffer): Fix typo in docstring.
13
12006-10-27 Ben North <ben@redfrontdoor.org> (tiny change) 142006-10-27 Ben North <ben@redfrontdoor.org> (tiny change)
2 15
3 * w32term.c (x_draw_glyph_string_foreground): Set background mode 16 * w32term.c (x_draw_glyph_string_foreground): Set background mode
@@ -431,7 +444,7 @@
431 avoid confusing redisplay by placing the cursor outside the visible 444 avoid confusing redisplay by placing the cursor outside the visible
432 window area. 445 window area.
433 446
4342006-09-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> 4472006-09-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
435 448
436 * xterm.c (x_initialize): Don't install Xt event timer here. 449 * xterm.c (x_initialize): Don't install Xt event timer here.
437 (x_timeout_atimer_activated_flag): New var. 450 (x_timeout_atimer_activated_flag): New var.
@@ -2176,7 +2189,7 @@
2176 * xdisp.c (display_tool_bar_line): Restore entire tool-bar 2189 * xdisp.c (display_tool_bar_line): Restore entire tool-bar
2177 geometry when backtracking in case last image doesn't fit on line. 2190 geometry when backtracking in case last image doesn't fit on line.
2178 2191
21792006-05-18 MIYOSHI Masanori <miyoshi@meadowy.org> (tiny change) 21922006-05-18 MIYOSHI Masanori <miyoshi@meadowy.org> (tiny change)
2180 2193
2181 * xdisp.c (display_tool_bar_line): Don't adjust tool-bar height by 2194 * xdisp.c (display_tool_bar_line): Don't adjust tool-bar height by
2182 more than height of one frame default line. 2195 more than height of one frame default line.
diff --git a/src/m/amdx86-64.h b/src/m/amdx86-64.h
index 3a1ace91b41..419fa131692 100644
--- a/src/m/amdx86-64.h
+++ b/src/m/amdx86-64.h
@@ -118,7 +118,14 @@ Boston, MA 02110-1301, USA. */
118#undef LIB_STANDARD 118#undef LIB_STANDARD
119#define LIB_STANDARD -lgcc -lc -lgcc /usr/lib/crtn.o 119#define LIB_STANDARD -lgcc -lc -lgcc /usr/lib/crtn.o
120 120
121#else /* !__FreeBSD__ */ 121#elif defined(__OpenBSD__)
122
123#undef START_FILES
124#define START_FILES pre-crt0.o /usr/lib/crt0.o /usr/lib/crtbegin.o
125#undef LIB_STANDARD
126#define LIB_STANDARD -lgcc -lc -lgcc /usr/lib/crtend.o
127
128#else /* !__OpenBSD__ && !__FreeBSD__ */
122 129
123#undef START_FILES 130#undef START_FILES
124#define START_FILES pre-crt0.o /usr/lib64/crt1.o /usr/lib64/crti.o 131#define START_FILES pre-crt0.o /usr/lib64/crt1.o /usr/lib64/crti.o
diff --git a/src/ralloc.c b/src/ralloc.c
index fea9ea5d0a8..83a26dd35d6 100644
--- a/src/ralloc.c
+++ b/src/ralloc.c
@@ -330,7 +330,7 @@ static void
330relinquish () 330relinquish ()
331{ 331{
332 register heap_ptr h; 332 register heap_ptr h;
333 int excess = 0; 333 long excess = 0;
334 334
335 /* Add the amount of space beyond break_value 335 /* Add the amount of space beyond break_value
336 in all heaps which have extend beyond break_value at all. */ 336 in all heaps which have extend beyond break_value at all. */
diff --git a/src/window.c b/src/window.c
index 0233c6bf79e..e996fc5c597 100644
--- a/src/window.c
+++ b/src/window.c
@@ -3590,7 +3590,7 @@ See `same-window-buffer-names' and `same-window-regexps'. */)
3590DEFUN ("display-buffer", Fdisplay_buffer, Sdisplay_buffer, 1, 3, 3590DEFUN ("display-buffer", Fdisplay_buffer, Sdisplay_buffer, 1, 3,
3591 "BDisplay buffer: \nP", 3591 "BDisplay buffer: \nP",
3592 doc: /* Make BUFFER appear in some window but don't select it. 3592 doc: /* Make BUFFER appear in some window but don't select it.
3593BUFFER must be the name of an existing buffer, or, when called from Lisp, 3593BUFFER must be the name of an existing buffer, or, when called from Lisp,
3594a buffer. 3594a buffer.
3595If BUFFER is shown already in some window, just use that one, 3595If BUFFER is shown already in some window, just use that one,
3596unless the window is the selected window and the optional second 3596unless the window is the selected window and the optional second
generated by cgit v1.2.1 (git 2.18.0) at 2026-03-12 02:51:05 +0000