diff options
-rw-r--r-- | lisp/cedet/semantic/symref/cscope.el | 12 | ||||
-rw-r--r-- | lisp/cedet/semantic/symref/global.el | 10 | ||||
-rw-r--r-- | lisp/cedet/semantic/symref/grep.el | 11 | ||||
-rw-r--r-- | lisp/cedet/semantic/symref/idutils.el | 12 | ||||
-rw-r--r-- | lisp/emacs-lisp/autoload.el | 42 | ||||
-rw-r--r-- | lisp/progmodes/xref.el | 140 | ||||
-rw-r--r-- | src/doc.c | 25 | ||||
-rw-r--r-- | src/xwidget.c | 26 |
8 files changed, 168 insertions, 110 deletions
diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el index 4890b5b5755..3abd8b3f51c 100644 --- a/lisp/cedet/semantic/symref/cscope.el +++ b/lisp/cedet/semantic/symref/cscope.el @@ -60,6 +60,9 @@ See the function `cedet-cscope-search' for more details.") (semantic-symref-parse-tool-output tool b) )) +(defconst semantic-symref-cscope--line-re + "^\\([^ ]+\\) [^ ]+ \\([0-9]+\\) ") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -78,8 +81,13 @@ Moves cursor to end of the match." ;; We have to return something at this point. subtxt))) ) - (t - (when (re-search-forward "^\\([^ ]+\\) [^ ]+ \\([0-9]+\\) " nil t) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-cscope--line-re nil t) + (list (string-to-number (match-string 2)) + (expand-file-name (match-string 1)) + (buffer-substring-no-properties (point) (line-end-position))))) + (t ; :resulttype is 'line + (when (re-search-forward semantic-symref-cscope--line-re nil t) (cons (string-to-number (match-string 2)) (expand-file-name (match-string 1))) )))) diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el index e4c114e9c89..a33427e93a6 100644 --- a/lisp/cedet/semantic/symref/global.el +++ b/lisp/cedet/semantic/symref/global.el @@ -49,6 +49,9 @@ See the function `cedet-gnu-global-search' for more details.") (semantic-symref-parse-tool-output tool b) )) +(defconst semantic-symref-global--line-re + "^\\([^ ]+\\) +\\([0-9]+\\) \\([^ ]+\\) ") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -57,8 +60,13 @@ Moves cursor to end of the match." ;; Search for files (when (re-search-forward "^\\([^\n]+\\)$" nil t) (match-string 1))) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-global--line-re nil t) + (list (string-to-number (match-string 2)) + (match-string 3) + (buffer-substring-no-properties (point) (line-end-position))))) (t - (when (re-search-forward "^\\([^ ]+\\) +\\([0-9]+\\) \\([^ ]+\\) " nil t) + (when (re-search-forward semantic-symref-global--line-re nil t) (cons (string-to-number (match-string 2)) (match-string 3)) )))) diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 5d1fea8c829..36e97da818d 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -50,6 +50,7 @@ and those hits returned.") "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile") (perl-mode "*.pl" "*.PL") (cperl-mode "*.pl" "*.PL") + (lisp-interaction-mode "*.el" "*.ede" ".emacs" "_emacs") ) "List of major modes and file extension pattern. See find -name man page for format.") @@ -188,6 +189,9 @@ This shell should support pipe redirect syntax." ;; Return the answer ans)) +(defconst semantic-symref-grep--line-re + "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -195,8 +199,13 @@ Moves cursor to end of the match." ;; Search for files (when (re-search-forward "^\\([^\n]+\\)$" nil t) (match-string 1))) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-grep--line-re nil t) + (list (string-to-number (match-string 2)) + (match-string 1) + (buffer-substring-no-properties (point) (line-end-position))))) (t - (when (re-search-forward "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):" nil t) + (when (re-search-forward semantic-symref-grep--line-re nil t) (cons (string-to-number (match-string 2)) (match-string 1)) )))) diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el index 4127d7ae4ea..db3e9a0dddb 100644 --- a/lisp/cedet/semantic/symref/idutils.el +++ b/lisp/cedet/semantic/symref/idutils.el @@ -49,6 +49,9 @@ See the function `cedet-idutils-search' for more details.") (semantic-symref-parse-tool-output tool b) )) +(defconst semantic-symref-idutils--line-re + "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):") + (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." @@ -59,8 +62,13 @@ Moves cursor to end of the match." ((eq (oref tool :searchtype) 'tagcompletions) (when (re-search-forward "^\\([^ ]+\\) " nil t) (match-string 1))) - (t - (when (re-search-forward "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):" nil t) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward semantic-symref-idutils--line-re nil t) + (list (string-to-number (match-string 2)) + (expand-file-name (match-string 1) default-directory) + (buffer-substring-no-properties (point) (line-end-position))))) + (t ; resulttype is line + (when (re-search-forward semantic-symref-idutils--line-re nil t) (cons (string-to-number (match-string 2)) (expand-file-name (match-string 1) default-directory)) )))) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 14e584df672..1b06fb6a51d 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -251,22 +251,9 @@ If a buffer is visiting the desired autoload file, return it." (enable-local-eval nil)) ;; We used to use `raw-text' to read this file, but this causes ;; problems when the file contains non-ASCII characters. - (let* ((delay-mode-hooks t) - (file (autoload-generated-file)) - (file-missing (not (file-exists-p file)))) - (when file-missing - (autoload-ensure-default-file file)) - (with-current-buffer - (find-file-noselect - (autoload-ensure-file-writeable - file)) - ;; block backups when the file has just been created, since - ;; the backups will just be the auto-generated headers. - ;; bug#23203 - (when file-missing - (setq buffer-backed-up t) - (save-buffer)) - (current-buffer))))) + (let ((delay-mode-hooks t)) + (find-file-noselect + (autoload-ensure-default-file (autoload-generated-file)))))) (defun autoload-generated-file () (expand-file-name generated-autoload-file @@ -387,22 +374,21 @@ not be relied upon." ;;;###autoload (put 'autoload-ensure-writable 'risky-local-variable t) -(defun autoload-ensure-file-writeable (file) - ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, - ;; which was designed to handle CVSREAD=1 and equivalent. - (and autoload-ensure-writable - (let ((modes (file-modes file))) - (if (zerop (logand modes #o0200)) - ;; Ignore any errors here, and let subsequent attempts - ;; to write the file raise any real error. - (ignore-errors (set-file-modes file (logior modes #o0200)))))) - file) - (defun autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists, creating it if needed. If the file already exists and `autoload-ensure-writable' is non-nil, make it writable." - (write-region (autoload-rubric file) nil file)) + (if (file-exists-p file) + ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, + ;; which was designed to handle CVSREAD=1 and equivalent. + (and autoload-ensure-writable + (let ((modes (file-modes file))) + (if (zerop (logand modes #o0200)) + ;; Ignore any errors here, and let subsequent attempts + ;; to write the file raise any real error. + (ignore-errors (set-file-modes file (logior modes #o0200)))))) + (write-region (autoload-rubric file) nil file)) + file) (defun autoload-insert-section-header (outbuf autoloads load-name file time) "Insert the section-header line, diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index feed0fb36d9..f674c70b104 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -839,16 +839,16 @@ and just use etags." (kill-local-variable 'xref-backend-functions)) (setq-local xref-backend-functions xref-etags-mode--saved))) -(declare-function semantic-symref-find-references-by-name "semantic/symref") -(declare-function semantic-find-file-noselect "semantic/fw") +(declare-function semantic-symref-instantiate "semantic/symref") +(declare-function semantic-symref-perform-search "semantic/symref") (declare-function grep-expand-template "grep") (defvar ede-minor-mode) ;; ede.el (defun xref-collect-references (symbol dir) "Collect references to SYMBOL inside DIR. This function uses the Semantic Symbol Reference API, see -`semantic-symref-find-references-by-name' for details on which -tools are used, and when." +`semantic-symref-tool-alist' for details on which tools are used, +and when." (cl-assert (directory-name-p dir)) (require 'semantic/symref) (defvar semantic-symref-tool) @@ -859,19 +859,19 @@ tools are used, and when." ;; to force the backend to use `default-directory'. (let* ((ede-minor-mode nil) (default-directory dir) + ;; FIXME: Remove CScope and Global from the recognized tools? + ;; The current implementations interpret the symbol search as + ;; "find all calls to the given function", but not function + ;; definition. And they return nothing when passed a variable + ;; name, even a global one. (semantic-symref-tool 'detect) (case-fold-search nil) - (res (semantic-symref-find-references-by-name symbol 'subdirs)) - (hits (and res (oref res hit-lines))) - (orig-buffers (buffer-list))) - (unwind-protect - (cl-mapcan (lambda (hit) (xref--collect-matches - hit (format "\\_<%s\\_>" (regexp-quote symbol)))) - hits) - ;; TODO: Implement "lightweight" buffer visiting, so that we - ;; don't have to kill them. - (mapc #'kill-buffer - (cl-set-difference (buffer-list) orig-buffers))))) + (inst (semantic-symref-instantiate :searchfor symbol + :searchtype 'symbol + :searchscope 'subdirs + :resulttype 'line-and-text))) + (xref--convert-hits (semantic-symref-perform-search inst) + (format "\\_<%s\\_>" (regexp-quote symbol))))) ;;;###autoload (defun xref-collect-matches (regexp files dir ignores) @@ -890,34 +890,19 @@ IGNORES is a list of glob patterns." files (expand-file-name dir) ignores)) - (orig-buffers (buffer-list)) (buf (get-buffer-create " *xref-grep*")) (grep-re (caar grep-regexp-alist)) - (counter 0) - reporter hits) (with-current-buffer buf (erase-buffer) (call-process-shell-command command nil t) (goto-char (point-min)) (while (re-search-forward grep-re nil t) - (push (cons (string-to-number (match-string 2)) - (match-string 1)) + (push (list (string-to-number (match-string 2)) + (match-string 1) + (buffer-substring-no-properties (point) (line-end-position))) hits))) - (setq reporter (make-progress-reporter - (format "Collecting search results...") - 0 (length hits))) - (unwind-protect - (cl-mapcan (lambda (hit) - (prog1 - (progress-reporter-update reporter counter) - (cl-incf counter)) - (xref--collect-matches hit regexp)) - (nreverse hits)) - (progress-reporter-done reporter) - ;; TODO: Same as above. - (mapc #'kill-buffer - (cl-set-difference (buffer-list) orig-buffers))))) + (xref--convert-hits hits regexp))) (defun xref--rgrep-command (regexp files dir ignores) (require 'find-dired) ; for `find-name-arg' @@ -980,30 +965,71 @@ directory, used as the root of the ignore globs." (match-string 1 str))))) str t t)) -(defun xref--collect-matches (hit regexp) - (pcase-let* ((`(,line . ,file) hit) - (buf (or (find-buffer-visiting file) - (semantic-find-file-noselect file)))) - (with-current-buffer buf - (save-excursion +(defvar xref--last-visiting-buffer nil) +(defvar xref--temp-buffer-file-name nil) + +(defun xref--convert-hits (hits regexp) + (let (xref--last-visiting-buffer + (tmp-buffer (generate-new-buffer " *xref-temp*"))) + (unwind-protect + (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp tmp-buffer)) + hits) + (kill-buffer tmp-buffer)))) + +(defun xref--collect-matches (hit regexp tmp-buffer) + (pcase-let* ((`(,line ,file ,text) hit) + (buf (xref--find-buffer-visiting file))) + (if buf + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (xref--collect-matches-1 regexp file line + (line-beginning-position) + (line-end-position)))) + ;; Using the temporary buffer is both a performance and a buffer + ;; management optimization. + (with-current-buffer tmp-buffer + (erase-buffer) + (unless (equal file xref--temp-buffer-file-name) + (insert-file-contents file nil 0 200) + ;; Can't (setq-local delay-mode-hooks t) because of + ;; bug#23272, but the performance penalty seems minimal. + (let ((buffer-file-name file) + (inhibit-message t) + message-log-max) + (ignore-errors + (set-auto-mode t))) + (setq-local xref--temp-buffer-file-name file) + (setq-local inhibit-read-only t) + (erase-buffer)) + (insert text) (goto-char (point-min)) - (forward-line (1- line)) - (let ((line-end (line-end-position)) - (line-beg (line-beginning-position)) - matches) - (syntax-propertize line-end) - ;; FIXME: This results in several lines with the same - ;; summary. Solve with composite pattern? - (while (re-search-forward regexp line-end t) - (let* ((beg-column (- (match-beginning 0) line-beg)) - (end-column (- (match-end 0) line-beg)) - (loc (xref-make-file-location file line beg-column)) - (summary (buffer-substring line-beg line-end))) - (add-face-text-property beg-column end-column 'highlight - t summary) - (push (xref-make-match summary loc (- end-column beg-column)) - matches))) - (nreverse matches)))))) + (xref--collect-matches-1 regexp file line + (point) + (point-max)))))) + +(defun xref--collect-matches-1 (regexp file line line-beg line-end) + (let (matches) + (syntax-propertize line-end) + ;; FIXME: This results in several lines with the same + ;; summary. Solve with composite pattern? + (while (re-search-forward regexp line-end t) + (let* ((beg-column (- (match-beginning 0) line-beg)) + (end-column (- (match-end 0) line-beg)) + (loc (xref-make-file-location file line beg-column)) + (summary (buffer-substring line-beg line-end))) + (add-face-text-property beg-column end-column 'highlight + t summary) + (push (xref-make-match summary loc (- end-column beg-column)) + matches))) + (nreverse matches))) + +(defun xref--find-buffer-visiting (file) + (unless (equal (car xref--last-visiting-buffer) file) + (setq xref--last-visiting-buffer + (cons file (find-buffer-visiting file)))) + (cdr xref--last-visiting-buffer)) (provide 'xref) diff --git a/src/doc.c b/src/doc.c index c5dd8d5a786..e1f508e5014 100644 --- a/src/doc.c +++ b/src/doc.c @@ -34,6 +34,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "coding.h" #include "buffer.h" #include "disptab.h" +#include "intervals.h" #include "keymap.h" /* Buffer used for reading from documentation file. */ @@ -739,6 +740,7 @@ Otherwise, return a new string. */) { char *buf; bool changed = false; + bool nonquotes_changed = false; unsigned char *strp; char *bufp; ptrdiff_t idx; @@ -786,7 +788,7 @@ Otherwise, return a new string. */) { /* \= quotes the next character; thus, to put in \[ without its special meaning, use \=\[. */ - changed = true; + changed = nonquotes_changed = true; strp += 2; if (multibyte) { @@ -946,6 +948,8 @@ Otherwise, return a new string. */) length = SCHARS (tem); length_byte = SBYTES (tem); subst: + nonquotes_changed = true; + subst_quote: changed = true; { ptrdiff_t offset = bufp - buf; @@ -967,7 +971,7 @@ Otherwise, return a new string. */) length = 1; length_byte = sizeof uLSQM - 1; idx = strp - SDATA (string) + 1; - goto subst; + goto subst_quote; } else if (strp[0] == '`' && quoting_style == STRAIGHT_QUOTING_STYLE) { @@ -1003,7 +1007,22 @@ Otherwise, return a new string. */) } if (changed) /* don't bother if nothing substituted */ - tem = make_string_from_bytes (buf, nchars, bufp - buf); + { + tem = make_string_from_bytes (buf, nchars, bufp - buf); + if (!nonquotes_changed) + { + /* Nothing has changed other than quoting, so copy the string’s + text properties. FIXME: Text properties should survive other + changes too. */ + INTERVAL interval_copy = copy_intervals (string_intervals (string), + 0, SCHARS (string)); + if (interval_copy) + { + set_interval_object (interval_copy, tem); + set_string_intervals (tem, interval_copy); + } + } + } else tem = string; xfree (buf); diff --git a/src/xwidget.c b/src/xwidget.c index 7e96307bdd8..82449f7a215 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -580,20 +580,14 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) int text_area_x, text_area_y, text_area_width, text_area_height; - window_box (s->w, - ANY_AREA, - &text_area_x, - &text_area_y, - &text_area_width, - &text_area_height); - clip_right = min (xww->width, - text_area_width); - clip_left = max (0, - text_area_x); - - clip_bottom = min (xww->height, - text_area_height); - clip_top = max (0, text_area_y); + window_box (s->w, TEXT_AREA, &text_area_x, &text_area_y, + &text_area_width, &text_area_height); + clip_left = max (0, text_area_x - x); + clip_right = max (clip_left, + min (xww->width, text_area_x + text_area_width - x)); + clip_top = max (0, text_area_y - y); + clip_bottom = max (clip_top, + min (xww->height, text_area_y + text_area_height - y)); /* We are concerned with movement of the onscreen area. The area might sit still when the widget actually moves. This happens @@ -622,8 +616,8 @@ x_draw_xwidget_glyph_string (struct glyph_string *s) || xv->clip_bottom != clip_bottom || xv->clip_top != clip_top || xv->clip_left != clip_left) { - gtk_widget_set_size_request (xv->widgetwindow, clip_right + clip_left, - clip_bottom + clip_top); + gtk_widget_set_size_request (xv->widgetwindow, clip_right - clip_left, + clip_bottom - clip_top); gtk_fixed_move (GTK_FIXED (xv->widgetwindow), xv->widget, -clip_left, -clip_top); |