/[emacs]/emacs/lisp/replace.el
ViewVC logotype

Diff of /emacs/lisp/replace.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.196 by jurta, Thu Dec 16 07:16:17 2004 UTC revision 1.197 by jurta, Thu Dec 16 13:16:30 2004 UTC
# Line 735  Alternatively, click \\[occur-mode-mouse Line 735  Alternatively, click \\[occur-mode-mouse
735  Compatibility function for \\[next-error] invocations."  Compatibility function for \\[next-error] invocations."
736    (interactive "p")    (interactive "p")
737    ;; we need to run occur-find-match from within the Occur buffer    ;; we need to run occur-find-match from within the Occur buffer
738    (with-current-buffer    (with-current-buffer
739        (if (next-error-buffer-p (current-buffer))        (if (next-error-buffer-p (current-buffer))
740            (current-buffer)            (current-buffer)
741          (next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode))))          (next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode))))
742        
743      (when reset      (goto-char (cond (reset (point-min))
744        (goto-char (point-min)))                       ((< argp 0) (line-beginning-position))
745                         ((line-end-position))))
746      (occur-find-match      (occur-find-match
747       (abs (prefix-numeric-value argp))       (abs argp)
748       (if (> 0 (prefix-numeric-value argp))       (if (> 0 argp)
749           #'previous-single-property-change           #'previous-single-property-change
750         #'next-single-property-change)         #'next-single-property-change)
751       "No more matches")       "No more matches")
# Line 790  If the value is nil, don't highlight the Line 791  If the value is nil, don't highlight the
791  (defun occur-accumulate-lines (count &optional keep-props)  (defun occur-accumulate-lines (count &optional keep-props)
792    (save-excursion    (save-excursion
793      (let ((forwardp (> count 0))      (let ((forwardp (> count 0))
794            (result nil))            result beg end)
795        (while (not (or (zerop count)        (while (not (or (zerop count)
796                        (if forwardp                        (if forwardp
797                            (eobp)                            (eobp)
798                          (bobp))))                          (bobp))))
799          (setq count (+ count (if forwardp -1 1)))          (setq count (+ count (if forwardp -1 1)))
800            (setq beg (line-beginning-position)
801                  end (line-end-position))
802            (if (and keep-props font-lock-mode
803                     (text-property-not-all beg end 'fontified t))
804                (font-lock-fontify-region beg end))
805          (push          (push
806           (funcall (if keep-props           (funcall (if keep-props
807                        #'buffer-substring                        #'buffer-substring
808                      #'buffer-substring-no-properties)                      #'buffer-substring-no-properties)
809            (line-beginning-position)                    beg end)
           (line-end-position))  
810           result)           result)
811          (forward-line (if forwardp 1 -1)))          (forward-line (if forwardp 1 -1)))
812        (nreverse result))))        (nreverse result))))
# Line 996  See also `multi-occur'." Line 1001  See also `multi-occur'."
1001                    (when (setq endpt (re-search-forward regexp nil t))                    (when (setq endpt (re-search-forward regexp nil t))
1002                      (setq matches (1+ matches)) ;; increment match count                      (setq matches (1+ matches)) ;; increment match count
1003                      (setq matchbeg (match-beginning 0))                      (setq matchbeg (match-beginning 0))
                     (setq begpt (save-excursion  
                                   (goto-char matchbeg)  
                                   (line-beginning-position)))  
1004                      (setq lines (+ lines (1- (count-lines origpt endpt))))                      (setq lines (+ lines (1- (count-lines origpt endpt))))
1005                        (save-excursion
1006                          (goto-char matchbeg)
1007                          (setq begpt (line-beginning-position)
1008                                endpt (line-end-position)))
1009                      (setq marker (make-marker))                      (setq marker (make-marker))
1010                      (set-marker marker matchbeg)                      (set-marker marker matchbeg)
1011                      (setq curstring (buffer-substring begpt                      (if (and keep-props font-lock-mode
1012                                                        (line-end-position)))                               (text-property-not-all begpt endpt 'fontified t))
1013                            (font-lock-fontify-region begpt endpt))
1014                        (setq curstring (buffer-substring begpt endpt))
1015                      ;; Depropertize the string, and maybe                      ;; Depropertize the string, and maybe
1016                      ;; highlight the matches                      ;; highlight the matches
1017                      (let ((len (length curstring))                      (let ((len (length curstring))
# Line 1012  See also `multi-occur'." Line 1020  See also `multi-occur'."
1020                          (set-text-properties 0 len nil curstring))                          (set-text-properties 0 len nil curstring))
1021                        (while (and (< start len)                        (while (and (< start len)
1022                                    (string-match regexp curstring start))                                    (string-match regexp curstring start))
1023                          (add-text-properties (match-beginning 0)                          (add-text-properties
1024                                               (match-end 0)                           (match-beginning 0) (match-end 0)
1025                                               (append                           (append
1026                                                `(occur-match t)                            `(occur-match t)
1027                                                (when match-face                            (when match-face
1028                                                  ;; Use `face' rather than                              ;; Use `face' rather than `font-lock-face' here
1029                                                  ;; `font-lock-face' here                              ;; so as to override faces copied from the buffer.
1030                                                  ;; so as to override faces                              `(face ,match-face)))
1031                                                  ;; copied from the buffer.                           curstring)
                                                 `(face ,match-face)))  
                                              curstring)  
1032                          (setq start (match-end 0))))                          (setq start (match-end 0))))
1033                      ;; Generate the string to insert for this match                      ;; Generate the string to insert for this match
1034                      (let* ((out-line                      (let* ((out-line
# Line 1033  See also `multi-occur'." Line 1039  See also `multi-occur'."
1039                                       (when prefix-face                                       (when prefix-face
1040                                         `(font-lock-face prefix-face))                                         `(font-lock-face prefix-face))
1041                                       '(occur-prefix t)))                                       '(occur-prefix t)))
1042                               curstring                               ;; We don't put `mouse-face' on the newline,
1043                                 ;; because that loses.  And don't put it
1044                                 ;; on context lines to reduce flicker.
1045                                 (propertize curstring 'mouse-face 'highlight)
1046                               "\n"))                               "\n"))
1047                             (data                             (data
1048                              (if (= nlines 0)                              (if (= nlines 0)
# Line 1057  See also `multi-occur'." Line 1066  See also `multi-occur'."
1066                              (insert "-------\n"))                              (insert "-------\n"))
1067                            (add-text-properties                            (add-text-properties
1068                             beg end                             beg end
1069                             `(occur-target ,marker help-echo "mouse-2: go to this occurrence"))                             `(occur-target ,marker help-echo "mouse-2: go to this occurrence")))))
                           ;; We don't put `mouse-face' on the newline,  
                           ;; because that loses.  
                           (add-text-properties beg (1- end) '(mouse-face highlight)))))  
1070                      (goto-char endpt))                      (goto-char endpt))
1071                    (if endpt                    (if endpt
1072                        (progn                        (progn

Legend:
Removed from v.1.196  
changed lines
  Added in v.1.197

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26