Mercurial > emacs
comparison lisp/progmodes/compile.el @ 75281:4f425a488281
(compilation-loop): New arg limit. Handle case where the first error
is at point-min.
(compilation-next-error): New arg to compilation-loop call.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Fri, 19 Jan 2007 02:25:48 +0000 |
| parents | 72242573ed99 |
| children | 09d4f4bcd527 |
comparison
equal
deleted
inserted
replaced
| 75280:a04a1922e9fc | 75281:4f425a488281 |
|---|---|
| 1492 (defsubst compilation-buffer-p (buffer) | 1492 (defsubst compilation-buffer-p (buffer) |
| 1493 "Test if BUFFER is a compilation buffer." | 1493 "Test if BUFFER is a compilation buffer." |
| 1494 (with-current-buffer buffer | 1494 (with-current-buffer buffer |
| 1495 (compilation-buffer-internal-p))) | 1495 (compilation-buffer-internal-p))) |
| 1496 | 1496 |
| 1497 (defmacro compilation-loop (< property-change 1+ error) | 1497 (defmacro compilation-loop (< property-change 1+ error limit) |
| 1498 `(while (,< n 0) | 1498 `(let (opt) |
| 1499 (or (setq pt (,property-change pt 'message)) | 1499 (while (,< n 0) |
| 1500 (error ,error compilation-error)) | 1500 (setq opt pt) |
| 1501 ;; prop 'message usually has 2 changes, on and off, so re-search if off | 1501 (or (setq pt (,property-change pt 'message)) |
| 1502 (or (setq msg (get-text-property pt 'message)) | 1502 ;; Handle the case where where the first error message is |
| 1503 (if (setq pt (,property-change pt 'message)) | 1503 ;; at the start of the buffer, and n < 0. |
| 1504 (setq msg (get-text-property pt 'message))) | 1504 (if (or (eq (get-text-property ,limit 'message) |
| 1505 (error ,error compilation-error)) | 1505 (get-text-property opt 'message)) |
| 1506 (or (< (cadr msg) compilation-skip-threshold) | 1506 (eq pt opt)) |
| 1507 (if different-file | 1507 (error ,error compilation-error) |
| 1508 (eq (prog1 last (setq last (nth 2 (car msg)))) | 1508 (setq pt ,limit))) |
| 1509 last)) | 1509 ;; prop 'message usually has 2 changes, on and off, so |
| 1510 (if compilation-skip-visited | 1510 ;; re-search if off |
| 1511 (nthcdr 4 (car msg))) | 1511 (or (setq msg (get-text-property pt 'message)) |
| 1512 (if compilation-skip-to-next-location | 1512 (if (setq pt (,property-change pt 'message nil ,limit)) |
| 1513 (eq (car msg) loc)) | 1513 (setq msg (get-text-property pt 'message))) |
| 1514 ;; count this message only if none of the above are true | 1514 (error ,error compilation-error)) |
| 1515 (setq n (,1+ n))))) | 1515 (or (< (cadr msg) compilation-skip-threshold) |
| 1516 (if different-file | |
| 1517 (eq (prog1 last (setq last (nth 2 (car msg)))) | |
| 1518 last)) | |
| 1519 (if compilation-skip-visited | |
| 1520 (nthcdr 4 (car msg))) | |
| 1521 (if compilation-skip-to-next-location | |
| 1522 (eq (car msg) loc)) | |
| 1523 ;; count this message only if none of the above are true | |
| 1524 (setq n (,1+ n)))))) | |
| 1516 | 1525 |
| 1517 (defun compilation-next-error (n &optional different-file pt) | 1526 (defun compilation-next-error (n &optional different-file pt) |
| 1518 "Move point to the next error in the compilation buffer. | 1527 "Move point to the next error in the compilation buffer. |
| 1519 Prefix arg N says how many error messages to move forwards (or | 1528 Prefix arg N says how many error messages to move forwards (or |
| 1520 backwards, if negative). | 1529 backwards, if negative). |
| 1540 (setq last (nth 2 (car msg))) | 1549 (setq last (nth 2 (car msg))) |
| 1541 (if (>= n 0) | 1550 (if (>= n 0) |
| 1542 (compilation-loop > next-single-property-change 1- | 1551 (compilation-loop > next-single-property-change 1- |
| 1543 (if (get-buffer-process (current-buffer)) | 1552 (if (get-buffer-process (current-buffer)) |
| 1544 "No more %ss yet" | 1553 "No more %ss yet" |
| 1545 "Moved past last %s")) | 1554 "Moved past last %s") |
| 1555 (point-max)) | |
| 1546 ;; Don't move "back" to message at or before point. | 1556 ;; Don't move "back" to message at or before point. |
| 1547 ;; Pass an explicit (point-min) to make sure pt is non-nil. | 1557 ;; Pass an explicit (point-min) to make sure pt is non-nil. |
| 1548 (setq pt (previous-single-property-change pt 'message nil (point-min))) | 1558 (setq pt (previous-single-property-change pt 'message nil (point-min))) |
| 1549 (compilation-loop < previous-single-property-change 1+ | 1559 (compilation-loop < previous-single-property-change 1+ |
| 1550 "Moved back before first %s"))) | 1560 "Moved back before first %s" (point-min)))) |
| 1551 (goto-char pt) | 1561 (goto-char pt) |
| 1552 (or msg | 1562 (or msg |
| 1553 (error "No %s here" compilation-error)))) | 1563 (error "No %s here" compilation-error)))) |
| 1554 | 1564 |
| 1555 (defun compilation-previous-error (n) | 1565 (defun compilation-previous-error (n) |