Archived
1
0
Fork 0
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/code/elpa/manage-minor-mode-20210108.1832/manage-minor-mode.el

492 lines
19 KiB
EmacsLisp
Raw Permalink Normal View History

;;; manage-minor-mode.el --- Manage your minor-modes easily -*- lexical-binding: t -*-
;; Copyright (C) 2014 by Shingo Fukuyama
;; Copyright (C) 2020-2021 Shen, Jen-Chieh
;; Version: 1.1
;; Package-Version: 20210108.1832
;; Package-Commit: e1af20253fbc5a91034ccd01cf00141130c11863
;; Author: Shingo Fukuyama - http://fukuyama.co
;; Maintainer: Jen-Chieh Shen <jcs090218@gmail.com>
;; URL: https://github.com/ShingoFukuyama/manage-minor-mode
;; Created: Mar 8 2014
;; Keywords: tools minor-mode manage emacs
;; Package-Requires: ((emacs "24.3"))
;; This program 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 2 of
;; the License, or (at your option) any later version.
;; This program 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.
;;; Commentary:
;; Usage:
;; 1. M-x manage-minor-mode
;; 2. Minor modes list buffer will appear
;; 3. Then type "RET" key on any minor-mode you want to toggle active/inactive
;;; Code:
(require 'cl-lib)
(defun manage-minor-mode--active-list ()
"Get a list of which minor modes are enabled in the current buffer."
(let ($list)
(mapc (lambda ($mode)
(condition-case nil
(if (and (symbolp $mode) (symbol-value $mode))
(setq $list (cons $mode $list)))
(error nil)))
minor-mode-list)
(sort $list 'string<)))
(defun manage-minor-mode--inactive-list ()
"Get a list of which minor modes are disabled in the current buffer."
(let ($list)
(mapc (lambda ($mode)
(condition-case nil
(if (and (symbolp $mode) (not (symbol-value $mode)))
(setq $list (cons $mode $list)))
(error nil)))
minor-mode-list)
(sort $list 'string<)))
(defgroup manage-minor-mode nil
"Group for manage minor modes"
:prefix "manage-minor-mode-"
:group 'convenience)
(defvar manage-minor-mode-buffer "*manage-minor-mode*")
(defface manage-minor-mode-face-active
'((t :inherit success :foreground "#33eeee"))
"Face for active minor modes"
:group 'manage-minor-mode)
(defface manage-minor-mode-face-inactive
'((t :inherit warning :foreground "#ff6666"))
"Face for inactive minor modes"
:group 'manage-minor-mode)
(defface manage-minor-mode-face-changed
'((t :inherit underline :foreground "#eeee00"))
"Face for last changed minor modes"
:group 'manage-minor-mode)
(defcustom manage-minor-mode-always-show-keybind t
"Show keybind on the top of the buffer."
:group 'manage-minor-mode :type 'boolean)
(defvar manage-minor-mode-map
(let (($map (make-sparse-keymap)))
(define-key $map (kbd "RET") 'manage-minor-mode-toggle)
(define-key $map (kbd "<mouse-1>") 'manage-minor-mode-toggle)
(define-key $map (kbd "g") 'manage-minor-mode-refresh)
(define-key $map (kbd "e") 'manage-minor-mode-whole-session-enable)
(define-key $map (kbd "d") 'manage-minor-mode-whole-session-disable)
(define-key $map (kbd "r") 'manage-minor-mode-whole-session-release)
$map))
(defun manage-minor-mode--goto-line ($line)
"Go to $LINE considering narrowing."
(goto-char (point-min))
(forward-line (- $line 1)))
(defsubst manage-minor-mode--enable ($mode)
"Enable $MODE."
(ignore-errors (funcall $mode 1)))
(defsubst manage-minor-mode--disable ($mode)
"Disable $MODE."
(ignore-errors (funcall $mode 0)))
(defvar manage-minor-mode-default nil
"Set `minor-mode' active/inactive when `major-mode' changed.
;; Value structure:
'((global (on minor-mode minor-mode ...)
(off minor-mode minor-mode ...))
(major-mode1 (on minor-mode minor-mode ...)
(off minor-mode minor-mode ...))
(major-mode2 (on minor-mode minor-mode ...)
(off minor-mode minor-mode ...))
...)
;; Example
(setq manage-minor-mode-default
'((global
(on rainbow-mode hl-line-mode)
(off line-number-mode))
(emacs-lisp-mode
(on rainbow-delimiters-mode eldoc-mode show-paren-mode))
(js2-mode
(on color-identifiers-mode)
(off flycheck-mode))))")
;;;###autoload
(defun manage-minor-mode-set ()
"Manage minor mode set."
(when manage-minor-mode-default
(let* (($global (assoc-default 'global manage-minor-mode-default))
($global-on (assoc-default 'on $global))
($global-off (assoc-default 'off $global))
($major (assoc-default major-mode manage-minor-mode-default))
($major-on (assoc-default 'on $major))
($major-off (assoc-default 'off $major))
($on (append $global-on $major-on))
($off (append $global-off $major-off)))
(mapc (lambda ($m) (manage-minor-mode--enable $m)) $on)
(mapc (lambda ($m) (manage-minor-mode--disable $m)) $off))))
(add-hook 'after-change-major-mode-hook 'manage-minor-mode-set t)
(defun manage-minor-mode-whole-session-enable ()
"Enable minor-mode on the whole session."
(interactive)
(let (($po (if (eolp) (- (point) 1) (point)))
$mode)
(when (get-text-property $po 'manage-minor-mode)
(setq $mode (intern (thing-at-point 'symbol)))
(mapc (lambda ($buf)
(with-current-buffer $buf
(manage-minor-mode--enable $mode)))
(buffer-list))
(let* (($global (assoc-default 'global manage-minor-mode-default))
($on (assq 'on $global))
($off (assq 'off $global)))
(cond ((not $global)
(setq manage-minor-mode-default
(cons '(global (on) (off)) manage-minor-mode-default)))
((and $global (not $on) $off)
(setf (cdr (assq 'global manage-minor-mode-default))
`((on) ,$off)))
((and $global (not $off) $on)
(setf (cdr (assq 'global manage-minor-mode-default))
`(,$on (off)))))
(setf (cdr (assq 'on (assoc-default 'global manage-minor-mode-default)))
(cons $mode (cdr $on)))
(setf (cdr (assq 'off (assoc-default 'global manage-minor-mode-default)))
(delq $mode (cdr $off))))
(manage-minor-mode-refresh $mode))))
(defun manage-minor-mode-whole-session-disable ()
"Disable minor-mode on the whole session."
(interactive)
(let (($po (if (eolp) (- (point) 1) (point)))
$mode)
(when (get-text-property $po 'manage-minor-mode)
(setq $mode (intern (thing-at-point 'symbol)))
(mapc (lambda ($buf)
(with-current-buffer $buf
(manage-minor-mode--disable $mode)))
(buffer-list))
(let* (($global (assoc-default 'global manage-minor-mode-default))
($on (assq 'on $global))
($off (assq 'off $global)))
(cond ((not $global)
(setq manage-minor-mode-default
(cons '(global (on) (off)) manage-minor-mode-default)))
((and $global (not $on) $off)
(setf (cdr (assq 'global manage-minor-mode-default))
`((on) ,$off)))
((and $global (not $off) $on)
(setf (cdr (assq 'global manage-minor-mode-default))
`(,$on (off)))))
(setf (cdr (assq 'on (assoc-default 'global manage-minor-mode-default)))
(delq $mode (cdr $on)))
(setf (cdr (assq 'off (assoc-default 'global manage-minor-mode-default)))
(cons $mode (cdr $off))))
(manage-minor-mode-refresh $mode))))
(defun manage-minor-mode-whole-session-release ()
"Disable minor-mode on the whole session."
(interactive)
(let ($mode)
(when (get-text-property (point) 'manage-minor-mode)
(setq $mode (intern (thing-at-point 'symbol)))
(let* (($global (assoc-default 'global manage-minor-mode-default))
($on (assq 'on $global))
($off (assq 'off $global)))
(cond ((not $global)
(setq manage-minor-mode-default
(cons '(global (on) (off)) manage-minor-mode-default)))
((and $global (not $on) $off)
(setf (cdr (assq 'global manage-minor-mode-default))
`((on) ,$off)))
((and $global (not $off) $on)
(setf (cdr (assq 'global manage-minor-mode-default))
`(,$on (off)))))
(setf (cdr (assq 'on (assoc-default 'global manage-minor-mode-default)))
(delq $mode (cdr $on)))
(setf (cdr (assq 'off (assoc-default 'global manage-minor-mode-default)))
(delq $mode (cdr $off))))
(manage-minor-mode-refresh))))
(defun manage-minor-mode-whole-session-show ()
"Show globally enable/disable list."
(let* (($global (assoc-default 'global manage-minor-mode-default))
($enable (assoc-default 'on $global))
($disable (assoc-default 'off $global)))
(when $enable
(mapc (lambda ($m)
(goto-char (point-min))
(when (re-search-forward (concat "\\_<"
(format "%s" $m)
"\\_>") nil t)
(let (($ov (make-overlay (match-beginning 0) (match-end 0))))
(if (not (save-excursion (goto-char (match-end 0)) (eolp)))
(delete-char 3))
(overlay-put $ov 'after-string
(propertize
"[E]"
'face '(:foreground "#ffff00" :background "#555555"))))))
$enable))
(when $disable
(mapc (lambda ($m)
(goto-char (point-min))
(when (re-search-forward (concat "\\_<"
(format "%s" $m)
"\\_>") nil t)
(let (($ov (make-overlay (match-beginning 0) (match-end 0))))
(overlay-put $ov 'after-string
(propertize
"[D]"
'face '(:foreground "#eeee00" :background "#333333"))))))
$disable))))
(defvar manage-minor-mode-window-config nil)
(defun manage-minor-mode--buffer-p ()
"Return non-nil if buffer-p."
(equal (buffer-name (current-buffer)) manage-minor-mode-buffer))
(defvar manage-minor-mode-target-info nil)
(defun manage-minor-mode--get-target-info ($key)
"Get target info $KEY."
(car (assoc-default $key manage-minor-mode-target-info)))
(defun manage-minor-mode-refresh (&optional $mode-for-highlight $line $column)
"Redraw the `*manabe-minor-mode*' buffer."
(interactive)
(let (($li (or $line (line-number-at-pos)))
($cl (or $column (current-column))))
(set-window-configuration manage-minor-mode-window-config)
(if (manage-minor-mode--buffer-p)
(with-current-buffer (manage-minor-mode--get-target-info 'buffer)
(manage-minor-mode $mode-for-highlight))
(manage-minor-mode $mode-for-highlight))
(manage-minor-mode--goto-line $li)
(line-move-to-column $cl)
(when (called-interactively-p 'any)
(message (format "Refreshed '%s'" manage-minor-mode-buffer)))))
(defun manage-minor-mode-toggle ()
"Toggle a minor-mode status under the cursor."
(interactive)
(let (($po (if (eolp) (- (point) 1) (point)))
($li (line-number-at-pos))
($cl (current-column))
($buf (manage-minor-mode--get-target-info 'buffer)))
(cl-case (get-text-property $po 'manage-minor-mode)
(active (let (($mode (intern (thing-at-point 'symbol))))
(with-current-buffer $buf
(manage-minor-mode--disable $mode)
(manage-minor-mode-refresh $mode $li $cl))))
(inactive (let (($mode (intern (thing-at-point 'symbol))))
(with-current-buffer $buf
(manage-minor-mode--enable $mode)
(manage-minor-mode-refresh $mode $li $cl)))))))
(defun manage-minor-mode--kill-buffer ($after-select-window)
"Kill $AFTER-SELECT-WINDOW."
(when (get-buffer manage-minor-mode-buffer)
(kill-buffer manage-minor-mode-buffer)
(select-window $after-select-window)))
;;;###autoload
(defun manage-minor-mode (&optional $last-toggled-item)
"The minor mode.
Record for the $LAST-TOGGLED-ITEM."
(interactive)
(and $last-toggled-item
(not (listp $last-toggled-item))
(setq $last-toggled-item (cons $last-toggled-item nil)))
(setq manage-minor-mode-window-config (current-window-configuration))
(let* (($act (manage-minor-mode--active-list))
($inact (manage-minor-mode--inactive-list))
($max-line (+ (length $act) (length $inact)))
($current-buf (current-buffer))
($current-win (get-buffer-window $current-buf))
($major-mode major-mode))
(manage-minor-mode--kill-buffer $current-win)
(pop-to-buffer manage-minor-mode-buffer)
(setq truncate-lines t)
(set (make-local-variable 'manage-minor-mode-target-info)
`((buffer ,$current-buf)
(window ,$current-win)
(major-mode ,$major-mode)))
(cl-dotimes (ignored $max-line)
(insert (format "| \n")))
;; Insert inactive minor-modes
(goto-char (point-min))
(mapc (lambda ($m)
(goto-char (point-at-eol))
(insert
(propertize
(format "%s" $m)
'face 'manage-minor-mode-face-inactive
'manage-minor-mode 'inactive
'pointer 'hand))
(forward-line))
$inact)
;; Insert active minor-modes
(goto-char (point-min))
(mapc (lambda ($m)
(insert
(concat
(propertize
(format "%s" $m)
'face 'manage-minor-mode-face-active
'manage-minor-mode 'active
'pointer 'hand)
" " ;; 5 spaces
))
(forward-line))
$act)
;; header
(goto-char (point-min))
(setq header-line-format
(concat "buffer: "
(propertize
(format "%s" $current-buf)
'face 'manage-minor-mode-face-active)
" major-mode: "
(propertize
(format "%s" $major-mode)
'face 'manage-minor-mode-face-active)))
(if manage-minor-mode-always-show-keybind
(insert (concat "g: Refresh this buffer\n"
"e: Enable in the whole session [E]\n"
"d: Disable in the whole session [D]\n"
"r: Release out of the enable/disable list\n"
"RET: Toggle active/inactive\n"
"\n")))
(insert (concat "Active" " | " "Inactive" "\n"))
;; Adjust buffer
(goto-char (point-min))
(while (re-search-forward "^\\s-*|\\s-*$" nil t)
(delete-region (match-beginning 0) (match-end 0)))
(align-regexp (point-min) (point-max) "\\(\\s-*\\)|")
(manage-minor-mode-whole-session-show)
;; highlight last toggled mode
(when $last-toggled-item
(mapc (lambda ($m)
(goto-char (point-min))
(when (re-search-forward (concat "\\_<"
(format "%s" $m)
"\\_>") nil t)
(put-text-property (match-beginning 0) (match-end 0)
'face 'manage-minor-mode-face-changed)))
$last-toggled-item))
(goto-char (point-min))
(when (re-search-forward "^Active" nil t)
(goto-char (point-at-bol)))
(read-only-mode)
(use-local-map manage-minor-mode-map)))
(defvar manage-minor-mode-modes-before-bals nil)
(defvar manage-minor-mode-bals-exclude-list nil
"Minor-modes list evade from the eradication by `manage-minor-mode-bals'.
;; Value structure:
'((global (minor-mode1 minor-mode2 ...))
(major-mode (minor-mode1 minor-mode2 ...))
(major-mode (minor-mode1 minor-mode2 ...))
...)
;; Example
(setq manage-minor-mode-bals-exclude-list
'((global (recentf-mode global-font-lock-mode
delete-selection-mode transient-mark-mode tabbar-mode))
(text-mode (line-number-mode))
(org-mode (line-number-mode blink-cursor-mode))))")
;;;###autoload
(defun manage-minor-mode-bals ()
"Eradicate all minor-modes in the current buffer.
This command may cause unexpected effect even to other buffers.
However, don't worry, restore command exists:
`manage-minor-mode-restore-from-bals'."
(interactive)
(let (($restore-variable (manage-minor-mode--active-list))
$switched)
(cl-flet
((set-restore-variable
() (set (make-local-variable 'manage-minor-mode-modes-before-bals)
$restore-variable))
(bals
() (let (($excludes
(append
(car (assoc-default 'global manage-minor-mode-bals-exclude-list))
(car (assoc-default
(if (manage-minor-mode--buffer-p)
(manage-minor-mode--get-target-info 'major-mode)
major-mode)
manage-minor-mode-bals-exclude-list)))))
(mapc (lambda ($m)
(unless (memq $m $excludes)
(manage-minor-mode--disable $m)
(setq $switched (cons $m $switched))))
$restore-variable))))
(if (manage-minor-mode--buffer-p)
(progn
(with-current-buffer (manage-minor-mode--get-target-info 'buffer)
(bals)
(set-restore-variable))
(manage-minor-mode-refresh $switched 2 1)
(set-restore-variable))
(set-restore-variable)
(bals)))))
(defun manage-minor-mode-restore-from-bals ()
"Restore minor modes to before `manage-minor-mode-bals' happened."
(interactive)
(if (manage-minor-mode--buffer-p)
(let ($switched)
(with-current-buffer (manage-minor-mode--get-target-info 'buffer)
(mapc (lambda ($m)
(manage-minor-mode--enable $m)
(setq $switched (cons $m $switched)))
manage-minor-mode-modes-before-bals))
(manage-minor-mode-refresh $switched 2 1))
(mapc (lambda ($m)
(manage-minor-mode--enable $m))
manage-minor-mode-modes-before-bals)))
;; Mouse click minor-mode in mode-line to popup "Manage minor modes"
(defadvice popup-menu (before manage-minor-mode-add-for-popup-menu disable)
"Advice `popup-menu'."
(ad-set-arg 0 (append (ad-get-arg 0)
'((manage-minor-mode
menu-item "Manage minor modes"
(lambda () (interactive) (manage-minor-mode)))))))
(defadvice minor-mode-menu-from-indicator (around manage-minor-mode-add-mode-line-menu activate)
"Advice for `minor-mode-menu-from-indicator'."
(ad-enable-advice 'popup-menu 'before 'manage-minor-mode-add-for-popup-menu)
(ad-activate 'popup-menu)
ad-do-it
(ad-disable-advice 'popup-menu 'before 'manage-minor-mode-add-for-popup-menu)
(ad-activate 'popup-menu))
(provide 'manage-minor-mode)
;;; manage-minor-mode.el ends here