Merge branch 'master' into emacs-25
This commit is contained in:
Dmitry Gutov
commit
f234fc2cb3
9 changed files with 414 additions and 293 deletions
|
|
@ -666,6 +666,22 @@ If command is repeated at same position, delete the rectangle."
|
|||
(setq rect (cons row rect))))))
|
||||
(nreverse rect)))
|
||||
|
||||
(defun cua--extract-rectangle-bounds ()
|
||||
(let (rect)
|
||||
(if (not (cua--rectangle-virtual-edges))
|
||||
(cua--rectangle-operation nil nil nil nil nil ; do not tabify
|
||||
(lambda (s e _l _r)
|
||||
(setq rect (cons (cons s e) rect))))
|
||||
(cua--rectangle-operation nil 1 nil nil nil ; do not tabify
|
||||
(lambda (s e l r _v)
|
||||
(goto-char s)
|
||||
(move-to-column l)
|
||||
(setq s (point))
|
||||
(move-to-column r)
|
||||
(setq e (point))
|
||||
(setq rect (cons (cons s e) rect)))))
|
||||
(nreverse rect)))
|
||||
|
||||
(defun cua--insert-rectangle (rect &optional below paste-column line-count)
|
||||
;; Insert rectangle as insert-rectangle, but don't set mark and exit with
|
||||
;; point at either next to top right or below bottom left corner
|
||||
|
|
@ -1394,6 +1410,8 @@ With prefix arg, indent to that column."
|
|||
|
||||
(add-function :around region-extract-function
|
||||
#'cua--rectangle-region-extract)
|
||||
(add-function :around region-insert-function
|
||||
#'cua--insert-rectangle)
|
||||
(add-function :around redisplay-highlight-region-function
|
||||
#'cua--rectangle-highlight-for-redisplay)
|
||||
|
||||
|
|
@ -1405,8 +1423,12 @@ With prefix arg, indent to that column."
|
|||
|
||||
(defun cua--rectangle-region-extract (orig &optional delete)
|
||||
(cond
|
||||
((not cua--rectangle) (funcall orig delete))
|
||||
((eq delete 'delete-only) (cua--delete-rectangle))
|
||||
((not cua--rectangle)
|
||||
(funcall orig delete))
|
||||
((eq delete 'bounds)
|
||||
(cua--extract-rectangle-bounds))
|
||||
((eq delete 'delete-only)
|
||||
(cua--delete-rectangle))
|
||||
(t
|
||||
(let* ((strs (cua--extract-rectangle))
|
||||
(str (mapconcat #'identity strs "\n")))
|
||||
|
|
|
|||
|
|
@ -228,8 +228,7 @@ Blank lines separate paragraphs. Semicolons start comments.
|
|||
|
||||
\\{emacs-lisp-mode-map}"
|
||||
:group 'lisp
|
||||
(defvar xref-find-function)
|
||||
(defvar xref-identifier-completion-table-function)
|
||||
(defvar xref-backend-functions)
|
||||
(defvar project-library-roots-function)
|
||||
(lisp-mode-variables nil nil 'elisp)
|
||||
(add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
|
||||
|
|
@ -239,9 +238,7 @@ Blank lines separate paragraphs. Semicolons start comments.
|
|||
(setq imenu-case-fold-search nil)
|
||||
(add-function :before-until (local 'eldoc-documentation-function)
|
||||
#'elisp-eldoc-documentation-function)
|
||||
(setq-local xref-find-function #'elisp-xref-find)
|
||||
(setq-local xref-identifier-completion-table-function
|
||||
#'elisp--xref-identifier-completion-table)
|
||||
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
|
||||
(setq-local project-library-roots-function #'elisp-library-roots)
|
||||
(add-hook 'completion-at-point-functions
|
||||
#'elisp-completion-at-point nil 'local))
|
||||
|
|
@ -588,21 +585,7 @@ It can be quoted, or be inside a quoted form."
|
|||
(declare-function xref-make "xref" (summary location))
|
||||
(declare-function xref-collect-references "xref" (symbol dir))
|
||||
|
||||
(defun elisp-xref-find (action id)
|
||||
(require 'find-func)
|
||||
;; FIXME: use information in source near point to filter results:
|
||||
;; (dvc-log-edit ...) - exclude 'feature
|
||||
;; (require 'dvc-log-edit) - only 'feature
|
||||
;; Semantic may provide additional information
|
||||
(pcase action
|
||||
(`definitions
|
||||
(let ((sym (intern-soft id)))
|
||||
(when sym
|
||||
(elisp--xref-find-definitions sym))))
|
||||
(`references
|
||||
(elisp--xref-find-references id))
|
||||
(`apropos
|
||||
(elisp--xref-find-apropos id))))
|
||||
(defun elisp--xref-backend () 'elisp)
|
||||
|
||||
;; WORKAROUND: This is nominally a constant, but the text properties
|
||||
;; are not preserved thru dump if use defconst. See bug#21237.
|
||||
|
|
@ -638,7 +621,17 @@ Each function should return a list of xrefs, or nil; the first
|
|||
non-nil result supercedes the xrefs produced by
|
||||
`elisp--xref-find-definitions'.")
|
||||
|
||||
;; FIXME: name should be singular; match xref-find-definition
|
||||
(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier)
|
||||
(require 'find-func)
|
||||
;; FIXME: use information in source near point to filter results:
|
||||
;; (dvc-log-edit ...) - exclude 'feature
|
||||
;; (require 'dvc-log-edit) - only 'feature
|
||||
;; Semantic may provide additional information
|
||||
;;
|
||||
(let ((sym (intern-soft identifier)))
|
||||
(when sym
|
||||
(elisp--xref-find-definitions sym))))
|
||||
|
||||
(defun elisp--xref-find-definitions (symbol)
|
||||
;; The file name is not known when `symbol' is defined via interactive eval.
|
||||
(let (xrefs)
|
||||
|
|
@ -805,7 +798,7 @@ non-nil result supercedes the xrefs produced by
|
|||
(declare-function project-roots "project")
|
||||
(declare-function project-current "project")
|
||||
|
||||
(defun elisp--xref-find-references (symbol)
|
||||
(cl-defmethod xref-backend-references ((_backend (eql elisp)) symbol)
|
||||
"Find all references to SYMBOL (a string) in the current project."
|
||||
(cl-mapcan
|
||||
(lambda (dir)
|
||||
|
|
@ -815,7 +808,7 @@ non-nil result supercedes the xrefs produced by
|
|||
(project-roots pr)
|
||||
(project-library-roots pr)))))
|
||||
|
||||
(defun elisp--xref-find-apropos (regexp)
|
||||
(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp)
|
||||
(apply #'nconc
|
||||
(let (lst)
|
||||
(dolist (sym (apropos-internal regexp))
|
||||
|
|
@ -832,7 +825,7 @@ non-nil result supercedes the xrefs produced by
|
|||
(facep sym)))
|
||||
'strict))
|
||||
|
||||
(defun elisp--xref-identifier-completion-table ()
|
||||
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp)))
|
||||
elisp--xref-identifier-completion-table)
|
||||
|
||||
(cl-defstruct (xref-elisp-location
|
||||
|
|
|
|||
|
|
@ -2084,17 +2084,12 @@ for \\[find-tag] (which see)."
|
|||
|
||||
(defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p
|
||||
tag-implicit-name-match-p)
|
||||
"Tag order used in `etags-xref-find' to look for definitions.")
|
||||
"Tag order used in `xref-backend-definitions' to look for definitions.")
|
||||
|
||||
;;;###autoload
|
||||
(defun etags-xref-find (action id)
|
||||
(pcase action
|
||||
(`definitions (etags--xref-find-definitions id))
|
||||
(`references (etags--xref-find-references id))
|
||||
(`apropos (etags--xref-find-definitions id t))))
|
||||
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags)))
|
||||
(tags-lazy-completion-table))
|
||||
|
||||
(defun etags--xref-find-references (symbol)
|
||||
;; TODO: Merge together with the Elisp impl.
|
||||
(cl-defmethod xref-backend-references ((_backend (eql etags)) symbol)
|
||||
(cl-mapcan
|
||||
(lambda (dir)
|
||||
(xref-collect-references symbol dir))
|
||||
|
|
@ -2103,6 +2098,12 @@ for \\[find-tag] (which see)."
|
|||
(project-roots pr)
|
||||
(project-library-roots pr)))))
|
||||
|
||||
(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol)
|
||||
(etags--xref-find-definitions symbol))
|
||||
|
||||
(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol)
|
||||
(etags--xref-find-definitions symbol t))
|
||||
|
||||
(defun etags--xref-find-definitions (pattern &optional regexp?)
|
||||
;; This emulates the behaviour of `find-tag-in-order' but instead of
|
||||
;; returning one match at a time all matches are returned as list.
|
||||
|
|
|
|||
|
|
@ -23,14 +23,21 @@
|
|||
;; referencing commands, in particular "find-definition".
|
||||
;;
|
||||
;; Some part of the functionality must be implemented in a language
|
||||
;; dependent way and that's done by defining `xref-find-function',
|
||||
;; `xref-identifier-at-point-function' and
|
||||
;; `xref-identifier-completion-table-function', which see.
|
||||
;; dependent way and that's done by defining an xref backend.
|
||||
;;
|
||||
;; A major mode should make these variables buffer-local first.
|
||||
;; That consists of a constructor function, which should return a
|
||||
;; backend value, and a set of implementations for the generic
|
||||
;; functions:
|
||||
;;
|
||||
;; `xref-find-function' can be called in several ways, see its
|
||||
;; description. It has to operate with "xref" and "location" values.
|
||||
;; `xref-backend-identifier-at-point',
|
||||
;; `xref-backend-identifier-completion-table',
|
||||
;; `xref-backend-definitions', `xref-backend-references',
|
||||
;; `xref-backend-apropos', which see.
|
||||
;;
|
||||
;; A major mode would normally use `add-hook' to add the backend
|
||||
;; constructor to `xref-backend-functions'.
|
||||
;;
|
||||
;; The last three methods operate with "xref" and "location" values.
|
||||
;;
|
||||
;; One would usually call `make-xref' and `xref-make-file-location',
|
||||
;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
|
||||
|
|
@ -38,15 +45,19 @@
|
|||
;; class inheriting from `xref-location' and implementing
|
||||
;; `xref-location-group' and `xref-location-marker'.
|
||||
;;
|
||||
;; There's a special kind of xrefs we call "match xrefs", which
|
||||
;; correspond to search results. For these values,
|
||||
;; `xref-match-length' must be defined, and `xref-location-marker'
|
||||
;; must return the beginning of the match.
|
||||
;;
|
||||
;; Each identifier must be represented as a string. Implementers can
|
||||
;; use string properties to store additional information about the
|
||||
;; identifier, but they should keep in mind that values returned from
|
||||
;; `xref-identifier-completion-table-function' should still be
|
||||
;; `xref-backend-identifier-completion-table' should still be
|
||||
;; distinct, because the user can't see the properties when making the
|
||||
;; choice.
|
||||
;;
|
||||
;; See the functions `etags-xref-find' and `elisp-xref-find' for full
|
||||
;; examples.
|
||||
;; See the etags and elisp-mode implementations for full examples.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -79,8 +90,8 @@ This is typically the filename.")
|
|||
"Return the line number corresponding to the location."
|
||||
nil)
|
||||
|
||||
(cl-defgeneric xref-match-bounds (_item)
|
||||
"Return a cons with columns of the beginning and end of the match."
|
||||
(cl-defgeneric xref-match-length (_item)
|
||||
"Return the length of the match."
|
||||
nil)
|
||||
|
||||
;;;; Commonly needed location classes are defined here:
|
||||
|
|
@ -109,7 +120,7 @@ Line numbers start from 1 and columns from 0.")
|
|||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(beginning-of-line line)
|
||||
(move-to-column column)
|
||||
(forward-char column)
|
||||
(point-marker))))))
|
||||
|
||||
(cl-defmethod xref-location-group ((l xref-file-location))
|
||||
|
|
@ -176,55 +187,60 @@ LOCATION is an `xref-location'."
|
|||
(location :initarg :location
|
||||
:type xref-file-location
|
||||
:reader xref-item-location)
|
||||
(end-column :initarg :end-column))
|
||||
:comment "An xref item describes a reference to a location
|
||||
somewhere.")
|
||||
(length :initarg :length :reader xref-match-length))
|
||||
:comment "A match xref item describes a search result.")
|
||||
|
||||
(cl-defmethod xref-match-bounds ((i xref-match-item))
|
||||
(with-slots (end-column location) i
|
||||
(cons (xref-file-location-column location)
|
||||
end-column)))
|
||||
|
||||
(defun xref-make-match (summary end-column location)
|
||||
(defun xref-make-match (summary location length)
|
||||
"Create and return a new `xref-match-item'.
|
||||
SUMMARY is a short string to describe the xref.
|
||||
END-COLUMN is the match end column number inside SUMMARY.
|
||||
LOCATION is an `xref-location'."
|
||||
(make-instance 'xref-match-item :summary summary :location location
|
||||
:end-column end-column))
|
||||
LOCATION is an `xref-location'.
|
||||
LENGTH is the match length, in characters."
|
||||
(make-instance 'xref-match-item :summary summary
|
||||
:location location :length length))
|
||||
|
||||
|
||||
;;; API
|
||||
|
||||
(declare-function etags-xref-find "etags" (action id))
|
||||
(declare-function tags-lazy-completion-table "etags" ())
|
||||
;; We make the etags backend the default for now, until something
|
||||
;; better comes along.
|
||||
(defvar xref-backend-functions (list #'xref--etags-backend)
|
||||
"Special hook to find the xref backend for the current context.
|
||||
Each functions on this hook is called in turn with no arguments
|
||||
and should return either nil to mean that it is not applicable,
|
||||
or an xref backend, which is a value to be used to dispatch the
|
||||
generic functions.")
|
||||
|
||||
;; For now, make the etags backend the default.
|
||||
(defvar xref-find-function #'etags-xref-find
|
||||
"Function to look for cross-references.
|
||||
It can be called in several ways:
|
||||
(defun xref-find-backend ()
|
||||
(run-hook-with-args-until-success 'xref-backend-functions))
|
||||
|
||||
(definitions IDENTIFIER): Find definitions of IDENTIFIER. The
|
||||
result must be a list of xref objects. If IDENTIFIER contains
|
||||
sufficient information to determine a unique definition, returns
|
||||
only that definition. If there are multiple possible definitions,
|
||||
return all of them. If no definitions can be found, return nil.
|
||||
(defun xref--etags-backend () 'etags)
|
||||
|
||||
(references IDENTIFIER): Find references of IDENTIFIER. The
|
||||
result must be a list of xref objects. If no references can be
|
||||
found, return nil.
|
||||
(cl-defgeneric xref-backend-definitions (backend identifier)
|
||||
"Find definitions of IDENTIFIER.
|
||||
|
||||
(apropos PATTERN): Find all symbols that match PATTERN. PATTERN
|
||||
is a regexp.
|
||||
The result must be a list of xref objects. If IDENTIFIER
|
||||
contains sufficient information to determine a unique definition,
|
||||
return only that definition. If there are multiple possible
|
||||
definitions, return all of them. If no definitions can be found,
|
||||
return nil.
|
||||
|
||||
IDENTIFIER can be any string returned by
|
||||
`xref-identifier-at-point-function', or from the table returned
|
||||
by `xref-identifier-completion-table-function'.
|
||||
`xref-backend-identifier-at-point', or from the table returned by
|
||||
`xref-backend-identifier-completion-table'.
|
||||
|
||||
To create an xref object, call `xref-make'.")
|
||||
|
||||
(defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
|
||||
"Function to get the relevant identifier at point.
|
||||
(cl-defgeneric xref-backend-references (backend identifier)
|
||||
"Find references of IDENTIFIER.
|
||||
The result must be a list of xref objects. If no references can
|
||||
be found, return nil.")
|
||||
|
||||
(cl-defgeneric xref-backend-apropos (backend pattern)
|
||||
"Find all symbols that match PATTERN.
|
||||
PATTERN is a regexp")
|
||||
|
||||
(cl-defgeneric xref-backend-identifier-at-point (_backend)
|
||||
"Return the relevant identifier at point.
|
||||
|
||||
The return value must be a string or nil. nil means no
|
||||
identifier at point found.
|
||||
|
|
@ -232,16 +248,14 @@ identifier at point found.
|
|||
If it's hard to determine the identifier precisely (e.g., because
|
||||
it's a method call on unknown type), the implementation can
|
||||
return a simple string (such as symbol at point) marked with a
|
||||
special text property which `xref-find-function' would recognize
|
||||
and then delegate the work to an external process.")
|
||||
|
||||
(defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
|
||||
"Function that returns the completion table for identifiers.")
|
||||
|
||||
(defun xref-default-identifier-at-point ()
|
||||
special text property which e.g. `xref-backend-definitions' would
|
||||
recognize and then delegate the work to an external process."
|
||||
(let ((thing (thing-at-point 'symbol)))
|
||||
(and thing (substring-no-properties thing))))
|
||||
|
||||
(cl-defgeneric xref-backend-identifier-completion-table (backend)
|
||||
"Returns the completion table for identifiers.")
|
||||
|
||||
|
||||
;;; misc utilities
|
||||
(defun xref--alistify (list key test)
|
||||
|
|
@ -345,22 +359,14 @@ elements is negated."
|
|||
(pcase-let ((`(,beg . ,end)
|
||||
(save-excursion
|
||||
(or
|
||||
(xref--match-buffer-bounds xref--current-item)
|
||||
(let ((length (xref-match-length xref--current-item)))
|
||||
(and length (cons (point) (+ (point) length))))
|
||||
(back-to-indentation)
|
||||
(if (eolp)
|
||||
(cons (line-beginning-position) (1+ (point)))
|
||||
(cons (point) (line-end-position)))))))
|
||||
(pulse-momentary-highlight-region beg end 'next-error)))
|
||||
|
||||
(defun xref--match-buffer-bounds (item)
|
||||
(save-excursion
|
||||
(let ((bounds (xref-match-bounds item)))
|
||||
(when bounds
|
||||
(cons (progn (move-to-column (car bounds))
|
||||
(point))
|
||||
(progn (move-to-column (cdr bounds))
|
||||
(point)))))))
|
||||
|
||||
;; etags.el needs this
|
||||
(defun xref-clear-marker-stack ()
|
||||
"Discard all markers from the marker stack."
|
||||
|
|
@ -487,50 +493,54 @@ WINDOW controls how the buffer is displayed:
|
|||
(progn
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
;; TODO: Check that none of the matches are out of date;
|
||||
;; offer to re-scan otherwise. Note that saving the last
|
||||
;; modification tick won't work, as long as not all of the
|
||||
;; buffers are kept open.
|
||||
(while (setq item (xref--search-property 'xref-item))
|
||||
(when (xref-match-bounds item)
|
||||
(when (xref-match-length item)
|
||||
(save-excursion
|
||||
;; FIXME: Get rid of xref--goto-location, by making
|
||||
;; xref-match-bounds return markers already.
|
||||
(xref--goto-location (xref-item-location item))
|
||||
(let ((bounds (xref--match-buffer-bounds item))
|
||||
(beg (make-marker))
|
||||
(end (make-marker)))
|
||||
(move-marker beg (car bounds))
|
||||
(move-marker end (cdr bounds))
|
||||
(push (cons beg end) pairs)))))
|
||||
(let* ((loc (xref-item-location item))
|
||||
(beg (xref-location-marker loc))
|
||||
(len (xref-match-length item)))
|
||||
;; Perform sanity check first.
|
||||
(xref--goto-location loc)
|
||||
;; FIXME: The check should probably be a generic
|
||||
;; function, instead of the assumption that all
|
||||
;; matches contain the full line as summary.
|
||||
;; TODO: Offer to re-scan otherwise.
|
||||
(unless (equal (buffer-substring-no-properties
|
||||
(line-beginning-position)
|
||||
(line-end-position))
|
||||
(xref-item-summary item))
|
||||
(user-error "Search results out of date"))
|
||||
(push (cons beg len) pairs)))))
|
||||
(setq pairs (nreverse pairs)))
|
||||
(unless pairs (user-error "No suitable matches here"))
|
||||
(xref--query-replace-1 from to pairs))
|
||||
(dolist (pair pairs)
|
||||
(move-marker (car pair) nil)
|
||||
(move-marker (cdr pair) nil)))))
|
||||
(move-marker (car pair) nil)))))
|
||||
|
||||
;; FIXME: Write a nicer UI.
|
||||
(defun xref--query-replace-1 (from to pairs)
|
||||
(let* ((query-replace-lazy-highlight nil)
|
||||
current-pair current-buf
|
||||
current-beg current-len current-buf
|
||||
;; Counteract the "do the next match now" hack in
|
||||
;; `perform-replace'. And still, it'll report that those
|
||||
;; matches were "filtered out" at the end.
|
||||
(isearch-filter-predicate
|
||||
(lambda (beg end)
|
||||
(and current-pair
|
||||
(and current-beg
|
||||
(eq (current-buffer) current-buf)
|
||||
(>= beg (car current-pair))
|
||||
(<= end (cdr current-pair)))))
|
||||
(>= beg current-beg)
|
||||
(<= end (+ current-beg current-len)))))
|
||||
(replace-re-search-function
|
||||
(lambda (from &optional _bound noerror)
|
||||
(let (found)
|
||||
(let (found pair)
|
||||
(while (and (not found) pairs)
|
||||
(setq current-pair (pop pairs)
|
||||
current-buf (marker-buffer (car current-pair)))
|
||||
(setq pair (pop pairs)
|
||||
current-beg (car pair)
|
||||
current-len (cdr pair)
|
||||
current-buf (marker-buffer current-beg))
|
||||
(pop-to-buffer current-buf)
|
||||
(goto-char (car current-pair))
|
||||
(when (re-search-forward from (cdr current-pair) noerror)
|
||||
(goto-char current-beg)
|
||||
(when (re-search-forward from (+ current-beg current-len) noerror)
|
||||
(setq found t)))
|
||||
found))))
|
||||
;; FIXME: Despite this being a multi-buffer replacement, `N'
|
||||
|
|
@ -695,7 +705,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
|
|||
|
||||
(defun xref--read-identifier (prompt)
|
||||
"Return the identifier at point or read it from the minibuffer."
|
||||
(let ((id (funcall xref-identifier-at-point-function)))
|
||||
(let* ((backend (xref-find-backend))
|
||||
(id (xref-backend-identifier-at-point backend)))
|
||||
(cond ((or current-prefix-arg
|
||||
(not id)
|
||||
(xref--prompt-p this-command))
|
||||
|
|
@ -705,7 +716,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
|
|||
"[ :]+\\'" prompt))
|
||||
id)
|
||||
prompt)
|
||||
(funcall xref-identifier-completion-table-function)
|
||||
(xref-backend-identifier-completion-table backend)
|
||||
nil nil nil
|
||||
'xref--read-identifier-history id))
|
||||
(t id))))
|
||||
|
|
@ -714,7 +725,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
|
|||
;;; Commands
|
||||
|
||||
(defun xref--find-xrefs (input kind arg window)
|
||||
(let ((xrefs (funcall xref-find-function kind arg)))
|
||||
(let ((xrefs (funcall (intern (format "xref-backend-%s" kind))
|
||||
(xref-find-backend)
|
||||
arg)))
|
||||
(unless xrefs
|
||||
(user-error "No %s found for: %s" (symbol-name kind) input))
|
||||
(xref--show-xrefs xrefs window)))
|
||||
|
|
@ -799,14 +812,9 @@ and just use etags."
|
|||
:lighter ""
|
||||
(if xref-etags-mode
|
||||
(progn
|
||||
(setq xref-etags-mode--saved
|
||||
(cons xref-find-function
|
||||
xref-identifier-completion-table-function))
|
||||
(kill-local-variable 'xref-find-function)
|
||||
(kill-local-variable 'xref-identifier-completion-table-function))
|
||||
(setq-local xref-find-function (car xref-etags-mode--saved))
|
||||
(setq-local xref-identifier-completion-table-function
|
||||
(cdr xref-etags-mode--saved))))
|
||||
(setq xref-etags-mode--saved xref-backend-functions)
|
||||
(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")
|
||||
|
|
@ -826,10 +834,11 @@ tools are used, and when."
|
|||
(hits (and res (oref res hit-lines)))
|
||||
(orig-buffers (buffer-list)))
|
||||
(unwind-protect
|
||||
(delq nil
|
||||
(mapcar (lambda (hit) (xref--collect-match
|
||||
hit (format "\\_<%s\\_>" (regexp-quote symbol))))
|
||||
hits))
|
||||
(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)))))
|
||||
|
||||
|
|
@ -860,9 +869,9 @@ IGNORES is a list of glob patterns."
|
|||
(match-string 1))
|
||||
hits)))
|
||||
(unwind-protect
|
||||
(delq nil
|
||||
(mapcar (lambda (hit) (xref--collect-match hit regexp))
|
||||
(nreverse hits)))
|
||||
(cl-mapcan (lambda (hit) (xref--collect-matches hit regexp))
|
||||
(nreverse hits))
|
||||
;; TODO: Same as above.
|
||||
(mapc #'kill-buffer
|
||||
(cl-set-difference (buffer-list) orig-buffers)))))
|
||||
|
||||
|
|
@ -918,7 +927,7 @@ IGNORES is a list of glob patterns."
|
|||
(match-string 1 str)))))
|
||||
str t t))
|
||||
|
||||
(defun xref--collect-match (hit regexp)
|
||||
(defun xref--collect-matches (hit regexp)
|
||||
(pcase-let* ((`(,line . ,file) hit)
|
||||
(buf (or (find-buffer-visiting file)
|
||||
(semantic-find-file-noselect file))))
|
||||
|
|
@ -926,18 +935,22 @@ IGNORES is a list of glob patterns."
|
|||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line))
|
||||
(syntax-propertize (line-end-position))
|
||||
;; TODO: Handle multiple matches per line.
|
||||
(when (re-search-forward regexp (line-end-position) t)
|
||||
(goto-char (match-beginning 0))
|
||||
(let ((loc (xref-make-file-location file line
|
||||
(current-column))))
|
||||
(goto-char (match-end 0))
|
||||
(xref-make-match (buffer-substring
|
||||
(line-beginning-position)
|
||||
(line-end-position))
|
||||
(current-column)
|
||||
loc)))))))
|
||||
(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))))))
|
||||
|
||||
(provide 'xref)
|
||||
|
||||
|
|
|
|||
32
lisp/rect.el
32
lisp/rect.el
|
|
@ -257,6 +257,19 @@ Return it as a list of strings, one for each line of the rectangle."
|
|||
(apply-on-rectangle 'extract-rectangle-line start end lines)
|
||||
(nreverse (cdr lines))))
|
||||
|
||||
(defun extract-rectangle-bounds (start end)
|
||||
"Return the bounds of the rectangle with corners at START and END.
|
||||
Return it as a list of (START . END) positions, one for each line of
|
||||
the rectangle."
|
||||
(let (bounds)
|
||||
(apply-on-rectangle
|
||||
(lambda (startcol endcol)
|
||||
(move-to-column startcol)
|
||||
(push (cons (prog1 (point) (move-to-column endcol)) (point))
|
||||
bounds))
|
||||
start end)
|
||||
(nreverse bounds)))
|
||||
|
||||
(defvar killed-rectangle nil
|
||||
"Rectangle for `yank-rectangle' to insert.")
|
||||
|
||||
|
|
@ -563,6 +576,8 @@ with a prefix argument, prompt for START-AT and FORMAT."
|
|||
#'rectangle--unhighlight-for-redisplay)
|
||||
(add-function :around region-extract-function
|
||||
#'rectangle--extract-region)
|
||||
(add-function :around region-insert-function
|
||||
#'rectangle--insert-region)
|
||||
|
||||
(defvar rectangle-mark-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
|
@ -681,8 +696,12 @@ Ignores `line-move-visual'."
|
|||
|
||||
|
||||
(defun rectangle--extract-region (orig &optional delete)
|
||||
(if (not rectangle-mark-mode)
|
||||
(funcall orig delete)
|
||||
(cond
|
||||
((not rectangle-mark-mode)
|
||||
(funcall orig delete))
|
||||
((eq delete 'bounds)
|
||||
(extract-rectangle-bounds (region-beginning) (region-end)))
|
||||
(t
|
||||
(let* ((strs (funcall (if delete
|
||||
#'delete-extract-rectangle
|
||||
#'extract-rectangle)
|
||||
|
|
@ -696,7 +715,14 @@ Ignores `line-move-visual'."
|
|||
(put-text-property 0 (length str) 'yank-handler
|
||||
`(rectangle--insert-for-yank ,strs t)
|
||||
str)
|
||||
str))))
|
||||
str)))))
|
||||
|
||||
(defun rectangle--insert-region (orig strings)
|
||||
(cond
|
||||
((not rectangle-mark-mode)
|
||||
(funcall orig strings))
|
||||
(t
|
||||
(funcall #'insert-rectangle strings))))
|
||||
|
||||
(defun rectangle--insert-for-yank (strs)
|
||||
(push (point) buffer-undo-list)
|
||||
|
|
|
|||
|
|
@ -284,7 +284,7 @@ the original string if not."
|
|||
(and current-prefix-arg (not (eq current-prefix-arg '-)))
|
||||
(and current-prefix-arg (eq current-prefix-arg '-)))))
|
||||
|
||||
(defun query-replace (from-string to-string &optional delimited start end backward)
|
||||
(defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p)
|
||||
"Replace some occurrences of FROM-STRING with TO-STRING.
|
||||
As each match is found, the user must type a character saying
|
||||
what to do with it. For directions, type \\[help-command] at that time.
|
||||
|
|
@ -328,22 +328,21 @@ To customize possible responses, change the bindings in `query-replace-map'."
|
|||
(if current-prefix-arg
|
||||
(if (eq current-prefix-arg '-) " backward" " word")
|
||||
"")
|
||||
(if (and transient-mark-mode mark-active) " in region" ""))
|
||||
(if (use-region-p) " in region" ""))
|
||||
nil)))
|
||||
(list (nth 0 common) (nth 1 common) (nth 2 common)
|
||||
;; These are done separately here
|
||||
;; so that command-history will record these expressions
|
||||
;; rather than the values they had this time.
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-beginning))
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-end))
|
||||
(nth 3 common))))
|
||||
(perform-replace from-string to-string t nil delimited nil nil start end backward))
|
||||
(if (use-region-p) (region-beginning))
|
||||
(if (use-region-p) (region-end))
|
||||
(nth 3 common)
|
||||
(if (use-region-p) (region-noncontiguous-p)))))
|
||||
(perform-replace from-string to-string t nil delimited nil nil start end backward region-noncontiguous-p))
|
||||
|
||||
(define-key esc-map "%" 'query-replace)
|
||||
|
||||
(defun query-replace-regexp (regexp to-string &optional delimited start end backward)
|
||||
(defun query-replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p)
|
||||
"Replace some things after point matching REGEXP with TO-STRING.
|
||||
As each match is found, the user must type a character saying
|
||||
what to do with it. For directions, type \\[help-command] at that time.
|
||||
|
|
@ -408,18 +407,17 @@ Use \\[repeat-complex-command] after this command for details."
|
|||
(if (eq current-prefix-arg '-) " backward" " word")
|
||||
"")
|
||||
" regexp"
|
||||
(if (and transient-mark-mode mark-active) " in region" ""))
|
||||
(if (use-region-p) " in region" ""))
|
||||
t)))
|
||||
(list (nth 0 common) (nth 1 common) (nth 2 common)
|
||||
;; These are done separately here
|
||||
;; so that command-history will record these expressions
|
||||
;; rather than the values they had this time.
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-beginning))
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-end))
|
||||
(nth 3 common))))
|
||||
(perform-replace regexp to-string t t delimited nil nil start end backward))
|
||||
(if (use-region-p) (region-beginning))
|
||||
(if (use-region-p) (region-end))
|
||||
(nth 3 common)
|
||||
(if (use-region-p) (region-noncontiguous-p)))))
|
||||
(perform-replace regexp to-string t t delimited nil nil start end backward region-noncontiguous-p))
|
||||
|
||||
(define-key esc-map [?\C-%] 'query-replace-regexp)
|
||||
|
||||
|
|
@ -485,10 +483,8 @@ for Lisp calls." "22.1"))
|
|||
;; and the user might enter a single token.
|
||||
(replace-match-string-symbols to)
|
||||
(list from (car to) current-prefix-arg
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-beginning))
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-end))))))
|
||||
(if (use-region-p) (region-beginning))
|
||||
(if (use-region-p) (region-end))))))
|
||||
(perform-replace regexp (cons 'replace-eval-replacement to-expr)
|
||||
t 'literal delimited nil nil start end))
|
||||
|
||||
|
|
@ -523,10 +519,8 @@ Fourth and fifth arg START and END specify the region to operate on."
|
|||
(list from to
|
||||
(and current-prefix-arg
|
||||
(prefix-numeric-value current-prefix-arg))
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-beginning))
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-end)))))
|
||||
(if (use-region-p) (region-beginning))
|
||||
(if (use-region-p) (region-end)))))
|
||||
(let (replacements)
|
||||
(if (listp to-strings)
|
||||
(setq replacements to-strings)
|
||||
|
|
@ -587,13 +581,11 @@ and TO-STRING is also null.)"
|
|||
(if (eq current-prefix-arg '-) " backward" " word")
|
||||
"")
|
||||
" string"
|
||||
(if (and transient-mark-mode mark-active) " in region" ""))
|
||||
(if (use-region-p) " in region" ""))
|
||||
nil)))
|
||||
(list (nth 0 common) (nth 1 common) (nth 2 common)
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-beginning))
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-end))
|
||||
(if (use-region-p) (region-beginning))
|
||||
(if (use-region-p) (region-end))
|
||||
(nth 3 common))))
|
||||
(perform-replace from-string to-string nil nil delimited nil nil start end backward))
|
||||
|
||||
|
|
@ -661,13 +653,11 @@ which will run faster and will not set the mark or print anything."
|
|||
(if (eq current-prefix-arg '-) " backward" " word")
|
||||
"")
|
||||
" regexp"
|
||||
(if (and transient-mark-mode mark-active) " in region" ""))
|
||||
(if (use-region-p) " in region" ""))
|
||||
t)))
|
||||
(list (nth 0 common) (nth 1 common) (nth 2 common)
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-beginning))
|
||||
(if (and transient-mark-mode mark-active)
|
||||
(region-end))
|
||||
(if (use-region-p) (region-beginning))
|
||||
(if (use-region-p) (region-end))
|
||||
(nth 3 common))))
|
||||
(perform-replace regexp to-string nil t delimited nil nil start end backward))
|
||||
|
||||
|
|
@ -832,7 +822,7 @@ a previously found match."
|
|||
(unless (or (bolp) (eobp))
|
||||
(forward-line 0))
|
||||
(point-marker)))))
|
||||
(if (and interactive transient-mark-mode mark-active)
|
||||
(if (and interactive (use-region-p))
|
||||
(setq rstart (region-beginning)
|
||||
rend (progn
|
||||
(goto-char (region-end))
|
||||
|
|
@ -901,7 +891,7 @@ starting on the same line at which another match ended is ignored."
|
|||
(progn
|
||||
(goto-char (min rstart rend))
|
||||
(setq rend (copy-marker (max rstart rend))))
|
||||
(if (and interactive transient-mark-mode mark-active)
|
||||
(if (and interactive (use-region-p))
|
||||
(setq rstart (region-beginning)
|
||||
rend (copy-marker (region-end)))
|
||||
(setq rstart (point)
|
||||
|
|
@ -951,7 +941,7 @@ a previously found match."
|
|||
(setq rend (max rstart rend)))
|
||||
(goto-char rstart)
|
||||
(setq rend (point-max)))
|
||||
(if (and interactive transient-mark-mode mark-active)
|
||||
(if (and interactive (use-region-p))
|
||||
(setq rstart (region-beginning)
|
||||
rend (region-end))
|
||||
(setq rstart (point)
|
||||
|
|
@ -2068,7 +2058,7 @@ It is called with three arguments, as if it were
|
|||
|
||||
(defun perform-replace (from-string replacements
|
||||
query-flag regexp-flag delimited-flag
|
||||
&optional repeat-count map start end backward)
|
||||
&optional repeat-count map start end backward region-noncontiguous-p)
|
||||
"Subroutine of `query-replace'. Its complexity handles interactive queries.
|
||||
Don't use this in your own program unless you want to query and set the mark
|
||||
just as `query-replace' does. Instead, write a simple loop like this:
|
||||
|
|
@ -2115,6 +2105,9 @@ It must return a string."
|
|||
|
||||
;; If non-nil, it is marker saying where in the buffer to stop.
|
||||
(limit nil)
|
||||
;; Use local binding in add-function below.
|
||||
(isearch-filter-predicate isearch-filter-predicate)
|
||||
(region-bounds nil)
|
||||
|
||||
;; Data for the next match. If a cons, it has the same format as
|
||||
;; (match-data); otherwise it is t if a match is possible at point.
|
||||
|
|
@ -2127,6 +2120,24 @@ It must return a string."
|
|||
"Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
|
||||
minibuffer-prompt-properties))))
|
||||
|
||||
;; Unless a single contiguous chunk is selected, operate on multiple chunks.
|
||||
(when region-noncontiguous-p
|
||||
(setq region-bounds
|
||||
(mapcar (lambda (position)
|
||||
(cons (copy-marker (car position))
|
||||
(copy-marker (cdr position))))
|
||||
(funcall region-extract-function 'bounds)))
|
||||
(add-function :after-while isearch-filter-predicate
|
||||
(lambda (start end)
|
||||
(delq nil (mapcar
|
||||
(lambda (bounds)
|
||||
(and
|
||||
(>= start (car bounds))
|
||||
(<= start (cdr bounds))
|
||||
(>= end (car bounds))
|
||||
(<= end (cdr bounds))))
|
||||
region-bounds)))))
|
||||
|
||||
;; If region is active, in Transient Mark mode, operate on region.
|
||||
(if backward
|
||||
(when end
|
||||
|
|
|
|||
229
lisp/simple.el
229
lisp/simple.el
|
|
@ -970,15 +970,34 @@ instead of deleted."
|
|||
(defvar region-extract-function
|
||||
(lambda (delete)
|
||||
(when (region-beginning)
|
||||
(if (eq delete 'delete-only)
|
||||
(delete-region (region-beginning) (region-end))
|
||||
(filter-buffer-substring (region-beginning) (region-end) delete))))
|
||||
(cond
|
||||
((eq delete 'bounds)
|
||||
(list (cons (region-beginning) (region-end))))
|
||||
((eq delete 'delete-only)
|
||||
(delete-region (region-beginning) (region-end)))
|
||||
(t
|
||||
(filter-buffer-substring (region-beginning) (region-end) delete)))))
|
||||
"Function to get the region's content.
|
||||
Called with one argument DELETE.
|
||||
If DELETE is `delete-only', then only delete the region and the return value
|
||||
is undefined. If DELETE is nil, just return the content as a string.
|
||||
If DELETE is `bounds', then don't delete, but just return the
|
||||
boundaries of the region as a list of (START . END) positions.
|
||||
If anything else, delete the region and return its content as a string.")
|
||||
|
||||
(defvar region-insert-function
|
||||
(lambda (lines)
|
||||
(let ((first t))
|
||||
(while lines
|
||||
(or first
|
||||
(insert ?\n))
|
||||
(insert-for-yank (car lines))
|
||||
(setq lines (cdr lines)
|
||||
first nil))))
|
||||
"Function to insert the region's content.
|
||||
Called with one argument LINES.
|
||||
Insert the region as a list of lines.")
|
||||
|
||||
(defun delete-backward-char (n &optional killflag)
|
||||
"Delete the previous N characters (following if N is negative).
|
||||
If Transient Mark mode is enabled, the mark is active, and N is 1,
|
||||
|
|
@ -3419,7 +3438,8 @@ and only used if a buffer is displayed."
|
|||
|
||||
(defun shell-command-on-region (start end command
|
||||
&optional output-buffer replace
|
||||
error-buffer display-error-buffer)
|
||||
error-buffer display-error-buffer
|
||||
region-noncontiguous-p)
|
||||
"Execute string COMMAND in inferior shell with region as input.
|
||||
Normally display output (if any) in temp buffer `*Shell Command Output*';
|
||||
Prefix arg means replace the region with it. Return the exit code of
|
||||
|
|
@ -3482,7 +3502,8 @@ interactively, this is t."
|
|||
current-prefix-arg
|
||||
current-prefix-arg
|
||||
shell-command-default-error-buffer
|
||||
t)))
|
||||
t
|
||||
(region-noncontiguous-p))))
|
||||
(let ((error-file
|
||||
(if error-buffer
|
||||
(make-temp-file
|
||||
|
|
@ -3491,96 +3512,109 @@ interactively, this is t."
|
|||
temporary-file-directory)))
|
||||
nil))
|
||||
exit-status)
|
||||
(if (or replace
|
||||
(and output-buffer
|
||||
(not (or (bufferp output-buffer) (stringp output-buffer)))))
|
||||
;; Replace specified region with output from command.
|
||||
(let ((swap (and replace (< start end))))
|
||||
;; Don't muck with mark unless REPLACE says we should.
|
||||
(goto-char start)
|
||||
(and replace (push-mark (point) 'nomsg))
|
||||
(setq exit-status
|
||||
(call-process-region start end shell-file-name replace
|
||||
(if error-file
|
||||
(list t error-file)
|
||||
t)
|
||||
nil shell-command-switch command))
|
||||
;; It is rude to delete a buffer which the command is not using.
|
||||
;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
|
||||
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
|
||||
;; (kill-buffer shell-buffer)))
|
||||
;; Don't muck with mark unless REPLACE says we should.
|
||||
(and replace swap (exchange-point-and-mark)))
|
||||
;; No prefix argument: put the output in a temp buffer,
|
||||
;; replacing its entire contents.
|
||||
(let ((buffer (get-buffer-create
|
||||
(or output-buffer "*Shell Command Output*"))))
|
||||
(unwind-protect
|
||||
(if (eq buffer (current-buffer))
|
||||
;; If the input is the same buffer as the output,
|
||||
;; delete everything but the specified region,
|
||||
;; then replace that region with the output.
|
||||
(progn (setq buffer-read-only nil)
|
||||
(delete-region (max start end) (point-max))
|
||||
(delete-region (point-min) (min start end))
|
||||
(setq exit-status
|
||||
(call-process-region (point-min) (point-max)
|
||||
shell-file-name t
|
||||
(if error-file
|
||||
(list t error-file)
|
||||
t)
|
||||
nil shell-command-switch
|
||||
command)))
|
||||
;; Clear the output buffer, then run the command with
|
||||
;; output there.
|
||||
(let ((directory default-directory))
|
||||
(with-current-buffer buffer
|
||||
(setq buffer-read-only nil)
|
||||
(if (not output-buffer)
|
||||
(setq default-directory directory))
|
||||
(erase-buffer)))
|
||||
(setq exit-status
|
||||
(call-process-region start end shell-file-name nil
|
||||
(if error-file
|
||||
(list buffer error-file)
|
||||
buffer)
|
||||
nil shell-command-switch command)))
|
||||
;; Report the output.
|
||||
(with-current-buffer buffer
|
||||
(setq mode-line-process
|
||||
(cond ((null exit-status)
|
||||
" - Error")
|
||||
((stringp exit-status)
|
||||
(format " - Signal [%s]" exit-status))
|
||||
((not (equal 0 exit-status))
|
||||
(format " - Exit [%d]" exit-status)))))
|
||||
(if (with-current-buffer buffer (> (point-max) (point-min)))
|
||||
;; There's some output, display it
|
||||
(display-message-or-buffer buffer)
|
||||
;; No output; error?
|
||||
(let ((output
|
||||
(if (and error-file
|
||||
(< 0 (nth 7 (file-attributes error-file))))
|
||||
(format "some error output%s"
|
||||
(if shell-command-default-error-buffer
|
||||
(format " to the \"%s\" buffer"
|
||||
shell-command-default-error-buffer)
|
||||
""))
|
||||
"no output")))
|
||||
(cond ((null exit-status)
|
||||
(message "(Shell command failed with error)"))
|
||||
((equal 0 exit-status)
|
||||
(message "(Shell command succeeded with %s)"
|
||||
output))
|
||||
((stringp exit-status)
|
||||
(message "(Shell command killed by signal %s)"
|
||||
exit-status))
|
||||
(t
|
||||
(message "(Shell command failed with code %d and %s)"
|
||||
exit-status output))))
|
||||
;; Don't kill: there might be useful info in the undo-log.
|
||||
;; (kill-buffer buffer)
|
||||
))))
|
||||
;; Unless a single contiguous chunk is selected, operate on multiple chunks.
|
||||
(if region-noncontiguous-p
|
||||
(let ((input (concat (funcall region-extract-function 'delete) "\n"))
|
||||
output)
|
||||
(with-temp-buffer
|
||||
(insert input)
|
||||
(call-process-region (point-min) (point-max)
|
||||
shell-file-name t t
|
||||
nil shell-command-switch
|
||||
command)
|
||||
(setq output (split-string (buffer-string) "\n")))
|
||||
(goto-char start)
|
||||
(funcall region-insert-function output))
|
||||
(if (or replace
|
||||
(and output-buffer
|
||||
(not (or (bufferp output-buffer) (stringp output-buffer)))))
|
||||
;; Replace specified region with output from command.
|
||||
(let ((swap (and replace (< start end))))
|
||||
;; Don't muck with mark unless REPLACE says we should.
|
||||
(goto-char start)
|
||||
(and replace (push-mark (point) 'nomsg))
|
||||
(setq exit-status
|
||||
(call-process-region start end shell-file-name replace
|
||||
(if error-file
|
||||
(list t error-file)
|
||||
t)
|
||||
nil shell-command-switch command))
|
||||
;; It is rude to delete a buffer which the command is not using.
|
||||
;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
|
||||
;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
|
||||
;; (kill-buffer shell-buffer)))
|
||||
;; Don't muck with mark unless REPLACE says we should.
|
||||
(and replace swap (exchange-point-and-mark)))
|
||||
;; No prefix argument: put the output in a temp buffer,
|
||||
;; replacing its entire contents.
|
||||
(let ((buffer (get-buffer-create
|
||||
(or output-buffer "*Shell Command Output*"))))
|
||||
(unwind-protect
|
||||
(if (eq buffer (current-buffer))
|
||||
;; If the input is the same buffer as the output,
|
||||
;; delete everything but the specified region,
|
||||
;; then replace that region with the output.
|
||||
(progn (setq buffer-read-only nil)
|
||||
(delete-region (max start end) (point-max))
|
||||
(delete-region (point-min) (min start end))
|
||||
(setq exit-status
|
||||
(call-process-region (point-min) (point-max)
|
||||
shell-file-name t
|
||||
(if error-file
|
||||
(list t error-file)
|
||||
t)
|
||||
nil shell-command-switch
|
||||
command)))
|
||||
;; Clear the output buffer, then run the command with
|
||||
;; output there.
|
||||
(let ((directory default-directory))
|
||||
(with-current-buffer buffer
|
||||
(setq buffer-read-only nil)
|
||||
(if (not output-buffer)
|
||||
(setq default-directory directory))
|
||||
(erase-buffer)))
|
||||
(setq exit-status
|
||||
(call-process-region start end shell-file-name nil
|
||||
(if error-file
|
||||
(list buffer error-file)
|
||||
buffer)
|
||||
nil shell-command-switch command)))
|
||||
;; Report the output.
|
||||
(with-current-buffer buffer
|
||||
(setq mode-line-process
|
||||
(cond ((null exit-status)
|
||||
" - Error")
|
||||
((stringp exit-status)
|
||||
(format " - Signal [%s]" exit-status))
|
||||
((not (equal 0 exit-status))
|
||||
(format " - Exit [%d]" exit-status)))))
|
||||
(if (with-current-buffer buffer (> (point-max) (point-min)))
|
||||
;; There's some output, display it
|
||||
(display-message-or-buffer buffer)
|
||||
;; No output; error?
|
||||
(let ((output
|
||||
(if (and error-file
|
||||
(< 0 (nth 7 (file-attributes error-file))))
|
||||
(format "some error output%s"
|
||||
(if shell-command-default-error-buffer
|
||||
(format " to the \"%s\" buffer"
|
||||
shell-command-default-error-buffer)
|
||||
""))
|
||||
"no output")))
|
||||
(cond ((null exit-status)
|
||||
(message "(Shell command failed with error)"))
|
||||
((equal 0 exit-status)
|
||||
(message "(Shell command succeeded with %s)"
|
||||
output))
|
||||
((stringp exit-status)
|
||||
(message "(Shell command killed by signal %s)"
|
||||
exit-status))
|
||||
(t
|
||||
(message "(Shell command failed with code %d and %s)"
|
||||
exit-status output))))
|
||||
;; Don't kill: there might be useful info in the undo-log.
|
||||
;; (kill-buffer buffer)
|
||||
)))))
|
||||
|
||||
(when (and error-file (file-exists-p error-file))
|
||||
(if (< 0 (nth 7 (file-attributes error-file)))
|
||||
|
|
@ -5175,6 +5209,11 @@ also checks the value of `use-empty-active-region'."
|
|||
;; region is active when there's no mark.
|
||||
(progn (cl-assert (mark)) t)))
|
||||
|
||||
(defun region-noncontiguous-p ()
|
||||
"Return non-nil if the region contains several pieces.
|
||||
An example is a rectangular region handled as a list of
|
||||
separate contiguous regions for each line."
|
||||
(> (length (funcall region-extract-function 'bounds)) 1))
|
||||
|
||||
(defvar redisplay-unhighlight-region-function
|
||||
(lambda (rol) (when (overlayp rol) (delete-overlay rol))))
|
||||
|
|
|
|||
|
|
@ -1821,7 +1821,7 @@ With a prefix argument, try to REVERSE the hunk."
|
|||
"Kill all hunks that have already been applied starting at point."
|
||||
(interactive)
|
||||
(while (not (eobp))
|
||||
(pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
|
||||
(pcase-let ((`(,_buf ,line-offset ,_pos ,_src ,_dst ,switched)
|
||||
(diff-find-source-location nil nil)))
|
||||
(if (and line-offset switched)
|
||||
(diff-hunk-kill)
|
||||
|
|
|
|||
|
|
@ -306,14 +306,30 @@ See also `capitalize-region'. */)
|
|||
return Qnil;
|
||||
}
|
||||
|
||||
DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r",
|
||||
DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3,
|
||||
"(list (region-beginning) (region-end) (region-noncontiguous-p))",
|
||||
doc: /* Convert the region to lower case. In programs, wants two arguments.
|
||||
These arguments specify the starting and ending character numbers of
|
||||
the region to operate on. When used as a command, the text between
|
||||
point and the mark is operated on. */)
|
||||
(Lisp_Object beg, Lisp_Object end)
|
||||
(Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p)
|
||||
{
|
||||
casify_region (CASE_DOWN, beg, end);
|
||||
Lisp_Object bounds = Qnil;
|
||||
|
||||
if (!NILP (region_noncontiguous_p))
|
||||
{
|
||||
bounds = call1 (Fsymbol_value (intern ("region-extract-function")),
|
||||
intern ("bounds"));
|
||||
|
||||
while (CONSP (bounds))
|
||||
{
|
||||
casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds)));
|
||||
bounds = XCDR (bounds);
|
||||
}
|
||||
}
|
||||
else
|
||||
casify_region (CASE_DOWN, beg, end);
|
||||
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue