Mercurial > emacs
comparison lisp/replace.el @ 44924:4a1d60fe2473
(occur-accumulate-lines): Avoid incf and decf.
(occur-engine-add-prefix): New function.
(occur-engine): Avoid using macrolet, incf and decf.
Use occur-engine-add-prefix instead.
Rename `l' to `lines' and `c' to `matches'.
(occur-engine, occur-mode-mouse-goto)
(occur-mode-find-occurrence, occur-mode-goto-occurrence)
(occur-mode-goto-occurrence-other-window)
(occur-mode-display-occurrence): A position is just a marker,
not a list.
(occur-revert-arguments):
Renamed from occur-revert-properties. All uses changed.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 28 Apr 2002 17:46:19 +0000 |
parents | 590c97430876 |
children | 829beb9a6a4b |
comparison
equal
deleted
inserted
replaced
44923:66535b19af6b | 44924:4a1d60fe2473 |
---|---|
24 | 24 |
25 ;; This package supplies the string and regular-expression replace functions | 25 ;; This package supplies the string and regular-expression replace functions |
26 ;; documented in the Emacs user's manual. | 26 ;; documented in the Emacs user's manual. |
27 | 27 |
28 ;;; Code: | 28 ;;; Code: |
29 | |
30 (eval-when-compile | |
31 (require 'cl)) | |
32 | 29 |
33 (defcustom case-replace t | 30 (defcustom case-replace t |
34 "*Non-nil means `query-replace' should preserve case in replacements." | 31 "*Non-nil means `query-replace' should preserve case in replacements." |
35 :type 'boolean | 32 :type 'boolean |
36 :group 'matching) | 33 :group 'matching) |
447 (define-key map "\M-p" 'occur-prev) | 444 (define-key map "\M-p" 'occur-prev) |
448 (define-key map "g" 'revert-buffer) | 445 (define-key map "g" 'revert-buffer) |
449 map) | 446 map) |
450 "Keymap for `occur-mode'.") | 447 "Keymap for `occur-mode'.") |
451 | 448 |
452 (defvar occur-revert-properties nil) | 449 (defvar occur-revert-arguments nil |
450 "Arguments to pass to `occur-1' to revert an Occur mode buffer. | |
451 See `occur-revert-function'.") | |
453 | 452 |
454 (put 'occur-mode 'mode-class 'special) | 453 (put 'occur-mode 'mode-class 'special) |
455 (defun occur-mode () | 454 (defun occur-mode () |
456 "Major mode for output from \\[occur]. | 455 "Major mode for output from \\[occur]. |
457 \\<occur-mode-map>Move point to one of the items in this buffer, then use | 456 \\<occur-mode-map>Move point to one of the items in this buffer, then use |
468 '(nil t nil nil nil | 467 '(nil t nil nil nil |
469 (font-lock-fontify-region-function . occur-fontify-region-function) | 468 (font-lock-fontify-region-function . occur-fontify-region-function) |
470 (font-lock-unfontify-region-function . occur-unfontify-region-function))) | 469 (font-lock-unfontify-region-function . occur-unfontify-region-function))) |
471 (setq revert-buffer-function 'occur-revert-function) | 470 (setq revert-buffer-function 'occur-revert-function) |
472 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) | 471 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) |
473 (make-local-variable 'occur-revert-properties) | 472 (make-local-variable 'occur-revert-arguments) |
474 (run-hooks 'occur-mode-hook)) | 473 (run-hooks 'occur-mode-hook)) |
475 | 474 |
476 (defun occur-revert-function (ignore1 ignore2) | 475 (defun occur-revert-function (ignore1 ignore2) |
477 "Handle `revert-buffer' for *Occur* buffers." | 476 "Handle `revert-buffer' for Occur mode buffers." |
478 (apply 'occur-1 occur-revert-properties)) | 477 (apply 'occur-1 occur-revert-arguments)) |
479 | 478 |
480 (defun occur-mode-mouse-goto (event) | 479 (defun occur-mode-mouse-goto (event) |
481 "In Occur mode, go to the occurrence whose line you click on." | 480 "In Occur mode, go to the occurrence whose line you click on." |
482 (interactive "e") | 481 (interactive "e") |
483 (let ((buffer nil) | 482 (let (pos) |
484 (pos nil)) | |
485 (save-excursion | 483 (save-excursion |
486 (set-buffer (window-buffer (posn-window (event-end event)))) | 484 (set-buffer (window-buffer (posn-window (event-end event)))) |
487 (save-excursion | 485 (save-excursion |
488 (goto-char (posn-point (event-end event))) | 486 (goto-char (posn-point (event-end event))) |
489 (let ((props (occur-mode-find-occurrence))) | 487 (setq pos (occur-mode-find-occurrence)))) |
490 (setq buffer (car props)) | 488 (pop-to-buffer (marker-buffer pos)) |
491 (setq pos (cdr props))))) | 489 (goto-char pos))) |
492 (pop-to-buffer buffer) | |
493 (goto-char (marker-position pos)))) | |
494 | 490 |
495 (defun occur-mode-find-occurrence () | 491 (defun occur-mode-find-occurrence () |
496 (let ((props (get-text-property (point) 'occur-target))) | 492 (let ((pos (get-text-property (point) 'occur-target))) |
497 (unless props | 493 (unless pos |
498 (error "No occurrence on this line")) | 494 (error "No occurrence on this line")) |
499 (unless (buffer-live-p (car props)) | 495 (unless (buffer-live-p (marker-buffer pos)) |
500 (error "Buffer in which occurrence was found is deleted")) | 496 (error "Buffer for this occurrence was killed")) |
501 props)) | 497 pos)) |
502 | 498 |
503 (defun occur-mode-goto-occurrence () | 499 (defun occur-mode-goto-occurrence () |
504 "Go to the occurrence the current line describes." | 500 "Go to the occurrence the current line describes." |
505 (interactive) | 501 (interactive) |
506 (let ((target (occur-mode-find-occurrence))) | 502 (let ((pos (occur-mode-find-occurrence))) |
507 (pop-to-buffer (car target)) | 503 (pop-to-buffer (marker-buffer pos)) |
508 (goto-char (marker-position (cdr target))))) | 504 (goto-char pos))) |
509 | 505 |
510 (defun occur-mode-goto-occurrence-other-window () | 506 (defun occur-mode-goto-occurrence-other-window () |
511 "Go to the occurrence the current line describes, in another window." | 507 "Go to the occurrence the current line describes, in another window." |
512 (interactive) | 508 (interactive) |
513 (let ((target (occur-mode-find-occurrence))) | 509 (let ((pos (occur-mode-find-occurrence))) |
514 (switch-to-buffer-other-window (car target)) | 510 (switch-to-buffer-other-window (marker-buffer pos)) |
515 (goto-char (marker-position (cdr target))))) | 511 (goto-char pos))) |
516 | 512 |
517 (defun occur-mode-display-occurrence () | 513 (defun occur-mode-display-occurrence () |
518 "Display in another window the occurrence the current line describes." | 514 "Display in another window the occurrence the current line describes." |
519 (interactive) | 515 (interactive) |
520 (let ((target (occur-mode-find-occurrence)) | 516 (let ((pos (occur-mode-find-occurrence)) |
517 window | |
518 ;; Bind these to ensure `display-buffer' puts it in another window. | |
521 same-window-buffer-names | 519 same-window-buffer-names |
522 same-window-regexps | 520 same-window-regexps) |
523 window) | 521 (setq window (display-buffer (marker-buffer pos))) |
524 (setq window (display-buffer (car target))) | |
525 ;; This is the way to set point in the proper window. | 522 ;; This is the way to set point in the proper window. |
526 (save-selected-window | 523 (save-selected-window |
527 (select-window window) | 524 (select-window window) |
528 (goto-char (marker-position (cdr target)))))) | 525 (goto-char pos)))) |
529 | 526 |
530 (defun occur-next (&optional n) | 527 (defun occur-next (&optional n) |
531 "Move to the Nth (default 1) next match in the *Occur* buffer." | 528 "Move to the Nth (default 1) next match in an Occur mode buffer." |
532 (interactive "p") | 529 (interactive "p") |
533 (if (not n) (setq n 1)) | 530 (if (not n) (setq n 1)) |
534 (let ((r)) | 531 (let ((r)) |
535 (while (> n 0) | 532 (while (> n 0) |
536 (if (get-text-property (point) 'occur-point) | 533 (if (get-text-property (point) 'occur-point) |
540 (goto-char r) | 537 (goto-char r) |
541 (error "No more matches")) | 538 (error "No more matches")) |
542 (setq n (1- n))))) | 539 (setq n (1- n))))) |
543 | 540 |
544 (defun occur-prev (&optional n) | 541 (defun occur-prev (&optional n) |
545 "Move to the Nth (default 1) previous match in the *Occur* buffer." | 542 "Move to the Nth (default 1) previous match in an Occur mode buffer." |
546 (interactive "p") | 543 (interactive "p") |
547 (if (not n) (setq n 1)) | 544 (if (not n) (setq n 1)) |
548 (let ((r)) | 545 (let ((r)) |
549 (while (> n 0) | 546 (while (> n 0) |
550 | 547 |
585 (result nil)) | 582 (result nil)) |
586 (while (not (or (zerop count) | 583 (while (not (or (zerop count) |
587 (if forwardp | 584 (if forwardp |
588 (eobp) | 585 (eobp) |
589 (bobp)))) | 586 (bobp)))) |
590 (if forwardp | 587 (setq count (+ count (if forwardp 1 -1))) |
591 (decf count) | |
592 (incf count)) | |
593 (push | 588 (push |
594 (funcall (if no-props | 589 (funcall (if no-props |
595 #'buffer-substring-no-properties | 590 #'buffer-substring-no-properties |
596 #'buffer-substring) | 591 #'buffer-substring) |
597 (line-beginning-position) | 592 (line-beginning-position) |
699 (format "%d" count)) | 694 (format "%d" count)) |
700 regexp) | 695 regexp) |
701 (if (> count 0) | 696 (if (> count 0) |
702 (display-buffer occur-buf) | 697 (display-buffer occur-buf) |
703 (kill-buffer occur-buf))) | 698 (kill-buffer occur-buf))) |
704 (setq occur-revert-properties (list regexp nlines bufs) | 699 (setq occur-revert-arguments (list regexp nlines bufs) |
705 buffer-read-only t)))) | 700 buffer-read-only t)))) |
706 | 701 |
707 ;; Most of these are macros becuase if we used `flet', it wouldn't | 702 (defun occur-engine-add-prefix (lines) |
708 ;; create a closure, so things would blow up at run time. Ugh. :( | 703 (mapcar |
709 (macrolet ((insert-get-point (obj) | 704 #'(lambda (line) |
710 `(progn | 705 (concat " :" line "\n")) |
711 (insert ,obj) | 706 lines)) |
712 (point))) | 707 |
713 (add-prefix (lines) | 708 (defun occur-engine (regexp buffers out-buf nlines case-fold-search |
714 `(mapcar | 709 title-face prefix-face match-face keep-props) |
715 #'(lambda (line) | 710 (with-current-buffer out-buf |
716 (concat " :" line "\n")) | 711 (setq buffer-read-only nil) |
717 ,lines))) | 712 (let ((globalcount 0)) |
718 (defun occur-engine (regexp buffers out-buf nlines case-fold-search | 713 ;; Map over all the buffers |
719 title-face prefix-face match-face keep-props) | 714 (dolist (buf buffers) |
720 (with-current-buffer out-buf | 715 (when (buffer-live-p buf) |
721 (setq buffer-read-only nil) | 716 (let ((matches 0) ;; count of matched lines |
722 (let ((globalcount 0)) | 717 (lines 1) ;; line count |
723 ;; Map over all the buffers | 718 (matchbeg 0) |
724 (dolist (buf buffers) | 719 (matchend 0) |
725 (when (buffer-live-p buf) | 720 (origpt nil) |
726 (let ((c 0) ;; count of matched lines | 721 (begpt nil) |
727 (l 1) ;; line count | 722 (endpt nil) |
728 (matchbeg 0) | 723 (marker nil) |
729 (matchend 0) | 724 (curstring "") |
730 (origpt nil) | 725 (headerpt (with-current-buffer out-buf (point)))) |
731 (begpt nil) | 726 (save-excursion |
732 (endpt nil) | 727 (set-buffer buf) |
733 (marker nil) | |
734 (curstring "") | |
735 (headerpt (with-current-buffer out-buf (point)))) | |
736 (save-excursion | 728 (save-excursion |
737 (set-buffer buf) | 729 (goto-char (point-min)) ;; begin searching in the buffer |
738 (save-excursion | 730 (while (not (eobp)) |
739 (goto-char (point-min)) ;; begin searching in the buffer | 731 (setq origpt (point)) |
740 (while (not (eobp)) | 732 (when (setq endpt (re-search-forward regexp nil t)) |
741 (setq origpt (point)) | 733 (setq matches (1+ matches)) ;; increment match count |
742 (when (setq endpt (re-search-forward regexp nil t)) | 734 (setq globalcount (1+ globalcount)) |
743 (incf c) ;; increment match count | 735 (setq matchbeg (match-beginning 0) |
744 (incf globalcount) | 736 matchend (match-end 0)) |
745 (setq matchbeg (match-beginning 0) | 737 (setq begpt (save-excursion |
746 matchend (match-end 0)) | 738 (goto-char matchbeg) |
747 (setq begpt (save-excursion | 739 (line-beginning-position))) |
748 (goto-char matchbeg) | 740 (setq lines (+ lines (1- (count-lines origpt endpt)))) |
749 (line-beginning-position))) | 741 (setq marker (make-marker)) |
750 (incf l (1- (count-lines origpt endpt))) | 742 (set-marker marker matchbeg) |
751 (setq marker (make-marker)) | 743 (setq curstring (buffer-substring begpt |
752 (set-marker marker matchbeg) | 744 (line-end-position))) |
753 (setq curstring (buffer-substring begpt | 745 ;; Depropertize the string, and maybe |
754 (line-end-position))) | 746 ;; highlight the matches |
755 ;; Depropertize the string, and maybe | 747 (let ((len (length curstring)) |
756 ;; highlight the matches | 748 (start 0)) |
757 (let ((len (length curstring)) | 749 (unless keep-props |
758 (start 0)) | 750 (set-text-properties 0 len nil curstring)) |
759 (unless keep-props | 751 (while (and (< start len) |
760 (set-text-properties 0 len nil curstring)) | 752 (string-match regexp curstring start)) |
761 (while (and (< start len) | 753 (add-text-properties (match-beginning 0) |
762 (string-match regexp curstring start)) | 754 (match-end 0) |
763 (add-text-properties (match-beginning 0) | 755 (append |
764 (match-end 0) | 756 '(occur-match t) |
765 (append | 757 (when match-face |
766 '(occur-match t) | 758 `(face ,match-face))) |
767 (when match-face | 759 curstring) |
768 `(face ,match-face))) | 760 (setq start (match-end 0)))) |
769 curstring) | 761 ;; Generate the string to insert for this match |
770 (setq start (match-end 0)))) | 762 (let* ((out-line |
771 ;; Generate the string to insert for this match | 763 (concat |
772 (let* ((out-line | 764 (apply #'propertize (format "%6d:" lines) |
773 (concat | 765 (append |
774 (apply #'propertize (format "%6d:" l) | 766 (when prefix-face |
775 (append | 767 `(face prefix-face)) |
776 (when prefix-face | 768 '(occur-prefix t))) |
777 `(face prefix-face)) | 769 curstring |
778 '(occur-prefix t))) | 770 "\n")) |
779 curstring | 771 (data |
780 "\n")) | 772 (if (= nlines 0) |
781 (data | 773 ;; The simple display style |
782 (if (= nlines 0) | 774 out-line |
783 ;; The simple display style | 775 ;; The complex multi-line display |
784 out-line | 776 ;; style. Generate a list of lines, |
785 ;; The complex multi-line display | 777 ;; concatenate them all together. |
786 ;; style. Generate a list of lines, | 778 (apply #'concat |
787 ;; concatenate them all together. | 779 (nconc |
788 (apply #'concat | 780 (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ nlines)) t)))) |
789 (nconc | 781 (list out-line) |
790 (add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ nlines)) t)))) | 782 (occur-engine-add-prefix (cdr (occur-accumulate-lines (1+ nlines) t)))))))) |
791 (list out-line) | 783 ;; Actually insert the match display data |
792 (add-prefix (cdr (occur-accumulate-lines (1+ nlines) t)))))))) | 784 (with-current-buffer out-buf |
793 ;; Actually insert the match display data | 785 (let ((beg (point)) |
794 (with-current-buffer out-buf | 786 (end (progn (insert data) (point)))) |
795 (let ((beg (point)) | 787 (unless (= nlines 0) |
796 (end (insert-get-point data))) | 788 (insert "-------\n")) |
797 (unless (= nlines 0) | 789 (add-text-properties |
798 (insert-get-point "-------\n")) | 790 beg (1- end) |
799 (add-text-properties | 791 `(occur-target ,marker |
800 beg (1- end) | 792 mouse-face highlight help-echo |
801 `(occur-target ,(cons buf marker) | 793 "mouse-2: go to this occurrence"))))) |
802 mouse-face highlight help-echo | 794 (goto-char endpt)) |
803 "mouse-2: go to this occurrence"))))) | 795 (setq lines (1+ lines)) |
804 (goto-char endpt)) | 796 ;; On to the next match... |
805 (incf l) | 797 (forward-line 1)))) |
806 ;; On to the next match... | 798 (when (not (zerop matches)) ;; is the count zero? |
807 (forward-line 1)))) | 799 (with-current-buffer out-buf |
808 (when (not (zerop c)) ;; is the count zero? | 800 (goto-char headerpt) |
809 (with-current-buffer out-buf | 801 (let ((beg (point)) |
810 (goto-char headerpt) | 802 end) |
811 (let ((beg (point)) | 803 (insert (format "%d lines matching \"%s\" in buffer: %s\n" |
812 (end (insert-get-point | 804 matches regexp (buffer-name buf))) |
813 (format "%d lines matching \"%s\" in buffer: %s\n" | 805 (setq end (point)) |
814 c regexp (buffer-name buf))))) | 806 (add-text-properties beg end |
815 (add-text-properties beg end | 807 (append |
816 (append | 808 (when title-face |
817 (when title-face | 809 `(face ,title-face)) |
818 `(face ,title-face)) | 810 `(occur-title ,buf)))) |
819 `(occur-title ,buf)))) | 811 (goto-char (point-min))))))) |
820 (goto-char (point-min))))))) | 812 ;; Return the number of matches |
821 ;; Return the number of matches | 813 globalcount))) |
822 globalcount)))) | |
823 | 814 |
824 (defun occur-fontify-on-property (prop face beg end) | 815 (defun occur-fontify-on-property (prop face beg end) |
825 (let ((prop-beg (or (and (get-text-property (point) prop) (point)) | 816 (let ((prop-beg (or (and (get-text-property (point) prop) (point)) |
826 (next-single-property-change (point) prop nil end)))) | 817 (next-single-property-change (point) prop nil end)))) |
827 (when (and prop-beg (not (= prop-beg end))) | 818 (when (and prop-beg (not (= prop-beg end))) |