Mercurial > hg > xemacs-beta

comparison lisp/replace.el @ 3000:5df5ea55d3fc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-10-18 20:49:41 by malcolmp] Sync of occur mode with GNU Emacs 22.0.50.1 (CVS)
author malcolmp
date Tue, 18 Oct 2005 20:49:43 +0000
parents 16738b49b833
children f00192e1cd49 308d34e9f07d
comparison
equal deleted inserted replaced
2999:77dd8b943765 3000:5df5ea55d3fc
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 22 ;; Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; 02111-1307, USA. 23 ;; Boston, MA 02110-1301, USA.
24 24
25 ;;; Synched up with: FSF 19.34 [Partially]. 25 ;;; Synched up with: FSF 19.34 [Partially].
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
453 (forward-char 1) 453 (forward-char 1)
454 (setq count (1+ count)))) 454 (setq count (1+ count))))
455 (message "%d occurrences" count))))) 455 (message "%d occurrences" count)))))
456 456
457 457
458 (defvar occur-mode-map ()) 458 ;;; occur code moved to occur.el
459 (if occur-mode-map
460 ()
461 (setq occur-mode-map (make-sparse-keymap))
462 (set-keymap-name occur-mode-map 'occur-mode-map) ; XEmacs
463 (define-key occur-mode-map 'button2 'occur-mode-mouse-goto) ; XEmacs
464 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence)
465 (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence))
466
467 (defvar occur-buffer nil)
468 (defvar occur-nlines nil)
469 (defvar occur-pos-list nil)
470
471 (defun occur-mode ()
472 "Major mode for output from \\[occur].
473 \\<occur-mode-map>Move point to one of the items in this buffer, then use
474 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
475 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
476
477 \\{occur-mode-map}"
478 (kill-all-local-variables)
479 (use-local-map occur-mode-map)
480 (setq major-mode 'occur-mode)
481 (setq mode-name (gettext "Occur")) ; XEmacs
482 (make-local-variable 'occur-buffer)
483 (make-local-variable 'occur-nlines)
484 (make-local-variable 'occur-pos-list)
485 (require 'mode-motion) ; XEmacs
486 (setq mode-motion-hook 'mode-motion-highlight-line) ; XEmacs
487 (run-hooks 'occur-mode-hook))
488
489 ;; FSF Version of next function:
490 ; (let (buffer pos)
491 ; (save-excursion
492 ; (set-buffer (window-buffer (posn-window (event-end event))))
493 ; (save-excursion
494 ; (goto-char (posn-point (event-end event)))
495 ; (setq pos (occur-mode-find-occurrence))
496 ; (setq buffer occur-buffer)))
497 ; (pop-to-buffer buffer)
498 ; (goto-char (marker-position pos))))
499
500 (defun occur-mode-mouse-goto (event)
501 "Go to the occurrence highlighted by mouse.
502 This function should be bound to a mouse key in the `*Occur*' buffer."
503 (interactive "e")
504 (let ((window-save (selected-window))
505 (frame-save (selected-frame)))
506 ;; preserve the window/frame setup
507 (unwind-protect
508 (progn
509 (mouse-set-point event)
510 (occur-mode-goto-occurrence))
511 (select-frame frame-save)
512 (select-window window-save))))
513
514 ;; Called occur-mode-find-occurrence in FSF
515 (defun occur-mode-goto-occurrence ()
516 "Go to the occurrence the current line describes."
517 (interactive)
518 (if (or (null occur-buffer)
519 (null (buffer-name occur-buffer)))
520 (progn
521 (setq occur-buffer nil
522 occur-pos-list nil)
523 (error "Buffer in which occurrences were found is deleted")))
524 (let* ((line-count
525 (count-lines (point-min)
526 (save-excursion
527 (beginning-of-line)
528 (point))))
529 (occur-number (save-excursion
530 (beginning-of-line)
531 (/ (1- line-count)
532 (cond ((< occur-nlines 0)
533 (- 2 occur-nlines))
534 ((> occur-nlines 0)
535 (+ 2 (* 2 occur-nlines)))
536 (t 1)))))
537 (pos (nth occur-number occur-pos-list))
538 ;; removed t arg from Bob Weiner, 10/6/95
539 (window (get-buffer-window occur-buffer))
540 (occur-source-buffer occur-buffer))
541 (if (< line-count 1)
542 (error "No occurrence on this line"))
543 (or pos
544 (error "No occurrence on this line"))
545 ;; XEmacs: don't raise window unless it isn't visible
546 ;; allow for the possibility that the occur buffer is on another frame
547 (or (and window
548 (window-live-p window)
549 (frame-visible-p (window-frame window))
550 (set-buffer occur-source-buffer))
551 (and (pop-to-buffer occur-source-buffer)
552 (setq window (get-buffer-window occur-source-buffer))))
553 (goto-char pos)
554 (set-window-point window pos)))
555
556
557 (defvar list-matching-lines-default-context-lines 0
558 "*Default number of context lines to include around a `list-matching-lines'
559 match. A negative number means to include that many lines before the match.
560 A positive number means to include that many lines both before and after.")
561
562 ;; XEmacs addition
563 ;;; Damn you Jamie, this is utter trash.
564 (defvar list-matching-lines-whole-buffer t
565 "If t, occur operates on whole buffer, otherwise occur starts from point.
566 default is t.")
567
568 (define-function 'occur 'list-matching-lines)
569 (defun list-matching-lines (regexp &optional nlines)
570 "Show all lines in the current buffer containing a match for REGEXP.
571
572 If a match spreads across multiple lines, all those lines are shown.
573
574 If variable `list-matching-lines-whole-buffer' is non-nil, the entire
575 buffer is searched, otherwise search begins at point.
576
577 Each line is displayed with NLINES lines before and after, or -NLINES
578 before if NLINES is negative.
579 NLINES defaults to `list-matching-lines-default-context-lines'.
580 Interactively it is the prefix arg.
581
582 The lines are shown in a buffer named `*Occur*'.
583 It serves as a menu to find any of the occurrences in this buffer.
584 \\[describe-mode] in that buffer will explain how."
585 (interactive
586 ;; XEmacs change
587 (list (let* ((default (or (symbol-near-point)
588 (and regexp-history
589 (car regexp-history))))
590 (minibuffer-history-minimum-string-length 0)
591 (input
592 (if default
593 ;; rewritten for I18N3 snarfing
594 (read-from-minibuffer
595 (format "List lines matching regexp (default `%s'): "
596 default) nil nil nil 'regexp-history nil
597 default)
598 (read-from-minibuffer
599 "List lines matching regexp: "
600 nil nil nil
601 'regexp-history))))
602 (if (and (equal input "") default)
603 (progn
604 (setq input default)
605 (setcar regexp-history default)))
606 ;; clear extra entries
607 (setcdr regexp-history (delete (car regexp-history)
608 (cdr regexp-history)))
609 input)
610 current-prefix-arg))
611 (if (equal regexp "")
612 (error "Must pass non-empty regexp to `list-matching-lines'"))
613 (setq nlines (if nlines (prefix-numeric-value nlines)
614 list-matching-lines-default-context-lines))
615 (let ((first t)
616 (dir default-directory)
617 (buffer (current-buffer))
618 (linenum 1)
619 (prevpos (point-min))
620 ;; The rest of this function is very different from FSF.
621 ;; Presumably that's due to Jamie's misfeature
622 (final-context-start (make-marker)))
623 (if (not list-matching-lines-whole-buffer)
624 (save-excursion
625 (beginning-of-line)
626 (setq linenum (1+ (count-lines (point-min) (point))))
627 (setq prevpos (point))))
628 (with-output-to-temp-buffer "*Occur*"
629 (save-excursion
630 (set-buffer standard-output)
631 (setq default-directory dir)
632 ;; We will insert the number of lines, and "lines", later.
633 ;; #### Needs fixing for I18N3
634 (let ((print-escape-newlines t))
635 (insert (format " matching %s in buffer %s.\n"
636 regexp (buffer-name buffer))))
637 (occur-mode)
638 (setq occur-buffer buffer)
639 (setq occur-nlines nlines)
640 (setq occur-pos-list ()))
641 (if (eq buffer standard-output)
642 (goto-char (point-max)))
643 (with-interactive-search-caps-disable-folding regexp t
644 (save-excursion
645 (if list-matching-lines-whole-buffer
646 (beginning-of-buffer))
647 (message "Searching for %s ..." regexp)
648 ;; Find next match, but give up if prev match was at end of buffer.
649 (while (and (not (= prevpos (point-max)))
650 (re-search-forward regexp nil t))
651 (goto-char (match-beginning 0))
652 (beginning-of-line)
653 (save-match-data
654 (setq linenum (+ linenum (count-lines prevpos (point)))))
655 (setq prevpos (point))
656 (goto-char (match-end 0))
657 (let* ((start (save-excursion
658 (goto-char (match-beginning 0))
659 (forward-line (if (< nlines 0) nlines (- nlines)))
660 (point)))
661 (end (save-excursion
662 (goto-char (match-end 0))
663 (if (> nlines 0)
664 (forward-line (1+ nlines))
665 (forward-line 1))
666 (point)))
667 (tag (format "%5d" linenum))
668 (empty (make-string (length tag) ?\ ))
669 tem)
670 (save-excursion
671 (setq tem (make-marker))
672 (set-marker tem (point))
673 (set-buffer standard-output)
674 (setq occur-pos-list (cons tem occur-pos-list))
675 (or first (zerop nlines)
676 (insert "--------\n"))
677 (setq first nil)
678 (insert-buffer-substring buffer start end)
679 (set-marker final-context-start
680 (- (point) (- end (match-end 0))))
681 (backward-char (- end start))
682 (setq tem (if (< nlines 0) (- nlines) nlines))
683 (while (> tem 0)
684 (insert empty ?:)
685 (forward-line 1)
686 (setq tem (1- tem)))
687 (let ((this-linenum linenum))
688 (while (< (point) final-context-start)
689 (if (null tag)
690 (setq tag (format "%5d" this-linenum)))
691 (insert tag ?:)
692 ;; FSFmacs --
693 ;; we handle this using mode-motion-highlight-line, above.
694 ;; (put-text-property (save-excursion
695 ;; (beginning-of-line)
696 ;; (point))
697 ;; (save-excursion
698 ;; (end-of-line)
699 ;; (point))
700 ;; 'mouse-face 'highlight)
701 (forward-line 1)
702 (setq tag nil)
703 (setq this-linenum (1+ this-linenum)))
704 (while (<= (point) final-context-start)
705 (insert empty ?:)
706 (forward-line 1)
707 (setq this-linenum (1+ this-linenum))))
708 (while (< tem nlines)
709 (insert empty ?:)
710 (forward-line 1)
711 (setq tem (1+ tem)))
712 (goto-char (point-max)))
713 (forward-line 1)))
714 (set-buffer standard-output)
715 ;; Put positions in increasing order to go with buffer.
716 (setq occur-pos-list (nreverse occur-pos-list))
717 (goto-char (point-min))
718 (if (= (length occur-pos-list) 1)
719 (insert "1 line")
720 (insert (format "%d lines" (length occur-pos-list))))
721 (if (interactive-p)
722 (message "%d matching lines." (length occur-pos-list))))))))
723 459
724 ;; It would be nice to use \\[...], but there is no reasonable way 460 ;; It would be nice to use \\[...], but there is no reasonable way
725 ;; to make that display both SPC and Y. 461 ;; to make that display both SPC and Y.
726 (defconst query-replace-help 462 (defconst query-replace-help
727 "Type Space or `y' to replace one match, Delete or `n' to skip to next, 463 "Type Space or `y' to replace one match, Delete or `n' to skip to next,