From 84e0b7dad6f1a8e53261f9b96f5a9080fea681a4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 13 Apr 2015 15:51:15 -0400 Subject: [PATCH] Deprecate `intangible' and `point-entered' properties * lisp/emacs-lisp/cursor-sensor.el: New file. * lisp/simple.el (pre-redisplay-functions): New hook. (redisplay--pre-redisplay-functions): New function. (pre-redisplay-function): Use it. (minibuffer-avoid-prompt): Mark obsolete. (redisplay--update-region-highlight): Adapt it to work as a function on pre-redisplay-functions. * lisp/cus-start.el (minibuffer-prompt-properties--setter): New fun. (minibuffer-prompt-properties): Use it. Use cursor-intangible rather than point-entered to make the prompt intangible. * lisp/forms.el: Move `provide' calls to the end. (forms-mode): Don't use `run-hooks' on a local var. (forms--make-format, forms--make-format-elt-using-text-properties): Use cursor-intangible rather than `intangible'. (forms-mode): Enable cursor-intangible-mode. * lisp/isearch.el (isearch-mode): Use defvar-local. (cursor-sensor-inhibit): Declare. (isearch-mode): Set cursor-sensor-inhibit. (isearch-done): Set it back. (isearch-open-overlay-temporary, isearch-open-necessary-overlays) (isearch-close-unnecessary-overlays): Don't bother with `intangible' any more. * lisp/ses.el (ses-localvars): Remove `mode-line-process'. (ses-sym-rowcol, ses-cell-value, ses-col-width, ses-col-printer): Add Edebug spec. (ses-goto-print, ses-print-cell, ses-adjust-print-width) (ses-goto-data, ses-setup, ses-copy-region): Don't let-bind inhibit-point-motion-hooks any more. (ses--cell-at-pos, ses--curcell): New functions, extracted from ses-set-curcell. (ses-set-curcell): Use them. (ses-print-cell, ses-setup): Use cursor-intangible instead of `intangible'. Make sure cursor-intangible isn't sticky at BOB. (ses-print-cell-new-width, ses-reprint-all, ses-recalculate-all): Use ses--cell-at-pos. (ses--mode-line-process, ses--cursor-sensor-highlight): New functions, extracted from ses-command-hook. Make them work with multiple windows displaying the same buffer. (ses-mode): Use them via mode-line-process and pre-redisplay-functions. Enable cursor-intangible-mode. (ses-command-hook): Remove cell highlight and mode-line update code. (ses-forward-or-insert, ses-copy-region-helper, ses-sort-column): Update for new name of text-property holding the cell name. (ses-rename-cell): Don't mess with mode-line-process. * lisp/erc/erc-stamp.el (erc-add-timestamp): Use the new cursor-sensor-functions property instead of point-entered. (erc-insert-timestamp-right, erc-format-timestamp): Use cursor-intangible rather than `intangible'. (erc-munge-invisibility-spec): Use add-to-invisibility-spec and remove-from-invisibility-spec. Enable cursor-intangible-mode and cursor-sensor-mode if needed. (erc-echo-timestamp): Adapt to calling convention of cursor-sensor-functions. (erc-insert-timestamp-right): Remove unused vars `current-window' and `indent'. * lisp/gnus/gnus-group.el (gnus-tmp-*): Declare. (gnus-update-group-mark-positions): Remove unused `topic' var. (gnus-group-insert-group-line): Remove unused var `header'. (gnus-group--setup-tool-bar-update): New function. (gnus-group-insert-group-line): Use it. (gnus-group-update-eval-form): Declare local dynamically-bound variables. (gnus-group-unsubscribe-group): Use \` and \' to match string bounds. * lisp/gnus/gnus-topic.el (gnus-topic-jump-to-topic) (gnus-group-prepare-topics, gnus-topic-update-topic) (gnus-topic-change-level, gnus-topic-catchup-articles) (gnus-topic-remove-group, gnus-topic-delete, gnus-topic-indent): Use inhibit-read-only. (gnus-topic-prepare-topic): Use gnus-group--setup-tool-bar-update. (gnus-topic-mode): Use define-minor-mode and derived-mode-p. * lisp/textmodes/reftex-index.el (reftex-display-index): Use cursor-intangible-mode if available. (reftex-index-post-command-hook): Check cursor-intangible. * lisp/textmodes/reftex-toc.el (reftex-toc): Use cursor-intangible-mode if available. (reftex-toc-recenter, reftex-toc-post-command-hook): Check cursor-intangible. * lisp/textmodes/sgml-mode.el: Use lexical-binding. (sgml-tag): Use cursor-sensor-functions instead of point-entered. (sgml-tags-invisible): Use with-silent-modifications and inhibit-read-only. Enable cursor-sensor-mode. (sgml-cursor-sensor): Rename from sgml-point-entered and adjust to calling convention of cursor-sensor-functions. * lisp/textmodes/table.el (table-cell-map-hook, table-load-hook) (table-point-entered-cell-hook, table-point-left-cell-hook): Don't autoload. (table-cell-entered-state): Remove var. (table--put-cell-point-entered/left-property) (table--remove-cell-properties): Use cursor-sensor-functions rather than point-entered/left. (table--point-entered/left-cell-function): Merge table--point-entered-cell-function and table--point-left-cell-function and adjust to calling convention of cursor-sensor-functions. --- etc/NEWS | 7 ++ lisp/cus-start.el | 59 +++++----- lisp/emacs-lisp/cursor-sensor.el | 180 +++++++++++++++++++++++++++++ lisp/erc/erc-stamp.el | 54 ++++----- lisp/forms.el | 20 ++-- lisp/gnus/gnus-group.el | 52 +++++++-- lisp/gnus/gnus-topic.el | 46 +++----- lisp/isearch.el | 35 +++--- lisp/ses.el | 191 ++++++++++++++++++------------- lisp/simple.el | 65 ++++++----- lisp/textmodes/reftex-index.el | 29 +++-- lisp/textmodes/reftex-toc.el | 19 ++- lisp/textmodes/sgml-mode.el | 127 ++++++++++---------- lisp/textmodes/table.el | 53 +++------ 14 files changed, 600 insertions(+), 337 deletions(-) create mode 100644 lisp/emacs-lisp/cursor-sensor.el diff --git a/etc/NEWS b/etc/NEWS index caf62501841..8a9fa7c5c84 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -693,6 +693,13 @@ word syntax, use `\sw' instead. * Lisp Changes in Emacs 25.1 +** New hook `pre-redisplay-functions', a bit easier to use than pre-redisplay-function. + +** Obsolete text properties `intangible', `point-entered', and `point-left'. +Replaced by properties `cursor-intangible' and `cursor-sensor-functions', +implemented by the new `cursor-intangible-mode' and +`cursor-sensor-mode' minor modes. + ** New process type `pipe', which can be used in combination with the `:stderr' keyword of make-process to handle standard error output of subprocess. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 71506cb680e..b96b81763ce 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -1,4 +1,4 @@ -;;; cus-start.el --- define customization properties of builtins +;;; cus-start.el --- define customization properties of builtins -*- lexical-binding:t -*- ;; Copyright (C) 1997, 1999-2015 Free Software Foundation, Inc. @@ -33,6 +33,14 @@ ;;; Code: +(defun minibuffer-prompt-properties--setter (symbol value) + (set-default symbol value) + (if (memq 'cursor-intangible value) + (add-hook 'minibuffer-setup-hook 'cursor-intangible-mode) + ;; Removing it is a bit trickier since it could have been added by someone + ;; else as well, so let's just not bother. + )) + ;; Elements of this list have the form: ;; SYMBOL GROUP TYPE VERSION REST... ;; SYMBOL is the name of the variable. @@ -46,7 +54,23 @@ ;; :risky - risky-local-variable property ;; :safe - safe-local-variable property ;; :tag - custom-tag property -(let ((all '(;; alloc.c +(let (standard native-p prop propval + ;; This function turns a value + ;; into an expression which produces that value. + (quoter (lambda (sexp) + ;; FIXME: We'd like to use macroexp-quote here, but cus-start + ;; is loaded too early in loadup.el for that. + (if (or (memq sexp '(t nil)) + (keywordp sexp) + (and (listp sexp) + (memq (car sexp) '(lambda))) + (stringp sexp) + (numberp sexp)) + sexp + (list 'quote sexp))))) + (pcase-dolist + (`(,symbol ,group ,type ,version . ,rest) + '(;; alloc.c (gc-cons-threshold alloc integer) (gc-cons-percentage alloc float) (garbage-collection-messages alloc boolean) @@ -269,10 +293,10 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (make-pointer-invisible mouse boolean "23.2") (menu-bar-mode frames boolean nil ;; FIXME? -; :initialize custom-initialize-default + ;; :initialize custom-initialize-default :set custom-set-minor-mode) (tool-bar-mode (frames mouse) boolean nil -; :initialize custom-initialize-default + ;; :initialize custom-initialize-default :set custom-set-minor-mode) (frame-resize-pixelwise frames boolean "24.4") (frame-inhibit-implied-resize frames @@ -342,14 +366,15 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of :doc "Prevent point from ever entering prompt" :format "%t%n%h" :inline t - (point-entered minibuffer-avoid-prompt))) + (cursor-intangible t))) (repeat :inline t :tag "Other Properties" (list :inline t :format "%v" (symbol :tag "Property") (sexp :tag "Value")))) - "21.1") + "21.1" + :set minibuffer-prompt-properties--setter) (minibuffer-auto-raise minibuffer boolean) ;; options property set at end (read-buffer-function minibuffer @@ -550,27 +575,7 @@ since it could result in memory overflow and make Emacs crash." (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c (font-use-system-font font-selection boolean "23.2"))) - this symbol group type standard version native-p rest prop propval - ;; This function turns a value - ;; into an expression which produces that value. - (quoter (lambda (sexp) - (if (or (memq sexp '(t nil)) - (keywordp sexp) - (and (listp sexp) - (memq (car sexp) '(lambda))) - (stringp sexp) - (numberp sexp)) - sexp - (list 'quote sexp))))) - (while all - (setq this (car all) - all (cdr all) - symbol (nth 0 this) - group (nth 1 this) - type (nth 2 this) - version (nth 3 this) - rest (nthcdr 4 this) - ;; If we did not specify any standard value expression above, + (setq ;; If we did not specify any standard value expression above, ;; use the current value as the standard value. standard (if (setq prop (memq :standard rest)) (cadr prop) diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el new file mode 100644 index 00000000000..1d1780baed0 --- /dev/null +++ b/lisp/emacs-lisp/cursor-sensor.el @@ -0,0 +1,180 @@ +;;; cursor-sensor.el --- React to cursor movement -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package implements the `cursor-intangible' property, which is +;; meant to replace the old `intangible' property. To use it, just enable the +;; `cursor-intangible-mode', after which this package will move point away from +;; any position that has a non-nil `cursor-intangible' property. This is only +;; done just before redisplay happens, contrary to the old `intangible' +;; property which was done at a much lower level. + +;;; Code: + +(defvar cursor-sensor-inhibit nil) + +(defun cursor-sensor--intangible-p (pos) + (let ((p (get-pos-property pos 'cursor-intangible))) + (if p + (let (a b) + (if (and (setq a (get-char-property pos 'cursor-intangible)) + (setq b (if (> pos (point-min)) + (get-char-property (1- pos) 'cursor-intangible))) + (not (eq a b))) + ;; If we're right between two different intangible thingies, + ;; we can stop here. This is not quite consistent with the + ;; interpretation of "if it's sticky, then this boundary is + ;; itself intangible", but it's convenient (and it better matches + ;; the behavior of `intangible', making it easier to port code). + nil p)) + p))) + +(defun cursor-sensor-tangible-pos (curpos window &optional second-chance) + (let ((newpos curpos)) + (when (cursor-sensor--intangible-p newpos) + (let ((oldpos (window-parameter window 'cursor-intangible--last-point))) + (cond + ((or (and (integerp oldpos) (< oldpos newpos)) + (eq newpos (point-min))) + (while + (when (< newpos (point-max)) + (setq newpos + (if (get-char-property newpos 'cursor-intangible) + (next-single-char-property-change + newpos 'cursor-intangible nil (point-max)) + (1+ newpos))) + (cursor-sensor--intangible-p newpos)))) + (t ;; (>= oldpos newpos) + (while + (when (> newpos (point-min)) + (setq newpos + (if (get-char-property (1- newpos) 'cursor-intangible) + (previous-single-char-property-change + newpos 'cursor-intangible nil (point-min)) + (1- newpos))) + (cursor-sensor--intangible-p newpos))))) + (if (not (and (or (eq newpos (point-min)) (eq newpos (point-max))) + (cursor-sensor--intangible-p newpos))) + ;; All clear, we're good to go. + newpos + ;; We're still on an intangible position because we bumped + ;; into an intangible BOB/EOB: try to move in the other direction. + (if second-chance + ;; Actually, we tried already and that failed! + curpos + (cursor-sensor-tangible-pos newpos window 'second-chance))))))) + +(defun cursor-sensor-move-to-tangible (window) + (let* ((curpos (window-point window)) + (newpos (cursor-sensor-tangible-pos curpos window))) + (when newpos (set-window-point window newpos)) + (set-window-parameter window 'cursor-intangible--last-point + (or newpos curpos)))) + +(defun cursor-sensor--move-to-tangible (window) + (unless cursor-sensor-inhibit + (cursor-sensor-move-to-tangible window))) + +;;;###autoload +(define-minor-mode cursor-intangible-mode + "Keep cursor outside of any `cursor-intangible' text property." + nil nil nil + (if cursor-intangible-mode + (add-hook 'pre-redisplay-functions #'cursor-sensor--move-to-tangible + nil t) + (remove-hook 'pre-redisplay-functions #'cursor-sensor--move-to-tangible t))) + +;;; Detect cursor movement. + +(defun cursor-sensor--detect (window) + (unless cursor-sensor-inhibit + (let* ((point (window-point window)) + ;; It's often desirable to make the cursor-sensor-functions property + ;; non-sticky on both ends, but that means get-pos-property might + ;; never see it. + (new (or (get-char-property point 'cursor-sensor-functions) + (unless (bobp) + (get-char-property (1- point) 'cursor-sensor-functions)))) + (old (window-parameter window 'cursor-sensor--last-state)) + (oldposmark (car old)) + (oldpos (or (if oldposmark (marker-position oldposmark)) + (point-min))) + (start (min oldpos point)) + (end (max oldpos point))) + (unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer))) + ;; `window' does not display the same buffer any more! + (setcdr old nil)) + (if (or (and (null new) (null (cdr old))) + (and (eq new (cdr old)) + (eq (next-single-property-change + start 'cursor-sensor-functions nil end) + end))) + ;; Clearly nothing to do. + nil + ;; Maybe something to do. Let's see exactly what needs to run. + (let* ((missing-p + (lambda (f) + "Non-nil if F is missing somewhere between START and END." + (let ((pos start) + (missing nil)) + (while (< pos end) + (setq pos (next-single-property-change + pos 'cursor-sensor-functions + nil end)) + (unless (memq f (get-char-property + pos 'cursor-sensor-functions)) + (setq missing t))) + missing)))) + (dolist (f (cdr old)) + (unless (and (memq f new) (not (funcall missing-p f))) + (funcall f window oldpos 'left))) + (dolist (f new) + (unless (and (memq f (cdr old)) (not (funcall missing-p f))) + (funcall f window oldpos 'entered))))) + + ;; Remember current state for next time. + ;; Re-read cursor-sensor-functions since the functions may have moved + ;; window-point! + (if old + (progn (move-marker (car old) point) + (setcdr old new)) + (set-window-parameter window 'cursor-sensor--last-state + (cons (copy-marker point) new)))))) + +;;;###autoload +(define-minor-mode cursor-sensor-mode + "Handle the `cursor-sensor-functions' text property. +This property should hold a list of functions which react to the motion +of the cursor. They're called with three arguments (WINDOW OLDPOS DIR) +where WINDOW is the affected window, OLDPOS is the last known position of +the cursor and DIR can be `left' or `entered' depending on whether the cursor is +entering the area covered by the text-property property or leaving it." + nil nil nil + (if cursor-sensor-mode + (add-hook 'pre-redisplay-functions #'cursor-sensor--detect + nil t) + (remove-hook 'pre-redisplay-functions #'cursor-sensor--detect + t))) + +(provide 'cursor-sensor) +;;; cursor-sensor.el ends here diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 1ec3f32a81e..cbcd055c3b0 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -114,7 +114,7 @@ If `erc-timestamp-format' is set, this will not be used." (string))) (defcustom erc-insert-away-timestamp-function - 'erc-insert-timestamp-left-and-right + #'erc-insert-timestamp-left-and-right "Function to use to insert the away timestamp. See `erc-insert-timestamp-function' for details." @@ -161,12 +161,12 @@ from entering them and instead jump over them." ;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." - ((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec) - (add-hook 'erc-insert-modify-hook 'erc-add-timestamp t) - (add-hook 'erc-send-modify-hook 'erc-add-timestamp t)) - ((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec) - (remove-hook 'erc-insert-modify-hook 'erc-add-timestamp) - (remove-hook 'erc-send-modify-hook 'erc-add-timestamp))) + ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec) + (add-hook 'erc-insert-modify-hook #'erc-add-timestamp t) + (add-hook 'erc-send-modify-hook #'erc-add-timestamp t)) + ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec) + (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) + (remove-hook 'erc-send-modify-hook #'erc-add-timestamp))) (defun erc-add-timestamp () "Add timestamp and text-properties to message. @@ -188,7 +188,8 @@ or `erc-send-modify-hook'." (add-text-properties (point-min) (point-max) (list 'timestamp ct)) (add-text-properties (point-min) (point-max) - (list 'point-entered 'erc-echo-timestamp))))) + (list 'cursor-sensor-functions + (list #'erc-echo-timestamp)))))) (defvar erc-timestamp-last-inserted nil "Last timestamp inserted into the buffer.") @@ -289,8 +290,7 @@ be printed just before the window-width." (setq erc-timestamp-last-inserted string) (goto-char (point-max)) (forward-char -1);; before the last newline - (let* ((current-window (get-buffer-window (current-buffer))) - (str-width (string-width string)) + (let* ((str-width (string-width string)) (pos (cond (erc-timestamp-right-column erc-timestamp-right-column) ((and (boundp 'erc-fill-mode) @@ -303,8 +303,7 @@ be printed just before the window-width." (t (- (window-width) str-width 1)))) (from (point)) - (col (current-column)) - indent) + (col (current-column))) ;; The following is a kludge used to calculate whether to move ;; to the next line before inserting a stamp. It allows for ;; some margin of error if what is displayed on the line differs @@ -319,9 +318,9 @@ be printed just before the window-width." (erc-put-text-property from (point) 'field 'erc-timestamp) (erc-put-text-property from (point) 'rear-nonsticky t) (when erc-timestamp-intangible - (erc-put-text-property from (1+ (point)) 'intangible t))))) + (erc-put-text-property from (1+ (point)) 'cursor-intangible t))))) -(defun erc-insert-timestamp-left-and-right (string) +(defun erc-insert-timestamp-left-and-right (_string) "This is another function that can be assigned to `erc-insert-timestamp-function'. If the date is changed, it will print a blank line, the date, and another blank line. If the time is @@ -356,7 +355,7 @@ Return the empty string if FORMAT is nil." ;; inelegant, hack. -- BPT (and erc-timestamp-intangible (not erc-hide-timestamps) ; bug#11706 - (erc-put-text-property 0 (length ts) 'intangible t ts)) + (erc-put-text-property 0 (length ts) 'cursor-intangible t ts)) ts) "")) @@ -366,15 +365,13 @@ Return the empty string if FORMAT is nil." ;; please modify this function and move it to a more appropriate ;; location. (defun erc-munge-invisibility-spec () + (and erc-timestamp-intangible (not (bound-and-true-p cursor-intangible-mode)) + (cursor-intangible-mode 1)) + (and erc-echo-timestamps (not (bound-and-true-p cursor-sensor-mode)) + (cursor-sensor-mode 1)) (if erc-hide-timestamps - (setq buffer-invisibility-spec - (if (listp buffer-invisibility-spec) - (cons 'timestamp buffer-invisibility-spec) - (list 't 'timestamp))) - (setq buffer-invisibility-spec - (if (listp buffer-invisibility-spec) - (remove 'timestamp buffer-invisibility-spec) - (list 't))))) + (add-to-invisibility-spec 'timespec) + (remove-from-invisibility-spec 'timespec))) (defun erc-hide-timestamps () "Hide timestamp information from display." @@ -405,12 +402,11 @@ enabled when the message was inserted." (erc-munge-invisibility-spec))) (erc-buffer-list))) -(defun erc-echo-timestamp (before now) - "Print timestamp text-property of an IRC message. -Argument BEFORE is where point was before it got moved and -NOW is position of point currently." - (when erc-echo-timestamps - (let ((stamp (get-text-property now 'timestamp))) +(defun erc-echo-timestamp (window _before dir) + "Print timestamp text-property of an IRC message." + (when (and erc-echo-timestamps (eq 'entered dir)) + (let* ((now (window-point window)) + (stamp (get-text-property now 'timestamp))) (when stamp (message "%s" (format-time-string erc-echo-timestamp-format stamp)))))) diff --git a/lisp/forms.el b/lisp/forms.el index 22ddd65c0a4..aa57a667ae7 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -297,9 +297,6 @@ ;;; Global variables and constants: -(provide 'forms) ;;; official -(provide 'forms-mode) ;;; for compatibility - (defcustom forms-mode-hook nil "Hook run upon entering Forms mode." :group 'forms @@ -443,6 +440,7 @@ Also, initial position is at last record." ;;;###autoload (defun forms-mode (&optional primary) + ;; FIXME: use define-derived-mode "Major mode to visit files in a field-structured manner using a form. Commands: Equivalent keys in read-only mode: @@ -637,6 +635,8 @@ Commands: Equivalent keys in read-only mode: (setq major-mode 'forms-mode) (setq mode-name "Forms") + (cursor-intangible-mode 1) + ;; find the data file (setq forms--file-buffer (find-file-noselect forms-file)) @@ -647,7 +647,7 @@ Commands: Equivalent keys in read-only mode: (with-current-buffer forms--file-buffer (let ((inhibit-read-only t) (file-modified (buffer-modified-p))) - (run-hooks 'read-file-filter) + (mapc #'funcall read-file-filter) (if (not file-modified) (set-buffer-modified-p nil))) (if write-file-filter (add-hook 'write-file-functions write-file-filter nil t))) @@ -921,7 +921,7 @@ Commands: Equivalent keys in read-only mode: ,@(if (numberp (car forms-format-list)) nil '((add-text-properties (point-min) (1+ (point-min)) - '(front-sticky (read-only intangible))))) + '(front-sticky (read-only cursor-intangible))))) ;; Prevent insertion after the last text. (remove-text-properties (1- (point)) (point) '(rear-nonsticky))) @@ -1005,10 +1005,10 @@ Commands: Equivalent keys in read-only mode: (point)) (list 'face forms--ro-face ; read-only appearance 'read-only ,@(list (1+ forms--marker)) - 'intangible ,@(list (1+ forms--marker)) + 'cursor-intangible ,@(list (1+ forms--marker)) 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(face read-only insert-in-front-hooks - intangible))))) + cursor-intangible))))) ((numberp el) `((let ((here (point))) @@ -1034,10 +1034,10 @@ Commands: Equivalent keys in read-only mode: (point)) (list 'face forms--ro-face 'read-only ,@(list (1+ forms--marker)) - 'intangible ,@(list (1+ forms--marker)) + 'cursor-intangible ,@(list (1+ forms--marker)) 'insert-in-front-hooks '(forms--iif-hook) 'rear-nonsticky '(read-only face insert-in-front-hooks - intangible))))) + cursor-intangible))))) ;; end of cond )) @@ -2055,4 +2055,6 @@ Usage: (setq forms-number-of-fields (goto-char (point-max)) (insert ret))))) +(provide 'forms-mode) ; for compatibility +(provide 'forms) ;;; forms.el ends here diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e22138b7028..8e8d1752a43 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -478,6 +478,26 @@ simple manner.") (defvar gnus-group-edit-buffer nil) +(defvar gnus-tmp-news-method) +(defvar gnus-tmp-colon) +(defvar gnus-tmp-news-server) +(defvar gnus-tmp-decoded-group) +(defvar gnus-tmp-header) +(defvar gnus-tmp-process-marked) +(defvar gnus-tmp-summary-live) +(defvar gnus-tmp-news-method-string) +(defvar gnus-tmp-group-icon) +(defvar gnus-tmp-moderated-string) +(defvar gnus-tmp-newsgroup-description) +(defvar gnus-tmp-comment) +(defvar gnus-tmp-qualified-group) +(defvar gnus-tmp-subscribed) +(defvar gnus-tmp-number-of-read) +(defvar gnus-inhibit-demon) +(defvar gnus-pick-mode) +(defvar gnus-tmp-marked-mark) +(defvar gnus-tmp-number-of-unread) + (defvar gnus-group-line-format-alist `((?M gnus-tmp-marked-mark ?c) (?S gnus-tmp-subscribed ?c) @@ -1140,8 +1160,7 @@ The following commands are available: (let ((gnus-process-mark ?\200) (gnus-group-update-hook nil) (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0)) - (topic "")) + (gnus-active-hashtb (make-vector 10 0))) (gnus-set-active "dummy.group" '(0 . 0)) (gnus-set-work-buffer) (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) @@ -1574,7 +1593,7 @@ if it is a string, only list groups matching REGEXP." gnus-process-mark ? )) (buffer-read-only nil) beg end - header gnus-tmp-header) ; passed as parameter to user-funcs. + gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) (setq beg (point)) (gnus-add-text-properties @@ -1592,20 +1611,31 @@ if it is a string, only list groups matching REGEXP." gnus-indentation ,gnus-group-indentation gnus-level ,gnus-tmp-level)) (setq end (point)) - (when gnus-group-update-tool-bar - (gnus-put-text-property beg end 'point-entered - 'gnus-tool-bar-update) - (gnus-put-text-property beg end 'point-left - 'gnus-tool-bar-update)) + (gnus-group--setup-tool-bar-update beg end) (forward-line -1) (when (inline (gnus-visual-p 'group-highlight 'highlight)) (gnus-group-highlight-line gnus-tmp-group beg end)) (gnus-run-hooks 'gnus-group-update-hook) (forward-line))) +(defun gnus-group--setup-tool-bar-update (beg end) + (when gnus-group-update-tool-bar + (if (fboundp 'cursor-sensor-mode) + (progn + (unless (bound-and-true-p cursor-sensor-mode) + (cursor-sensor-mode 1)) + (gnus-put-text-property beg end 'cursor-sensor-functions + #'gnus-tool-bar-update)) + (gnus-put-text-property beg end 'point-entered + #'gnus-tool-bar-update) + (gnus-put-text-property beg end 'point-left + #'gnus-tool-bar-update)))) + (defun gnus-group-update-eval-form (group list) "Eval `car' of each element of LIST, and return the first that return t. Some value are bound so the form can use them." + (defvar group-age) (defvar ticked) (defvar score) (defvar level) + (defvar mailp) (defvar total) (defvar unread) (when list (let* ((entry (gnus-group-entry group)) (unread (if (numberp (car entry)) (car entry) 0)) @@ -3107,8 +3137,8 @@ If SOLID (the prefix), create a solid group." (defvar nnrss-group-alist) (eval-when-compile - (defun nnrss-discover-feed (arg)) - (defun nnrss-save-server-data (arg))) + (defun nnrss-discover-feed (_arg)) + (defun nnrss-save-server-data (_arg))) (defun gnus-group-make-rss-group (&optional url) "Given a URL, discover if there is an RSS feed. If there is, use Gnus to create an nnrss group" @@ -3757,7 +3787,7 @@ group line." nil nil (gnus-read-active-file-p)))) (let ((newsrc (gnus-group-entry group))) (cond - ((string-match "^[ \t]*$" group) + ((string-match "\\`[ \t]*\\'" group) (error "Empty group name")) (newsrc ;; Toggle subscription flag. diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index f536a271e05..47cdcbc50ac 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -154,7 +154,7 @@ See Info node `(gnus)Formatting Variables'." "Go to TOPIC." (interactive (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))) - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (dolist (topic (gnus-current-topics topic)) (unless (gnus-topic-goto-topic topic) (gnus-topic-goto-missing-topic topic) @@ -427,7 +427,7 @@ If PREDICATE is a function, list groups that the function returns non-nil; if it is t, list groups that have no unread articles. If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (lowest (or lowest 1)) (not-in-list (and gnus-group-listed-groups @@ -582,11 +582,7 @@ articles in the topic and its subtopics." (not (eq (nth 2 type) 'hidden)) level all-entries unread)) (gnus-topic-update-unreads (car type) unread) - (when gnus-group-update-tool-bar - (gnus-put-text-property beg end 'point-entered - 'gnus-tool-bar-update) - (gnus-put-text-property beg end 'point-left - 'gnus-tool-bar-update)) + (gnus-group--setup-tool-bar-update beg end) (goto-char end) unread)) @@ -684,7 +680,7 @@ articles in the topic and its subtopics." gnus-topic-mode) (let ((group (gnus-group-group-name)) (m (point-marker)) - (buffer-read-only nil)) + (inhibit-read-only t)) (when (and group (gnus-get-info group) (gnus-topic-goto-topic (gnus-current-topic))) @@ -902,7 +898,7 @@ articles in the topic and its subtopics." (defun gnus-topic-change-level (group level oldlevel &optional previous) "Run when changing levels to enter/remove groups from topics." (with-current-buffer gnus-group-buffer - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (unless gnus-topic-inhibit-change-level (gnus-group-goto-group (or (car (nth 2 previous)) group)) (when (and gnus-topic-mode @@ -1131,22 +1127,17 @@ articles in the topic and its subtopics." ["Edit parameters" gnus-topic-edit-parameters t]) ["List active" gnus-topic-list-active t])))) -(defun gnus-topic-mode (&optional arg redisplay) +(define-minor-mode gnus-topic-mode "Minor mode for topicsifying Gnus group buffers." - ;; FIXME: Use define-minor-mode. - (interactive (list current-prefix-arg t)) - (when (eq major-mode 'gnus-group-mode) - (make-local-variable 'gnus-topic-mode) - (setq gnus-topic-mode - (if (null arg) (not gnus-topic-mode) - (> (prefix-numeric-value arg) 0))) + :lighter " Topic" :keymap gnus-topic-mode-map + (if (not (derived-mode-p 'gnus-group-mode)) + (setq gnus-topic-mode nil) ;; Infest Gnus with topics. (if (not gnus-topic-mode) (setq gnus-goto-missing-group-function nil) (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) - (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) (set (make-local-variable 'gnus-group-prepare-function) 'gnus-group-prepare-topics) @@ -1168,8 +1159,7 @@ articles in the topic and its subtopics." (setq gnus-topology-checked-p nil) ;; We check the topology. (when gnus-newsrc-alist - (gnus-topic-check-topology)) - (gnus-run-hooks 'gnus-topic-mode-hook)) + (gnus-topic-check-topology))) ;; Remove topic infestation. (unless gnus-topic-mode (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) @@ -1177,7 +1167,7 @@ articles in the topic and its subtopics." (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) - (when redisplay + (when (called-interactively-p 'any) (gnus-group-list-groups)))) (defun gnus-topic-select-group (&optional all) @@ -1229,10 +1219,10 @@ Also see `gnus-group-catchup'." (call-interactively 'gnus-group-catchup-current) (save-excursion (let* ((groups - (mapcar (lambda (entry) (car (nth 2 entry))) - (gnus-topic-find-groups topic gnus-level-killed t - nil t))) - (buffer-read-only nil) + (mapcar (lambda (entry) (car (nth 2 entry))) + (gnus-topic-find-groups topic gnus-level-killed t + nil t))) + (inhibit-read-only t) (gnus-group-marked groups)) (gnus-group-catchup-current) (mapcar 'gnus-topic-update-topics-containing-group groups))))) @@ -1336,7 +1326,7 @@ If COPYP, copy the groups instead." (lambda (group) (gnus-group-remove-mark group use-marked) (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) + (inhibit-read-only t)) (when (and topicl group) (gnus-delete-line) (gnus-delete-first group topicl)) @@ -1515,7 +1505,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (unless topic (error "No topic to be deleted")) (let ((entry (assoc topic gnus-topic-alist)) - (buffer-read-only nil)) + (inhibit-read-only t)) (when (cdr entry) (error "Topic not empty")) ;; Delete if visible. @@ -1560,7 +1550,7 @@ If UNINDENT, remove an indentation." (gnus-topic-unindent) (let* ((topic (gnus-current-topic)) (parent (gnus-topic-previous-topic topic)) - (buffer-read-only nil)) + (inhibit-read-only t)) (unless parent (error "Nothing to indent %s into" topic)) (when topic diff --git a/lisp/isearch.el b/lisp/isearch.el index 99ca73f9f54..35fb0608dd0 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -578,7 +578,7 @@ variable by the command `isearch-toggle-lax-whitespace'.") "Stack of search status elements. Each element is an `isearch--state' struct where the slots are [STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD - INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH]") + ERROR WRAPPED BARRIER CASE-FOLD-SEARCH]") (defvar isearch-string "") ; The current search string. (defvar isearch-message "") ; text-char-description version of isearch-string @@ -657,8 +657,7 @@ Each element is an `isearch--state' struct where the slots are (nconc minor-mode-alist (list '(isearch-mode isearch-mode)))) -(defvar isearch-mode nil) ;; Name of the minor mode, if non-nil. -(make-variable-buffer-local 'isearch-mode) +(defvar-local isearch-mode nil) ;; Name of the minor mode, if non-nil. (define-key global-map "\C-s" 'isearch-forward) (define-key esc-map "\C-s" 'isearch-forward-regexp) @@ -826,6 +825,7 @@ See the command `isearch-forward-symbol' for more information." (isearch-update))))) +(defvar cursor-sensor-inhibit) ;; isearch-mode only sets up incremental search for the minor mode. ;; All the work is done by the isearch-mode commands. @@ -932,6 +932,12 @@ convert the search string to a regexp used by regexp search functions." (add-hook 'post-command-hook 'isearch-post-command-hook) (add-hook 'mouse-leave-buffer-hook 'isearch-done) (add-hook 'kbd-macro-termination-hook 'isearch-done) + (make-local-variable 'cursor-sensor-inhibit) + (unless (boundp 'cursor-sensor-inhibit) + (setq cursor-sensor-inhibit nil)) + ;; Suspend things like cursor-intangible during Isearch so we can search even + ;; within intangible text. + (push 'isearch cursor-sensor-inhibit) ;; isearch-mode can be made modal (in the sense of not returning to ;; the calling function until searching is completed) by entering @@ -1020,6 +1026,7 @@ NOPUSH is t and EDIT is t." (remove-hook 'mouse-leave-buffer-hook 'isearch-done) (remove-hook 'kbd-macro-termination-hook 'isearch-done) (setq isearch-lazy-highlight-start nil) + (setq cursor-sensor-inhibit (delq 'isearch cursor-sensor-inhibit)) ;; Called by all commands that terminate isearch-mode. ;; If NOPUSH is non-nil, we don't push the string on the search ring. @@ -2717,17 +2724,12 @@ update the match data, and return point." ;; isearch in their own way, they should set the ;; `isearch-open-invisible-temporary' to a function doing this. (funcall (overlay-get ov 'isearch-open-invisible-temporary) ov nil) - ;; Store the values for the `invisible' and `intangible' - ;; properties, and then set them to nil. This way the text hidden - ;; by this overlay becomes visible. + ;; Store the values for the `invisible' property, and then set it to nil. + ;; This way the text hidden by this overlay becomes visible. - ;; Do we really need to set the `intangible' property to t? Can we - ;; have the point inside an overlay with an `intangible' property? ;; In 19.34 this does not exist so I cannot test it. (overlay-put ov 'isearch-invisible (overlay-get ov 'invisible)) - (overlay-put ov 'isearch-intangible (overlay-get ov 'intangible)) - (overlay-put ov 'invisible nil) - (overlay-put ov 'intangible nil))) + (overlay-put ov 'invisible nil))) ;; This is called at the end of isearch. It will open the overlays @@ -2741,12 +2743,9 @@ update the match data, and return point." ;; this function, not by us tweaking the overlay properties. (fct-temp (overlay-get ov 'isearch-open-invisible-temporary))) (when (or inside-overlay (not fct-temp)) - ;; restore the values for the `invisible' and `intangible' - ;; properties + ;; restore the values for the `invisible' properties. (overlay-put ov 'invisible (overlay-get ov 'isearch-invisible)) - (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible)) - (overlay-put ov 'isearch-invisible nil) - (overlay-put ov 'isearch-intangible nil)) + (overlay-put ov 'isearch-invisible nil)) (if inside-overlay (funcall (overlay-get ov 'isearch-open-invisible) ov) (if fct-temp @@ -2784,9 +2783,7 @@ update the match data, and return point." ;; properties. (funcall fct-temp ov t) (overlay-put ov 'invisible (overlay-get ov 'isearch-invisible)) - (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible)) - (overlay-put ov 'isearch-invisible nil) - (overlay-put ov 'isearch-intangible nil))))))) + (overlay-put ov 'isearch-invisible nil))))))) (defun isearch-range-invisible (beg end) diff --git a/lisp/ses.el b/lisp/ses.el index 47fe0d3fbf4..e9860158450 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -25,8 +25,18 @@ ;;; To-do list: +;; * M-w should deactivate the mark. +;; * offer some way to use absolute cell addressing. +;; * Maybe some way to copy a reference to a cell's formula rather than the +;; formula itself. ;; * split (catch 'cycle ...) call back into one or more functions ;; * Use $ or … for truncated fields +;; * M-t to transpose 2 columns. +;; * M-d should kill the cell under point. +;; * C-t to transpose 2 rows. +;; * C-k and M-k should be ses-kill-row and ses-kill-column. +;; * C-o should insert the row below point rather than above? +;; * rows inserted with C-o should inherit formulas from surrounding rows. ;; * Add command to make a range of columns be temporarily invisible. ;; * Allow paste of one cell to a range of cells -- copy formula to each. ;; * Do something about control characters & octal codes in cell print @@ -296,7 +306,7 @@ default printer and then modify its output.") ;; an area containing renamed cell is deleted. ses--renamed-cell-symb-list ;; Global variables that we override - mode-line-process next-line-add-newlines transient-mark-mode) + next-line-add-newlines transient-mark-mode) "Buffer-local variables used by SES.")) (defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t)) @@ -421,6 +431,7 @@ functions refer to its value." (defmacro ses-sym-rowcol (sym) "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result is nil if SYM is not a symbol that names a cell." + (declare (debug t)) `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) (if (eq rc :ses-named) (gethash ,sym ses--named-cell-hashmap) @@ -465,14 +476,17 @@ the corresponding cell with name PROPERTY-NAME." (defmacro ses-cell-value (row &optional col) "From a CELL or a pair (ROW,COL), get the current value for that cell." + (declare (debug t)) `(symbol-value (ses-cell-symbol ,row ,col))) (defmacro ses-col-width (col) "Return the width for column COL." + (declare (debug t)) `(aref ses--col-widths ,col)) (defmacro ses-col-printer (col) "Return the default printer for column COL." + (declare (debug t)) `(aref ses--col-printers ,col)) (defun ses-is-cell-sym-p (sym) @@ -1054,8 +1068,7 @@ if the cell's value is unchanged and FORCE is nil." ;; is called during a recursive ses-print-cell). (defun ses-goto-print (row col) "Move point to print area for cell (ROW,COL)." - (let ((inhibit-point-motion-hooks t) - (n 0)) + (let ((n 0)) (goto-char (point-min)) (forward-line row) ;; Calculate column position. @@ -1067,23 +1080,36 @@ if the cell's value is unchanged and FORCE is nil." ;; Move point to the bol of next line (for TAB at the last cell). (forward-char)))) -(defun ses-set-curcell () - "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a +(defun ses--cell-at-pos (pos &optional object) + (or (get-text-property pos 'cursor-intangible object) + ;; (when (> pos (if object 0 (point-min))) + ;; (get-text-property (1- pos) 'cursor-intangible object)) + )) + +(defun ses--curcell (&optional pos) + "Return the current cell symbol, or a cons (BEG,END) for a region, or nil if cursor is not at a cell." + (unless pos (setq pos (point))) (if (or (not mark-active) deactivate-mark - (= (region-beginning) (region-end))) + (= pos (mark t))) ;; Single cell. - (setq ses--curcell (get-text-property (point) 'intangible)) + (ses--cell-at-pos pos) ;; Range. - (let ((bcell (get-text-property (region-beginning) 'intangible)) - (ecell (get-text-property (1- (region-end)) 'intangible))) - (when (= (region-end) ses--data-marker) + (let* ((re (max pos (mark t))) + (bcell (ses--cell-at-pos (min pos (mark t)))) + (ecell (ses--cell-at-pos (1- re)))) + (when (= re ses--data-marker) ;; Correct for overflow. - (setq ecell (get-text-property (- (region-end) 2) 'intangible))) - (setq ses--curcell (if (and bcell ecell) - (cons bcell ecell) - nil)))) + (setq ecell (ses--cell-at-pos (- (region-end) 2)))) + (if (and bcell ecell) + (cons bcell ecell) + nil)))) + +(defun ses-set-curcell () + "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a +region, or nil if cursor is not at a cell." + (setq ses--curcell (ses--curcell)) nil) (defun ses-check-curcell (&rest args) @@ -1197,11 +1223,10 @@ preceding cell has spilled over." ;; Install the printed result. This is not interruptible. (let ((inhibit-read-only t) (inhibit-quit t)) - (let ((inhibit-point-motion-hooks t)) - (delete-region (point) (progn - (move-to-column (+ (current-column) - (string-width text))) - (1+ (point))))) + (delete-region (point) (progn + (move-to-column (+ (current-column) + (string-width text))) + (1+ (point)))) ;; We use concat instead of inserting separate strings in order to ;; reduce the number of cells in the undo list. (setq x (concat text (if (< maxcol ses--numcols) " " "\n"))) @@ -1211,13 +1236,15 @@ preceding cell has spilled over." ;; inherit from surrounding text?) (set-text-properties 0 (length x) nil x) (insert-and-inherit x) - (put-text-property startpos (point) 'intangible + (put-text-property startpos (point) 'cursor-intangible (ses-cell-symbol cell)) (when (and (zerop row) (zerop col)) ;; Reconstruct special beginning-of-buffer attributes. (put-text-property (point-min) (point) 'keymap 'ses-mode-print-map) (put-text-property (point-min) (point) 'read-only 'ses) - (put-text-property (point-min) (1+ (point-min)) 'front-sticky t))) + (put-text-property (point-min) (1+ (point-min)) + ;; `cursor-intangible' shouldn't be sticky at BOB. + 'front-sticky '(read-only keymap)))) (if (= row (1- ses--header-row)) ;; This line is part of the header --- force recalc. (ses-reset-header-string)) @@ -1284,8 +1311,7 @@ COL=NUMCOLS. Deletes characters if CHANGE < 0. Caller should bind (ses-goto-print row col) (when at-end ;; Insert new columns before newline. - (let ((inhibit-point-motion-hooks t)) - (backward-char 1))) + (backward-char 1)) (if blank (insert blank) (delete-char (- change)))))) @@ -1299,7 +1325,7 @@ when the width of cell (ROW,COL) has changed." ;;Cell was skipped over - reprint previous (ses-goto-print row col) (backward-char 1) - (let ((rowcol (ses-sym-rowcol (get-text-property (point) 'intangible)))) + (let ((rowcol (ses-sym-rowcol (ses--cell-at-pos (point))))) (ses-print-cell (car rowcol) (cdr rowcol))))) @@ -1319,17 +1345,16 @@ number, COL is the column number for a data cell -- otherwise DEF is one of the symbols ses--col-widths, ses--col-printers, ses--default-printer, ses--numrows, or ses--numcols." (ses-widen) - (let ((inhibit-point-motion-hooks t)) ; In case intangible attrs are wrong. - (if col - ;; It's a cell. - (progn - (goto-char ses--data-marker) - (forward-line (+ 1 (* def (1+ ses--numcols)) col))) - ;; Convert def-symbol to offset. - (setq def (plist-get ses-paramlines-plist def)) - (or def (signal 'args-out-of-range nil)) - (goto-char ses--params-marker) - (forward-line def)))) + (if col + ;; It's a cell. + (progn + (goto-char ses--data-marker) + (forward-line (+ 1 (* def (1+ ses--numcols)) col))) + ;; Convert def-symbol to offset. + (setq def (plist-get ses-paramlines-plist def)) + (or def (signal 'args-out-of-range nil)) + (goto-char ses--params-marker) + (forward-line def))) (defun ses-file-format-extend-parameter-list (new-file-format) "Extend the global parameters list when file format is updated @@ -1843,7 +1868,6 @@ Narrows the buffer to show only the print area. Gives it `read-only' and `intangible' properties. Sets up highlighting for current cell." (interactive) (let ((end (point-min)) - (inhibit-point-motion-hooks t) pos sym) (with-silent-modifications (ses-goto-data 0 0) ; Include marker between print-area and data-area. @@ -1855,7 +1879,9 @@ Narrows the buffer to show only the print area. Gives it `read-only' and (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map) ;; For the beginning of the buffer, we want the read-only and keymap ;; attributes to be inherited from the first character. - (put-text-property (point-min) (1+ (point-min)) 'front-sticky t) + (put-text-property (point-min) (1+ (point-min)) + ;; `cursor-intangible' shouldn't be sticky at BOB. + 'front-sticky '(read-only keymap)) ;; Create intangible properties, which also indicate which cell the text ;; came from. (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..." @@ -1878,7 +1904,7 @@ Narrows the buffer to show only the print area. Gives it `read-only' and (+ end (ses-col-width col) 1) (forward-char) (point)))) - (put-text-property pos end 'intangible sym)))))) + (put-text-property pos end 'cursor-intangible sym)))))) ;; Create the underlining overlay. It's impossible for (point) to be 2, ;; because column A must be at least 1 column wide. (setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min)))) @@ -1968,6 +1994,11 @@ formula: (window-hscroll)) (ses-create-header-string)) ses--header-string))) + (setq-local mode-line-process '(:eval (ses--mode-line-process))) + (add-hook 'pre-redisplay-functions #'ses--cursor-sensor-highlight + ;; Highlight the cell after moving cursor out of intangible. + 'append t) + (cursor-intangible-mode 1) (let ((was-empty (zerop (buffer-size))) (was-modified (buffer-modified-p))) (save-excursion @@ -2032,32 +2063,7 @@ narrows the buffer now." ;; read the local variables at the end of the file. Now it's safe to ;; do the narrowing. (narrow-to-region (point-min) ses--data-marker) - (setq ses--deferred-narrow nil)) - ;; Update the mode line. - (let ((oldcell ses--curcell)) - (ses-set-curcell) - (unless (eq ses--curcell oldcell) - (cond - ((not ses--curcell) - (setq mode-line-process nil)) - ((atom ses--curcell) - (setq mode-line-process (list " cell " - (symbol-name ses--curcell)))) - (t - (setq mode-line-process (list " range " - (symbol-name (car ses--curcell)) - "-" - (symbol-name (cdr ses--curcell)))))) - (force-mode-line-update))) - ;; Use underline overlay for single-cells only, turn off otherwise. - (if (listp ses--curcell) - (move-overlay ses--curcell-overlay 2 2) - (let ((next (next-single-property-change (point) 'intangible))) - (move-overlay ses--curcell-overlay (point) (1- next)))) - (when (not (pos-visible-in-window-p)) - ;; Scrolling will happen later. - (run-with-idle-timer 0.01 nil 'ses-command-hook) - (setq ses--curcell t))) + (setq ses--deferred-narrow nil))) ;; Prevent errors in this post-command-hook from silently erasing the hook! (error (unless executing-kbd-macro @@ -2065,6 +2071,38 @@ narrows the buffer now." (message "%s" (error-message-string err)))) nil) ; Make coverage-tester happy. +(defun ses--mode-line-process () + (let ((cmlp (window-parameter nil 'ses--mode-line-process)) + (curcell (ses--curcell (window-point)))) + (if (equal curcell (car cmlp)) + (cdr cmlp) + (let ((mlp + (cond + ((not curcell) nil) + ((atom curcell) (list " cell " (symbol-name curcell))) + (t + (list " range " + (symbol-name (car curcell)) + "-" + (symbol-name (cdr curcell))))))) + (set-window-parameter nil 'ses--mode-line-process (cons curcell mlp)) + mlp)))) + +(defun ses--cursor-sensor-highlight (window) + (let ((curcell (ses--curcell)) + (ol (window-parameter window 'ses--curcell-overlay))) + (unless ol + (setq ol (make-overlay (point) (point))) + (overlay-put ol 'window window) + (overlay-put ol 'face 'underline) + (set-window-parameter window 'ses--curcell-overlay ol)) + ;; Use underline overlay for single-cells only, turn off otherwise. + (if (listp curcell) + (delete-overlay ol) + (let* ((pos (window-point window)) + (next (next-single-property-change pos 'cursor-intangible))) + (move-overlay ol pos (1- next)))))) + (defun ses-create-header-string () "Set up `ses--header-string' as the buffer's header line. Based on the current set of columns and `window-hscroll' position." @@ -2132,7 +2170,7 @@ print area if NONARROW is nil." (widen) (unless nonarrow (setq ses--deferred-narrow t)) - (let ((startcell (get-text-property (point) 'intangible)) + (let ((startcell (ses--cell-at-pos (point))) (inhibit-read-only t)) (ses-begin-change) (goto-char (point-min)) @@ -2222,7 +2260,7 @@ to are recalculated first." (defun ses-recalculate-all () "Recalculate and reprint all cells." (interactive "*") - (let ((startcell (get-text-property (point) 'intangible)) + (let ((startcell (ses--cell-at-pos (point))) (ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows) (1- ses--numcols))))) (ses-recalculate-cell) @@ -2730,7 +2768,7 @@ inserts a new row if at bottom of print area. Repeat COUNT times." (let ((col (cdr (ses-sym-rowcol ses--curcell)))) (when (/= 32 (char-before (next-single-property-change (point) - 'intangible))) + 'cursor-intangible))) ;; We're already in last nonskipped cell on line. Need to create a ;; new column. (barf-if-buffer-read-only) @@ -2811,12 +2849,11 @@ SES attributes recording the contents of the cell as of the time of copying." (when (= end ses--data-marker) ;;Avoid overflow situation (setq end (1- ses--data-marker))) - (let* ((inhibit-point-motion-hooks t) - (x (mapconcat #'ses-copy-region-helper + (let* ((x (mapconcat #'ses-copy-region-helper (extract-rectangle beg (1- end)) "\n"))) (remove-text-properties 0 (length x) '(read-only t - intangible t + cursor-intangible t keymap t front-sticky t) x) @@ -2832,8 +2869,8 @@ the corresponding data cell." (pos 0) mycell next sym rowcol) (while pos - (setq sym (get-text-property pos 'intangible line) - next (next-single-property-change pos 'intangible line) + (setq sym (ses--cell-at-pos pos line) + next (next-single-property-change pos 'cursor-intangible line) rowcol (ses-sym-rowcol sym) mycell (ses-get-cell (car rowcol) (cdr rowcol))) (put-text-property pos (or next (length line)) @@ -3229,7 +3266,7 @@ With prefix, sorts in REVERSE order." ;;Get key columns and sort them (dotimes (x (- maxrow minrow -1)) (ses-goto-print (+ minrow x) sorter) - (setq end (next-single-property-change (point) 'intangible)) + (setq end (next-single-property-change (point) 'cursor-intangible)) (push (cons (buffer-substring-no-properties (point) end) (+ minrow x)) keys)) @@ -3379,10 +3416,8 @@ highlighted range in the spreadsheet." (if (eolp) (+ pos (ses-col-width col) 1) (point))))) - (put-text-property pos end 'intangible new-name)) - ;; update mode line - (setq mode-line-process (list " cell " - (symbol-name new-name))) + (put-text-property pos end 'cursor-intangible new-name)) + ;; Update the cell name in the mode-line. (force-mode-line-update))) (defun ses-refresh-local-printer (name _compiled-value) ;FIXME: unused arg? @@ -3622,7 +3657,7 @@ Use `math-format-value' as a printer for Calc objects." "Return ARGS reversed, with the blank elements (nil and *skip*) removed." (let (result) (dolist (cur args) - (unless (memq cur '(nil *skip*)) + (unless (memq cur '(nil *skip* *error*)) (push cur result))) result)) diff --git a/lisp/simple.el b/lisp/simple.el index 51856070437..cf1912ade4f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1776,6 +1776,7 @@ in this use of the minibuffer.") (defun minibuffer-avoid-prompt (_new _old) "A point-motion hook for the minibuffer, that moves point out of the prompt." + (declare (obsolete cursor-intangible-mode "25.1")) (constrain-to-field nil (point-max))) (defcustom minibuffer-history-case-insensitive-variables nil @@ -4908,7 +4909,7 @@ also checks the value of `use-empty-active-region'." ;; without the mark being set (e.g. bug#17324). We really should fix ;; that problem, but in the mean time, let's make sure we don't say the ;; region is active when there's no mark. - (mark))) + (progn (cl-assert (mark)) t))) (defvar redisplay-unhighlight-region-function @@ -4934,37 +4935,41 @@ also checks the value of `use-empty-active-region'." 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" + (let ((rol (window-parameter window 'internal-region-overlay))) + (if (not (and (region-active-p) + (or highlight-nonselected-windows + (eq window (selected-window)) + (and (window-minibuffer-p) + (eq window (minibuffer-selected-window)))))) + (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)))))) + +(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight) + "Hook run just before redisplay. +It is called in each window that is to be redisplayed. It takes one argument, +which is the window that will be redisplayed. When run, the `current-buffer' +is set to the buffer displayed in that window.") + +(defun redisplay--pre-redisplay-functions (windows) + (with-demoted-errors "redisplay--pre-redisplay-functions: %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))))))))) + (with-current-buffer (window-buffer (selected-window)) + (run-hook-with-args 'pre-redisplay-functions (selected-window))) + (dolist (win (if (listp windows) windows (window-list-1 nil nil t))) + (with-current-buffer (window-buffer win) + (run-hook-with-args 'pre-redisplay-functions win)))))) (add-function :before pre-redisplay-function - #'redisplay--update-region-highlights) + #'redisplay--pre-redisplay-functions) (defvar-local mark-ring nil @@ -7001,6 +7006,8 @@ More precisely, a char with closeparen syntax is self-inserted.") (not executing-kbd-macro) (not noninteractive) ;; Verify an even number of quoting characters precede the close. + ;; FIXME: Also check if this parenthesis closes a comment as + ;; can happen in Pascal and SML. (= 1 (logand 1 (- (point) (save-excursion (forward-char -1) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index b1aff428278..7e961e83406 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -544,18 +544,28 @@ With prefix 3, restrict index to region." (setq buffer-read-only nil) (insert (format -"INDEX <%s> on %s + "INDEX <%s> on %s Restriction: <%s> SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help ------------------------------------------------------------------------------ -" index-tag (abbreviate-file-name master) -(if (eq (car (car reftex-index-restriction-data)) 'toc) - (nth 2 (car reftex-index-restriction-data)) - reftex-index-restriction-indicator))) +" + index-tag (abbreviate-file-name master) + (if (eq (car (car reftex-index-restriction-data)) 'toc) + (nth 2 (car reftex-index-restriction-data)) + reftex-index-restriction-indicator))) (if (reftex-use-fonts) - (put-text-property 1 (point) 'face reftex-index-header-face)) - (put-text-property 1 (point) 'intangible t) + (put-text-property (point-min) (point) + 'face reftex-index-header-face)) + (if (fboundp 'cursor-intangible-mode) + (cursor-intangible-mode 1) + ;; If `cursor-intangible' is not available, fallback on the old + ;; intrusive `intangible' property. + (put-text-property (point-min) (point) 'intangible t)) + (add-text-properties (point-min) (point) + '(cursor-intangible t + front-sticky (cursor-intangible) + rear-nonsticky (cursor-intangible))) (reftex-insert-index docstruct index-tag) (goto-char (point-min)) @@ -697,9 +707,10 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help (defun reftex-index-post-command-hook () ;; Used in the post-command-hook for the *Index* buffer + ;; FIXME: Lots of redundancy with reftex-toc-post-command-hook! (when (get-text-property (point) :data) - (and (> (point) 1) - (not (get-text-property (point) 'intangible)) + (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing? + (not (get-text-property (point) 'cursor-intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 1 (or (previous-single-property-change (1+ (point)) :data) diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 69cab782315..085f2d7bdf9 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -280,7 +280,15 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (if (reftex-use-fonts) (put-text-property (point-min) (point) 'font-lock-face reftex-toc-header-face)) - (put-text-property (point-min) (point) 'intangible t) + (if (fboundp 'cursor-intangible-mode) + (cursor-intangible-mode 1) + ;; If `cursor-intangible' is not available, fallback on the old + ;; intrusive `intangible' property. + (put-text-property (point-min) (point) 'intangible t)) + (add-text-properties (point-min) (point) + '(cursor-intangible t + front-sticky (cursor-intangible) + rear-nonsticky (cursor-intangible))) (put-text-property (point-min) (1+ (point-min)) 'xr-alist xr-alist) (setq offset @@ -331,8 +339,8 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (let ((current-prefix-arg nil)) (select-window (get-buffer-window buf frame)) (reftex-toc nil t))) - (and (> (point) 1) - (not (get-text-property (point) 'intangible)) + (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing? + (not (get-text-property (point) 'cursor-intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 2 (or (previous-single-property-change @@ -349,10 +357,11 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (defun reftex-toc-post-command-hook () ;; used in the post-command-hook for the *toc* buffer + ;; FIXME: Lots of redundancy with reftex-index-post-command-hook! (when (get-text-property (point) :data) (put 'reftex-toc :reftex-data (get-text-property (point) :data)) - (and (> (point) 1) - (not (get-text-property (point) 'intangible)) + (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing? + (not (get-text-property (point) 'cursor-intangible)) (memq reftex-highlight-selection '(cursor both)) (reftex-highlight 2 (or (previous-single-property-change (1+ (point)) :data) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 82666478d59..c71ecb4d7a0 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -1,4 +1,4 @@ -;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: utf-8 -*- +;;; sgml-mode.el --- SGML- and HTML-editing modes -*- lexical-binding:t -*- ;; Copyright (C) 1992, 1995-1996, 1998, 2001-2015 Free Software ;; Foundation, Inc. @@ -442,7 +442,7 @@ an optional alist of possible values." (comment-style 'plain)) (comment-indent-new-line soft))) -(defun sgml-mode-facemenu-add-face-function (face end) +(defun sgml-mode-facemenu-add-face-function (face _end) (let ((tag-face (cdr (assq face sgml-face-tag-alist)))) (cond (tag-face (setq tag-face (funcall skeleton-transformation-function tag-face)) @@ -844,7 +844,7 @@ Return non-nil if we skipped over matched tags." (defvar sgml-electric-tag-pair-overlays nil) (defvar sgml-electric-tag-pair-timer nil) -(defun sgml-electric-tag-pair-before-change-function (beg end) +(defun sgml-electric-tag-pair-before-change-function (_beg end) (condition-case err (save-excursion (goto-char end) @@ -1012,7 +1012,7 @@ With prefix argument ARG, repeat this ARG times." (or (get 'sgml-tag 'invisible) (setplist 'sgml-tag (append '(invisible t - point-entered sgml-point-entered + cursor-sensor-functions (sgml-cursor-sensor) rear-nonsticky t read-only t) (symbol-plist 'sgml-tag)))) @@ -1020,63 +1020,59 @@ With prefix argument ARG, repeat this ARG times." (defun sgml-tags-invisible (arg) "Toggle visibility of existing tags." (interactive "P") - (let ((modified (buffer-modified-p)) - (inhibit-read-only t) - (inhibit-modification-hooks t) - ;; Avoid spurious the `file-locked' checks. - (buffer-file-name nil) - ;; This is needed in case font lock gets called, - ;; since it moves point and might call sgml-point-entered. - ;; How could it get called? -stef - (inhibit-point-motion-hooks t) + (let ((inhibit-read-only t) string) - (unwind-protect - (save-excursion - (goto-char (point-min)) - (if (setq-local sgml-tags-invisible - (if arg - (>= (prefix-numeric-value arg) 0) - (not sgml-tags-invisible))) - (while (re-search-forward sgml-tag-name-re nil t) - (setq string - (cdr (assq (intern-soft (downcase (match-string 1))) - sgml-display-text))) - (goto-char (match-beginning 0)) - (and (stringp string) - (not (overlays-at (point))) - (let ((ol (make-overlay (point) (match-beginning 1)))) - (overlay-put ol 'before-string string) - (overlay-put ol 'sgml-tag t))) - (put-text-property (point) - (progn (forward-list) (point)) - 'category 'sgml-tag)) - (let ((pos (point-min))) - (while (< (setq pos (next-overlay-change pos)) (point-max)) - (dolist (ol (overlays-at pos)) - (if (overlay-get ol 'sgml-tag) - (delete-overlay ol))))) - (remove-text-properties (point-min) (point-max) '(category nil)))) - (restore-buffer-modified-p modified)) + (with-silent-modifications + (save-excursion + (goto-char (point-min)) + (if (setq-local sgml-tags-invisible + (if arg + (>= (prefix-numeric-value arg) 0) + (not sgml-tags-invisible))) + (while (re-search-forward sgml-tag-name-re nil t) + (setq string + (cdr (assq (intern-soft (downcase (match-string 1))) + sgml-display-text))) + (goto-char (match-beginning 0)) + (and (stringp string) + (not (overlays-at (point))) + (let ((ol (make-overlay (point) (match-beginning 1)))) + (overlay-put ol 'before-string string) + (overlay-put ol 'sgml-tag t))) + (put-text-property (point) + (progn (forward-list) (point)) + 'category 'sgml-tag)) + (let ((pos (point-min))) + (while (< (setq pos (next-overlay-change pos)) (point-max)) + (dolist (ol (overlays-at pos)) + (if (overlay-get ol 'sgml-tag) + (delete-overlay ol))))) + (remove-text-properties (point-min) (point-max) '(category nil))))) + (cursor-sensor-mode (if sgml-tags-invisible 1 -1)) (run-hooks 'sgml-tags-invisible-hook) (message ""))) -(defun sgml-point-entered (x y) - ;; Show preceding or following hidden tag, depending of cursor direction. - (let ((inhibit-point-motion-hooks t)) - (save-excursion - (condition-case nil - (message "Invisible tag: %s" - ;; Strip properties, otherwise, the text is invisible. - (buffer-substring-no-properties - (point) - (if (or (and (> x y) - (not (eq (following-char) ?<))) - (and (< x y) - (eq (preceding-char) ?>))) - (backward-list) - (forward-list)))) - (error nil))))) - +(defun sgml-cursor-sensor (window x dir) + ;; Show preceding or following hidden tag, depending of cursor direction (and + ;; `dir' is not the direction in this sense). + (when (eq dir 'entered) + (ignore-errors + (let* ((y (window-point window)) + (otherend + (save-excursion + (goto-char y) + (cond + ((and (eq (char-before) ?>) + (or (not (eq (char-after) ?<)) + (> x y))) + (backward-sexp)) + ((eq (char-after y) ?<) + (forward-sexp))) + (point)))) + (message "Invisible tag: %s" + ;; Strip properties, otherwise, the text is invisible. + (buffer-substring-no-properties + y otherend)))))) (defun sgml-validate (command) @@ -1158,7 +1154,7 @@ If nil, start from a preceding tag at indentation." ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state))) (t (cons 'text text-start)))))) -(defun sgml-beginning-of-tag (&optional top-level) +(defun sgml-beginning-of-tag (&optional only-immediate) "Skip to beginning of tag and return its name. If this can't be done, return nil." (let ((context (sgml-lexical-context))) @@ -1167,7 +1163,7 @@ If this can't be done, return nil." (goto-char (cdr context)) (when (looking-at sgml-tag-name-re) (match-string-no-properties 1))) - (if top-level nil + (if only-immediate nil (when (not (eq (car context) 'text)) (goto-char (cdr context)) (sgml-beginning-of-tag t)))))) @@ -1581,6 +1577,19 @@ LCON is the lexical context, if any." (skip-chars-forward " \t\n") (< (point) here) (sgml-at-indentation-p)) (current-column)) + ;; ;; If the parsing failed, try to recover. + ;; ((and (null context) (bobp) + ;; (not (eq (char-after here) ?<))) + ;; (goto-char here) + ;; (if (and (looking-at "--[ \t\n]*>") + ;; (re-search-backward "