Mercurial > hg > xemacs-beta
annotate lisp/build-report.el @ 5146:88bd4f3ef8e4
make lrecord UID's have a separate UID space for each object, resurrect debug SOE code in extents.c
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-15 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (c_readonly):
* alloc.c (deadbeef_memory):
* alloc.c (make_compiled_function):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (noseeum_make_marker):
* alloc.c (ADDITIONAL_FREE_string):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* casetab.c:
* casetab.c (print_case_table):
* console.c:
* console.c (print_console):
* database.c (print_database):
* database.c (finalize_database):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (print_devmode):
* device-msw.c (finalize_devmode):
* device.c:
* device.c (print_device):
* elhash.c:
* elhash.c (print_hash_table):
* eval.c (print_multiple_value):
* eval.c (mark_multiple_value):
* events.c (deinitialize_event):
* events.c (print_event):
* events.c (event_equal):
* extents.c:
* extents.c (soe_dump):
* extents.c (soe_insert):
* extents.c (soe_delete):
* extents.c (soe_move):
* extents.c (extent_fragment_update):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* frame.c:
* frame.c (print_frame):
* free-hook.c:
* free-hook.c (check_free):
* glyphs.c:
* glyphs.c (print_image_instance):
* glyphs.c (print_glyph):
* gui.c:
* gui.c (copy_gui_item):
* hash.c:
* hash.c (NULL_ENTRY):
* hash.c (KEYS_DIFFER_P):
* keymap.c (print_keymap):
* keymap.c (MARKED_SLOT):
* lisp.h:
* lrecord.h:
* lrecord.h (LISP_OBJECT_UID):
* lrecord.h (set_lheader_implementation):
* lrecord.h (struct old_lcrecord_header):
* lstream.c (print_lstream):
* lstream.c (finalize_lstream):
* marker.c (print_marker):
* marker.c (marker_equal):
* mc-alloc.c (visit_all_used_page_headers):
* mule-charset.c:
* mule-charset.c (print_charset):
* objects.c (print_color_instance):
* objects.c (print_font_instance):
* objects.c (finalize_font_instance):
* opaque.c (print_opaque):
* opaque.c (print_opaque_ptr):
* opaque.c (equal_opaque_ptr):
* print.c (internal_object_printer):
* print.c (enum printing_badness):
* rangetab.c (print_range_table):
* rangetab.c (range_table_equal):
* specifier.c (print_specifier):
* specifier.c (finalize_specifier):
* symbols.c:
* symbols.c (print_symbol_value_magic):
* tooltalk.c:
* tooltalk.c (print_tooltalk_message):
* tooltalk.c (print_tooltalk_pattern):
* window.c (print_window):
* window.c (debug_print_window):
(1) Make lrecord UID's have a separate UID space for each object.
Otherwise, with 20-bit UID's, we rapidly wrap around, especially
when common objects like conses and strings increment the UID value
for every object created. (Originally I tried making two UID spaces,
one for objects that always print readably and hence don't display
the UID, and one for other objects. But certain objects like markers
for which a UID is displayed are still generated rapidly enough that
UID overflow is a serious issue.) This also has the advantage of
making UID values smaller, hence easier to remember -- their main
purpose is to make it easier to keep track of different objects of
the same type when debugging code. Make sure we dump lrecord UID's
so that we don't have problems with pdumped and non-dumped objects
having the same UID.
(2) Display UID's consistently whenever an object (a) doesn't
consistently print readably (objects like cons and string, which
always print readably, can't display a UID), and (b) doesn't
otherwise have a unique property that makes objects of a
particular type distinguishable. (E.g. buffers didn't and still
don't print an ID, but the buffer name uniquely identifies the
buffer.) Some types, such as event, extent, compiled-function,
didn't always (or didn't ever) display an ID; others (such as
marker, extent, lstream, opaque, opaque-ptr, any object using
internal_object_printer()) used to display the actual machine
pointer instead.
(3) Rename NORMAL_LISP_OBJECT_UID to LISP_OBJECT_UID; make it work
over all Lisp objects and take a Lisp object, not a struct pointer.
(4) Some misc cleanups in alloc.c, elhash.c.
(5) Change code in events.c that "deinitializes" an event so that
it doesn't increment the event UID counter in the process. Also
use deadbeef_memory() to overwrite memory instead of doing the same
with custom code. In the process, make deadbeef_memory() in
alloc.c always available, and delete extraneous copy in mc-alloc.c.
Also capitalize all uses of 0xDEADBEEF. Similarly in elhash.c
call deadbeef_memory().
(6) Resurrect "debug SOE" code in extents.c. Make it conditional
on DEBUG_XEMACS and on a `debug-soe' variable, rather than on
SOE_DEBUG. Make it output to stderr, not stdout.
(7) Delete some custom print methods that were identical to
external_object_printer().
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 15 Mar 2010 16:35:38 -0500 (2010-03-15) |
parents | eb82fbb675ea |
children | 308d34e9f07d |
rev | line source |
---|---|
428 | 1 ;;; build-report.el --- Automatically formatted build reports for XEmacs |
2 | |
2976 | 3 ;; Copyright (C) 1997-2003 Adrian Aichner |
428 | 4 |
434 | 5 ;; Author: Adrian Aichner <adrian@xemacs.org> |
4021 | 6 ;; Date: $Date: 2007/06/21 13:39:10 $ |
7 ;; Version: $Revision: 1.15 $ | |
428 | 8 ;; Keywords: internal |
9 | |
10 ;; This file is part of XEmacs. | |
11 | |
12 ;; XEmacs 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 ;; XEmacs is distributed in the hope that it will be useful, but | |
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
20 ;; General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
25 ;; 02111-1307, USA. | |
26 | |
3008 | 27 ;;; Synched up with: XEmacs build package build-report.el Revision 1.49. |
428 | 28 |
29 ;;; Commentary: | |
30 | |
31 ;; The Idea: | |
32 ;; Let XEmacs report interesting aspects of how it was built. | |
33 | |
34 ;; The Concept: | |
35 ;; User creates an XEmacs Build Report by just calling | |
36 ;; M-x build-report | |
37 ;; which will initialize a mail buffer with relevant information | |
38 ;; derived from the XEmacs build process. Point is left at the | |
39 ;; beginning of the report for user to input some personal notes and | |
40 ;; send the report. | |
41 | |
42 ;; The Status: | |
43 ;; This is the first `Proof of Concept'. | |
44 | |
45 ;; The Author: | |
46 ;; Adrian Aichner, Teradyne GmbH Munich, Sun., Apr. 20, 1997. | |
47 | |
48 ;;; Code: | |
49 | |
50 (require 'config) | |
442 | 51 (require 'custom) |
52 (require 'cl) | |
428 | 53 (provide 'build-report) |
54 | |
442 | 55 ;;; Constant definitions used internally by `build-report'. These are not |
56 ;;; anticipated to be changed by users of `build-report'. | |
57 ;;; If users do need to change the value of any of these, they need to do | |
58 ;;; it after `build-report' has been loaded (not just required). Please | |
59 ;;; report it to the maintainers of `build-report' when you think you | |
60 ;;; need to do this. | |
61 (defconst build-report-installation-version-regexp | |
975 | 62 "XEmacs\\s-+\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\(-b\\|\\.\\)\\([0-9]+\\)\\)?\\s-+\\\\?\"\\([^\\\"]+\\)\\\\?\"\\s-+\\(.*\\)?configured\\s-+for\\s-+`\\(.+\\)'\\." |
442 | 63 "*REGEXP matching XEmacs Beta Version string in |
64 `build-report-installation-file' file. This variable is used by | |
65 `build-report-installation-data'.") | |
66 | |
67 (defconst build-report-version-file-regexp | |
68 "emacs_major_version\\s-*=\\s-*\\([0-9]+\\) | |
69 emacs_minor_version\\s-*=\\s-*\\([0-9]+\\) | |
70 emacs_beta_version\\s-*=\\s-*\\([0-9]+\\)? | |
2976 | 71 xemacs_codename\\s-*=\\s-*\"\\([^\"]+\\)\"\\( |
4419
eb82fbb675ea
Use Mercurial changeset hash to identify build version.
Mike Sperber <sperber@deinprogramm.de>
parents:
4021
diff
changeset
|
72 xemacs_extra_name\\s-*=\\s-*\"?\\([^\"]+\\)\"?\\)?" |
442 | 73 "*REGEXP matching XEmacs Beta Version variable assignments in |
74 `build-report-version-file' file. This variable is used by | |
75 `build-report-version-file-data'.") | |
76 | |
77 (defconst build-report-installation-srcdir-regexp | |
78 "\\s-*Where should the build process find the source code\\?\\s-*\\(.*\\)$" | |
79 "REGEXP matching XEmacs Beta srcdir as the first substring match in | |
80 `build-report-installation-file' file. This variable is used by | |
81 `build-report-installation-data'.") | |
82 | |
83 ;;; Customization support for build-report starts here. | |
428 | 84 |
85 (defgroup build-report nil | |
442 | 86 "Standardizes the Creation of XEmacs Build Reports." |
87 :load 'build-report | |
428 | 88 :group 'build) |
89 | |
90 (defcustom build-report-destination | |
460 | 91 (list |
92 "XEmacs Build Reports List <xemacs-buildreports@xemacs.org>" | |
93 "XEmacs Beta List <xemacs-beta@xemacs.org>") | |
442 | 94 "*The list of mail addresses XEmacs Build Reports should most likely |
95 go to." | |
96 :type '(repeat | |
97 :custom-show t | |
98 :documentation-shown t | |
99 string) | |
428 | 100 :group 'build-report) |
101 | |
102 (defcustom build-report-keep-regexp | |
460 | 103 (list |
104 "^\\(cd\\|n?make\\)\\s-" | |
105 "errors?" | |
106 "warnings?" | |
107 "pure.*\\(space\\|size\\)" | |
108 "hides\\b" | |
109 "strange" | |
110 "shadowings" | |
111 "^Compil\\(ing\\s-+in\\|ation\\)" | |
112 "^Using" | |
113 "not\\s-+found" | |
114 "^While\\s-+compiling.*\\(\n\\s-+.+\\)*" | |
115 "^Note:" | |
116 "Installing" | |
117 "[Ff]ile(s) copied" | |
2976 | 118 "\\s-+tests\\s-+" |
119 "^[A-Z] [^ ]+$" | |
120 "^Wrong number of arguments:" | |
121 "^ \\*\\* " | |
122 "^\\(FAIL\\|SKIP\\):") | |
442 | 123 "*Regexp of make process output lines to keep in the report." |
124 :type '(repeat | |
125 :custom-show t | |
126 :documentation-shown t | |
127 regexp) | |
428 | 128 :group 'build-report) |
129 | |
130 (defcustom build-report-delete-regexp | |
460 | 131 (list |
132 "confl.*with.*auto-inlining" | |
133 "^Formatting:" | |
2976 | 134 "^\\s-*0 .*\\(failure\\|error\\)s?" |
135 "^PASS:" | |
460 | 136 "(100%) tests successful") |
442 | 137 "*Regexp of make process output lines to delete from the report." |
138 :type '(repeat | |
139 :custom-show t | |
140 :documentation-shown t | |
141 regexp) | |
428 | 142 :group 'build-report) |
143 | |
442 | 144 (defcustom build-report-make-output-dir |
145 (cond | |
146 ((equal system-type 'windows-nt) | |
147 (expand-file-name "nt" | |
148 (gethash 'blddir (config-value-hash-table)))) | |
149 (t | |
150 (gethash 'blddir (config-value-hash-table)))) | |
151 "*Directory where the build report file is found. | |
152 If this is empty or nil, the default, it is replaced by the value of | |
153 the XEmacs build directory." | |
154 :type '(directory | |
155 :custom-show t | |
156 :documentation-shown t) | |
157 :group 'build-report) | |
158 | |
159 (defcustom build-report-make-output-files | |
460 | 160 (list |
161 "beta.err" | |
162 "xemacs-make-all.err" | |
163 "xemacs-make-check-temacs.err" | |
164 "xemacs-make-check.err" | |
165 "xemacs-make-install.err") | |
442 | 166 "*List of Filenames where stdout and stderr of XEmacs make process |
167 have been stored. These are relative to | |
168 `build-report-make-output-dir`. You'll have to run make with output | |
169 redirection or use the `build' XEmacs package to save this output. You | |
170 may use following alias | |
171 | |
428 | 172 alias mk 'make \!* >>&\! \!$.err &' |
442 | 173 |
501 | 174 under csh, so that you get beta.err when you run `mk beta'." |
442 | 175 :type '(repeat |
176 :custom-show t | |
177 :documentation-shown t | |
178 file) | |
428 | 179 :group 'build-report) |
180 | |
181 (defcustom build-report-installation-file | |
442 | 182 (expand-file-name "Installation" |
183 (gethash 'blddir (config-value-hash-table))) | |
184 "*Installation file produced by XEmacs configure process." | |
185 :type '(file | |
186 :custom-show t | |
187 :documentation-shown t) | |
428 | 188 :group 'build-report) |
189 | |
442 | 190 (defcustom build-report-version-file |
191 (expand-file-name | |
192 "version.sh" | |
193 (gethash 'blddir (config-value-hash-table))) | |
194 "*version.sh file identifying XEmacs (Beta) Distribution." | |
195 :type '(file | |
196 :custom-show t | |
197 :documentation-shown t) | |
198 :group 'build-report) | |
199 | |
200 (defcustom build-report-installation-insert-all | |
201 nil | |
202 "*Tell build-report to insert the whole Installation file | |
203 instead of just the last report." | |
428 | 204 :type 'boolean |
205 :group 'build-report) | |
206 | |
207 (defcustom build-report-subject | |
208 (concat "[%s] " emacs-version " on " system-configuration) | |
2976 | 209 ;; #### this should allow variable names which will be evalled and |
210 ;; formatted using %s, see `build-report-prompts' | |
442 | 211 "*XEmacs Build Report Subject Line. %s-sequences will be substituted |
212 with user input through `build-report' according to | |
213 `build-report-prompts' using `format'." | |
214 :type '(string | |
215 :custom-show t | |
216 :documentation-shown t) | |
428 | 217 :group 'build-report) |
218 | |
219 (defcustom build-report-prompts | |
442 | 220 (quote (("Status?: " ("Success" "Failure")))) |
2976 | 221 ;; #### this should allow variable names which will be evalled and |
222 ;; formatted using %s, see `build-report-prompts' | |
442 | 223 "*XEmacs Build Report Prompt(s). This is a list of prompt-string |
224 lists used by `build-report' in conjunction with | |
225 `build-report-subject'. Each list consists of a prompt string | |
226 followed by any number of strings which can be chosen via the history | |
227 mechanism." | |
228 :type '(repeat | |
229 :custom-show t | |
230 :documentation-shown t | |
231 (list | |
232 :tag "Prompt" | |
233 string | |
234 (repeat | |
235 :tag "Values" | |
236 string))) | |
428 | 237 :group 'build-report) |
238 | |
239 (defcustom build-report-file-encoding | |
240 "7bit" | |
442 | 241 "*XEmacs Build Report File Encoding to be used when MIME support is |
242 available." | |
428 | 243 :group 'build-report) |
244 | |
245 ;; Symbol Name mappings from TM to SEMI serving as Compatibility | |
246 ;; Bandaid | |
247 (when (featurep 'mime-setup) | |
248 ;; No (defvaralias ...) so far. Thanks to "Didier Verna" | |
442 | 249 ;; <didier@xemacs.org> for reporting my incorrect defvaraliasing of |
428 | 250 ;; `mime-editor/insert-tag'. |
251 ;; Thanks to Jens-Ulrik Holger Petersen | |
252 ;; <petersen@kurims.kyoto-u.ac.jp> for suggesting the conditional | |
253 ;; aliasing of SEMI functions. | |
254 (unless (fboundp 'mime-edit-content-beginning) | |
255 (defalias 'mime-edit-content-beginning 'mime-editor/content-beginning)) | |
256 (unless (fboundp 'mime-edit-insert-tag) | |
257 (defalias 'mime-edit-insert-tag 'mime-editor/insert-tag)) | |
258 (unless (fboundp 'mime-edit-insert-binary-file) | |
259 (defalias 'mime-edit-insert-binary-file | |
260 'mime-editor/insert-binary-file))) | |
261 | |
442 | 262 (defun build-report-make-output-get () |
2976 | 263 "Return the filename the XEmacs make output is saved in." |
442 | 264 (interactive) |
265 (if (or (string-equal build-report-make-output-dir "") | |
266 (null build-report-make-output-dir)) | |
267 (mapcar | |
268 (function | |
269 (lambda (f) | |
270 (expand-file-name | |
271 f | |
272 (file-name-as-directory | |
273 (gethash 'blddir (config-value-hash-table)))))) | |
274 build-report-make-output-files) | |
275 (mapcar | |
276 (function | |
277 (lambda (f) | |
278 (expand-file-name | |
279 f | |
280 (file-name-as-directory build-report-make-output-dir)))) | |
281 build-report-make-output-files))) | |
282 | |
283 ;;;###autoload | |
428 | 284 (defun build-report (&rest args) |
462 | 285 "Report build information including Installation and make output. |
286 | |
287 Prompts for status (usually \"Success\" or \"Failure\"). Then uses | |
288 `compose-mail' to create a mail message. The Subject header contains | |
289 status and version information. Point is left at the beginning of the | |
290 mail text. Add some notes if you like, and send the report. | |
291 | |
292 Looks for Installation and the make output file (`beta.err' by | |
293 default, customizable via `build-report-make-output-files') in the | |
294 build directory of the running XEmacs by default (customizable via | |
295 `build-report-make-output-dir'). The output from make is filtered | |
296 through `build-report-keep-regexp' and `build-report-delete-regexp' | |
297 before including in the message. | |
298 | |
299 See also `mail-user-agent', `build-report-destination', and | |
300 `build-report-installation-file'." | |
442 | 301 ;; `interactive' form returns value for formal parameter `args'. |
428 | 302 (interactive |
303 (let (prompt | |
442 | 304 hist |
305 arg | |
306 (prompts build-report-prompts)) | |
428 | 307 (progn |
308 (while prompts | |
442 | 309 (defvar hist) |
310 (setq prompt (caar prompts)) | |
311 (setq hist (cdar prompts)) | |
312 ;; `build-report-prompts' used to be a list of lists, the | |
313 ;; first element of each list being the prompt, the rest being | |
314 ;; the history. The history is now in a separate list. We | |
315 ;; better check for that. | |
316 (if (listp (car hist)) | |
317 (setq hist (car hist))) | |
318 (setq prompts (cdr prompts)) | |
319 (setq arg (cons (read-string prompt "" 'hist) arg))) | |
428 | 320 arg))) |
3006 | 321 (let ((destination-address |
322 ;; `build-report-destination' used to be a single string, so | |
323 ;; let's test if we really get a list of destinations. | |
324 (if (listp build-report-destination) | |
325 (read-string | |
326 "Build Report Destination: " | |
327 (car build-report-destination) | |
328 'build-report-destination) | |
329 (read-string | |
330 "Build Report Destination: " | |
331 build-report-destination) | |
332 ))) | |
333 (save-excursion | |
334 (build-report-create-report destination-address args)))) | |
335 | |
336 ;;;###autoload | |
337 (defun batch-build-report (&optional status destination) | |
338 "Format a build report. Save it as \"./BUILD-REPORT\". | |
339 If the file \"./BUILD-REPORT-COMMENT\" is readable, insert its contents. | |
340 Optional STATUS is a string to insert in the subject. It defaults to | |
341 \"Success\". \(This will be made customizable.) | |
342 Optional DESTINATION is a string containing the destination mailbox. It | |
343 defaults to \"XEmacs Build Reports <xemacs-buildreports@xemacs.org>\". | |
344 \(This will be made customizable.) | |
345 This function may be invoked as a command." | |
346 (interactive) | |
347 (unless (stringp status) (setq status "Success")) | |
348 (unless (stringp destination) | |
349 (setq destination "XEmacs Build Reports <xemacs-buildreports@xemacs.org>")) | |
428 | 350 (save-excursion |
3006 | 351 (build-report-create-report destination |
352 ;; #### listify in the internal function? | |
353 (list status))) | |
354 (when (file-readable-p "BUILD-REPORT-COMMENT") | |
355 (insert-file "BUILD-REPORT-COMMENT")) | |
356 (write-file "BUILD-REPORT")) | |
357 | |
358 (defun build-report-create-report (destination status) | |
359 "Format current buffer as an XEmacs build report to DESTINATION. | |
360 | |
361 DESTINATION is the mailbox to which the report will be submitted. | |
362 STATUS is the status of the build. | |
363 You probably don't want to use this function; see `build-report' for the | |
364 interactive command, and `batch-build-report' for a command suitable for | |
365 use in shell scripts and Makefiles." | |
366 (if (file-exists-p build-report-installation-file) | |
442 | 367 (multiple-value-bind |
3006 | 368 (major minor beta codename extraname configuration) |
369 (build-report-installation-data build-report-installation-file) | |
370 (setq build-report-subject | |
371 (format "[%%s] XEmacs %s.%s%s \"%s\" %s%s" | |
372 major minor beta codename extraname configuration))) | |
373 (multiple-value-bind | |
374 (major minor beta codename extraname) | |
375 (build-report-version-file-data build-report-version-file) | |
376 (setq build-report-subject | |
377 (format "[%%s] XEmacs %s.%s%s \"%s\" %s%s" | |
378 major minor beta codename extraname system-configuration)))) | |
379 (compose-mail destination | |
380 (apply 'format build-report-subject status) | |
381 nil nil nil nil nil) | |
382 (let* ((report-begin (point)) | |
383 (files (reverse (build-report-make-output-get))) | |
384 (file (car files))) | |
385 (while file | |
386 (if (file-exists-p file) | |
387 (insert (build-report-insert-make-output report-begin file)) | |
388 (insert (format "%s not found!\n" file))) | |
442 | 389 (insert "\n") |
3006 | 390 (setq files (cdr files)) |
391 (setq file (car files))) | |
392 (if (file-exists-p build-report-installation-file) | |
393 (insert (build-report-insert-installation-file | |
394 report-begin | |
395 build-report-installation-insert-all)) | |
396 (insert (format "%s not found!\n" build-report-installation-file))) | |
397 (insert "\n") | |
398 (insert (build-report-insert-header report-begin)) | |
399 (goto-char report-begin))) | |
428 | 400 |
401 (defun build-report-insert-header (where) | |
402 "Inserts the build-report-header at the point specified by `where'." | |
403 (goto-char where) | |
404 (with-temp-buffer | |
442 | 405 (insert |
406 (format " | |
407 > XEmacs Build Report generated by emacs-version | |
408 > %s | |
409 > with system-configuration | |
410 > %s | |
411 > follows:\n\n" emacs-version system-configuration)) | |
428 | 412 (buffer-string))) |
413 | |
442 | 414 (defun build-report-insert-make-output (where file) |
415 "Inserts the output of the XEmacs Beta make run in the | |
416 current buffer at position WHERE. | |
428 | 417 The make process output must have been saved in |
442 | 418 `build-report-make-output-files' during the XEmacs Beta building." |
428 | 419 (goto-char where) |
420 (with-temp-buffer | |
442 | 421 (if (file-exists-p file) |
422 (progn | |
423 (if (featurep 'mime-setup) | |
424 (progn | |
425 (mime-edit-insert-tag | |
426 "text" | |
427 "plain" | |
428 (concat | |
429 "\nContent-Disposition: attachment;" | |
430 " filename=\"" | |
431 (file-name-nondirectory | |
432 file) | |
433 "\"")) | |
434 (mime-edit-insert-binary-file | |
435 file | |
436 build-report-file-encoding)) | |
437 (insert-file-contents file)) | |
438 (when build-report-keep-regexp | |
439 (goto-char (point-min)) | |
440 (delete-non-matching-lines (build-report-keep))) | |
441 (when build-report-delete-regexp | |
442 (goto-char (point-min)) | |
443 (delete-matching-lines (build-report-delete))) | |
444 (goto-char (point-min)) | |
445 (if build-report-keep-regexp | |
446 (insert | |
447 (format | |
448 "> keeping lines matching | |
449 > \"%s\" | |
450 " | |
451 (build-report-keep)))) | |
452 (if build-report-delete-regexp | |
453 (insert | |
454 (format | |
455 "> %sdeleting lines matching | |
456 > \"%s\" | |
457 " | |
458 (if build-report-keep-regexp | |
459 "and then " | |
460 "") | |
461 (build-report-delete)))) | |
462 (insert "\n") | |
463 (goto-char (point-min)) | |
464 (insert | |
465 (format "> Contents of %s\n" file))) | |
466 (insert "> " file | |
467 " does not exist!\n\n")) | |
428 | 468 (buffer-string))) |
442 | 469 |
428 | 470 (defun build-report-insert-installation-file (where all) |
471 "Inserts the contents of the `build-report-installation-file' | |
472 created by the XEmacs Beta configure process." | |
473 (goto-char where) | |
474 (with-temp-buffer | |
475 (if (file-exists-p build-report-installation-file) | |
442 | 476 (let (file-begin last-configure) |
477 (insert "> Contents of " | |
478 build-report-installation-file | |
479 ":\n") | |
480 (insert | |
481 (format | |
482 "> (Output from %s of ./configure)\n\n" | |
483 (if all "all runs" "most recent run"))) | |
484 (if (featurep 'mime-setup) | |
485 (progn | |
486 (mime-edit-insert-tag | |
487 "text" | |
488 "plain" | |
489 (concat | |
490 "\nContent-Disposition: attachment;" | |
491 " filename=\"" | |
492 (file-name-nondirectory | |
493 build-report-installation-file) | |
494 "\"")) | |
495 (mime-edit-insert-binary-file | |
496 build-report-installation-file | |
497 build-report-file-encoding) | |
498 (setq file-begin (mime-edit-content-beginning))) | |
499 (setq file-begin (point)) | |
500 (insert-file-contents | |
501 build-report-installation-file)) | |
502 (unless all | |
503 (setq last-configure | |
504 (search-backward-regexp | |
505 "^\\(uname.*\\|osversion\\|OS\\):\\s-+" file-begin t)) | |
506 (if (and file-begin last-configure) | |
507 (delete-region file-begin last-configure)))) | |
428 | 508 (insert "> " build-report-installation-file |
442 | 509 " does not exist!\n\n")) |
428 | 510 (buffer-string))) |
511 | |
512 (defun build-report-keep () | |
442 | 513 "Concatenate elements of `build-report-keep-regexp' and a general |
514 MIME tag REGEXP. The result is a REGEXP string matching either of the | |
515 REGEXPs in `build-report-keep-regexp' or a general MIME tag REGEXP." | |
428 | 516 (mapconcat #'identity |
442 | 517 (cons "^--\\[\\[\\|\\]\\]$" build-report-keep-regexp) "\\|")) |
428 | 518 |
519 (defun build-report-delete () | |
442 | 520 "Concatenate elements of `build-report-delete-regexp' and a general |
521 MIME tag REGEXP. The result is a REGEXP string matching either of the | |
522 REGEXPs in `build-report-delete-regexp' or a general MIME tag REGEXP." | |
4021 | 523 (mapconcat #'identity |
442 | 524 build-report-delete-regexp "\\|")) |
525 | |
526 (defun build-report-installation-data (&optional file) | |
527 "Return a list of XEmacs installation data containing MAJOR_NUMBER | |
528 MINOR_NUMBER BETA_STRING CODENAME CONFIGURATION SRCDIR from FILE, | |
529 which defaults to `build-report-installation-file'." | |
530 (interactive "fInstallation file: ") | |
531 (unless file | |
532 (setq file build-report-installation-file)) | |
533 (let | |
975 | 534 (major minor beta codename extraname configuration srcdir) |
442 | 535 (save-window-excursion |
536 (find-file-read-only file) | |
537 (goto-char (point-min)) | |
538 (while (< (point) (point-max)) | |
539 (cond | |
540 ((looking-at build-report-installation-version-regexp) | |
541 (goto-char (match-end 0)) | |
2976 | 542 (setq major (or (match-string 1) "")) |
543 (setq minor (or (match-string 2) "")) | |
544 (setq beta (or (match-string 3) "")) | |
545 (setq codename (or (match-string 6) "")) | |
546 (setq extraname (or (match-string 7) "")) | |
547 (setq configuration (or (match-string 8) ""))) | |
442 | 548 ((looking-at build-report-installation-srcdir-regexp) |
549 (goto-char (match-end 0)) | |
2976 | 550 (setq srcdir (or (match-string 1) ""))) |
442 | 551 ;; We avoid matching a potentially zero-length string to avoid |
552 ;; infinite looping. | |
553 ((looking-at | |
554 "^.+$") | |
555 (goto-char (match-end 0))) | |
556 ((looking-at "\n") | |
557 (goto-char (match-end 0))))) | |
975 | 558 (values major minor (or beta "") codename extraname configuration srcdir)))) |
442 | 559 |
560 (defun build-report-version-file-data (&optional file) | |
561 "Return a list of XEmacs version information containing | |
562 MAJOR_NUMBER MINOR_NUMBER BETA_STRING CODENAME from FILE, which | |
563 defaults to `build-report-version-file'." | |
564 (interactive "fversion.sh file: ") | |
565 (unless file | |
566 (setq file build-report-version-file)) | |
567 (let | |
975 | 568 (major minor beta codename extraname) |
442 | 569 (save-window-excursion |
570 (find-file-read-only file) | |
571 (goto-char (point-min)) | |
572 (while (< (point) (point-max)) | |
573 (cond | |
574 ((looking-at build-report-version-file-regexp) | |
575 (goto-char (match-end 0)) | |
2976 | 576 (setq major (or (match-string 1) "")) |
577 (setq minor (or (match-string 2) "")) | |
578 (setq beta (or (match-string 3) "")) | |
579 (setq codename (or (match-string 4) "")) | |
580 (setq extraname (or (match-string 6) ""))) | |
442 | 581 ;; We avoid matching a potentially zero-length string to avoid |
582 ;; infinite looping. | |
583 ((looking-at | |
584 "^.+$") | |
585 (goto-char (match-end 0))) | |
586 ((looking-at "\n") | |
587 (goto-char (match-end 0))))) | |
975 | 588 (values major minor (or beta "") codename extraname)))) |
428 | 589 |
590 ;;; build-report.el ends here |