* 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.
\f
* 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.
-;;; 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.
;;; 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.
;; :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)
(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
: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
(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)
--- /dev/null
+;;; 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
(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."
;;;###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.
(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.")
(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)
(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
(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
;; 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)
""))
;; 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."
(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))))))
;;; 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
;;;###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:
(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))
(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)))
,@(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)))
(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)))
(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
))
(goto-char (point-max))
(insert ret)))))
+(provide 'forms-mode) ; for compatibility
+(provide 'forms)
;;; forms.el ends here
(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)
(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)
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
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))
(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"
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.
"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)
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
(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))
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)))
(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
["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)
(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)
(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)
(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)))))
(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))
(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.
(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
"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
(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)
(isearch-update)))))
\f
+(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.
(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
(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.
;; 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
;; 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
;; 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)
;;; 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
;; 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))
(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)
(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)
;; 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.
;; 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)
;; 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")))
;; 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))
(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))))))
;;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)))))
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
`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.
(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..."
(+ 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))))
(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
;; 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
(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."
(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))
(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)
(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)
(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)
(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))
;;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))
(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?
"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))
(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
;; 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
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
(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)
(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))
(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)
(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
(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
(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)
-;;; 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.
(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))
(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)
(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))))
(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))))))
\f
(defun sgml-validate (command)
((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)))
(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))))))
(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)
: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."
: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
"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
;; 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))
(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.
'table-valign nil
'face nil
'rear-nonsticky nil
- 'point-entered nil
- 'point-left nil
+ 'cursor-sensor-functions nil
'keymap nil)
object))
(setq beg next)))
"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)
+ (force-mode-line-update)
+ (pcase dir
+ ('left
+ (setq table-mode-indicator nil)
+ (run-hooks 'table-point-left-cell-hook))
+ ('entered
(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)
- (setq table-mode-indicator nil)
- (force-mode-line-update)
- (run-hooks 'table-point-left-cell-hook))))
+ (run-hooks 'table-point-entered-cell-hook)))))
(defun table--warn-incompatibility ()
"If called from interactive operation warn the know incompatibilities.
projects / emacs.git / commitdiff