mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-14 16:50:58 +00:00
Code Issues Releases Activity

Deprecate intangible' and point-entered' properties

Browse Source 
* 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.
This commit is contained in:
Stefan Monnier 2015-04-13 15:51:15 -04:00
parent b430d2a836
commit 84e0b7dad6
14 changed files with 603 additions and 340 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
etc/NEWS
View File

@ -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.

59
lisp/cus-start.el
View File

@ -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)

180
lisp/emacs-lisp/cursor-sensor.el Normal file
View File

@ -0,0 +1,180 @@
;;; cursor-sensor.el --- React to cursor movement -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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

54
lisp/erc/erc-stamp.el
View File

@ -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))))))

20
lisp/forms.el
View File

@ -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

52
lisp/gnus/gnus-group.el
View File

@ -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.

46
lisp/gnus/gnus-topic.el
View File

@ -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

35
lisp/isearch.el
View File

@ -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)

197
lisp/ses.el
View File

@ -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--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
(= pos (mark t)))
;; Single cell.
(ses--cell-at-pos pos)
;; Range.
(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 (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."
(if (or (not mark-active)
deactivate-mark
(= (region-beginning) (region-end)))
;; Single cell.
(setq ses--curcell (get-text-property (point) 'intangible))
;; Range.
(let ((bcell (get-text-property (region-beginning) 'intangible))
(ecell (get-text-property (1- (region-end)) 'intangible)))
(when (= (region-end) 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 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))

63
lisp/simple.el
View File

@ -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)))))))
(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))))))
(defun redisplay--update-region-highlights (windows)
(with-demoted-errors "redisplay--update-region-highlights: %S"
(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)

29
lisp/textmodes/reftex-index.el
View File

@ -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)

19
lisp/textmodes/reftex-toc.el
View File

@ -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)

127
lisp/textmodes/sgml-mode.el
View File

@ -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 "<!--" nil t))
;; ;; No wonder parsing failed: we're in a comment.
;; (sgml-calculate-indent (prog2 (goto-char (match-end 0))
;; (sgml-lexical-context)
;; (goto-char here)))
;; ;; We have no clue what's going on, let's be honest about it.
;; nil))
;; Otherwise, just follow the rules.
(t
(goto-char there)
(+ (current-column)

55
lisp/textmodes/table.el
View File

@ -770,7 +770,6 @@ the cell contents dynamically."
:type 'integer
:group 'table)
;;;###autoload
(defcustom table-cell-map-hook nil
"Normal hooks run when finishing construction of `table-cell-map'.
User can modify `table-cell-map' by adding custom functions here."
@ -794,19 +793,16 @@ simply by any key input."
:type 'boolean
:group 'table)
;;;###autoload
(defcustom table-load-hook nil
"List of functions to be called after the table is first loaded."
:type 'hook
:group 'table-hooks)
;;;###autoload
(defcustom table-point-entered-cell-hook nil
"List of functions to be called after point entered a table cell."
:type 'hook
:group 'table-hooks)
;;;###autoload
(defcustom table-point-left-cell-hook nil
"List of functions to be called after point left a table cell."
:type 'hook
@ -865,8 +861,6 @@ time.")
"Cache point coordinate based from the cell origin.")
(defvar table-cell-cache-mark-coordinate nil
"Cache mark coordinate based from the cell origin.")
(defvar table-cell-entered-state nil
"Records the state whether currently in a cell or nor.")
(defvar table-update-timer nil
"Timer id for deferred cell update.")
(defvar table-widen-timer nil
@ -1216,14 +1210,14 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
;; does not cause a problem in the old implementation. Sigh...
(when (featurep 'xemacs)
(defun table--tweak-menu-for-xemacs (menu)
(cond
((listp menu)
(mapcar #'table--tweak-menu-for-xemacs menu))
((vectorp menu)
(let ((len (length menu)))
(dotimes (i len)
;; replace :help with something harmless.
(if (eq (aref menu i) :help) (aset menu i :included)))))))
(cond
((listp menu)
(mapcar #'table--tweak-menu-for-xemacs menu))
((vectorp menu)
(let ((len (length menu)))
(dotimes (i len)
;; replace :help with something harmless.
(if (eq (aref menu i) :help) (aset menu i :included)))))))
(mapcar #'table--tweak-menu-for-xemacs
(list table-global-menu table-cell-menu))
(defvar mark-active t))
@ -5187,8 +5181,8 @@ and the right cell border character."
(defun table--put-cell-point-entered/left-property (beg end &optional object)
"Put point-entered/left property."
(put-text-property beg end 'point-entered 'table--point-entered-cell-function object)
(put-text-property beg end 'point-left 'table--point-left-cell-function object))
(put-text-property beg end 'cursor-sensor-functions
'(table--point-entered/left-cell-function) object))
(defun table--remove-cell-properties (beg end &optional object)
"Remove all cell properties.
@ -5204,8 +5198,7 @@ instead of the current buffer and returns the OBJECT."
'table-valign nil
'face nil
'rear-nonsticky nil
'point-entered nil
'point-left nil
'cursor-sensor-functions nil
'keymap nil)
object))
(setq beg next)))
@ -5247,28 +5240,20 @@ instead of the current buffer and returns the OBJECT."
"Put cell's vertical alignment property."
(table--put-property cell 'table-valign valign))
(defun table--point-entered-cell-function (&optional _old-point _new-point)
(defun table--point-entered/left-cell-function (_window _oldpos dir)
"Point has entered a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
(let ((inhibit-point-motion-hooks t))
(unless table-cell-entered-state
(setq table-cell-entered-state t)
(setq table-mode-indicator t)
(force-mode-line-update)
(table--warn-incompatibility)
(run-hooks 'table-point-entered-cell-hook))))
(defun table--point-left-cell-function (&optional _old-point _new-point)
"Point has left a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
(let ((inhibit-point-motion-hooks t))
(when table-cell-entered-state
(setq table-cell-entered-state nil)
(force-mode-line-update)
(pcase dir
('left
(setq table-mode-indicator nil)
(force-mode-line-update)
(run-hooks 'table-point-left-cell-hook))))
(run-hooks 'table-point-left-cell-hook))
('entered
(setq table-mode-indicator t)
(table--warn-incompatibility)
(run-hooks 'table-point-entered-cell-hook)))))
(defun table--warn-incompatibility ()
"If called from interactive operation warn the know incompatibilities.