diff options
| -rw-r--r-- | etc/NEWS | 7 | ||||
| -rw-r--r-- | lisp/ChangeLog | 27 | ||||
| -rw-r--r-- | lisp/comint.el | 7 | ||||
| -rw-r--r-- | lisp/delsel.el | 6 | ||||
| -rw-r--r-- | lisp/rect.el | 148 | ||||
| -rw-r--r-- | lisp/simple.el | 140 | ||||
| -rw-r--r-- | lisp/subr.el | 1 | ||||
| -rw-r--r-- | src/ChangeLog | 24 | ||||
| -rw-r--r-- | src/dispextern.h | 11 | ||||
| -rw-r--r-- | src/font.c | 6 | ||||
| -rw-r--r-- | src/fontset.c | 2 | ||||
| -rw-r--r-- | src/insdel.c | 11 | ||||
| -rw-r--r-- | src/window.h | 4 | ||||
| -rw-r--r-- | src/xdisp.c | 155 | ||||
| -rw-r--r-- | src/xfaces.c | 44 |
15 files changed, 357 insertions, 236 deletions
@@ -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. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 885540cdba4..988047c9bc0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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. diff --git a/lisp/comint.el b/lisp/comint.el index 7572e8baabc..8e1b2105de3 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -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. diff --git a/lisp/delsel.el b/lisp/delsel.el index 672c93443d8..07a7a37db34 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -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) diff --git a/lisp/rect.el b/lisp/rect.el index ec234b6514f..44799f2616a 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -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 diff --git a/lisp/simple.el b/lisp/simple.el index 1f1b5cb376f..cd4df60e394 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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 diff --git a/lisp/subr.el b/lisp/subr.el index 05bbe6ea649..ae1db6652db 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -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) diff --git a/src/ChangeLog b/src/ChangeLog index 287215392db..06e71e33fde 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -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'. diff --git a/src/dispextern.h b/src/dispextern.h index 0d225e9616f..dd64ae1921f 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -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 *); diff --git a/src/font.c b/src/font.c index aaa02c20e48..1e1670b21af 100644 --- a/src/font.c +++ b/src/font.c @@ -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); } diff --git a/src/fontset.c b/src/fontset.c index 15fdf9f41a0..090c097c929 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -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)) diff --git a/src/insdel.c b/src/insdel.c index 0eb80c04d99..7e6182deb91 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -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); } diff --git a/src/window.h b/src/window.h index cc4332ccf7f..f619b82e8a3 100644 --- a/src/window.h +++ b/src/window.h @@ -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; diff --git a/src/xdisp.c b/src/xdisp.c index d62bc6ba96c..5cd2c2badcc 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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)); diff --git a/src/xfaces.c b/src/xfaces.c index 2145d7ff59d..f50fffc6419 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -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); |