mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-06 03:40:56 -08:00
Code Issues Projects Releases Wiki Activity

(delete-selection-pre-hook): Handle and resignal

Browse source 
file-supersession errors to interact properly with userlock.el.
This commit is contained in:
Richard M. Stallman 2001-11-19 06:21:11 +00:00
parent a764440a8f
commit f13e84fa4b
1 changed files with 25 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

43
lisp/delsel.el
View file

@ -84,24 +84,31 @@ any selection."
(not buffer-read-only)) (not buffer-read-only))
(let ((type (and (symbolp this-command) (let ((type (and (symbolp this-command)
(get this-command 'delete-selection)))) (get this-command 'delete-selection))))
(cond ((eq type 'kill) (condition-case data
(delete-active-region t)) (cond ((eq type 'kill)
((eq type 'yank) (delete-active-region t))
;; Before a yank command, ((eq type 'yank)
;; make sure we don't yank the same region ;; Before a yank command,
;; that we are going to delete. ;; make sure we don't yank the same region
;; That would make yank a no-op. ;; that we are going to delete.
(when (string= (buffer-substring-no-properties (point) (mark)) ;; That would make yank a no-op.
(car kill-ring)) (when (string= (buffer-substring-no-properties (point) (mark))
(current-kill 1)) (car kill-ring))
(delete-active-region)) (current-kill 1))
((eq type 'supersede) (delete-active-region))
(let ((empty-region (= (point) (mark)))) ((eq type 'supersede)
(delete-active-region) (let ((empty-region (= (point) (mark))))
(unless empty-region (delete-active-region)
(setq this-command 'ignore)))) (unless empty-region
(type (setq this-command 'ignore))))
(delete-active-region)))))) (type
(delete-active-region)))
(file-supersession
;; If ask-user-about-supersession-threat signals an error,
;; stop safe_run_hooks from clearing out pre-command-hook.
(and (eq inhibit-quit 'pre-command-hook)
(setq inhibit-quit 'delete-selection-dummy))
(signal 'file-supersession (cdr data)))))))
(put 'self-insert-command 'delete-selection t) (put 'self-insert-command 'delete-selection t)
(put 'self-insert-iso 'delete-selection t) (put 'self-insert-iso 'delete-selection t)