summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2018-06-21 23:30:11 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2018-06-21 23:30:11 -0400
commita5511956b483e22cfebc0ebeb54d83c95f852648 (patch)
treef708410de024fafadde9317447ea999734c44fd7
parent8a7475ca796ecd5816fab9f11baf07bcc395d951 (diff)
downloademacs-a5511956b483e22cfebc0ebeb54d83c95f852648.tar.gz
New functions to switch back and forth to another major mode
* subr.el (major-mode--suspended): New var. (major-mode-suspend, major-mode-restore): New funs, extracted from doc-view. * doc-view.el (doc-view--previous-major-mode): Remove. (doc-view-mode): Use major-mode-suspend. (doc-view-fallback-mode): Use major-mode-restore. * hexl-mode.el (hexl-mode--minor-mode-p, hexl-mode--setq-local): Remove. (hexl-mode): Use major-mode-suspend and hexl-follow-ascii-mode. (hexl-mode-exit): Use major-mode-restore. (hexl-activate-ruler, hexl-follow-line): Don't bother trying to preserve earlier state, now that entering/leaving hexl-mode kills local vars. (hexl-follow-ascii-mode): New proper local minor mode. (hexl-follow-ascii): Rewrite, using it. * image-mode.el (image-mode-previous-major-mode): Remove. (image-mode): Use major-mode-suspend. (image-mode-to-text): Use major-mode-restore.
-rw-r--r--etc/NEWS4
-rw-r--r--lisp/doc-view.el19
-rw-r--r--lisp/hexl.el161
-rw-r--r--lisp/image-mode.el26
-rw-r--r--lisp/subr.el34
5 files changed, 98 insertions, 146 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 537e99c90e8..83e106ced8c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -658,6 +658,10 @@ manual for more details.
* Lisp Changes in Emacs 27.1
+** New functions 'major-mode-suspend' and 'major-mode-restore'
+Used when switching temporarily to another major mode, e.g. for hexl-mode,
+or to switch between c-mode and image-mode in XPM.
+
+++
** New macro 'dolist-with-progress-reporter'.
This works like 'dolist', but reports progress similar to
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index dfc4d887ae3..970e12402d0 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -354,9 +354,6 @@ of the page moves to the previous page."
(defvar doc-view--pending-cache-flush nil
"Only used internally.")
-(defvar doc-view--previous-major-mode nil
- "Only used internally.")
-
(defvar doc-view--buffer-file-name nil
"Only used internally.
The file name used for conversion. Normally it's the same as
@@ -1752,12 +1749,7 @@ toggle between displaying the document or editing it as text.
;; returns nil for tar members.
(doc-view-fallback-mode)
- (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode)
- doc-view--previous-major-mode
- (unless (eq major-mode 'fundamental-mode)
- major-mode))))
- (kill-all-local-variables)
- (setq-local doc-view--previous-major-mode prev-major-mode))
+ (major-mode-suspend)
(dolist (var doc-view-saved-settings)
(set (make-local-variable (car var)) (cdr var)))
@@ -1848,14 +1840,7 @@ toggle between displaying the document or editing it as text.
'(doc-view-resolution
image-mode-winprops-alist)))))
(remove-overlays (point-min) (point-max) 'doc-view t)
- (if doc-view--previous-major-mode
- (funcall doc-view--previous-major-mode)
- (let ((auto-mode-alist
- (rassq-delete-all
- 'doc-view-mode-maybe
- (rassq-delete-all 'doc-view-mode
- (copy-alist auto-mode-alist)))))
- (normal-mode)))
+ (major-mode-restore '(doc-view-mode-maybe doc-view-mode))
(when vars
(setq-local doc-view-saved-settings vars))))
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 2c1a7de48a7..f37be9d4102 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -58,53 +58,45 @@
(const 16)
(const 32)
(const 64))
- :group 'hexl
:version "24.3")
(defcustom hexl-program "hexl"
"The program that will hexlify and dehexlify its stdin.
`hexl-program' will always be concatenated with `hexl-options'
and \"-de\" when dehexlifying a buffer."
- :type 'string
- :group 'hexl)
+ :type 'string)
(defcustom hexl-iso ""
"If your Emacs can handle ISO characters, this should be set to
\"-iso\" otherwise it should be \"\"."
- :type 'string
- :group 'hexl)
+ :type 'string)
(defcustom hexl-options (format "-hex %s" hexl-iso)
"Space separated options to `hexl-program' that suit your needs.
Quoting cannot be used, so the arguments cannot themselves contain spaces.
If you wish to set the `-group-by-X-bits' options, set `hexl-bits' instead,
as that will override any bit grouping options set here."
- :type 'string
- :group 'hexl)
+ :type 'string)
(defcustom hexl-follow-ascii t
"If non-nil then highlight the ASCII character corresponding to point."
:type 'boolean
- :group 'hexl
:version "20.3")
(defcustom hexl-mode-hook '(hexl-follow-line hexl-activate-ruler)
"Normal hook run when entering Hexl mode."
:type 'hook
- :options '(hexl-follow-line hexl-activate-ruler eldoc-mode)
- :group 'hexl)
+ :options '(hexl-follow-line hexl-activate-ruler eldoc-mode))
(defface hexl-address-region
'((t (:inherit header-line)))
- "Face used in address area of Hexl mode buffer."
- :group 'hexl)
+ "Face used in address area of Hexl mode buffer.")
(defface hexl-ascii-region
'((t (:inherit header-line)))
- "Face used in ASCII area of Hexl mode buffer."
- :group 'hexl)
+ "Face used in ASCII area of Hexl mode buffer.")
-(defvar hexl-max-address 0
+(defvar-local hexl-max-address 0
"Maximum offset into hexl buffer.")
(defvar hexl-mode-map
@@ -252,24 +244,6 @@ as that will override any bit grouping options set here."
"The length of a hexl display line (varies with `hexl-bits')."
(+ 60 (/ 128 (or hexl-bits 16))))
-(defun hexl-mode--minor-mode-p (var)
- (memq var '(ruler-mode hl-line-mode)))
-
-(defun hexl-mode--setq-local (var val)
- ;; `var' can be either a symbol or a pair, in which case the `car'
- ;; is the getter function and the `cdr' is the corresponding setter.
- (unless (or (member var hexl-mode--old-var-vals)
- (assoc var hexl-mode--old-var-vals))
- (push (if (or (consp var) (boundp var))
- (cons var
- (if (consp var) (funcall (car var)) (symbol-value var)))
- var)
- hexl-mode--old-var-vals))
- (cond
- ((consp var) (funcall (cdr var) val))
- ((hexl-mode--minor-mode-p var) (funcall var (if val 1 -1)))
- (t (set (make-local-variable var) val))))
-
;;;###autoload
(defun hexl-mode (&optional arg)
"\\<hexl-mode-map>A mode for editing binary files in hex dump format.
@@ -364,35 +338,33 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(or (bolp) (setq original-point (1- original-point))))
(hexlify-buffer)
(restore-buffer-modified-p modified))
- (set (make-local-variable 'hexl-max-address)
- (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
+ (setq hexl-max-address
+ (+ (* (/ (1- (buffer-size)) (hexl-line-displen)) 16) 15))
(condition-case nil
(hexl-goto-address original-point)
(error nil)))
- ;; We do not turn off the old major mode; instead we just
- ;; override most of it. That way, we can restore it perfectly.
+ (let ((max-address hexl-max-address))
+ (major-mode-suspend)
+ (setq hexl-max-address max-address))
- (hexl-mode--setq-local '(current-local-map . use-local-map) hexl-mode-map)
+ (use-local-map hexl-mode-map)
- (hexl-mode--setq-local 'mode-name "Hexl")
- (hexl-mode--setq-local 'isearch-search-fun-function
- 'hexl-isearch-search-function)
- (hexl-mode--setq-local 'major-mode 'hexl-mode)
+ (setq-local mode-name "Hexl")
+ (setq-local isearch-search-fun-function #'hexl-isearch-search-function)
+ (setq-local major-mode 'hexl-mode)
- (hexl-mode--setq-local '(syntax-table . set-syntax-table)
- (standard-syntax-table))
+ ;; (set-syntax-table (standard-syntax-table))
- (add-hook 'write-contents-functions 'hexl-save-buffer nil t)
+ (add-hook 'write-contents-functions #'hexl-save-buffer nil t)
- (hexl-mode--setq-local 'require-final-newline nil)
+ (setq-local require-final-newline nil)
- (hexl-mode--setq-local 'font-lock-defaults '(hexl-font-lock-keywords t))
+ (setq-local font-lock-defaults '(hexl-font-lock-keywords t))
- (hexl-mode--setq-local 'revert-buffer-function
- #'hexl-revert-buffer-function)
- (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
+ (setq-local revert-buffer-function #'hexl-revert-buffer-function)
+ (add-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer nil t)
;; Set a callback function for eldoc.
(add-function :before-until (local 'eldoc-documentation-function)
@@ -401,7 +373,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(eldoc-remove-command "hexl-save-buffer"
"hexl-current-address")
- (if hexl-follow-ascii (hexl-follow-ascii 1)))
+ (if hexl-follow-ascii (hexl-follow-ascii-mode 1)))
(run-mode-hooks 'hexl-mode-hook))
@@ -469,6 +441,7 @@ and edit the file in `hexl-mode'."
(hexl-mode)))
(defun hexl-revert-buffer-function (_ignore-auto _noconfirm)
+ ;; FIXME: We don't obey revert-buffer-preserve-modes!
(let ((coding-system-for-read 'no-conversion)
revert-buffer-function)
;; Call the original `revert-buffer' without code conversion; also
@@ -481,7 +454,7 @@ and edit the file in `hexl-mode'."
;; already hexl-mode.
;; 2. reset change-major-mode-hook in case that `hexl-mode'
;; previously added hexl-maybe-dehexlify-buffer to it.
- (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
+ (remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t)
(setq major-mode 'fundamental-mode)
(hexl-mode)))
@@ -494,7 +467,7 @@ With arg, don't unhexlify buffer."
(inhibit-read-only t)
(original-point (1+ (hexl-current-address))))
(dehexlify-buffer)
- (remove-hook 'write-contents-functions 'hexl-save-buffer t)
+ (remove-hook 'write-contents-functions #'hexl-save-buffer t)
(restore-buffer-modified-p modified)
(goto-char original-point)
;; Maybe adjust point for the removed CR characters.
@@ -504,27 +477,8 @@ With arg, don't unhexlify buffer."
(or (bobp) (setq original-point (1+ original-point))))
(goto-char original-point)))
- (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
- (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
- (setq hexl-ascii-overlay nil)
-
- (let ((mms ()))
- (dolist (varval hexl-mode--old-var-vals)
- (let* ((bound (consp varval))
- (var (if bound (car varval) varval))
- (val (cdr-safe varval)))
- (cond
- ((consp var) (funcall (cdr var) val))
- ((hexl-mode--minor-mode-p var) (push (cons var val) mms))
- (bound (set (make-local-variable var) val))
- (t (kill-local-variable var)))))
- (kill-local-variable 'hexl-mode--old-var-vals)
- ;; Enable/disable minor modes. Do it after having reset the other vars,
- ;; since some of them may affect the minor modes.
- (dolist (mm mms)
- (funcall (car mm) (if (cdr mm) 1 -1))))
-
- (force-mode-line-update))
+ (remove-hook 'change-major-mode-hook #'hexl-maybe-dehexlify-buffer t)
+ (major-mode-restore))
(defun hexl-maybe-dehexlify-buffer ()
"Convert a hexl format buffer to binary.
@@ -534,7 +488,7 @@ Ask the user for confirmation."
(inhibit-read-only t)
(original-point (1+ (hexl-current-address))))
(dehexlify-buffer)
- (remove-hook 'write-contents-functions 'hexl-save-buffer t)
+ (remove-hook 'write-contents-functions #'hexl-save-buffer t)
(restore-buffer-modified-p modified)
(goto-char original-point))))
@@ -1041,48 +995,47 @@ Embedded whitespace, dashes, and periods in the string are ignored."
(error "Decimal number out of range")
(hexl-insert-multibyte-char num arg))))
-(defun hexl-follow-ascii (&optional arg)
- "Toggle following ASCII in Hexl buffers.
-With prefix ARG, turn on following if and only if ARG is positive.
+(define-minor-mode hexl-follow-ascii-mode
+ "Minor mode to follow ASCII in current Hexl buffer.
When following is enabled, the ASCII character corresponding to the
element under the point is highlighted.
-Customize the variable `hexl-follow-ascii' to disable this feature."
- (interactive "P")
+The default activation is controlled by `hexl-follow-ascii'."
+ (if hexl-follow-ascii-mode
+ ;; turn it on
+ (progn
+ (unless hexl-ascii-overlay
+ (setq hexl-ascii-overlay (make-overlay (point) (point)))
+ (overlay-put hexl-ascii-overlay 'face 'highlight))
+ (add-hook 'post-command-hook #'hexl-follow-ascii-find nil t))
+ ;; turn it off
+ (when hexl-ascii-overlay
+ (delete-overlay hexl-ascii-overlay)
+ (setq hexl-ascii-overlay nil))
+ (remove-hook 'post-command-hook #'hexl-follow-ascii-find t)))
+
+(define-minor-mode hexl-follow-ascii
+ "Toggle following ASCII in Hexl buffers.
+Like `hexl-follow-ascii-mode' but remembers the choice globally."
+ :global t
(let ((on-p (if arg
(> (prefix-numeric-value arg) 0)
(not hexl-ascii-overlay))))
-
- (if on-p
- ;; turn it on
- (if (not hexl-ascii-overlay)
- (progn
- (setq hexl-ascii-overlay (make-overlay 1 1)
- hexl-follow-ascii t)
- (overlay-put hexl-ascii-overlay 'face 'highlight)
- (add-hook 'post-command-hook 'hexl-follow-ascii-find nil t)))
- ;; turn it off
- (if hexl-ascii-overlay
- (progn
- (delete-overlay hexl-ascii-overlay)
- (setq hexl-ascii-overlay nil
- hexl-follow-ascii nil)
- (remove-hook 'post-command-hook 'hexl-follow-ascii-find t)
- )))))
+ (hexl-follow-ascii-mode (if on-p 1 -1))
+ ;; Remember this choice globally for later use.
+ (setq hexl-follow-ascii hexl-follow-ascii-mode)))
(defun hexl-activate-ruler ()
"Activate `ruler-mode'."
(require 'ruler-mode)
- (hexl-mode--setq-local 'ruler-mode-ruler-function
- #'hexl-mode-ruler)
- (hexl-mode--setq-local 'ruler-mode t))
+ (setq-local ruler-mode-ruler-function #'hexl-mode-ruler)
+ (ruler-mode 1))
(defun hexl-follow-line ()
"Activate `hl-line-mode'."
(require 'hl-line)
- (hexl-mode--setq-local 'hl-line-range-function
- #'hexl-highlight-line-range)
- (hexl-mode--setq-local 'hl-line-face 'highlight)
- (hexl-mode--setq-local 'hl-line-mode t))
+ (setq-local hl-line-range-function #'hexl-highlight-line-range)
+ (setq-local hl-line-face 'highlight) ;FIXME: Why?
+ (hl-line-mode 1))
(defun hexl-highlight-line-range ()
"Return the range of address region for the point.
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index c504afa6970..0925c6ef9c5 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -412,9 +412,6 @@ call."
(defvar-local image-multi-frame nil
"Non-nil if image for the current Image mode buffer has multiple frames.")
-(defvar image-mode-previous-major-mode nil
- "Internal variable to keep the previous non-image major mode.")
-
(defvar image-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'image-toggle-display)
@@ -551,7 +548,7 @@ Key bindings:
(unless (display-images-p)
(error "Display does not support images"))
- (kill-all-local-variables)
+ (major-mode-suspend)
(setq major-mode 'image-mode)
(if (not (image-get-display-property))
@@ -641,26 +638,7 @@ A non-mage major mode found from `auto-mode-alist' or fundamental mode
displays an image file as text."
;; image-mode-as-text = normal-mode + image-minor-mode
(let ((previous-image-type image-type)) ; preserve `image-type'
- (if image-mode-previous-major-mode
- ;; Restore previous major mode that was already found by this
- ;; function and cached in `image-mode-previous-major-mode'
- (funcall image-mode-previous-major-mode)
- (let ((auto-mode-alist
- (delq nil (mapcar
- (lambda (elt)
- (unless (memq (or (car-safe (cdr elt)) (cdr elt))
- '(image-mode image-mode-maybe image-mode-as-text))
- elt))
- auto-mode-alist)))
- (magic-fallback-mode-alist
- (delq nil (mapcar
- (lambda (elt)
- (unless (memq (or (car-safe (cdr elt)) (cdr elt))
- '(image-mode image-mode-maybe image-mode-as-text))
- elt))
- magic-fallback-mode-alist))))
- (normal-mode)
- (setq-local image-mode-previous-major-mode major-mode)))
+ (major-mode-restore '(image-mode image-mode-maybe image-mode-as-text))
;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'.
(setq image-type previous-image-type)
;; Enable image minor mode with `C-c C-c'.
diff --git a/lisp/subr.el b/lisp/subr.el
index 7ac1c912818..ca184d8fc81 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1866,7 +1866,7 @@ running their FOO-mode-hook."
(push hook delayed-mode-hooks))
;; Normal case, just run the hook as before plus any delayed hooks.
(setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
- (and syntax-propertize-function
+ (and (bound-and-true-p syntax-propertize-function)
(not (local-variable-p 'parse-sexp-lookup-properties))
;; `syntax-propertize' sets `parse-sexp-lookup-properties' for us, but
;; in order for the sexp primitives to automatically call
@@ -1908,6 +1908,36 @@ If you just want to check `major-mode', use `derived-mode-p'."
"Non-nil if the current major mode is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards."
(apply #'provided-mode-derived-p major-mode modes))
+
+(defvar-local major-mode--suspended nil)
+(put 'major-mode--suspended 'permanent-local t)
+
+(defun major-mode-suspend ()
+ "Exit current major, remembering it."
+ (let* ((prev-major-mode (or major-mode--suspended
+ (unless (eq major-mode 'fundamental-mode)
+ major-mode))))
+ (kill-all-local-variables)
+ (setq-local major-mode--suspended prev-major-mode)))
+
+(defun major-mode-restore (&optional avoided-modes)
+ "Restore major mode earlier suspended with `major-mode-suspend'.
+If there was no earlier suspended major mode, then fallback to `normal-mode',
+tho trying to avoid AVOIDED-MODES."
+ (if major-mode--suspended
+ (funcall (prog1 major-mode--suspended
+ (kill-local-variable 'major-mode--suspended)))
+ (let ((auto-mode-alist
+ (let ((alist (copy-sequence auto-mode-alist)))
+ (dolist (mode avoided-modes)
+ (setq alist (rassq-delete-all mode alist)))
+ alist))
+ (magic-fallback-mode-alist
+ (let ((alist (copy-sequence magic-fallback-mode-alist)))
+ (dolist (mode avoided-modes)
+ (setq alist (rassq-delete-all mode alist)))
+ alist)))
+ (normal-mode))))
;;;; Minor modes.
@@ -3034,6 +3064,8 @@ This function is like `insert', except it honors the variables
(inhibit-read-only inhibit-read-only)
end)
+ ;; FIXME: This throws away any yank-undo-function set by previous calls
+ ;; to insert-for-yank-1 within the loop of insert-for-yank!
(setq yank-undo-function t)
(if (nth 0 handler) ; FUNCTION
(funcall (car handler) param)