On Thu, May 29, 2008 at 12:14:51AM +0800, It's me FKtPp ;) wrote: hi Team, I've composed a patch against this issue, could you please help evaluate it. And if possiable install it? ChangeLog Entry: =============================================================================== 2008-06-09 It's me FKtPp ;) <m_pupil(a)yahoo.com.cn&gt; * occur.el: * occur.el (occur-accumulate-lines): Convert to use #'point-at-b(e)ol built-in functions * occur.el (occur-engine-update-lines): New. always count lines from a bol to anther bol * occur.el (occur-engine): change the lines value calculation method, so that it can deal with multine matches, e.g. `^(def[^()]+)'. Mainly because of the following lines in the (info "(lispref)Syntax of Regexps"). Note that a complement character set can match a newline, unless newline is mentioned as one of the characters not to match. Patch Entry: =============================================================================== core-beta[XEmacs] source patch: Diff command: hg diff -wbB Files affected: lisp/occur.el diff -r 0204391fc17c lisp/occur.el --- lisp/occur.el Wed Jun 04 21:57:49 2008 +0200 +++ lisp/occur.el Mon Jun 09 02:30:24 2008 +0800 ＠＠ -246,8 +246,9 ＠＠ (eobp) (bobp)))) (setq count (+ count (if forwardp -1 1))) - (setq beg (line-beginning-position) - end (line-end-position)) + ;; XEmacs specific line-beginning/end-possion to point-at-b(e)ol conversion + (setq beg (point-at-bol) + end (point-at-eol)) (if (and keep-props (if-boundp 'jit-lock-mode jit-lock-mode) (text-property-not-all beg end 'fontified t)) (if-fboundp 'jit-lock-fontify-now ＠＠ -426,6 +427,19 ＠＠ (concat " :" line "\n")) lines)) +(defsubst occur-engine-update-lines (lines beg end) + "count lines between the BEG and END point position, then add to LINES + +Returns updated LINES value. +NOTE: this is a XEmacs specific inline function." + (save-excursion + (let (beg-bol end-bol) + (goto-char beg) + (setq beg-bol (point-at-bol)) + (goto-char end) + (setq end-bol (point-at-bol)) + (+ lines (count-lines beg-bol end-bol))))) + (defun occur-engine (regexp buffers out-buf nlines case-fold-search title-face prefix-face match-face keep-props) (with-current-buffer out-buf ＠＠ -456,83 +470,96 ＠＠ (goto-char (point-min)) ;; begin searching in the buffer (while (not (eobp)) (setq origpt (point)) - (when (setq endpt (re-search-forward regexp nil t)) - (setq matches (1+ matches)) ;; increment match count - (setq matchbeg (match-beginning 0)) - (setq lines (+ lines (1- (count-lines origpt endpt)))) - (save-excursion - (goto-char matchbeg) - (setq begpt (line-beginning-position) - endpt (line-end-position))) - (setq marker (make-marker)) - (set-marker marker matchbeg) - (if (and keep-props - (if-boundp 'jit-lock-mode jit-lock-mode) - (text-property-not-all begpt endpt 'fontified t)) - (if-fboundp #'jit-lock-fontify-now - (jit-lock-fontify-now begpt endpt))) - (setq curstring (buffer-substring begpt endpt)) - ;; Depropertize the string, and maybe - ;; highlight the matches - (let ((len (length curstring)) - (start 0)) - (unless keep-props - (set-text-properties 0 len nil curstring)) - (while (and (< start len) - (string-match regexp curstring start)) - (add-text-properties - (match-beginning 0) (match-end 0) - (append - `(occur-match t) - (when match-face - ;; Use `face' rather than `font-lock-face' here - ;; so as to override faces copied from the buffer. - `(face ,match-face))) - curstring) - (setq start (match-end 0)))) - ;; Generate the string to insert for this match - (let* ((out-line - (concat - ;; Using 7 digits aligns tabs properly. - (apply #'propertize (format "%7d:" lines) - (append - (when prefix-face - `(font-lock-face prefix-face)) - '(occur-prefix t))) - ;; We don't put `mouse-face' on the newline, - ;; because that loses. And don't put it - ;; on context lines to reduce flicker. - (propertize curstring 'mouse-face 'highlight) - "\n")) - (data - (if (= nlines 0) - ;; The simple display style - out-line - ;; The complex multi-line display - ;; style. Generate a list of lines, - ;; concatenate them all together. - (apply #'concat - (nconc - (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props)))) - (list out-line) - (if (> nlines 0) - (occur-engine-add-prefix - (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))) - ;; Actually insert the match display data - (with-current-buffer out-buf - (let ((beg (point)) - (end (progn (insert data) (point)))) - (unless (= nlines 0) - (insert "-------\n")) - (add-text-properties - beg end - `(occur-target ,marker help-echo "mouse-2: go to this occurrence"))))) - (goto-char endpt)) - (if endpt - (progn - (setq lines (1+ lines)) - ;; On to the next match... - (forward-line 1)) + (if (setq endpt (re-search-forward regexp nil t)) + (progn (setq matches (1+ matches) ;; increment match count + matchbeg (match-beginning 0) + matchend endpt + ;; Yes, always count against the + ;; matchbeg to keep the lines value + ;; correct + lines (occur-engine-update-lines lines origpt matchbeg)) + ;; Later the #'occur-accumulate-lines + ;; function will relays current POINT + ;; position to extract correct result, so + ;; we don't do #'save-excursion here + ;; anymore. + (goto-char matchbeg) + ;; XEmacs specific + ;; line-beginning/end-possion to + ;; point-at-b(e)ol conversion. + (setq begpt (point-at-bol) + endpt (point-at-eol)) + (setq marker (make-marker)) + (set-marker marker matchbeg) + (if (and keep-props + (if-boundp 'jit-lock-mode jit-lock-mode) + (text-property-not-all begpt endpt 'fontified t)) + (if-fboundp #'jit-lock-fontify-now + (jit-lock-fontify-now begpt endpt))) + (setq curstring (buffer-substring begpt endpt)) + ;; Depropertize the string, and maybe + ;; highlight the matches + (let ((len (length curstring)) + (start 0)) + (unless keep-props + (set-text-properties 0 len nil curstring)) + (while (and (< start len) + (string-match regexp curstring start)) + (add-text-properties + (match-beginning 0) (match-end 0) + (append + `(occur-match t) + (when match-face + ;; Use `face' rather than `font-lock-face' here + ;; so as to override faces copied from the buffer. + `(face ,match-face))) + curstring) + (setq start (match-end 0)))) + ;; Generate the string to insert for this match + (let* ((out-line + (concat + ;; Using 7 digits aligns tabs properly. + (apply #'propertize (format "%7d:" lines) + (append + (when prefix-face + `(font-lock-face prefix-face)) + '(occur-prefix t))) + ;; We don't put `mouse-face' on the newline, + ;; because that loses. And don't put it + ;; on context lines to reduce flicker. + (propertize curstring 'mouse-face 'highlight) + "\n")) + (data + (if (= nlines 0) + ;; The simple display style + out-line + ;; The complex multi-line display + ;; style. Generate a list of lines, + ;; concatenate them all together. + (apply #'concat + (nconc + (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props)))) + (list out-line) + (if (> nlines 0) + (occur-engine-add-prefix + (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))) + ;; Actually insert the match display data + (with-current-buffer out-buf + (let ((beg (point)) + (end (progn (insert data) (point)))) + (unless (= nlines 0) + (insert "-------\n")) + (add-text-properties + beg end + `(occur-target ,marker help-echo "mouse-2: go to this occurrence"))))) + ;; On to the next match... Here we don't + ;; do the ugly #'forward-line and #'1+ + ;; lines, instead calculate the actual + ;; lines between the matchbeg and + ;; matchend so that it can deal with + ;; multi-line matches. + (goto-char matchend) + (setq lines (occur-engine-update-lines lines matchbeg matchend))) (goto-char (point-max)))))) (when (not (zerop matches)) ;; is the count zero? (setq globalcount (+ globalcount matches)) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches