Mercurial > hg > xemacs-beta

comparison lisp/packages/compile.el @ 193:f53b5ca2e663 r20-3b23

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b23
author cvs
date Mon, 13 Aug 2007 09:58:30 +0200
parents 489f57a838ef
children 78f53ef88e17
comparison
equal deleted inserted replaced
192:9d35321dd38c 193:f53b5ca2e663
647 (set-process-filter proc 'compilation-filter) 647 (set-process-filter proc 'compilation-filter)
648 (set-marker (process-mark proc) (point) outbuf) 648 (set-marker (process-mark proc) (point) outbuf)
649 (setq compilation-in-progress 649 (setq compilation-in-progress
650 (cons proc compilation-in-progress))) 650 (cons proc compilation-in-progress)))
651 ;; No asynchronous processes available. 651 ;; No asynchronous processes available.
652 (message "Executing `%s'..." command) 652 (display-message
653 'progress
654 (format "Executing `%s'..." command))
653 ; FSF 655 ; FSF
654 ; (setq mode-line-process ":run") 656 ; (setq mode-line-process ":run")
655 ; (force-mode-line-update) 657 ; (force-mode-line-update)
656 (sit-for 0) ;; Force redisplay 658 (sit-for 0) ;; Force redisplay
657 (let ((status (call-process shell-file-name nil outbuf nil "-c" 659 (let ((status (call-process shell-file-name nil outbuf nil "-c"
658 command)))) 660 command))))
659 (message "Executing `%s'...done" command))) 661 (display-message
662 'progress
663 (format "Executing `%s'...done" command))))
660 (set-buffer buffer-save))) 664 (set-buffer buffer-save)))
661 665
662 ;; Make it so the next C-x ` will use this buffer. 666 ;; Make it so the next C-x ` will use this buffer.
663 (setq compilation-last-buffer outbuf))) 667 (setq compilation-last-buffer outbuf)))
664 668
953 (if (and (not compilation-always-signal-completion) 957 (if (and (not compilation-always-signal-completion)
954 window 958 window
955 (pos-visible-in-window-p (point-max) window)) 959 (pos-visible-in-window-p (point-max) window))
956 nil ; assume that the user will see it... 960 nil ; assume that the user will see it...
957 (ding t 'ready) 961 (ding t 'ready)
958 (message "Compilation process completed%s." 962 (display-message
963 'progress
964 (format "Compilation process completed%s."
959 (or estatus " successfully") 965 (or estatus " successfully")
960 )) 966 )))
961 ;; Since the buffer and mode line will show that the 967 ;; Since the buffer and mode line will show that the
962 ;; process is dead, we can delete it now. Otherwise it 968 ;; process is dead, we can delete it now. Otherwise it
963 ;; will stay around until M-x list-processes. 969 ;; will stay around until M-x list-processes.
964 (delete-process proc) 970 (delete-process proc)
965 ;; Force mode line redisplay soon. 971 ;; Force mode line redisplay soon.
1635 1641
1636 (defun compilation-parse-errors (limit-search find-at-least) 1642 (defun compilation-parse-errors (limit-search find-at-least)
1637 "Parse the current buffer as grep, cc or lint error messages. 1643 "Parse the current buffer as grep, cc or lint error messages.
1638 See variable `compilation-parse-errors-function' for the interface it uses." 1644 See variable `compilation-parse-errors-function' for the interface it uses."
1639 (setq compilation-error-list nil) 1645 (setq compilation-error-list nil)
1640 (message "Parsing error messages...") 1646 (display-message 'progress "Parsing error messages...")
1641 (let (;;text-buffer -- unused 1647 (let (;;text-buffer -- unused
1642 orig orig-expanded parent-expanded 1648 orig orig-expanded parent-expanded
1643 regexp enter-group leave-group error-group 1649 regexp enter-group leave-group error-group
1644 alist subexpr error-regexp-groups 1650 alist subexpr error-regexp-groups
1645 (found-desired nil) 1651 (found-desired nil)
1882 ) 1888 )
1883 (t 1889 (t
1884 (error "compilation-parse-errors: known groups didn't match!"))) 1890 (error "compilation-parse-errors: known groups didn't match!")))
1885 1891
1886 (when (= (% compilation-num-errors-found message-freq) 0) 1892 (when (= (% compilation-num-errors-found message-freq) 0)
1887 (message "Parsing error messages...%d (%.0f%% of buffer)" 1893 (display-message
1894 'progress
1895 (format "Parsing error messages...%d (%.0f%% of buffer)"
1888 compilation-num-errors-found 1896 compilation-num-errors-found
1889 ;; Use floating-point because (* 100 (point)) frequently 1897 ;; Use floating-point because (* 100 (point)) frequently
1890 ;; exceeds the range of Emacs Lisp integers. 1898 ;; exceeds the range of Emacs Lisp integers.
1891 (/ (* 100.0 (point)) (point-max)))) 1899 (/ (* 100.0 (point)) (point-max)))))
1892 1900
1893 ;;; This is broken - it foils the logic above which is supposed to ensure 1901 ;;; This is broken - it foils the logic above which is supposed to ensure
1894 ;;; that all errors for the current file are found before we quit. 1902 ;;; that all errors for the current file are found before we quit.
1895 ; (and limit-search (>= (point) limit-search) 1903 ; (and limit-search (>= (point) limit-search)
1896 ; ;; The user wanted a specific error, and we're past it. 1904 ; ;; The user wanted a specific error, and we're past it.
1899 (setq compilation-parsing-end (if found-desired 1907 (setq compilation-parsing-end (if found-desired
1900 (point) 1908 (point)
1901 ;; We have searched the whole buffer. 1909 ;; We have searched the whole buffer.
1902 (point-max)))) 1910 (point-max))))
1903 (setq compilation-error-list (nreverse compilation-error-list)) 1911 (setq compilation-error-list (nreverse compilation-error-list))
1904 (message "Parsing error messages...done")) 1912 (display-message 'progress "Parsing error messages...done"))
1905 1913
1906 ;; If directory DIR is a subdir of ORIG or of ORIG's parent, 1914 ;; If directory DIR is a subdir of ORIG or of ORIG's parent,
1907 ;; return a relative name for it starting from ORIG or its parent. 1915 ;; return a relative name for it starting from ORIG or its parent.
1908 ;; ORIG-EXPANDED is an expanded version of ORIG. 1916 ;; ORIG-EXPANDED is an expanded version of ORIG.
1909 ;; PARENT-EXPANDED is an expanded version of ORIG's parent. 1917 ;; PARENT-EXPANDED is an expanded version of ORIG's parent.