mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00
Code Issues Releases Activity

Add pre-redisplay-function and rectangular region

Browse Source 
* lisp/rect.el: Use lexical-binding.  Add new rectangular region support.
(rectangle-mark): New command.
(rectangle--region): New var.
(deactivate-mark-hook): Reset rectangle--region.
(rectangle--extract-region, rectangle--insert-for-yank)
(rectangle--highlight-for-redisplay)
(rectangle--unhighlight-for-redisplay): New functions.
(region-extract-function, redisplay-unhighlight-region-function)
(redisplay-highlight-region-function): Use them to handle
rectangular region.
* lisp/simple.el (region-extract-function): New var.
(delete-backward-char, delete-forward-char, deactivate-mark): Use it.
(kill-new, kill-append): Remove obsolete `yank-handler' argument.
(kill-region): Replace obsolete `yank-handler' arg with `region'.
(copy-region-as-kill, kill-ring-save): Add `region' argument.
(redisplay-unhighlight-region-function)
(redisplay-highlight-region-function): New vars.
(redisplay--update-region-highlight): New function.
(pre-redisplay-function): Use it.
(exchange-point-and-mark): Don't deactivate the mark before
reactivate-it anyway.
* lisp/comint.el (comint-kill-region): Remove yank-handler argument.
* lisp/delsel.el (delete-backward-char, backward-delete-char-untabify)
(delete-char): Remove property, since it's now part of their
default behavior.
(self-insert-iso): Remove property since this command doesn't exist.

* src/xdisp.c (prepare_menu_bars): Call Vpre_redisplay_function.
(syms_of_xdisp): Declare pre-redisplay-function.
(markpos_of_region): Remove function.
(init_iterator, compute_stop_pos, handle_face_prop)
(face_before_or_after_it_pos, reseat_to_string)
(get_next_display_element, window_buffer_changed)
(redisplay_internal, try_cursor_movement, redisplay_window)
(try_window_reusing_current_matrix, try_window_id, display_line)
(note_mode_line_or_margin_highlight, note_mouse_highlight)
(display_string, mouse_face_from_buffer_pos): Remove region handling.
* src/window.h (struct window): Remove field `region_showing'.
* src/dispextern.h (struct it): Remove region_beg/end_charpos.
(face_at_buffer_position, face_for_overlay_string)
(face_at_string_position): Update prototypes.
* src/xfaces.c (face_at_buffer_position, face_for_overlay_string)
(face_at_string_position): Remove `region_beg' and `region_end' args.
* src/fontset.c (Finternal_char_font):
* src/font.c (font_at, font_range): Adjust calls accordingly.
* src/insdel.c (Qregion_extract_function): New var.
(syms_of_insdel): Initialize it.
(prepare_to_modify_buffer_1): Use it.
This commit is contained in:
Stefan Monnier 2013-10-29 12:11:50 -04:00
parent 2d9783e0b9
commit 3472b6c682
15 changed files with 357 additions and 236 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
etc/NEWS
View File

@ -179,6 +179,9 @@ and this variable has been marked obsolete.
* Editing Changes in Emacs 24.4
** New command `rectangle-mark' makes a rectangular region.
Most commands are still unaware of it, but kill/yank do work on the rectangle.
** C-x TAB enters a transient interactive mode.
You can then use the left/right cursor keys to move the block of text.
@ -631,6 +634,8 @@ low-level libraries gfilenotify.c, inotify.c or w32notify.c.
* Incompatible Lisp Changes in Emacs 24.4
** `kill-region' lost its `yank-handler' optional argument.
** `(input-pending-p)' no longer runs other timers which are ready to
run. The new optional CHECK-TIMERS param allows for the prior behavior.
@ -692,6 +697,8 @@ for something (not just adding elements to it), it ought not to affect you.
* Lisp Changes in Emacs 24.4
** New hook `pre-redisplay-function'.
+++
** Functions that pop up menus and dialogs now work on all terminal types,
including TTYs.

27
lisp/ChangeLog
View File

@ -1,5 +1,32 @@
2013-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
* rect.el: Use lexical-binding. Add new rectangular region support.
(rectangle-mark): New command.
(rectangle--region): New var.
(deactivate-mark-hook): Reset rectangle--region.
(rectangle--extract-region, rectangle--insert-for-yank)
(rectangle--highlight-for-redisplay)
(rectangle--unhighlight-for-redisplay): New functions.
(region-extract-function, redisplay-unhighlight-region-function)
(redisplay-highlight-region-function): Use them to handle
rectangular region.
* simple.el (region-extract-function): New var.
(delete-backward-char, delete-forward-char, deactivate-mark): Use it.
(kill-new, kill-append): Remove obsolete `yank-handler' argument.
(kill-region): Replace obsolete `yank-handler' arg with `region'.
(copy-region-as-kill, kill-ring-save): Add `region' argument.
(redisplay-unhighlight-region-function)
(redisplay-highlight-region-function): New vars.
(redisplay--update-region-highlight): New function.
(pre-redisplay-function): Use it.
(exchange-point-and-mark): Don't deactivate the mark before
reactivate-it anyway.
* comint.el (comint-kill-region): Remove yank-handler argument.
* delsel.el (delete-backward-char, backward-delete-char-untabify)
(delete-char): Remove property, since it's now part of their
default behavior.
(self-insert-iso): Remove property since this command doesn't exist.
* emacs-lisp/package.el (package--download-one-archive)
(describe-package-1): Don't query the user about final newline.

7
lisp/comint.el
View File

@ -2679,7 +2679,7 @@ if necessary."
(kill-whole-line count)
(when (>= count 0) (comint-update-fence))))
(defun comint-kill-region (beg end &optional yank-handler)
(defun comint-kill-region (beg end)
"Like `kill-region', but ignores read-only properties, if safe.
This command assumes that the buffer contains read-only
\"prompts\" which are regions with front-sticky read-only
@ -2693,7 +2693,6 @@ prompts should stay at the beginning of a line. If this is not
the case, this command just calls `kill-region' with all
read-only properties intact. The read-only status of newlines is
updated using `comint-update-fence', if necessary."
(declare (advertised-calling-convention (beg end) "23.3"))
(interactive "r")
(save-excursion
(let* ((true-beg (min beg end))
@ -2708,9 +2707,9 @@ updated using `comint-update-fence', if necessary."
(if (listp end-lst) (memq 'read-only end-lst) t))))
(if (or (and (not beg-bolp) (or beg-bad end-bad))
(and (not end-bolp) end-bad))
(kill-region beg end yank-handler)
(kill-region beg end)
(let ((inhibit-read-only t))
(kill-region beg end yank-handler)
(kill-region beg end)
(comint-update-fence))))))
;; Support for source-file processing commands.

6
lisp/delsel.el
View File

@ -165,16 +165,10 @@ See `delete-selection-helper'."
(not (run-hook-with-args-until-success
'self-insert-uses-region-functions))))
(put 'self-insert-iso 'delete-selection t)
(put 'yank 'delete-selection 'yank)
(put 'clipboard-yank 'delete-selection 'yank)
(put 'insert-register 'delete-selection t)
(put 'delete-backward-char 'delete-selection 'supersede)
(put 'backward-delete-char-untabify 'delete-selection 'supersede)
(put 'delete-char 'delete-selection 'supersede)
(put 'newline-and-indent 'delete-selection t)
(put 'newline 'delete-selection t)
(put 'open-line 'delete-selection 'kill)

148
lisp/rect.el
View File

@ -1,4 +1,4 @@
;;; rect.el --- rectangle functions for GNU Emacs
;;; rect.el --- rectangle functions for GNU Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985, 1999-2013 Free Software Foundation, Inc.
@ -412,6 +412,152 @@ with a prefix argument, prompt for START-AT and FORMAT."
(apply-on-rectangle 'rectangle-number-line-callback
start end format)))
;;; New rectangle integration with kill-ring.
;; FIXME: lots of known problems with the new rectangle support:
;; - no key binding for mark-rectangle.
;; - no access to the `string-rectangle' functionality.
;; - lots of commands handle the region without paying attention to its
;; rectangular shape.
(defvar-local rectangle--region nil
"If non-nil, the region is meant to delimit a rectangle.")
(add-hook 'deactivate-mark-hook
(lambda () (kill-local-variable 'rectangle--region)))
(add-function :around redisplay-highlight-region-function
#'rectangle--highlight-for-redisplay)
(add-function :around redisplay-unhighlight-region-function
#'rectangle--unhighlight-for-redisplay)
(add-function :around region-extract-function
#'rectangle--extract-region)
;;;###autoload
(defun rectangle-mark ()
"Toggle the region as rectangular."
(interactive)
(if rectangle--region
(kill-local-variable 'rectangle--region)
(unless (region-active-p) (push-mark-command t))
(setq rectangle--region t)))
(defun rectangle--extract-region (orig &optional delete)
(if (not rectangle--region)
(funcall orig delete)
(let* ((strs (funcall (if delete
#'delete-extract-rectangle
#'extract-rectangle)
(region-beginning) (region-end)))
(str (mapconcat #'identity strs "\n")))
(when (eq last-command 'kill-region)
;; Try to prevent kill-region from appending this to some
;; earlier element.
(setq last-command 'kill-region-dont-append))
(when strs
(put-text-property 0 (length str) 'yank-handler
`(rectangle--insert-for-yank ,strs t)
str)
str))))
(defun rectangle--insert-for-yank (strs)
(push (point) buffer-undo-list)
(let ((undo-at-start buffer-undo-list))
(insert-rectangle strs)
(setq yank-undo-function
(lambda (_start _end)
(undo-start)
(setcar undo-at-start nil) ;Turn it into a boundary.
(while (not (eq pending-undo-list (cdr undo-at-start)))
(undo-more 1))))))
(defun rectangle--highlight-for-redisplay (orig start end window rol)
(cond
((not rectangle--region)
(funcall orig start end window rol))
((and (eq 'rectangle (car-safe rol))
(eq (nth 1 rol) (buffer-modified-tick))
(eq start (nth 2 rol))
(eq end (nth 3 rol)))
rol)
(t
(save-excursion
(let* ((nrol nil)
(old (if (eq 'rectangle (car-safe rol))
(nthcdr 4 rol)
(funcall redisplay-unhighlight-region-function rol)
nil))
(ptcol (progn (goto-char start) (current-column)))
(markcol (progn (goto-char end) (current-column)))
(leftcol (min ptcol markcol))
(rightcol (max ptcol markcol)))
(goto-char start)
(while (< (point) end)
(let* ((mleft (move-to-column leftcol))
(left (point))
(mright (move-to-column rightcol))
(right (point))
(ol
(if (not old)
(let ((ol (make-overlay left right)))
(overlay-put ol 'window window)
(overlay-put ol 'face 'region)
ol)
(let ((ol (pop old)))
(move-overlay ol left right (current-buffer))
ol))))
;; `move-to-column' may stop before the column (if bumping into
;; EOL) or overshoot it a little, when column is in the middle
;; of a char.
(cond
((< mleft leftcol) ;`leftcol' is past EOL.
(overlay-put ol 'before-string
(spaces-string (- leftcol mleft)))
(setq mright (max mright leftcol)))
((and (> mleft leftcol) ;`leftcol' is in the middle of a char.
(eq (char-before left) ?\t))
(setq left (1- left))
(move-overlay ol left right)
(goto-char left)
(overlay-put ol 'before-string
(spaces-string (- leftcol (current-column)))))
((overlay-get ol 'before-string)
(overlay-put ol 'before-string nil)))
(cond
((< mright rightcol) ;`rightcol' is past EOL.
(let ((str (make-string (- rightcol mright) ?\s)))
(put-text-property 0 (length str) 'face 'region str)
;; If cursor happens to be here, draw it *before* rather than
;; after this highlighted pseudo-text.
(put-text-property 0 1 'cursor t str)
(overlay-put ol 'after-string str)))
((and (> mright rightcol) ;`rightcol' is in the middle of a char.
(eq (char-before right) ?\t))
(setq right (1- right))
(move-overlay ol left right)
(goto-char right)
(let ((str (make-string (- rightcol (current-column)) ?\s)))
(put-text-property 0 (length str) 'face 'region str)
(overlay-put ol 'after-string str)))
((overlay-get ol 'after-string)
(overlay-put ol 'after-string nil)))
(when (= leftcol rightcol)
;; Make zero-width rectangles visible!
(overlay-put ol 'after-string
(concat (propertize " "
'face '(region (:height 0.2)))
(overlay-get ol 'after-string))))
(push ol nrol))
(forward-line 1))
(mapc #'delete-overlay old)
`(rectangle ,(buffer-modified-tick) ,start ,end ,@nrol))))))
(defun rectangle--unhighlight-for-redisplay (orig rol)
(if (not (eq 'rectangle (car-safe rol)))
(funcall orig rol)
(mapc #'delete-overlay (nthcdr 4 rol))
(setcar (cdr rol) nil)))
(provide 'rect)
;;; rect.el ends here

140
lisp/simple.el
View File

@ -874,6 +874,18 @@ instead of deleted."
:group 'killing
:version "24.1")
(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))))
"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 anything else, delete the region and return its content as a string.")
(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,
@ -895,8 +907,8 @@ the end of the line."
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
(kill-region (region-beginning) (region-end))
(delete-region (region-beginning) (region-end))))
(kill-region (region-beginning) (region-end) 'region)
(funcall region-extract-function 'delete-only)))
;; In Overwrite mode, maybe untabify while deleting
((null (or (null overwrite-mode)
(<= n 0)
@ -927,8 +939,9 @@ KILLFLAG is set if N was explicitly specified."
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
(kill-region (region-beginning) (region-end))
(delete-region (region-beginning) (region-end))))
(kill-region (region-beginning) (region-end) 'region)
(funcall region-extract-function 'delete-only)))
;; Otherwise, do simple deletion.
(t (delete-char n killflag))))
@ -3417,7 +3430,7 @@ The comparison is done using `equal-including-properties'."
:group 'killing
:version "23.2")
(defun kill-new (string &optional replace yank-handler)
(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
@ -3432,13 +3445,6 @@ When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
(if (> (length string) 0)
(if yank-handler
(put-text-property 0 (length string)
'yank-handler yank-handler string))
(if yank-handler
(signal 'args-out-of-range
(list string "yank-handler specified for empty string"))))
(unless (and kill-do-not-save-duplicates
;; Due to text properties such as 'yank-handler that
;; can alter the contents to yank, comparison using
@ -3466,19 +3472,15 @@ argument should still be a \"useful\" string for such uses."
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string)))
(set-advertised-calling-convention
'kill-new '(string &optional replace) "23.3")
(defun kill-append (string before-p &optional yank-handler)
(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
If `interprogram-cut-function' is set, pass the resulting kill to it."
(let* ((cur (car kill-ring)))
(kill-new (if before-p (concat string cur) (concat cur string))
(or (= (length cur) 0)
(equal yank-handler (get-text-property 0 'yank-handler cur)))
yank-handler)))
(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
(equal nil (get-text-property 0 'yank-handler cur))))))
(defcustom yank-pop-change-selection nil
"Whether rotating the kill ring changes the window system selection.
@ -3539,7 +3541,7 @@ move the yanking point; just return the Nth kill forward."
:type 'boolean
:group 'killing)
(defun kill-region (beg end &optional yank-handler)
(defun kill-region (beg end &optional region)
"Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
The command \\[yank] can retrieve it from there.
@ -3559,19 +3561,24 @@ Supply two arguments, character positions indicating the stretch of text
Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
the text killed this time appends to the text killed last time
to make one entry in the kill ring."
to make one entry in the kill ring.
The optional argument REGION if non-nil, indicates that we're not just killing
some text between BEG and END, but we're killing the region."
;; Pass point first, then mark, because the order matters
;; when calling kill-append.
(interactive (list (point) (mark)))
(interactive (list (point) (mark) 'region))
(unless (and beg end)
(error "The mark is not set now, so there is no region"))
(condition-case nil
(let ((string (filter-buffer-substring beg end t)))
(let ((string (if region
(funcall region-extract-function 'delete)
(filter-buffer-substring beg end 'delete))))
(when string ;STRING is nil if BEG = END
;; Add that string to the kill ring, one way or another.
(if (eq last-command 'kill-region)
(kill-append string (< end beg) yank-handler)
(kill-new string nil yank-handler)))
(kill-append string (< end beg))
(kill-new string nil)))
(when (or string (eq last-command 'kill-region))
(setq this-command 'kill-region))
(setq deactivate-mark t)
@ -3582,7 +3589,7 @@ to make one entry in the kill ring."
;; We should beep, in case the user just isn't aware of this.
;; However, there's no harm in putting
;; the region's text in the kill ring, anyway.
(copy-region-as-kill beg end)
(copy-region-as-kill beg end region)
;; Set this-command now, so it will be set even if we get an error.
(setq this-command 'kill-region)
;; This should barf, if appropriate, and give us the correct error.
@ -3592,26 +3599,31 @@ to make one entry in the kill ring."
(barf-if-buffer-read-only)
;; If the buffer isn't read-only, the text is.
(signal 'text-read-only (list (current-buffer)))))))
(set-advertised-calling-convention 'kill-region '(beg end) "23.3")
;; copy-region-as-kill no longer sets this-command, because it's confusing
;; to get two copies of the text when the user accidentally types M-w and
;; then corrects it with the intended C-w.
(defun copy-region-as-kill (beg end)
(defun copy-region-as-kill (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
system cut and paste.
The optional argument REGION if non-nil, indicates that we're not just copying
some text between BEG and END, but we're copying the region.
This command's old key binding has been given to `kill-ring-save'."
(interactive "r")
(interactive "r\np")
(let ((str (if region
(funcall region-extract-function)
(filter-buffer-substring beg end))))
(if (eq last-command 'kill-region)
(kill-append (filter-buffer-substring beg end) (< end beg))
(kill-new (filter-buffer-substring beg end)))
(kill-append str (< end beg))
(kill-new str)))
(setq deactivate-mark t)
nil)
(defun kill-ring-save (beg end)
(defun kill-ring-save (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
@ -3620,10 +3632,13 @@ system cut and paste.
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-ring-save].
The optional argument REGION if non-nil, indicates that we're not just copying
some text between BEG and END, but we're copying the region.
This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
(interactive "r")
(copy-region-as-kill beg end)
(interactive "r\np")
(copy-region-as-kill beg end region)
;; This use of called-interactively-p is correct because the code it
;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
@ -4203,8 +4218,7 @@ run `deactivate-mark-hook'."
(or (x-selection-owner-p 'PRIMARY)
(null (x-selection-exists-p 'PRIMARY))))
(x-set-selection 'PRIMARY
(buffer-substring (region-beginning)
(region-end))))))
(funcall region-extract-function nil)))))
(if (and (null force)
(or (eq transient-mark-mode 'lambda)
(and (eq (car-safe transient-mark-mode) 'only)
@ -4289,9 +4303,60 @@ mode is enabled. Usually, such commands should use
also checks the value of `use-empty-active-region'."
(and transient-mark-mode mark-active))
(defvar mark-ring nil
(defvar redisplay-unhighlight-region-function
(lambda (rol) (when (overlayp rol) (delete-overlay rol))))
(defvar redisplay-highlight-region-function
(lambda (start end window rol)
(if (not (overlayp rol))
(let ((nrol (make-overlay start end)))
(funcall redisplay-unhighlight-region-function rol)
(overlay-put nrol 'window window)
(overlay-put nrol 'face 'region)
nrol)
(unless (and (eq (overlay-buffer rol) (current-buffer))
(eq (overlay-start rol) start)
(eq (overlay-end rol) end))
(move-overlay rol start end (current-buffer)))
rol)))
(defun redisplay--update-region-highlight (window)
(with-current-buffer (window-buffer window)
(let ((rol (window-parameter window 'internal-region-overlay)))
(if (not (region-active-p))
(funcall redisplay-unhighlight-region-function rol)
(let* ((pt (window-point window))
(mark (mark))
(start (min pt mark))
(end (max pt mark))
(new
(funcall redisplay-highlight-region-function
start end window rol)))
(unless (equal new rol)
(set-window-parameter window 'internal-region-overlay
new)))))))
(defun redisplay--update-region-highlights (windows)
(with-demoted-errors "redisplay--update-region-highlights: %S"
(if (null windows)
(redisplay--update-region-highlight (selected-window))
(unless (listp windows) (setq windows (window-list-1 nil nil t)))
(if highlight-nonselected-windows
(mapc #'redisplay--update-region-highlight windows)
(let ((msw (and (window-minibuffer-p) (minibuffer-selected-window))))
(dolist (w windows)
(if (or (eq w (selected-window)) (eq w msw))
(redisplay--update-region-highlight w)
(funcall redisplay-unhighlight-region-function
(window-parameter w 'internal-region-overlay)))))))))
(add-function :before pre-redisplay-function
#'redisplay--update-region-highlights)
(defvar-local mark-ring nil
"The list of former marks of the current buffer, most recent first.")
(make-variable-buffer-local 'mark-ring)
(put 'mark-ring 'permanent-local t)
(defcustom mark-ring-max 16
@ -4466,7 +4531,6 @@ mode temporarily."
(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
(if (null omark)
(error "No mark set in this buffer"))
(deactivate-mark)
(set-mark (point))
(goto-char omark)
(cond (temp-highlight

1
lisp/subr.el
View File

@ -2818,6 +2818,7 @@ if it's an autoloaded macro."
val))
;;;; Support for yanking and text properties.
;; Why here in subr.el rather than in simple.el? --Stef
(defvar yank-handled-properties)
(defvar yank-excluded-properties)

24
src/ChangeLog
View File

@ -1,3 +1,27 @@
2013-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
* xdisp.c (prepare_menu_bars): Call Vpre_redisplay_function.
(syms_of_xdisp): Declare pre-redisplay-function.
(markpos_of_region): Remove function.
(init_iterator, compute_stop_pos, handle_face_prop)
(face_before_or_after_it_pos, reseat_to_string)
(get_next_display_element, window_buffer_changed)
(redisplay_internal, try_cursor_movement, redisplay_window)
(try_window_reusing_current_matrix, try_window_id, display_line)
(note_mode_line_or_margin_highlight, note_mouse_highlight)
(display_string, mouse_face_from_buffer_pos): Remove region handling.
* window.h (struct window): Remove field `region_showing'.
* dispextern.h (struct it): Remove region_beg/end_charpos.
(face_at_buffer_position, face_for_overlay_string)
(face_at_string_position): Update prototypes.
* xfaces.c (face_at_buffer_position, face_for_overlay_string)
(face_at_string_position): Remove `region_beg' and `region_end' args.
* fontset.c (Finternal_char_font):
* font.c (font_at, font_range): Adjust calls accordingly.
* insdel.c (Qregion_extract_function): New var.
(syms_of_insdel): Initialize it.
(prepare_to_modify_buffer_1): Use it.
2013-10-29 Dmitry Antipov <dmantipov@yandex.ru>
Prefer 'unsigned long' to 'long unsigned int' and 'unsigned long int'.

11
src/dispextern.h
View File

@ -2214,10 +2214,6 @@ struct it
used for overlay strings and strings from display properties. */
ptrdiff_t string_nchars;
/* Start and end of a visible region; -1 if the region is not
visible in the window. */
ptrdiff_t region_beg_charpos, region_end_charpos;
/* Position at which redisplay end trigger functions should be run. */
ptrdiff_t redisplay_end_trigger_charpos;
@ -3325,7 +3321,7 @@ void init_baud_rate (int);
void init_sigio (int);
void ignore_sigio (void);
/* Defined in xfaces.c */
/* Defined in xfaces.c. */
#ifdef HAVE_X_WINDOWS
void unload_color (struct frame *, unsigned long);
@ -3352,16 +3348,13 @@ void init_frame_faces (struct frame *);
void free_frame_faces (struct frame *);
void recompute_basic_faces (struct frame *);
int face_at_buffer_position (struct window *w, ptrdiff_t pos,
ptrdiff_t region_beg, ptrdiff_t region_end,
ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, int base_face_id);
int face_for_overlay_string (struct window *w, ptrdiff_t pos,
ptrdiff_t region_beg, ptrdiff_t region_end,
ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, Lisp_Object overlay);
int face_at_string_position (struct window *w, Lisp_Object string,
ptrdiff_t pos, ptrdiff_t bufpos,
ptrdiff_t region_beg, ptrdiff_t region_end,
ptrdiff_t *endptr, enum face_id, int mouse);
int merge_faces (struct frame *, Lisp_Object, int, int);
int compute_char_face (struct frame *, int, Lisp_Object);
@ -3369,7 +3362,7 @@ void free_all_realized_faces (Lisp_Object);
extern Lisp_Object Qforeground_color, Qbackground_color;
extern char unspecified_fg[], unspecified_bg[];
/* Defined in xfns.c */
/* Defined in xfns.c. */
#ifdef HAVE_X_WINDOWS
void gamma_correct (struct frame *, XColor *);

6
src/font.c
View File

@ -3669,10 +3669,10 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w,
ptrdiff_t endptr;
if (STRINGP (string))
face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
face_id = face_at_string_position (w, string, pos, 0, &endptr,
DEFAULT_FACE_ID, 0);
else
face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
face_id = face_at_buffer_position (w, pos, &endptr,
pos + 100, 0, -1);
face = FACE_FROM_ID (f, face_id);
}
@ -3716,7 +3716,7 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit,
{
int face_id;
face_id = face_at_buffer_position (w, pos, 0, 0, &ignore,
face_id = face_at_buffer_position (w, pos, &ignore,
*limit, 0, -1);
face = FACE_FROM_ID (XFRAME (w->frame), face_id);
}

2
src/fontset.c
View File

@ -1875,7 +1875,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
return Qnil;
w = XWINDOW (window);
f = XFRAME (w->frame);
face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
face_id = face_at_buffer_position (w, pos, &dummy,
pos + 100, 0, -1);
}
if (! CHAR_VALID_P (c))

11
src/insdel.c
View File

@ -1778,6 +1778,8 @@ modify_text (ptrdiff_t start, ptrdiff_t end)
bset_point_before_scroll (current_buffer, Qnil);
}
Lisp_Object Qregion_extract_function;
/* Check that it is okay to modify the buffer between START and END,
which are char positions.
@ -1843,6 +1845,7 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
#endif /* not CLASH_DETECTION */
/* If `select-active-regions' is non-nil, save the region text. */
/* FIXME: Move this to Elisp (via before-change-functions). */
if (!NILP (BVAR (current_buffer, mark_active))
&& !inhibit_modification_hooks
&& XMARKER (BVAR (current_buffer, mark))->buffer
@ -1854,10 +1857,8 @@ prepare_to_modify_buffer_1 (ptrdiff_t start, ptrdiff_t end,
{
ptrdiff_t b = marker_position (BVAR (current_buffer, mark));
ptrdiff_t e = PT;
if (b < e)
Vsaved_region_selection = make_buffer_string (b, e, 0);
else if (b > e)
Vsaved_region_selection = make_buffer_string (e, b, 0);
Vsaved_region_selection
= call1 (Fsymbol_value (Qregion_extract_function), Qnil);
}
signal_before_change (start, end, preserve_ptr);
@ -2202,5 +2203,7 @@ as well as hooks attached to text properties and overlays. */);
inhibit_modification_hooks = 0;
DEFSYM (Qinhibit_modification_hooks, "inhibit-modification-hooks");
DEFSYM (Qregion_extract_function, "region-extract-function");
defsubr (&Scombine_after_change_execute);
}

4
src/window.h
View File

@ -341,10 +341,6 @@ struct window
y-direction (smooth scrolling). */
int vscroll;
/* If we have highlighted the region (or any part of it), the mark
(region start) position; otherwise zero. */
ptrdiff_t region_showing;
/* Z_BYTE - buffer position of the last glyph in the current matrix of W.
Should be nonnegative, and only valid if window_end_valid is nonzero. */
ptrdiff_t window_end_bytepos;

155
src/xdisp.c
View File

@ -2601,24 +2601,6 @@ check_window_end (struct window *w)
#endif /* GLYPH_DEBUG and ENABLE_CHECKING */
/* Return mark position if current buffer has the region of non-zero length,
or -1 otherwise. */
static ptrdiff_t
markpos_of_region (void)
{
if (!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (current_buffer, mark_active))
&& XMARKER (BVAR (current_buffer, mark))->buffer != NULL)
{
ptrdiff_t markpos = XMARKER (BVAR (current_buffer, mark))->charpos;
if (markpos != PT)
return markpos;
}
return -1;
}
/***********************************************************************
Iterator initialization
***********************************************************************/
@ -2647,7 +2629,6 @@ init_iterator (struct it *it, struct window *w,
ptrdiff_t charpos, ptrdiff_t bytepos,
struct glyph_row *row, enum face_id base_face_id)
{
ptrdiff_t markpos;
enum face_id remapped_base_face_id = base_face_id;
/* Some precondition checks. */
@ -2751,28 +2732,6 @@ init_iterator (struct it *it, struct window *w,
/* Are multibyte characters enabled in current_buffer? */
it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters));
/* If visible region is of non-zero length, set IT->region_beg_charpos
and IT->region_end_charpos to the start and end of a visible region
in window IT->w. Set both to -1 to indicate no region. */
markpos = markpos_of_region ();
if (markpos >= 0
/* Maybe highlight only in selected window. */
&& (/* Either show region everywhere. */
highlight_nonselected_windows
/* Or show region in the selected window. */
|| w == XWINDOW (selected_window)
/* Or show the region if we are in the mini-buffer and W is
the window the mini-buffer refers to. */
|| (MINI_WINDOW_P (XWINDOW (selected_window))
&& WINDOWP (minibuf_selected_window)
&& w == XWINDOW (minibuf_selected_window))))
{
it->region_beg_charpos = min (PT, markpos);
it->region_end_charpos = max (PT, markpos);
}
else
it->region_beg_charpos = it->region_end_charpos = -1;
/* Get the position at which the redisplay_end_trigger hook should
be run, if it is to be run at all. */
if (MARKERP (w->redisplay_end_trigger)
@ -3406,16 +3365,6 @@ compute_stop_pos (struct it *it)
if (pos < it->stop_charpos)
it->stop_charpos = pos;
/* If showing the region, we have to stop at the region
start or end because the face might change there. */
if (it->region_beg_charpos > 0)
{
if (IT_CHARPOS (*it) < it->region_beg_charpos)
it->stop_charpos = min (it->stop_charpos, it->region_beg_charpos);
else if (IT_CHARPOS (*it) < it->region_end_charpos)
it->stop_charpos = min (it->stop_charpos, it->region_end_charpos);
}
/* Set up variables for computing the stop position from text
property changes. */
XSETBUFFER (object, current_buffer);
@ -3799,8 +3748,6 @@ handle_face_prop (struct it *it)
new_face_id
= face_at_buffer_position (it->w,
IT_CHARPOS (*it),
it->region_beg_charpos,
it->region_end_charpos,
&next_stop,
(IT_CHARPOS (*it)
+ TEXT_PROP_DISTANCE_LIMIT),
@ -3877,8 +3824,6 @@ handle_face_prop (struct it *it)
base_face_id
= face_for_overlay_string (it->w,
IT_CHARPOS (*it),
it->region_beg_charpos,
it->region_end_charpos,
&next_stop,
(IT_CHARPOS (*it)
+ TEXT_PROP_DISTANCE_LIMIT),
@ -3907,8 +3852,6 @@ handle_face_prop (struct it *it)
it->string,
IT_STRING_CHARPOS (*it),
bufpos,
it->region_beg_charpos,
it->region_end_charpos,
&next_stop,
base_face_id, 0);
@ -4051,8 +3994,6 @@ face_before_or_after_it_pos (struct it *it, int before_p)
it->string,
charpos,
bufpos,
it->region_beg_charpos,
it->region_end_charpos,
&next_check_charpos,
base_face_id, 0);
@ -4142,8 +4083,6 @@ face_before_or_after_it_pos (struct it *it, int before_p)
/* Determine face for CHARSET_ASCII, or unibyte. */
face_id = face_at_buffer_position (it->w,
CHARPOS (pos),
it->region_beg_charpos,
it->region_end_charpos,
&next_check_charpos,
limit, 0, -1);
@ -6441,9 +6380,6 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
ptrdiff_t charpos, ptrdiff_t precision, int field_width,
int multibyte)
{
/* No region in strings. */
it->region_beg_charpos = it->region_end_charpos = -1;
/* No text property checks performed by default, but see below. */
it->stop_charpos = -1;
@ -7033,8 +6969,7 @@ get_next_display_element (struct it *it)
INC_TEXT_POS (pos, it->multibyte_p);
next_face_id = face_at_buffer_position
(it->w, CHARPOS (pos), it->region_beg_charpos,
it->region_end_charpos, &ignore,
(it->w, CHARPOS (pos), &ignore,
(IT_CHARPOS (*it) + TEXT_PROP_DISTANCE_LIMIT), 0,
-1);
it->end_of_box_run_p
@ -10906,8 +10841,7 @@ buffer_shared_and_changed (void)
&& UNCHANGED_MODIFIED < MODIFF);
}
/* Nonzero if W's buffer was changed but not saved or Transient Mark mode
is enabled and mark of W's buffer was changed since last W's update. */
/* Nonzero if W's buffer was changed but not saved. */
static int
window_buffer_changed (struct window *w)
@ -10916,9 +10850,7 @@ window_buffer_changed (struct window *w)
eassert (BUFFER_LIVE_P (b));
return (((BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) != w->last_had_star)
|| ((!NILP (Vtransient_mark_mode) && !NILP (BVAR (b, mark_active)))
!= (w->region_showing != 0)));
return (((BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) != w->last_had_star));
}
/* Nonzero if W has %c in its mode line and mode line should be updated. */
@ -11273,6 +11205,10 @@ prepare_menu_bars (void)
all_windows = (update_mode_lines
|| buffer_shared_and_changed ()
|| windows_or_buffers_changed);
if (FUNCTIONP (Vpre_redisplay_function))
safe_call1 (Vpre_redisplay_function, all_windows ? Qt : Qnil);
if (all_windows)
{
Lisp_Object tail, frame;
@ -13147,17 +13083,6 @@ redisplay_internal (void)
clear_garbaged_frames ();
}
/* If showing the region, and mark has changed, we must redisplay
the whole window. The assignment to this_line_start_pos prevents
the optimization directly below this if-statement. */
if (((!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (XBUFFER (w->contents), mark_active)))
!= (w->region_showing > 0))
|| (w->region_showing
&& w->region_showing
!= XINT (Fmarker_position (BVAR (XBUFFER (w->contents), mark)))))
CHARPOS (this_line_start_pos) = 0;
/* Optimize the case that only the line containing the cursor in the
selected window has changed. Variables starting with this_ are
set in display_line and record information about the line
@ -13317,13 +13242,7 @@ redisplay_internal (void)
}
/* If highlighting the region, or if the cursor is in the echo area,
then we can't just move the cursor. */
else if (! (!NILP (Vtransient_mark_mode)
&& !NILP (BVAR (current_buffer, mark_active)))
&& (EQ (selected_window,
BVAR (current_buffer, last_selected_window))
|| highlight_nonselected_windows)
&& !w->region_showing
&& NILP (Vshow_trailing_whitespace)
else if (NILP (Vshow_trailing_whitespace)
&& !cursor_in_echo_area)
{
struct it it;
@ -15003,11 +14922,6 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste
&& !update_mode_lines
&& !windows_or_buffers_changed
&& !f->cursor_type_changed
/* Can't use this case if highlighting a region. When a
region exists, cursor movement has to do more than just
set the cursor. */
&& markpos_of_region () < 0
&& !w->region_showing
&& NILP (Vshow_trailing_whitespace)
/* This code is not used for mini-buffer for the sake of the case
of redisplaying to replace an echo area message; since in
@ -15622,7 +15536,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
Move it back to a fully-visible line. */
new_vpos = window_box_height (w);
}
else if (w->cursor.vpos >=0)
else if (w->cursor.vpos >= 0)
{
/* Some people insist on not letting point enter the scroll
margin, even though this part handles windows that didn't
@ -15680,12 +15594,14 @@ redisplay_window (Lisp_Object window, int just_this_one_p)
/* If we are highlighting the region, then we just changed
the region, so redisplay to show it. */
if (markpos_of_region () >= 0)
/* FIXME: We need to (re)run pre-redisplay-function! */
/* if (markpos_of_region () >= 0)
{
clear_glyph_matrix (w->desired_matrix);
if (!try_window (window, startp, 0))
goto need_larger_matrices;
}
*/
}
#ifdef GLYPH_DEBUG
@ -16380,10 +16296,8 @@ try_window_reusing_current_matrix (struct window *w)
|| f->cursor_type_changed)
return 0;
/* Can't do this if region may have changed. */
if (markpos_of_region () >= 0
|| w->region_showing
|| !NILP (Vshow_trailing_whitespace))
/* Can't do this if showing trailing whitespace. */
if (!NILP (Vshow_trailing_whitespace))
return 0;
/* If top-line visibility has changed, give up. */
@ -17181,19 +17095,10 @@ try_window_id (struct window *w)
if (!w->window_end_valid)
GIVE_UP (8);
/* Can't use this if highlighting a region because a cursor movement
will do more than just set the cursor. */
if (markpos_of_region () >= 0)
GIVE_UP (9);
/* Likewise if highlighting trailing whitespace. */
if (!NILP (Vshow_trailing_whitespace))
GIVE_UP (11);
/* Likewise if showing a region. */
if (w->region_showing)
GIVE_UP (10);
/* Can't use this if overlay arrow position and/or string have
changed. */
if (overlay_arrows_changed_p ())
@ -19277,9 +19182,6 @@ display_line (struct it *it)
return 0;
}
/* Is IT->w showing the region? */
it->w->region_showing = it->region_beg_charpos > 0 ? it->region_beg_charpos : 0;
/* Clear the result glyph row and enable it. */
prepare_desired_row (row);
@ -22413,9 +22315,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
it->face_id
= face_at_string_position (it->w, face_string, face_string_pos,
0, it->region_beg_charpos,
it->region_end_charpos,
&endptr, it->base_face_id, 0);
0, &endptr, it->base_face_id, 0);
face = FACE_FROM_ID (it->f, it->face_id);
it->face_box_p = face->box != FACE_NO_BOX;
}
@ -27419,7 +27319,7 @@ mouse_face_from_buffer_pos (Lisp_Object window,
hlinfo->mouse_face_window = window;
hlinfo->mouse_face_face_id
= face_at_buffer_position (w, mouse_charpos, 0, 0, &ignore,
= face_at_buffer_position (w, mouse_charpos, &ignore,
mouse_charpos + 1,
!hlinfo->mouse_face_hidden, -1);
show_mouse_face (hlinfo, DRAW_MOUSE_FACE);
@ -28100,8 +28000,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
hlinfo->mouse_face_face_id = face_at_string_position (w, string,
charpos,
0, 0, 0,
&ignore,
0, &ignore,
glyph->face_id,
1);
show_mouse_face (hlinfo, DRAW_MOUSE_FACE);
@ -28402,7 +28301,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
hlinfo->mouse_face_past_end = 0;
hlinfo->mouse_face_window = window;
hlinfo->mouse_face_face_id
= face_at_string_position (w, object, pos, 0, 0, 0, &ignore,
= face_at_string_position (w, object, pos, 0, &ignore,
glyph->face_id, 1);
show_mouse_face (hlinfo, DRAW_MOUSE_FACE);
cursor = No_Cursor;
@ -28449,13 +28348,14 @@ note_mouse_highlight (struct frame *f, int x, int y)
the first row visible in a window does not
necessarily display the character whose position
is the smallest. */
Lisp_Object lim1 =
NILP (BVAR (XBUFFER (buffer), bidi_display_reordering))
Lisp_Object lim1
= NILP (BVAR (XBUFFER (buffer), bidi_display_reordering))
? Fmarker_position (w->start)
: Qnil;
Lisp_Object lim2 =
NILP (BVAR (XBUFFER (buffer), bidi_display_reordering))
? make_number (BUF_Z (XBUFFER (buffer)) - w->window_end_pos)
Lisp_Object lim2
= NILP (BVAR (XBUFFER (buffer), bidi_display_reordering))
? make_number (BUF_Z (XBUFFER (buffer))
- w->window_end_pos)
: Qnil;
if (NILP (overlay))
@ -29788,6 +29688,13 @@ cursor shapes. */);
DEFSYM (Qthin_space, "thin-space");
DEFSYM (Qzero_width, "zero-width");
DEFVAR_LISP ("pre-redisplay-function", Vpre_redisplay_function,
doc: /* Function run just before redisplay.
It is called with one argument, which is the set of windows that are to
be redisplayed. This set can be nil (meaning, only the selected window),
or t (meaning all windows). */);
Vpre_redisplay_function = intern ("ignore");
DEFSYM (Qglyphless_char_display, "glyphless-char-display");
Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_number (1));

44
src/xfaces.c
View File

@ -5916,7 +5916,6 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop)
int
face_at_buffer_position (struct window *w, ptrdiff_t pos,
ptrdiff_t region_beg, ptrdiff_t region_end,
ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, int base_face_id)
{
@ -5937,8 +5936,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
XSETFASTINT (position, pos);
endpos = ZV;
if (pos < region_beg && region_beg < endpos)
endpos = region_beg;
/* Get the `face' or `mouse_face' text property at POS, and
determine the next position at which the property changes. */
@ -5974,8 +5971,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
/* Optimize common cases where we can use the default face. */
if (noverlays == 0
&& NILP (prop)
&& !(pos >= region_beg && pos < region_end))
&& NILP (prop))
return default_face->id;
/* Begin with attributes from the default face. */
@ -6002,15 +5998,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
endpos = oendpos;
}
/* If in the region, merge in the region face. */
if (pos >= region_beg && pos < region_end)
{
merge_named_face (f, Qregion, attrs, 0);
if (region_end < endpos)
endpos = region_end;
}
*endptr = endpos;
/* Look up a realized face with the given face attributes,
@ -6026,7 +6013,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
int
face_for_overlay_string (struct window *w, ptrdiff_t pos,
ptrdiff_t region_beg, ptrdiff_t region_end,
ptrdiff_t *endptr, ptrdiff_t limit,
int mouse, Lisp_Object overlay)
{
@ -6045,8 +6031,6 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos,
XSETFASTINT (position, pos);
endpos = ZV;
if (pos < region_beg && region_beg < endpos)
endpos = region_beg;
/* Get the `face' or `mouse_face' text property at POS, and
determine the next position at which the property changes. */
@ -6060,7 +6044,6 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos,
/* Optimize common case where we can use the default face. */
if (NILP (prop)
&& !(pos >= region_beg && pos < region_end)
&& NILP (Vface_remapping_alist))
return DEFAULT_FACE_ID;
@ -6072,15 +6055,6 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos,
if (!NILP (prop))
merge_face_ref (f, prop, attrs, 1, 0);
/* If in the region, merge in the region face. */
if (pos >= region_beg && pos < region_end)
{
merge_named_face (f, Qregion, attrs, 0);
if (region_end < endpos)
endpos = region_end;
}
*endptr = endpos;
/* Look up a realized face with the given face attributes,
@ -6113,7 +6087,6 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos,
int
face_at_string_position (struct window *w, Lisp_Object string,
ptrdiff_t pos, ptrdiff_t bufpos,
ptrdiff_t region_beg, ptrdiff_t region_end,
ptrdiff_t *endptr, enum face_id base_face_id,
int mouse_p)
{
@ -6145,15 +6118,8 @@ face_at_string_position (struct window *w, Lisp_Object string,
base_face = FACE_FROM_ID (f, base_face_id);
eassert (base_face);
/* Optimize the default case that there is no face property and we
are not in the region. */
/* Optimize the default case that there is no face property. */
if (NILP (prop)
&& (base_face_id != DEFAULT_FACE_ID
/* BUFPOS <= 0 means STRING is not an overlay string, so
that the region doesn't have to be taken into account. */
|| bufpos <= 0
|| bufpos < region_beg
|| bufpos >= region_end)
&& (multibyte_p
/* We can't realize faces for different charsets differently
if we don't have fonts, so we can stop here if not working
@ -6169,12 +6135,6 @@ face_at_string_position (struct window *w, Lisp_Object string,
if (!NILP (prop))
merge_face_ref (f, prop, attrs, 1, 0);
/* If in the region, merge in the region face. */
if (bufpos
&& bufpos >= region_beg
&& bufpos < region_end)
merge_named_face (f, Qregion, attrs, 0);
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
return lookup_face (f, attrs);