Mercurial > emacs

comparison lisp/emacs-lisp/bytecomp.el @ 47110:ce17d4a1d32e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(byte-compile-warning-prefix): Decide here whether to print which form we're compiling. If we do that, still print file and line. Make file name relative to default-directory. Print fewer newlines. (byte-compile-log-file): Print something even if no file. Print messages for entering and leaving directories, and set default-directory. (displaying-byte-compile-warnings): Only sometimes bind warning-series. (byte-compile-warning-series): New function. (byte-compile-file): Set byte-compile-last-logged-file, don't bind it. (byte-compile-display-log-head-p): Function deleted.
author Richard M. Stallman <rms@gnu.org>
date Thu, 29 Aug 2002 17:26:47 +0000
parents 747c4a00be3e
children 1a358c4f4b8b
comparison
equal deleted inserted replaced
47109:796b2ef84d40 47110:ce17d4a1d32e
8 ;; Maintainer: FSF 8 ;; Maintainer: FSF
9 ;; Keywords: lisp 9 ;; Keywords: lisp
10 10
11 ;;; This version incorporates changes up to version 2.10 of the 11 ;;; This version incorporates changes up to version 2.10 of the
12 ;;; Zawinski-Furuseth compiler. 12 ;;; Zawinski-Furuseth compiler.
13 (defconst byte-compile-version "$Revision: 2.109 $") 13 (defconst byte-compile-version "$Revision: 2.110 $")
14 14
15 ;; This file is part of GNU Emacs. 15 ;; This file is part of GNU Emacs.
16 16
17 ;; GNU Emacs is free software; you can redistribute it and/or modify 17 ;; GNU Emacs is free software; you can redistribute it and/or modify
18 ;; it under the terms of the GNU General Public License as published by 18 ;; it under the terms of the GNU General Public License as published by
886 (> last byte-compile-last-position))))))) 886 (> last byte-compile-last-position)))))))
887 887
888 (defvar byte-compile-last-warned-form nil) 888 (defvar byte-compile-last-warned-form nil)
889 (defvar byte-compile-last-logged-file nil) 889 (defvar byte-compile-last-logged-file nil)
890 890
891 ;; Return non-nil if should say what defun we are in.
892 (defun byte-compile-display-log-head-p ()
893 (and (not (eq byte-compile-current-form :end))
894 (or (and byte-compile-current-file
895 (not (equal byte-compile-current-file
896 byte-compile-last-logged-file)))
897 (and byte-compile-last-warned-form
898 (not (eq byte-compile-current-form
899 byte-compile-last-warned-form))))))
900
901 (defun byte-goto-log-buffer () 891 (defun byte-goto-log-buffer ()
902 (set-buffer (get-buffer-create "*Compile-Log*")) 892 (set-buffer (get-buffer-create "*Compile-Log*"))
903 (unless (eq major-mode 'compilation-mode) 893 (unless (eq major-mode 'compilation-mode)
904 (compilation-mode))) 894 (compilation-mode)))
905 895
906 ;; This is used as warning-prefix for the compiler. 896 ;; This is used as warning-prefix for the compiler.
897 ;; It is always called with the warnings buffer current.
907 (defun byte-compile-warning-prefix (level entry) 898 (defun byte-compile-warning-prefix (level entry)
908 (save-current-buffer 899 (let* ((dir default-directory)
909 (byte-goto-log-buffer)) 900 (file (cond ((stringp byte-compile-current-file)
910 (let* ((file (cond ((stringp byte-compile-current-file) 901 (format "%s:" (file-relative-name byte-compile-current-file dir)))
911 (format "%s:" byte-compile-current-file))
912 ((bufferp byte-compile-current-file) 902 ((bufferp byte-compile-current-file)
913 (format "Buffer %s:" 903 (format "Buffer %s:"
914 (buffer-name byte-compile-current-file))) 904 (buffer-name byte-compile-current-file)))
915 (t ""))) 905 (t "")))
916 (pos (if (and byte-compile-current-file 906 (pos (if (and byte-compile-current-file
920 byte-compile-last-position) 910 byte-compile-last-position)
921 (save-excursion 911 (save-excursion
922 (goto-char byte-compile-last-position) 912 (goto-char byte-compile-last-position)
923 (1+ (current-column))))) 913 (1+ (current-column)))))
924 "")) 914 ""))
925 (form (or byte-compile-current-form "toplevel form"))) 915 (form (if (eq byte-compile-current-form :end) "end of data"
926 (when (byte-compile-display-log-head-p) 916 (or byte-compile-current-form "toplevel form"))))
917 (when (or (and byte-compile-current-file
918 (not (equal byte-compile-current-file
919 byte-compile-last-logged-file)))
920 (and byte-compile-last-warned-form
921 (not (eq byte-compile-current-form
922 byte-compile-last-warned-form))))
927 (insert (format "\nIn %s:\n" form))) 923 (insert (format "\nIn %s:\n" form)))
928 (when (and level (not (byte-compile-display-log-head-p))) 924 (when level
929 (insert (format "\n%s%s\n" file pos)))) 925 (insert (format "%s%s" file pos))))
930 (setq byte-compile-last-logged-file byte-compile-current-file 926 (setq byte-compile-last-logged-file byte-compile-current-file
931 byte-compile-last-warned-form byte-compile-current-form) 927 byte-compile-last-warned-form byte-compile-current-form)
932 entry) 928 entry)
929
930 ;; This no-op function is used as the value of warning-series
931 ;; to tell inner calls to displaying-byte-compile-warnings
932 ;; not to bind warning-series.
933 (defun byte-compile-warning-series (&rest ignore)
934 nil)
933 935
934 ;; Log the start of a file in *Compile-Log*, and mark it as done. 936 ;; Log the start of a file in *Compile-Log*, and mark it as done.
935 ;; Return the position of the start of the page in the log buffer. 937 ;; Return the position of the start of the page in the log buffer.
936 ;; But do nothing in batch mode. 938 ;; But do nothing in batch mode.
937 (defun byte-compile-log-file () 939 (defun byte-compile-log-file ()
938 (and byte-compile-current-file 940 (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
939 (not (equal byte-compile-current-file byte-compile-last-logged-file))
940 (not noninteractive) 941 (not noninteractive)
941 (save-excursion 942 (save-excursion
942 (byte-goto-log-buffer) 943 (byte-goto-log-buffer)
943 (goto-char (point-max)) 944 (goto-char (point-max))
944 (insert "\n") 945 (let* ((dir (and byte-compile-current-file
945 (let ((pt (point))) 946 (file-name-directory byte-compile-current-file)))
946 (insert "\f\nCompiling " 947 (was-same (equal default-directory dir))
947 (if (stringp byte-compile-current-file) 948 pt)
948 (concat "file " byte-compile-current-file) 949 (when dir
949 (concat "buffer " (buffer-name byte-compile-current-file))) 950 (unless was-same
950 " at " (current-time-string) "\n") 951 (insert (format "Leaving directory `%s'\n" default-directory))))
952 (unless (bolp)
953 (insert "\n"))
954 (setq pt (point-marker))
955 (if byte-compile-current-file
956 (insert "\f\nCompiling "
957 (if (stringp byte-compile-current-file)
958 (concat "file " byte-compile-current-file)
959 (concat "buffer " (buffer-name byte-compile-current-file)))
960 " at " (current-time-string) "\n")
961 (insert "\f\nCompiling no file at " (current-time-string) "\n"))
962 (when dir
963 (setq default-directory dir)
964 (unless was-same
965 (insert (format "Entering directory `%s'\n" default-directory))))
951 (setq byte-compile-last-logged-file byte-compile-current-file) 966 (setq byte-compile-last-logged-file byte-compile-current-file)
952 pt)))) 967 pt))))
953 968
954 ;; Log a message STRING in *Compile-Log*. 969 ;; Log a message STRING in *Compile-Log*.
955 ;; Also log the current function and file if not already done. 970 ;; Also log the current function and file if not already done.
1327 byte-compile-warning-types 1342 byte-compile-warning-types
1328 byte-compile-warnings)) 1343 byte-compile-warnings))
1329 ) 1344 )
1330 body))) 1345 body)))
1331 1346
1332 ;;; ;; Log the file name.
1333 ;;; (let ((tem (byte-compile-log-file)))
1334 ;;; ;; Record position of that text,
1335 ;;; ;; unless we're compiling multiple files and this isn't the first.
1336 ;;; (unless warning-series
1337 ;;; (setq warning-series tem)))
1338
1339 (defmacro displaying-byte-compile-warnings (&rest body) 1347 (defmacro displaying-byte-compile-warnings (&rest body)
1340 `(let (warning-series) 1348 `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
1341 ;; Log the file name. Record position of that text. 1349 (warning-series-started
1342 (setq warning-series (byte-compile-log-file)) 1350 (and (markerp warning-series)
1351 (eq (marker-buffer warning-series)
1352 (get-buffer "*Compile-Log*")))))
1343 (byte-compile-find-cl-functions) 1353 (byte-compile-find-cl-functions)
1344 (let ((--displaying-byte-compile-warnings-fn (lambda () 1354 (if (or (eq warning-series 'byte-compile-warning-series)
1345 ,@body))) 1355 warning-series-started)
1346 (if byte-compile-debug 1356 ;; warning-series does come from compilation,
1347 (funcall --displaying-byte-compile-warnings-fn) 1357 ;; so don't bind it, but maybe do set it.
1348 (condition-case error-info 1358 (let (tem)
1359 ;; Log the file name. Record position of that text.
1360 (setq tem (byte-compile-log-file))
1361 (unless warning-series-started
1362 (setq warning-series (or tem 'byte-compile-warning-series)))
1363 (if byte-compile-debug
1364 (funcall --displaying-byte-compile-warnings-fn)
1365 (condition-case error-info
1366 (funcall --displaying-byte-compile-warnings-fn)
1367 (error (byte-compile-report-error error-info)))))
1368 ;; warning-series does not come from compilation, so bind it.
1369 (let ((warning-series
1370 ;; Log the file name. Record position of that text.
1371 (or (byte-compile-log-file) 'byte-compile-warning-series)))
1372 (if byte-compile-debug
1349 (funcall --displaying-byte-compile-warnings-fn) 1373 (funcall --displaying-byte-compile-warnings-fn)
1350 (error (byte-compile-report-error error-info))))))) 1374 (condition-case error-info
1375 (funcall --displaying-byte-compile-warnings-fn)
1376 (error (byte-compile-report-error error-info))))))))
1351 1377
1352 ;;;###autoload 1378 ;;;###autoload
1353 (defun byte-force-recompile (directory) 1379 (defun byte-force-recompile (directory)
1354 "Recompile every `.el' file in DIRECTORY that already has a `.elc' file. 1380 "Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
1355 Files in subdirectories of DIRECTORY are processed also." 1381 Files in subdirectories of DIRECTORY are processed also."
1472 (let ((b (get-file-buffer (expand-file-name filename)))) 1498 (let ((b (get-file-buffer (expand-file-name filename))))
1473 (if (and b (buffer-modified-p b) 1499 (if (and b (buffer-modified-p b)
1474 (y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) 1500 (y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
1475 (save-excursion (set-buffer b) (save-buffer))))) 1501 (save-excursion (set-buffer b) (save-buffer)))))
1476 1502
1503 ;; Force logging of the file name for each file compiled.
1504 (setq byte-compile-last-logged-file nil)
1477 (let ((byte-compile-current-file filename) 1505 (let ((byte-compile-current-file filename)
1478 (byte-compile-last-logged-file nil)
1479 (set-auto-coding-for-load t) 1506 (set-auto-coding-for-load t)
1480 target-file input-buffer output-buffer 1507 target-file input-buffer output-buffer
1481 byte-compile-dest-file) 1508 byte-compile-dest-file)
1482 (setq target-file (byte-compile-dest-file filename)) 1509 (setq target-file (byte-compile-dest-file filename))
1483 (setq byte-compile-dest-file target-file) 1510 (setq byte-compile-dest-file target-file)