├── .gitignore ├── .travis.yml ├── Cask ├── Makefile ├── README.md ├── README.org ├── image ├── demo1.gif ├── demo2.gif ├── demo3.gif └── vimperator.png ├── pophint-dired.el ├── pophint-direx.el ├── pophint-e2wm.el ├── pophint-elisp.el ├── pophint-eww.el ├── pophint-help.el ├── pophint-info.el ├── pophint-isearch.el ├── pophint-line.el ├── pophint-mark.el ├── pophint-outline.el ├── pophint-ow.el ├── pophint-quote.el ├── pophint-region.el ├── pophint-slack.el ├── pophint-sym.el ├── pophint-tags.el ├── pophint-thing.el ├── pophint-typescript.el ├── pophint-url.el ├── pophint-vb.el ├── pophint-widget.el ├── pophint-yank.el ├── pophint-yaol.el ├── pophint.el └── test ├── compile-source.el ├── compile-to-function.el ├── defaction.el ├── defsituation.el ├── defsource.el ├── do-action.el ├── do-flexibly.el ├── do-interactively.el ├── do.el ├── event-loop.el ├── get-hints.el ├── make-index-char-string.el ├── make-prompt-interactively.el └── make-prompt.el /.gitignore: -------------------------------------------------------------------------------- 1 | .cask 2 | *.elc 3 | *-autoloads.el 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: emacs-lisp 2 | env: 3 | # - EMACS=emacs23 4 | - EMACS=emacs24 5 | - EMACS=emacs-snapshot 6 | matrix: 7 | allow_failures: 8 | - env: EMACS=emacs-snapshot 9 | before_install: 10 | # Install Emacs 11 | - sudo add-apt-repository -y ppa:cassou/emacs 12 | - sudo apt-get update -qq 13 | - sudo apt-get install -qq $EMACS 14 | # Install Cask 15 | - curl -fsSkL --max-time 10 --retry 10 --retry-delay 10 https://raw.github.com/cask/cask/master/go | python 16 | - export PATH="$HOME/.cask/bin:$PATH" 17 | - cask install 18 | script: 19 | make 20 | notifications: 21 | on_success: change 22 | on_failure: change 23 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa) 3 | (source marmalade) 4 | 5 | (package-file "pophint.el") 6 | 7 | (depends-on "popup" "0.5.0") 8 | (depends-on "log4e" "0.2.0") 9 | (depends-on "yaxception" "0.1") 10 | 11 | (development 12 | (depends-on "tenv" :git "https://github.com/aki2o/elisp-test.git" :files ("tenv.el")) 13 | (depends-on "el-expectations" :git "https://github.com/aki2o/elisp-test.git" :files ("el-expectations.el")) 14 | (depends-on "el-mock")) 15 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | CASK ?= cask 3 | 4 | all: 5 | ${MAKE} clean 6 | ${MAKE} test 7 | ${MAKE} compile 8 | ${MAKE} test 9 | ${MAKE} clean 10 | 11 | compile: 12 | ${CASK} exec ${EMACS} -Q --batch -L . --eval "(batch-byte-compile)" pophint.el 13 | ${CASK} exec ${EMACS} -Q --batch -L . --eval "(batch-byte-compile)" pophint-config.el 14 | 15 | test: 16 | ret=0 ; \ 17 | outfile=/tmp/.elisp-test-result ; \ 18 | for f in $$(find test -type f -name "*.el"); do \ 19 | test -f $$outfile && rm -f $$outfile ; \ 20 | ${CASK} exec ${EMACS} -Q --batch -L . -l $$f -f batch-expectations $$outfile || ret=1 ; \ 21 | test -f $$outfile && cat $$outfile ; \ 22 | done ; \ 23 | test $$ret -eq 0 24 | 25 | clean: 26 | rm -f pophint.elc 27 | rm -f pophint-config.elc 28 | 29 | .PHONY: all compile test clean 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/aki2o/emacs-pophint.svg?branch=master)](https://travis-ci.org/aki2o/emacs-pophint) 2 | 3 | # What's this? 4 | 5 | This is a extension of Emacs that provide navigation like the Vimperator/Keysnail Hint Mode of Firfox. 6 | 7 | Do you know Vimperator/Keysnail of Firefox Addon? 8 | If you don't know it, see a screenshot below. 9 | 10 | ![vimperator](image/vimperator.png) 11 | 12 | The hints that has a alphabet code are shown when you push a "f" key on Firefox like above. 13 | Then, if you push the alphabet, you can jump the linked URL. 14 | 15 | This extension provides same interface on Emacs. 16 | 17 | # Feature 18 | 19 | This extension is the framework provides showing hints on *LOCATION* at first, then doing *ACTION* for the selected. 20 | The simplest case is just move. 21 | 22 | ![demo1](image/demo1.gif) 23 | 24 | You can configure easily *LOCATION*, *ACTION* and more. 25 | Here is a part of them. 26 | 27 | ![demo2](image/demo2.gif) 28 | 29 | More, navigate you in many situation. 30 | 31 | ![demo3](image/demo3.gif) 32 | 33 | For checking all function, 34 | see Bundled Function section in . 35 | 36 | # Install 37 | 38 | ### If use package.el 39 | 40 | 2013/07/19 It's available by using melpa. 41 | 42 | ### If use el-get.el 43 | 44 | 2013/05/01 Now during an application for registration in el-get. 45 | 2013/06/30 But, not yet regist. 46 | 2013/07/26 It's available. But, master branch only. 47 | 48 | ### If use auto-install.el 49 | 50 | ```lisp 51 | (auto-install-from-url "https://raw.github.com/aki2o/emacs-pophint/master/pophint.el") 52 | ``` 53 | - In this case, you need to install each of the following dependency. 54 | 55 | ### Manually 56 | 57 | Download pophint.el and put it on your load-path. 58 | - In this case, you need to install each of the following dependency. 59 | 60 | ### Dependency 61 | 62 | - popup.el … bundled with [auto-complete.el](https://github.com/auto-complete/auto-complete) 63 | - [log4e.el](https://github.com/aki2o/log4e) 64 | - [yaxception.el](https://github.com/aki2o/yaxception) 65 | 66 | # Configuration 67 | 68 | You can find a sample at . 69 | For more information, 70 | see Configuration section in . 71 | 72 | # Tested On 73 | 74 | - Emacs … GNU Emacs 23.3.1 (i386-mingw-nt5.1.2600) of 2011-08-15 on GNUPACK 75 | - popup.el … 0.5.0 76 | - log4e.el … 0.1 77 | - yaxception.el … 0.1 78 | 79 | **Enjoy!!!** 80 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+OPTIONS: toc:nil 2 | 3 | [[travis-build:aki2o/emacs-pophint#master]] 4 | 5 | * What's this? 6 | 7 | This is a extension of Emacs that provide navigation like the Vimperator/Keysnail Hint Mode of Firfox. 8 | 9 | Do you know Vimperator/Keysnail of Firefox Addon? 10 | If you don't know it, see a screenshot below. 11 | 12 | [[file:image/vimperator.png][vimperator]] 13 | 14 | The hints that has a alphabet code are shown when you push a "f" key on Firefox like above. 15 | Then, if you push the alphabet, you can jump the linked URL. 16 | 17 | This extension provides same interface on Emacs. 18 | 19 | * Feature 20 | 21 | This extension is the framework provides showing hints on /LOCATION/ at first, then doing /ACTION/ for the selected. 22 | The simplest case is just move. 23 | 24 | [[file:image/demo1.gif][demo1]] 25 | 26 | You can configure easily /LOCATION/, /ACTION/ and more. 27 | Here is a part of them. 28 | 29 | [[file:image/demo2.gif][demo2]] 30 | 31 | More, navigate you in many situation. 32 | 33 | [[file:image/demo3.gif][demo3]] 34 | 35 | For checking all function, 36 | see Bundled Function section in https://github.com/aki2o/emacs-pophint/wiki. 37 | 38 | 39 | * Install 40 | 41 | *** If use package.el 42 | 43 | 2013/07/19 It's available by using melpa. 44 | 45 | *** If use el-get.el 46 | 47 | 2013/05/01 Now during an application for registration in el-get. 48 | 2013/06/30 But, not yet regist. 49 | 2013/07/26 It's available. But, master branch only. 50 | 51 | *** If use auto-install.el 52 | 53 | #+BEGIN_SRC lisp 54 | (auto-install-from-url "https://raw.github.com/aki2o/emacs-pophint/master/pophint.el") 55 | #+END_SRC 56 | 57 | - In this case, you need to install each of the following dependency. 58 | 59 | *** Manually 60 | 61 | Download pophint.el and put it on your load-path. 62 | 63 | - In this case, you need to install each of the following dependency. 64 | 65 | *** Dependency 66 | 67 | - popup.el ... bundled with [[https://github.com/auto-complete/auto-complete][auto-complete.el]] 68 | - [[https://github.com/aki2o/log4e][log4e.el]] 69 | - [[https://github.com/aki2o/yaxception][yaxception.el]] 70 | 71 | 72 | * Configuration 73 | 74 | You can find a sample at https://github.com/aki2o/emacs-pophint/wiki/ConfigExample. 75 | For more information, 76 | see Configuration section in https://github.com/aki2o/emacs-pophint/wiki. 77 | 78 | 79 | * Tested On 80 | 81 | - Emacs ... GNU Emacs 23.3.1 (i386-mingw-nt5.1.2600) of 2011-08-15 on GNUPACK 82 | - popup.el ... 0.5.0 83 | - log4e.el ... 0.1 84 | - yaxception.el ... 0.1 85 | 86 | 87 | *Enjoy!!!* 88 | 89 | -------------------------------------------------------------------------------- /image/demo1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aki2o/emacs-pophint/c37195caec62a56af77432a8bd92ac720689b5fe/image/demo1.gif -------------------------------------------------------------------------------- /image/demo2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aki2o/emacs-pophint/c37195caec62a56af77432a8bd92ac720689b5fe/image/demo2.gif -------------------------------------------------------------------------------- /image/demo3.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aki2o/emacs-pophint/c37195caec62a56af77432a8bd92ac720689b5fe/image/demo3.gif -------------------------------------------------------------------------------- /image/vimperator.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/aki2o/emacs-pophint/c37195caec62a56af77432a8bd92ac720689b5fe/image/vimperator.png -------------------------------------------------------------------------------- /pophint-dired.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-dired:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | ;;;###autoload 10 | (defun pophint:do-direx-node () (interactive)) 11 | (with-no-warnings 12 | (pophint:defsource :name "dired-node" 13 | :description "Node in directory." 14 | :source '((shown . "Node") 15 | (regexp . "^ *[d-][r-][w-][x-].+ +\\([^ ]+\\)$") 16 | (requires . 1) 17 | (highlight . nil) 18 | (dedicated . (e2wm)) 19 | (activebufferp . (lambda (b) 20 | (pophint--maybe-kind-mode-buffer-p b 'dired-mode))) 21 | (action . (lambda (hint) 22 | (funcall pophint--default-action hint) 23 | (when (and (featurep 'e2wm) 24 | (e2wm:managed-p)) 25 | (dired-find-file) 26 | (e2wm:pst-window-select-main))))))) 27 | 28 | (defun pophint-dired:setup () 29 | (add-to-list 'pophint:sources 'pophint:source-dired-node)) 30 | (define-obsolete-function-alias 'pophint-config:dired-setup 'pophint-dired:setup "1.1.0") 31 | 32 | ;;;###autoload 33 | (defun pophint-dired:provision (activate) 34 | (interactive) 35 | (if activate 36 | (add-hook 'dired-mode-hook 'pophint-dired:setup t) 37 | (remove-hook 'dired-mode-hook 'pophint-dired:setup))) 38 | 39 | ;;;###autoload 40 | (with-eval-after-load 'pophint 41 | (when pophint-dired:enable (pophint-dired:provision t))) 42 | 43 | 44 | (provide 'pophint-dired) 45 | ;;; pophint-dired.el ends here 46 | -------------------------------------------------------------------------------- /pophint-direx.el: -------------------------------------------------------------------------------- 1 | (require 'direx) 2 | (require 'rx) 3 | (require 'pophint) 4 | 5 | ;;;###autoload 6 | (defcustom pophint-direx:enable t 7 | "Whether to enable feature." 8 | :type 'boolean 9 | :group 'pophint) 10 | 11 | (defvar pophint-direx--node-regexp nil) 12 | 13 | (defun pophint-direx:node-regexp () 14 | (or pophint-direx--node-regexp 15 | (setq pophint-direx--node-regexp 16 | (rx-to-string `(and bol (* space) 17 | (or ,direx:leaf-icon 18 | ,direx:open-icon 19 | ,direx:closed-icon) 20 | (group (+ not-newline)) 21 | (* space) eol))))) 22 | (define-obsolete-function-alias 'pophint-config:direx-node-regexp 'pophint-direx:node-regexp "1.1.0") 23 | 24 | ;;;###autoload 25 | (defun pophint:do-direx-node () (interactive)) 26 | (with-no-warnings 27 | (pophint:defsource :name "direx-node" 28 | :description "Node on DireX." 29 | :source '((shown . "Node") 30 | (regexp . pophint-direx:node-regexp) 31 | (requires . 1) 32 | (highlight . nil) 33 | (dedicated . (e2wm)) 34 | (activebufferp . (lambda (b) 35 | (pophint--maybe-kind-mode-buffer-p b 'direx:direx-mode))) 36 | (action . (lambda (hint) 37 | (funcall pophint--default-action hint) 38 | (when (and (featurep 'e2wm) 39 | (e2wm:managed-p)) 40 | (direx:find-item-other-window) 41 | (e2wm:pst-window-select-main))))))) 42 | 43 | (defun pophint-direx:setup () 44 | (add-to-list 'pophint:sources 'pophint:source-direx-node)) 45 | (define-obsolete-function-alias 'pophint-config:direx-setup 'pophint-direx:setup "1.1.0") 46 | 47 | ;;;###autoload 48 | (defun pophint-direx:provision (activate) 49 | (interactive) 50 | (if activate 51 | (add-hook 'direx:direx-mode-hook 'pophint-direx:setup t) 52 | (remove-hook 'direx:direx-mode-hook 'pophint-direx:setup))) 53 | 54 | ;;;###autoload 55 | (with-eval-after-load 'direx 56 | (when pophint-direx:enable (pophint-direx:provision t))) 57 | 58 | 59 | (provide 'pophint-direx) 60 | ;;; pophint-direx.el ends here 61 | -------------------------------------------------------------------------------- /pophint-e2wm.el: -------------------------------------------------------------------------------- 1 | (require 'e2wm) 2 | (require 'e2wm-perspb nil t) 3 | (require 'e2wm-sww nil t) 4 | (require 'e2wm-term nil t) 5 | (require 'pophint) 6 | (require 'pophint-ow) 7 | (require 'pophint-widget) 8 | 9 | ;;;###autoload 10 | (defcustom pophint-e2wm:enable t 11 | "Whether to enable feature." 12 | :type 'boolean 13 | :group 'pophint) 14 | (make-obsolete 'pophint-config:set-automatically-when-e2wm-array 'pophint-e2wm:enable "1.1.0") 15 | 16 | (defcustom pophint-e2wm:array-quit-immediately t 17 | "Whether to do `e2wm:dp-array-goto-prev-pst-command' immediately 18 | in array perspective." 19 | :type 'boolean 20 | :group 'pophint) 21 | (make-obsolete 'pophint-config:set-goto-immediately-when-e2wm-array 'pophint-e2wm:array-quit-immediately "1.1.0") 22 | 23 | ;;;###autoload 24 | (defun pophint:do-situationally-e2wm () (interactive)) 25 | (with-no-warnings 26 | (pophint:defsituation e2wm)) 27 | 28 | ;;;###autoload 29 | (defun pophint:do-e2wm-files () (interactive)) 30 | (with-no-warnings 31 | (pophint:defsource 32 | :name "e2wm-files" 33 | :description "Node in files plugin of e2wm." 34 | :source '((dedicated . e2wm) 35 | (regexp . "^\\([^ ]+\\)") 36 | (requires . 1) 37 | (highlight . nil) 38 | (activebufferp . (lambda (b) 39 | (and (e2wm:managed-p) 40 | (pophint--maybe-kind-mode-buffer-p b 'e2wm:def-plugin-files-mode)))) 41 | (action . (lambda (hint) 42 | (select-window (pophint:hint-window hint)) 43 | (goto-char (pophint:hint-startpt hint)) 44 | (e2wm:def-plugin-files-select-command)))))) 45 | 46 | ;;;###autoload 47 | (defun pophint:do-e2wm-history () (interactive)) 48 | (with-no-warnings 49 | (pophint:defsource 50 | :name "e2wm-history" 51 | :description "Entry in history list plugin of e2wm." 52 | :source '((dedicated . e2wm) 53 | (regexp . "^ +[0-9]+ +\\([^ ]+\\)") 54 | (requires . 1) 55 | (highlight . nil) 56 | (activebufferp . (lambda (b) 57 | (and (e2wm:managed-p) 58 | (pophint--maybe-kind-mode-buffer-p b 'e2wm:def-plugin-history-list-mode)))) 59 | (action . (lambda (hint) 60 | (select-window (pophint:hint-window hint)) 61 | (goto-char (pophint:hint-startpt hint)) 62 | (e2wm:def-plugin-history-list-select-command)))))) 63 | 64 | ;;;###autoload 65 | (defun pophint:do-e2wm-history2 () (interactive)) 66 | (with-no-warnings 67 | (pophint:defsource 68 | :name "e2wm-history2" 69 | :description "Entry in history list2 plugin of e2wm." 70 | :source '((dedicated . e2wm) 71 | (regexp . "^\\(?:<-\\)?\\(?:->\\)? +[0-9]+ +\\([^ ]+\\)") 72 | (requires . 1) 73 | (highlight . nil) 74 | (activebufferp . (lambda (b) 75 | (and (e2wm:managed-p) 76 | (pophint--maybe-kind-mode-buffer-p b 'e2wm:def-plugin-history-list2-mode)))) 77 | (action . (lambda (hint) 78 | (select-window (pophint:hint-window hint)) 79 | (goto-char (pophint:hint-startpt hint)) 80 | (e2wm:def-plugin-history-list2-select-command) 81 | (e2wm:pst-window-select-main)))))) 82 | 83 | ;;;###autoload 84 | (defun pophint:do-e2wm-imenu () (interactive)) 85 | (with-no-warnings 86 | (pophint:defsource 87 | :name "e2wm-imenu" 88 | :description "Entry in imenu plugin of e2wm." 89 | :source '((dedicated . e2wm) 90 | (regexp . "^\\(.+\\) *$") 91 | (requires . 1) 92 | (highlight . nil) 93 | (activebufferp . (lambda (b) 94 | (and (e2wm:managed-p) 95 | (pophint--maybe-kind-mode-buffer-p b 'e2wm:def-plugin-imenu-mode)))) 96 | (action . (lambda (hint) 97 | (select-window (pophint:hint-window hint)) 98 | (goto-char (pophint:hint-startpt hint)) 99 | (e2wm:def-plugin-imenu-jump-command)))))) 100 | 101 | ;;;###autoload 102 | (defun pophint:do-e2wm-perspb () (interactive)) 103 | (with-no-warnings 104 | (pophint:defsource 105 | :name "e2wm-perspb" 106 | :description "Entry in perspb plugin of e2wm." 107 | :source '((dedicated . e2wm) 108 | (regexp . "^..\\(.+\\) *$") 109 | (requires . 1) 110 | (highlight . nil) 111 | (activebufferp . (lambda (b) 112 | (and (e2wm:managed-p) 113 | (pophint--maybe-kind-mode-buffer-p b 'e2wm-perspb:mode)))) 114 | (action . (lambda (hint) 115 | (select-window (pophint:hint-window hint)) 116 | (goto-char (pophint:hint-startpt hint)) 117 | (e2wm-perspb:select-command)))))) 118 | 119 | ;;;###autoload 120 | (defun pophint:do-e2wm-sww () (interactive)) 121 | (with-no-warnings 122 | (pophint:defsource 123 | :name "e2wm-sww" 124 | :description "Entry in sww plugin of e2wm." 125 | :source `((init . (lambda () 126 | (goto-char (point-min)))) 127 | (dedicated . e2wm) 128 | (action . (lambda (hint) 129 | (select-window (pophint:hint-window hint)) 130 | (goto-char (pophint:hint-startpt hint)) 131 | (widget-apply (widget-at) :action) 132 | (e2wm:pst-window-select-main))) 133 | ,@pophint:source-widget))) 134 | 135 | ;;;###autoload 136 | (defun pophint:do-e2wm-term-history () (interactive)) 137 | (with-no-warnings 138 | (pophint:defsource 139 | :name "e2wm-term-history" 140 | :description "" 141 | :source '((dedicated . e2wm) 142 | (requires . 1) 143 | (highlight . nil) 144 | (activebufferp . (lambda (b) 145 | (and (e2wm:managed-p) 146 | (pophint--maybe-kind-mode-buffer-p b 'e2wm-term:history-mode)))) 147 | (method . (lambda () 148 | (let* ((startpt (e2wm-term::history-currpt)) 149 | (endpt (progn (e2wm-term:history-move-next t t) (point))) 150 | (value (buffer-substring-no-properties startpt endpt))) 151 | `(:startpt ,startpt :endpt ,endpt :value ,value)))) 152 | (action . (lambda (hint) 153 | (select-window (pophint:hint-window hint)) 154 | (goto-char (pophint:hint-startpt hint)) 155 | (e2wm-term:history-highlight) 156 | (e2wm-term:history-sync) 157 | (e2wm-term:history-send-pt-point)))))) 158 | 159 | ;;;###autoload 160 | (defun pophint-e2wm:array-other-window () 161 | "Do `pophint:do-each-window' in array perspective of `e2wm.el'." 162 | (interactive) 163 | (if (<= (length (window-list)) 3) 164 | (e2wm:dp-array-move-right-command) 165 | (let ((pophint:use-pos-tip t)) 166 | (if (and (pophint:do-each-window) 167 | pophint-e2wm:array-quit-immediately) 168 | (e2wm:dp-array-goto-prev-pst-command) 169 | (e2wm:dp-array-update-summary))))) 170 | (define-obsolete-function-alias 'pophint-config:e2wm-array-other-window 'pophint-e2wm:array-other-window "1.1.0") 171 | 172 | 173 | (defadvice e2wm:dp-array (after do-pophint disable) 174 | (when (interactive-p) 175 | (pophint-e2wm:array-other-window))) 176 | 177 | 178 | (defun pophint-e2wm:setup-array-key (activate) 179 | (eval-after-load "e2wm" 180 | `(progn 181 | (let ((key (ignore-errors 182 | (key-description (nth 0 (where-is-internal 'other-window global-map)))))) 183 | (when (and key 184 | (keymapp e2wm:dp-array-minor-mode-map)) 185 | (define-key 186 | e2wm:dp-array-minor-mode-map 187 | (read-kbd-macro key) 188 | (if ,activate 'pophint-e2wm:array-other-window 'other-window))))))) 189 | 190 | ;;;###autoload 191 | (defun pophint-e2wm:provision (activate) 192 | (interactive) 193 | (if activate 194 | (ad-enable-advice 'e2wm:dp-array 'after 'do-pophint) 195 | (ad-disable-advice 'e2wm:dp-array 'after 'do-pophint)) 196 | (ad-activate 'e2wm:dp-array) 197 | (pophint-e2wm:setup-array-key activate)) 198 | 199 | ;;;###autoload 200 | (with-eval-after-load 'e2wm 201 | (when pophint-e2wm:enable (pophint-e2wm:provision t))) 202 | 203 | 204 | (provide 'pophint-e2wm) 205 | ;;; pophint-e2wm.el ends here 206 | -------------------------------------------------------------------------------- /pophint-elisp.el: -------------------------------------------------------------------------------- 1 | (require 'rx) 2 | (require 'pophint) 3 | (require 'pophint-quote) 4 | 5 | ;;;###autoload 6 | (defcustom pophint-elisp:enable t 7 | "Whether to enable feature." 8 | :type 'boolean 9 | :group 'pophint) 10 | 11 | (defvar pophint-elisp--regexp-sexp-start 12 | (rx-to-string `(and (or bos 13 | (not (any "("))) 14 | (group "(" (not (any ") \t\r\n")))))) 15 | 16 | ;;;###autoload 17 | (defun pophint:do-sexp () (interactive)) 18 | (with-no-warnings 19 | (pophint:defsource 20 | :name "sexp" 21 | :description "Sexp on emacs-lisp-mode." 22 | :source '((shown . "Sexp") 23 | (method .(lambda () 24 | (when (re-search-forward pophint-elisp--regexp-sexp-start nil t) 25 | (save-excursion 26 | (let* ((startpt (match-beginning 1)) 27 | (endpt (ignore-errors (goto-char startpt) (forward-sexp) (point))) 28 | (value (when endpt (buffer-substring-no-properties startpt endpt)))) 29 | `(:startpt ,startpt :endpt ,endpt :value ,value)))))) 30 | (highlight . nil)))) 31 | 32 | (defun pophint-elisp:setup () 33 | (add-to-list 'pophint:sources 'pophint:source-sexp) 34 | (setq pophint-quote:exclude-quote-chars '("'" "`"))) 35 | (define-obsolete-function-alias 'pophint-config:elisp-setup 'pophint-elisp:setup "1.1.0") 36 | 37 | ;;;###autoload 38 | (defun pophint-elisp:provision (activate) 39 | (interactive) 40 | (if activate 41 | (add-hook 'emacs-lisp-mode-hook 'pophint-elisp:setup t) 42 | (remove-hook 'emacs-lisp-mode-hook 'pophint-elisp:setup))) 43 | 44 | ;;;###autoload 45 | (with-eval-after-load 'pophint 46 | (when pophint-elisp:enable (pophint-elisp:provision t))) 47 | 48 | 49 | (provide 'pophint-elisp) 50 | ;;; pophint-elisp.el ends here 51 | -------------------------------------------------------------------------------- /pophint-eww.el: -------------------------------------------------------------------------------- 1 | (require 'eww) 2 | (require 'pophint) 3 | (require 'pophint-yank) 4 | 5 | ;;;###autoload 6 | (defcustom pophint-eww:enable t 7 | "Whether to enable feature." 8 | :type 'boolean 9 | :group 'pophint) 10 | 11 | (defcustom pophint-eww:use-new-tab t 12 | "Whether open new tab of eww when action by eww function." 13 | :type 'boolean 14 | :group 'pophint) 15 | (make-obsolete 'pophint-config:set-eww-use-new-tab 'pophint-eww:use-new-tab "1.1.0") 16 | 17 | (defvar pophint-eww--eww-buffer-name "*eww*") 18 | 19 | (defun pophint-eww--do-anchor-sentinel (method) 20 | (let ((pophint-eww:use-new-tab (cl-case method 21 | (open nil) 22 | (tab t) 23 | (invert (not pophint-eww:use-new-tab))))) 24 | (pophint:do-eww-anchor))) 25 | 26 | ;;;###autoload 27 | (defun pophint:do-eww-anchor () (interactive)) 28 | (with-no-warnings 29 | (pophint:defsource 30 | :name "eww-anchor" 31 | :description "Anchor on eww." 32 | :source '((shown . "Link") 33 | (dedicated . (e2wm)) 34 | (requires . 0) 35 | (activebufferp . (lambda (b) 36 | (pophint--maybe-kind-mode-buffer-p b 'eww-mode))) 37 | (method . (lambda () 38 | ;; Getting startpt by referring `shr-next-link' for silent execute 39 | (let* ((startpt (pophint--awhen (text-property-any (point) (point-max) 'help-echo nil) 40 | (text-property-not-all it (point-max) 'help-echo nil))) 41 | (endpt (or (when startpt (next-single-property-change startpt 'face)) 42 | (point-max))) 43 | (url (when startpt (get-text-property startpt 'shr-url)))) 44 | (when startpt 45 | (goto-char startpt) 46 | (pophint--trace "(eww)found anchor. url:[%s]" url) 47 | `(:startpt ,startpt :endpt ,endpt :value ,url))))) 48 | (action . (lambda (hint) 49 | (with-selected-window (pophint:hint-window hint) 50 | (goto-char (pophint:hint-startpt hint)) 51 | (let ((cmd (key-binding "\r"))) 52 | (when (and (eq cmd 'eww-follow-link) 53 | (not pophint-eww:use-new-tab) 54 | (not (get-buffer pophint-eww--eww-buffer-name))) 55 | ;; If open link in same tab, 56 | ;; back name to original buffer name before the open action 57 | ;; because `eww-setup-buffer' gets target buffer by 58 | ;; `get-buffer-create' to `pophint-eww--eww-buffer-name'. 59 | (rename-buffer pophint-eww--eww-buffer-name)) 60 | (call-interactively cmd)))))))) 61 | 62 | ;;;###autoload 63 | (defun pophint-eww:anchor-open () 64 | "Do `pophint:do-eww-anchor' in current tab." 65 | (interactive) 66 | (pophint-eww--do-anchor-sentinel 'open)) 67 | (define-obsolete-function-alias 'pophint-config:eww-anchor-open 'pophint-eww:anchor-open "1.1.0") 68 | 69 | ;;;###autoload 70 | (defun pophint-eww:anchor-open-new-tab () 71 | "Do `pophint:do-eww-anchor' in new tab." 72 | (interactive) 73 | (pophint-eww--do-anchor-sentinel 'tab)) 74 | (define-obsolete-function-alias 'pophint-config:eww-anchor-open-new-tab 'pophint-eww:anchor-open-new-tab "1.1.0") 75 | 76 | ;;;###autoload 77 | (defun pophint-eww:anchor-open-invert () 78 | "Do `pophint:do-eww-anchor' inverting `pophint-eww:use-new-tab'." 79 | (interactive) 80 | (pophint-eww--do-anchor-sentinel 'invert)) 81 | (define-obsolete-function-alias 'pophint-config:eww-anchor-open-invert 'pophint-eww:anchor-open-invert "1.1.0") 82 | 83 | ;;;###autoload 84 | (defun pophint-eww:anchor-open-new-tab-continuously () 85 | "Do `pophint:do-eww-anchor' in new tab continuously." 86 | (interactive) 87 | (let ((buff (current-buffer)) 88 | (pt (point))) 89 | (pophint-eww--do-anchor-sentinel 'tab) 90 | (switch-to-buffer buff) 91 | (goto-char pt) 92 | (pophint-eww:anchor-open-new-tab-continuously))) 93 | (define-obsolete-function-alias 'pophint-config:eww-anchor-open-new-tab-continuously 'pophint-eww:anchor-open-new-tab-continuously "1.1.0") 94 | 95 | ;;;###autoload 96 | (defun pophint-eww:anchor-open-with-external () 97 | "Do `pophint:source-eww-anchor' with external browser." 98 | (interactive) 99 | (pophint:do :source pophint:source-eww-anchor 100 | :action-name "External Browser" 101 | :action (lambda (hint) 102 | (eww-browse-with-external-browser (pophint:hint-value hint))))) 103 | (define-obsolete-function-alias 'pophint-config:eww-anchor-open-with-external 'pophint-eww:anchor-open-with-external "1.1.0") 104 | 105 | ;;;###autoload 106 | (defun pophint-eww:anchor-yank () 107 | "Yank using `pophint:source-eww-anchor'." 108 | (interactive) 109 | (pophint:do :source pophint:source-eww-anchor 110 | :action-name "Yank" 111 | :action pophint-yank--yank-action)) 112 | (define-obsolete-function-alias 'pophint-config:eww-anchor-yank 'pophint-eww:anchor-yank "1.1.0") 113 | 114 | ;;;###autoload 115 | (defun pophint-eww:anchor-focus () 116 | "Focus using `pophint:source-eww-anchor'." 117 | (interactive) 118 | (pophint:do :source pophint:source-eww-anchor 119 | :action-name "Focus" 120 | :action (lambda (hint) 121 | (goto-char (pophint:hint-startpt hint))))) 122 | (define-obsolete-function-alias 'pophint-config:eww-anchor-focus 'pophint-eww:anchor-focus "1.1.0") 123 | 124 | (defun pophint-eww:set-keys () 125 | (local-set-key (kbd "f") 'pophint:do-eww-anchor) 126 | (local-set-key (kbd "F") 'pophint-eww:anchor-open-invert) 127 | (local-set-key (kbd "C-c C-e") 'pophint-eww:anchor-open-new-tab-continuously) 128 | (local-set-key (kbd "; o") 'pophint-eww:anchor-open) 129 | (local-set-key (kbd "; t") 'pophint-eww:anchor-open-new-tab) 130 | (local-set-key (kbd "; F") 'pophint-eww:anchor-open-new-tab-continuously) 131 | (local-set-key (kbd "; e") 'pophint-eww:anchor-open-with-external) 132 | (local-set-key (kbd "; y") 'pophint-eww:anchor-yank) 133 | (local-set-key (kbd "; v") 'eww-view-source) 134 | (local-set-key (kbd "; RET") 'pophint-eww:anchor-focus)) 135 | 136 | (defun pophint-eww:setup () 137 | (add-to-list 'pophint:sources 'pophint:source-eww-anchor) 138 | (pophint-eww:set-keys)) 139 | (define-obsolete-function-alias 'pophint-config:eww-setup 'pophint-eww:setup "1.1.0") 140 | 141 | 142 | (defadvice eww-setup-buffer (after pophint:handle-tabs disable) 143 | ;; Always use not original buffer name for handling multiple tab 144 | (when (string= (buffer-name) pophint-eww--eww-buffer-name) 145 | (rename-uniquely))) 146 | 147 | 148 | ;;;###autoload 149 | (defun pophint-eww:provision (activate) 150 | (interactive) 151 | (if activate 152 | (ad-enable-advice 'eww-setup-buffer 'after 'pophint:handle-tabs) 153 | (ad-disable-advice 'eww-setup-buffer 'after 'pophint:handle-tabs)) 154 | (ad-activate 'eww-setup-buffer) 155 | (if activate 156 | (add-hook 'eww-mode-hook 'pophint-eww:setup t) 157 | (remove-hook 'eww-mode-hook 'pophint-eww:setup))) 158 | 159 | ;;;###autoload 160 | (with-eval-after-load 'eww 161 | (when pophint-eww:enable (pophint-eww:provision t))) 162 | 163 | 164 | (provide 'pophint-eww) 165 | ;;; pophint-eww.el ends here 166 | -------------------------------------------------------------------------------- /pophint-help.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-help:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | ;;;###autoload 10 | (defun pophint:do-help-btn () (interactive)) 11 | (with-no-warnings 12 | (pophint:defsource 13 | :name "help-btn" 14 | :description "Button on help-mode." 15 | :source '((shown . "Link") 16 | (dedicated . (e2wm)) 17 | (activebufferp . (lambda (b) 18 | (pophint--maybe-kind-mode-buffer-p b 'help-mode))) 19 | (method . (lambda () 20 | (when (forward-button 1) 21 | (let* ((btn (button-at (point))) 22 | (startpt (when btn (button-start btn))) 23 | (endpt (when btn (button-end btn))) 24 | (value (when btn (buffer-substring-no-properties startpt endpt)))) 25 | (pophint--trace "found button. startpt:[%s] endpt:[%s] value:[%s]" 26 | startpt endpt value) 27 | `(:startpt ,startpt :endpt ,endpt :value ,value))))) 28 | (action . (lambda (hint) 29 | (with-selected-window (pophint:hint-window hint) 30 | (goto-char (pophint:hint-startpt hint)) 31 | (push-button))))))) 32 | 33 | (defun pophint-help:setup () 34 | (add-to-list 'pophint:sources 'pophint:source-help-btn)) 35 | (define-obsolete-function-alias 'pophint-config:help-setup 'pophint-help:setup "1.1.0") 36 | 37 | ;;;###autoload 38 | (defun pophint-help:provision (activate) 39 | (interactive) 40 | (if activate 41 | (add-hook 'help-mode-hook 'pophint-help:setup t) 42 | (remove-hook 'help-mode-hook 'pophint-help:setup))) 43 | 44 | ;;;###autoload 45 | (with-eval-after-load 'pophint 46 | (when pophint-help:enable (pophint-help:provision t))) 47 | 48 | 49 | (provide 'pophint-help) 50 | ;;; pophint-help.el ends here 51 | -------------------------------------------------------------------------------- /pophint-info.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-info:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | ;;;###autoload 10 | (defun pophint:do-info-ref () (interactive)) 11 | (with-no-warnings 12 | (pophint:defsource 13 | :name "info-ref" 14 | :description "Reference on info-mode." 15 | :source '((shown . "Link") 16 | (dedicated . (e2wm)) 17 | (activebufferp . (lambda (b) 18 | (pophint--maybe-kind-mode-buffer-p b 'Info-mode))) 19 | (method . (lambda () 20 | (let* ((currpt (point)) 21 | (startpt (progn (Info-next-reference) (point))) 22 | (endpt (next-property-change startpt)) 23 | (value (buffer-substring-no-properties startpt endpt))) 24 | (when (<= currpt startpt) 25 | `(:startpt ,startpt :endpt ,endpt :value ,value))))) 26 | (action . (lambda (hint) 27 | (with-selected-window (pophint:hint-window hint) 28 | (goto-char (pophint:hint-startpt hint)) 29 | (Info-follow-nearest-node))))))) 30 | 31 | (defun pophint-info:setup () 32 | (add-to-list 'pophint:sources 'pophint:source-info-ref)) 33 | (define-obsolete-function-alias 'pophint-config:info-setup 'pophint-info:setup "1.1.0") 34 | 35 | ;;;###autoload 36 | (defun pophint-info:provision (activate) 37 | (interactive) 38 | (if activate 39 | (add-hook 'Info-mode-hook 'pophint-info:setup t) 40 | (remove-hook 'Info-mode-hook 'pophint-info:setup))) 41 | 42 | ;;;###autoload 43 | (with-eval-after-load 'pophint 44 | (when pophint-info:enable (pophint-info:provision t))) 45 | 46 | 47 | (provide 'pophint-info) 48 | ;;; pophint-info.el ends here 49 | -------------------------------------------------------------------------------- /pophint-isearch.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'pophint-region) 3 | 4 | ;;;###autoload 5 | (defcustom pophint-isearch:enable t 6 | "Whether to enable feature." 7 | :type 'boolean 8 | :group 'pophint) 9 | 10 | (defcustom pophint-isearch:start-on-isearch-exit-p t 11 | "Whether to start pophint to move to hit text on `isearch-exit'." 12 | :type 'boolean 13 | :group 'pophint) 14 | (make-obsolete 'pophint-config:set-automatically-when-isearch 'pophint-isearch:start-on-isearch-exit-p "1.1.0") 15 | 16 | (defvar pophint-isearch--overlay-index 0) 17 | (defvar pophint-isearch--action-result nil) 18 | 19 | ;;;###autoload 20 | (defun pophint-isearch:yank-region () 21 | "Pull rest of region by selecting hint-tip from buffer into search string." 22 | (interactive) 23 | (isearch-yank-internal 24 | (lambda () 25 | (when-let ((pt (pophint-region:narrow-or-wide :narrow-limit (pos-eol) 26 | :use-pos-tip nil 27 | :action 'point))) 28 | (goto-char pt) 29 | (point))))) 30 | (define-obsolete-function-alias 'pophint-config:isearch-yank-region 'pophint-isearch:yank-region "1.1.0") 31 | 32 | ;;;###autoload 33 | (cl-defmacro pophint-isearch:replace-to-yank-region (command) 34 | "Set advice to replace COMMAND with `pophint-isearch:yank-region'." 35 | (declare (indent 0)) 36 | `(defadvice ,command (around do-pophint activate) 37 | (pophint--trace "start do as substitute for %s" (symbol-name ',command)) 38 | (pophint-isearch:yank-region))) 39 | (define-obsolete-function-alias 'pophint-config:set-isearch-yank-region-command 'pophint-isearch:replace-to-yank-region "1.1.0") 40 | 41 | 42 | ;;;###autoload 43 | (defun pophint:do-flexibly-isearch () (interactive)) 44 | (with-no-warnings 45 | (pophint:defaction :key "i" 46 | :name "ISearch" 47 | :description "Do `isearch' from the text of selected hint-tip." 48 | :action (lambda (hint) 49 | (let ((pophint-isearch--action-result hint)) 50 | (with-selected-window (pophint:hint-window hint) 51 | (isearch-forward)))))) 52 | 53 | (defadvice pophint:do-flexibly-isearch (before set-pophint-condition activate) 54 | (let* ((ctx "pophint:do-flexibly-isearch") 55 | (lastc (pophint--get-last-condition-with-context ctx)) 56 | (glastc pophint--last-condition)) 57 | (when (and (not (pophint--condition-p lastc)) 58 | (pophint--condition-p glastc)) 59 | ;; 最初の実行時は、symbolをデフォルトにする 60 | (setf (pophint--condition-source glastc) 61 | (pophint--compile-source 'pophint:source-symbol)) 62 | (pophint--set-last-condition glastc :context ctx)))) 63 | 64 | 65 | ;;;###autoload 66 | (cl-defmacro pophint-isearch:defcommand (command) 67 | (declare (indent 0)) 68 | (let ((fnc-sym (intern (format "pophint-isearch:%s" (symbol-name command)))) 69 | (fnc-doc (format "Start `%s' after move to selected hint-tip point." (symbol-name command)))) 70 | `(progn 71 | (defun ,fnc-sym () 72 | ,fnc-doc 73 | (interactive) 74 | (pophint:do :not-highlight t 75 | :not-switch-window t 76 | :use-pos-tip nil 77 | :direction 'around 78 | :source '((shown . "Region") 79 | (action . (lambda (hint) 80 | (goto-char (pophint:hint-startpt hint)) 81 | (call-interactively ',command))))))))) 82 | (define-obsolete-function-alias 'pophint-config:def-isearch-command 'pophint-isearch:defcommand "1.1.0") 83 | 84 | ;;;###autoload 85 | (defun pophint-isearch:isearch-forward () (interactive)) 86 | (with-no-warnings 87 | (pophint-isearch:defcommand isearch-forward)) 88 | (define-obsolete-function-alias 'pophint-config:isearch-forward 'pophint-isearch:isearch-forward "1.1.0") 89 | 90 | ;;;###autoload 91 | (defun pophint-isearch:isearch-backward () (interactive)) 92 | (with-no-warnings 93 | (pophint-isearch:defcommand isearch-backward)) 94 | (define-obsolete-function-alias 'pophint-config:isearch-backward 'pophint-isearch:isearch-backward "1.1.0") 95 | 96 | 97 | (defun pophint-isearch:setup () 98 | (let ((hint pophint-isearch--action-result)) 99 | (when (pophint:hint-p hint) 100 | (setq isearch-string (pophint:hint-value hint)) 101 | (setq isearch-message (pophint:hint-value hint))))) 102 | (define-obsolete-function-alias 'pophint-config:isearch-setup 'pophint-isearch:setup "1.1.0") 103 | 104 | 105 | (defadvice isearch-exit (before do-pophint disable) 106 | (when-let ((pt (when pophint-isearch:start-on-isearch-exit-p 107 | (pophint:do :not-highlight t 108 | :not-switch-window t 109 | :source '((shown . "Cand") 110 | (init . (lambda () 111 | (setq pophint-isearch--overlay-index 0))) 112 | (method . (lambda () 113 | (pophint--trace "overlay count:[%s] index:[%s]" 114 | (length isearch-lazy-highlight-overlays) 115 | pophint-isearch--overlay-index) 116 | (let* ((idx pophint-isearch--overlay-index) 117 | (ov (when (< idx (length isearch-lazy-highlight-overlays)) 118 | (nth idx isearch-lazy-highlight-overlays))) 119 | (startpt (when ov (overlay-start ov))) 120 | (endpt (when ov (overlay-end ov))) 121 | (value (when ov (buffer-substring-no-properties startpt endpt))) 122 | (ret `(:startpt ,startpt :endpt ,endpt :value ,value))) 123 | (when ov (cl-incf pophint-isearch--overlay-index)) 124 | (when startpt (goto-char startpt)) 125 | ret))) 126 | (action . point)))))) 127 | (goto-char pt))) 128 | 129 | (defadvice anything-c-moccur-from-isearch (around pophint:disable disable) 130 | (let ((exitconf pophint-isearch:start-on-isearch-exit-p)) 131 | (setq pophint-isearch:start-on-isearch-exit-p nil) 132 | ad-do-it 133 | (setq pophint-isearch:start-on-isearch-exit-p exitconf))) 134 | 135 | (defadvice helm-c-moccur-from-isearch (around pophint:disable disable) 136 | (let ((exitconf pophint-isearch:start-on-isearch-exit-p)) 137 | (setq pophint-isearch:start-on-isearch-exit-p nil) 138 | ad-do-it 139 | (setq pophint-isearch:start-on-isearch-exit-p exitconf))) 140 | 141 | 142 | ;;;###autoload 143 | (defun pophint-isearch:provision (activate) 144 | (interactive) 145 | (if activate 146 | (progn 147 | (add-hook 'isearch-mode-hook 'pophint-isearch:setup t) 148 | (ad-enable-advice 'isearch-exit 'before 'do-pophint) 149 | (ad-enable-advice 'anything-c-moccur-from-isearch 'around 'pophint:disable) 150 | (ad-enable-advice 'helm-c-moccur-from-isearch 'around 'pophint:disable)) 151 | (remove-hook 'isearch-mode-hook 'pophint-isearch:setup) 152 | (ad-disable-advice 'isearch-exit 'before 'do-pophint) 153 | (ad-disable-advice 'anything-c-moccur-from-isearch 'around 'pophint:disable) 154 | (ad-disable-advice 'helm-c-moccur-from-isearch 'around 'pophint:disable)) 155 | (ad-activate 'isearch-exit) 156 | (ad-activate 'anything-c-moccur-from-isearch) 157 | (ad-activate 'helm-c-moccur-from-isearch)) 158 | 159 | ;;;###autoload 160 | (with-eval-after-load 'pophint 161 | (when pophint-isearch:enable (pophint-isearch:provision t))) 162 | 163 | 164 | (provide 'pophint-isearch) 165 | ;;; pophint-isearch.el ends here 166 | -------------------------------------------------------------------------------- /pophint-line.el: -------------------------------------------------------------------------------- 1 | (require 'rx) 2 | (require 'pophint) 3 | 4 | ;;;###autoload 5 | (defcustom pophint-line:enable t 6 | "Whether to enable feature." 7 | :type 'boolean 8 | :group 'pophint) 9 | 10 | (defvar pophint-line--regexp-one-line 11 | (rx-to-string `(and bol (* (syntax whitespace)) (group (+ not-newline))))) 12 | 13 | (pophint:defsource :name "one-line" 14 | :description "One line." 15 | :source '((shown . "Line") 16 | (regexp . pophint-line--regexp-one-line))) 17 | 18 | (pophint:defsource 19 | :name "comment-line" 20 | :description "Part of `font-lock-comment-face' in line" 21 | :source '((shown . "Cmt") 22 | (method . (lambda () 23 | (cl-loop while (re-search-forward "\\s<+" nil t) 24 | for startpt = (progn (skip-syntax-forward " ") (point)) 25 | for endpt = (when (and (eq (get-text-property (point) 'face) 'font-lock-comment-face) 26 | (re-search-forward "\\s-*\\(\\s>+\\|$\\)")) 27 | (match-beginning 0)) 28 | for value = (when endpt (buffer-substring-no-properties startpt endpt)) 29 | if (and (stringp value) 30 | (not (string= value ""))) 31 | return `(:startpt ,startpt :endpt ,endpt :value ,value)))))) 32 | 33 | ;;;###autoload 34 | (defun pophint-line:provision (activate) 35 | (interactive) 36 | (if activate 37 | (progn 38 | (add-to-list 'pophint:global-sources 'pophint:source-one-line t) 39 | (add-to-list 'pophint:global-sources 'pophint:source-comment-line t)) 40 | (setq pophint:global-sources 41 | (remove 'pophint:source-one-line 42 | (remove 'pophint:source-comment-line pophint:global-sources))))) 43 | 44 | ;;;###autoload 45 | (with-eval-after-load 'pophint 46 | (when pophint-line:enable (pophint-line:provision t))) 47 | 48 | 49 | (provide 'pophint-line) 50 | ;;; pophint-line.el ends here 51 | -------------------------------------------------------------------------------- /pophint-mark.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-mark:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | (make-obsolete 'pophint-config:set-automatically-when-marking 'pophint-mark:enable "1.1.0") 9 | 10 | (defcustom pophint-mark:yank-immediately-on-marking-p nil 11 | "Whether to yank immediately when select hint-tip 12 | after `set-mark-command' or `cua-set-mark'." 13 | :type 'boolean 14 | :group 'pophint) 15 | (make-obsolete 'pophint-config:set-yank-immediately-when-marking 'pophint-mark:yank-immediately-on-marking-p "1.1.0") 16 | 17 | (defcustom pophint-mark:direction 'forward 18 | "Set direction when select hint-tip after `set-mark-command' or `cua-set-mark'." 19 | :type 'symbol 20 | :group 'pophint) 21 | (make-obsolete 'pophint-config:set-mark-direction 'pophint-mark:direction "1.1.0") 22 | 23 | 24 | (defadvice set-mark-command (after do-pophint disable) 25 | (let ((pophint-mark--user-start (point)) 26 | (action-name (if pophint-mark:yank-immediately-on-marking-p 27 | "Yank" 28 | "Focus")) 29 | (action (lambda (hint) 30 | (let ((currpt (point))) 31 | (goto-char (pophint:hint-startpt hint)) 32 | (when pophint-mark:yank-immediately-on-marking-p 33 | (kill-ring-save currpt (point))))))) 34 | (cl-case pophint-mark:direction 35 | (forward 36 | (pophint-region:narrow-or-wide :narrow-limit (pos-eol) 37 | :use-pos-tip nil 38 | :action-name action-name 39 | :action action)) 40 | (backward 41 | (pophint-region:narrow-or-wide :backward-p t 42 | :narrow-limit (pos-bol) 43 | :use-pos-tip nil 44 | :action-name action-name 45 | :action action)) 46 | (t 47 | (pophint:do :not-highlight t 48 | :not-switch-window t 49 | :use-pos-tip nil 50 | :direction pophint-mark:direction 51 | :source '((shown . "Region") 52 | (method . (lambda () 53 | (when (= (point) pophint-mark--user-start) 54 | (pophint:inch-forward)) 55 | (pophint:make-hint-with-inch-forward)))) 56 | :action-name action-name 57 | :action action))))) 58 | 59 | (defadvice cua-set-mark (after do-pophint disable) 60 | (pophint:do :not-highlight t 61 | :not-switch-window t 62 | :use-pos-tip nil 63 | :direction pophint-mark:direction 64 | :source '((shown . "Region") 65 | (regexp . "[^a-zA-Z0-9]+") 66 | (action . (lambda (hint) 67 | (let* ((currpt (point))) 68 | (goto-char (pophint:hint-startpt hint)) 69 | (when pophint-mark:yank-immediately-on-marking-p 70 | (kill-ring-save currpt (point))))))))) 71 | 72 | 73 | ;;;###autoload 74 | (defun pophint-mark:provision (activate) 75 | (interactive) 76 | (cond (activate 77 | (ad-enable-advice 'set-mark-command 'after 'do-pophint) 78 | (ad-enable-advice 'cua-set-mark 'after 'do-pophint)) 79 | (t 80 | (ad-disable-advice 'set-mark-command 'after 'do-pophint) 81 | (ad-disable-advice 'cua-set-mark 'after 'do-pophint))) 82 | (ad-activate 'set-mark-command) 83 | (ad-activate 'cua-set-mark)) 84 | 85 | ;;;###autoload 86 | (with-eval-after-load 'pophint 87 | (when pophint-mark:enable (pophint-mark:provision t))) 88 | 89 | 90 | (provide 'pophint-mark) 91 | ;;; pophint-mark.el ends here 92 | -------------------------------------------------------------------------------- /pophint-outline.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-outline:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | (defcustom pophint-outline:heading-action 'outline-show-children 10 | "Function to invoke on it when hint selected." 11 | :type 'function 12 | :group 'pophint) 13 | 14 | ;;;###autoload 15 | (defun pophint:do-outline-heading () (interactive)) 16 | (with-no-warnings 17 | (pophint:defsource 18 | :name "outline-heading" 19 | :description "Heading of outline." 20 | :source '((shown . "Heading") 21 | (highlight . nil) 22 | (method . (lambda () 23 | (let* ((currpt (point)) 24 | (startpt (progn (outline-next-visible-heading 1) (+ (point) (funcall outline-level)))) 25 | (endpt (progn (outline-end-of-heading) (point))) 26 | (value (buffer-substring-no-properties startpt endpt))) 27 | (when (and (<= currpt startpt) 28 | (outline-on-heading-p)) 29 | `(:startpt ,startpt :endpt ,endpt :value ,value))))) 30 | (action . (lambda (hint) 31 | (with-selected-window (pophint:hint-window hint) 32 | (goto-char (pophint:hint-startpt hint)) 33 | (when pophint-outline:heading-action 34 | (funcall pophint-outline:heading-action)))))))) 35 | 36 | ;;;###autoload 37 | (defun pophint-outline:provision (activate) 38 | (interactive) 39 | (if activate 40 | (progn 41 | (add-to-list 'pophint:global-sources 'pophint:source-outline-heading t)) 42 | (setq pophint:global-sources 43 | (remove 'pophint:source-outline-heading pophint:global-sources)))) 44 | 45 | ;;;###autoload 46 | (with-eval-after-load 'pophint 47 | (when pophint-outline:enable (pophint-outline:provision t))) 48 | 49 | 50 | (provide 'pophint-outline) 51 | ;;; pophint-outline.el ends here 52 | -------------------------------------------------------------------------------- /pophint-ow.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-ow:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | (make-obsolete 'pophint-config:set-do-when-other-window 'pophint-ow:enable "1.1.0") 9 | 10 | ;;;###autoload 11 | (defun pophint:do-each-window () (interactive)) 12 | (with-no-warnings 13 | (pophint:defsource 14 | :name "each-window" 15 | :description "Each window" 16 | :source `((action . (lambda (hint) 17 | (funcall pophint--default-action hint) 18 | (goto-char (pophint:hint-endpt hint)))) 19 | ,@pophint--next-window-source))) 20 | 21 | (pophint:set-allwindow-command pophint:do-each-window) 22 | 23 | 24 | (defadvice other-window (around do-pophint disable) 25 | (if (and (called-interactively-p 'any) 26 | (> (length (window-list)) 2)) 27 | (let ((pophint:use-pos-tip t)) 28 | (pophint:do-each-window)) 29 | ad-do-it)) 30 | 31 | 32 | ;;;###autoload 33 | (defun pophint-ow:provision (activate) 34 | (interactive) 35 | (if activate 36 | (ad-enable-advice 'other-window 'around 'do-pophint) 37 | (ad-disable-advice 'other-window 'around 'do-pophint)) 38 | (ad-activate 'other-window)) 39 | 40 | ;;;###autoload 41 | (with-eval-after-load 'pophint 42 | (when pophint-ow:enable (pophint-ow:provision t))) 43 | 44 | 45 | (provide 'pophint-ow) 46 | ;;; pophint-ow.el ends here 47 | -------------------------------------------------------------------------------- /pophint-quote.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-quote:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | (defvar pophint-quote:quote-chars '("\"" "'" "`")) 10 | (make-variable-buffer-local 'pophint-quote:quote-chars) 11 | (make-obsolete 'pophint-config:quote-chars 'pophint-quote:quote-chars "1.1.0") 12 | 13 | (defvar pophint-quote:exclude-quote-chars nil) 14 | (make-variable-buffer-local 'pophint-quote:exclude-quote-chars) 15 | (make-obsolete 'pophint-config:exclude-quote-chars 'pophint-quote:exclude-quote-chars "1.1.0") 16 | 17 | (defun pophint-quote--quoted-point-p (pt) 18 | (when (> pt 0) 19 | (memq (get-text-property pt 'face) 20 | '(font-lock-string-face font-lock-doc-face)))) 21 | 22 | ;;;###autoload 23 | (defun pophint:do-quoted () (interactive)) 24 | (with-no-warnings 25 | (pophint:defsource 26 | :name "quoted" 27 | :description "Quoted range by `pophint-quote:quote-chars'. 28 | If exist the character that not be used for quote, set `pophint-quote:exclude-quote-chars'. 29 | It's a buffer local variable and list like `pophint-quote:quote-chars'." 30 | :source '((shown . "Quoted") 31 | (method . (lambda () 32 | (let* ((chars (cl-loop for c in pophint-quote:quote-chars 33 | if (not (member c pophint-quote:exclude-quote-chars)) 34 | collect c)) 35 | (char-re (when chars (regexp-opt chars))) 36 | (re (when char-re (rx-to-string `(and (group (regexp ,char-re))))))) 37 | (while (and (pophint-quote--quoted-point-p (point)) 38 | re 39 | (re-search-forward re nil t))) 40 | (cl-loop while (and re (re-search-forward re nil t)) 41 | for word = (match-string-no-properties 1) 42 | for startpt = (point) 43 | for endpt = (or (when (and (< (point) (point-max)) 44 | (string= (format "%c" (char-after)) word)) 45 | (forward-char) 46 | (- (point) 1)) 47 | (when (re-search-forward (format "[^\\]%s" word) nil t) 48 | (- (point) 1))) 49 | for value = (when (and endpt (< startpt endpt)) 50 | (buffer-substring-no-properties startpt endpt)) 51 | if (not endpt) return nil 52 | if (and (stringp value) (not (string= value ""))) 53 | return `(:startpt ,startpt :endpt ,endpt :value ,value)))))))) 54 | 55 | ;;;###autoload 56 | (defun pophint-quote:provision (activate) 57 | (interactive) 58 | (if activate 59 | (add-to-list 'pophint:global-sources 'pophint:source-quoted t) 60 | (setq pophint:global-sources (remove 'pophint:source-quoted pophint:global-sources)))) 61 | 62 | ;;;###autoload 63 | (with-eval-after-load 'pophint 64 | (when pophint-quote:enable (pophint-quote:provision t))) 65 | 66 | 67 | (provide 'pophint-quote) 68 | ;;; pophint-quote.el ends here 69 | -------------------------------------------------------------------------------- /pophint-region.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | (defvar pophint-region--start nil) 4 | (defvar pophint-region--end nil) 5 | (defvar pophint-region--user-start nil) 6 | 7 | (defun pophint-region--do-with-narrow-or-wide (key) 8 | (let ((startpt (plist-get pophint-region--start key)) 9 | (endpt (plist-get pophint-region--end key))) 10 | (when (< (point) startpt) 11 | (goto-char startpt)) 12 | (when (= (point) pophint-region--user-start) 13 | (pophint:inch-forward)) 14 | (pophint:make-hint-with-inch-forward :limit endpt))) 15 | 16 | ;;;###autoload 17 | (cl-defun pophint-region:narrow-or-wide (&key backward-p narrow-limit action-name action use-pos-tip) 18 | (let ((pophint:select-source-method 'nil) 19 | (pophint:switch-source-delay 0) 20 | (pophint-region--user-start (point)) 21 | (pophint-region--start (if backward-p 22 | `(:narrow ,(or narrow-limit 0) :wide 0) 23 | `(:narrow ,(point) :wide ,(point)))) 24 | (pophint-region--end (if backward-p 25 | `(:narrow ,(point) :wide ,(point)) 26 | `(:narrow ,narrow-limit :wide nil)))) 27 | (pophint:do :not-highlight t 28 | :not-switch-window t 29 | :use-pos-tip use-pos-tip 30 | :direction (if backward-p 'backward 'forward) 31 | :sources `(((shown . "Narrow") 32 | (requires . ,pophint:inch-forward-length) 33 | (method . (lambda () 34 | (pophint-region--do-with-narrow-or-wide :narrow)))) 35 | ((shown . "Wide") 36 | (requires . ,pophint:inch-forward-length) 37 | (method . (lambda () 38 | (pophint-region--do-with-narrow-or-wide :wide))))) 39 | :action-name action-name 40 | :action action))) 41 | (define-obsolete-function-alias 'pophint-config:do-with-narrow-or-wide 'pophint-region:narrow-or-wide "1.1.0") 42 | 43 | ;;;###autoload 44 | (defun pophint-region:forward () 45 | "Forward region by selecting hint-tip." 46 | (interactive) 47 | (pophint-region:narrow-or-wide 48 | :narrow-limit (pos-eol) 49 | :use-pos-tip t 50 | :action (lambda (hint) (goto-char (pophint:hint-startpt hint))))) 51 | (define-obsolete-function-alias 'pophint-config:forward-region 'pophint-region:forward "1.1.0") 52 | 53 | ;;;###autoload 54 | (defun pophint-region:backward () 55 | "Backward region by selecting hint-tip." 56 | (interactive) 57 | (pophint-region:narrow-or-wide 58 | :backward-p t 59 | :narrow-limit (pos-bol) 60 | :use-pos-tip t 61 | :action (lambda (hint) (goto-char (pophint:hint-startpt hint))))) 62 | (define-obsolete-function-alias 'pophint-config:backward-region 'pophint-region:backward "1.1.0") 63 | 64 | ;;;###autoload 65 | (defun pophint-region:kill () 66 | "Kill region by selecting hint-tip." 67 | (interactive) 68 | (pophint-region:narrow-or-wide 69 | :narrow-limit (pos-eol) 70 | :use-pos-tip t 71 | :action-name "kill-region" 72 | :action (lambda (hint) (kill-region (point) (pophint:hint-startpt hint))))) 73 | (define-obsolete-function-alias 'pophint-config:kill-region 'pophint-region:kill "1.1.0") 74 | 75 | ;;;###autoload 76 | (defun pophint-region:backward-kill () 77 | "Kill region by selecting hint-tip." 78 | (interactive) 79 | (pophint-region:narrow-or-wide 80 | :backward-p t 81 | :narrow-limit (pos-bol) 82 | :use-pos-tip t 83 | :action-name "kill-region" 84 | :action (lambda (hint) (kill-region (pophint:hint-startpt hint) (point))))) 85 | (define-obsolete-function-alias 'pophint-config:backward-kill-region 'pophint-region:backward-kill "1.1.0") 86 | 87 | ;;;###autoload 88 | (defun pophint-region:delete () 89 | "Delete region by selecting hint-tip." 90 | (interactive) 91 | (pophint-region:narrow-or-wide 92 | :narrow-limit (pos-eol) 93 | :use-pos-tip t 94 | :action-name "delete-region" 95 | :action (lambda (hint) (delete-region (point) (pophint:hint-startpt hint))))) 96 | 97 | ;;;###autoload 98 | (defun pophint-region:backward-delete () 99 | "Delete region by selecting hint-tip." 100 | (interactive) 101 | (pophint-region:narrow-or-wide 102 | :backward-p t 103 | :narrow-limit (pos-bol) 104 | :use-pos-tip t 105 | :action-name "delete-region" 106 | :action (lambda (hint) (delete-region (pophint:hint-startpt hint) (point))))) 107 | 108 | 109 | (provide 'pophint-region) 110 | ;;; pophint-region.el ends here 111 | -------------------------------------------------------------------------------- /pophint-slack.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-slack:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | ;;;###autoload 10 | (defun pophint:do-slack-link () (interactive)) 11 | (with-no-warnings 12 | (pophint:defsource 13 | :name "slack-link" 14 | :description "Link on slack." 15 | :source '((shown . "Link") 16 | (dedicated . (e2wm)) 17 | (activebufferp . (lambda (b) 18 | (pophint--maybe-kind-mode-buffer-p b 'slack-mode))) 19 | (requires . 1) 20 | (highlight . nil) 21 | (method . (lambda () 22 | (cl-loop while (not (eobp)) 23 | for startpt = (point) 24 | for endpt = (next-property-change startpt) 25 | for face = (get-text-property startpt 'face) 26 | for value = (buffer-substring-no-properties startpt endpt) 27 | do (goto-char (next-property-change (point))) 28 | do (pophint--trace "curr slack value: %s" value) 29 | if (or (string= value "(load more message)") 30 | (memq face '(slack-message-output-header lui-button-face))) 31 | return `(:startpt ,startpt :endpt ,endpt :value ,value)))) 32 | (action . (lambda (hint) 33 | (select-window (pophint:hint-window hint)) 34 | (goto-char (pophint:hint-startpt hint)) 35 | ;; do async to avoid freeze maybe slack.el trouble 36 | (run-with-idle-timer 0.2 nil 37 | '(lambda (commands) 38 | (cl-loop for command in commands 39 | if (ignore-errors (call-interactively command) t) return t)) 40 | (if (string= (pophint:hint-value hint) "(load more message)") 41 | '(slack-room-load-prev-messages) 42 | (cl-case (get-text-property (point) 'face) 43 | (lui-button-face 44 | '(push-button)) 45 | (slack-message-output-header 46 | ;; error will be raised if pointed message is not a self one. 47 | ;; in the case, do add reaction 48 | '(slack-message-edit slack-message-add-reaction)))))))))) 49 | 50 | (pophint:set-allwindow-command pophint:do-slack-link) 51 | 52 | (defun pophint-slack:setup () 53 | (add-to-list 'pophint:sources 'pophint:source-slack-link)) 54 | (define-obsolete-function-alias 'pophint-config:slack-setup 'pophint-slack:setup "1.1.0") 55 | 56 | ;;;###autoload 57 | (defun pophint-slack:provision (activate) 58 | (interactive) 59 | (if activate 60 | (add-hook 'slack-mode-hook 'pophint-slack:setup t) 61 | (remove-hook 'slack-mode-hook 'pophint-slack:setup))) 62 | 63 | ;;;###autoload 64 | (with-eval-after-load 'slack 65 | (when pophint-slack:enable (pophint-slack:provision t))) 66 | 67 | 68 | (provide 'pophint-slack) 69 | ;;; pophint-slack.el ends here 70 | -------------------------------------------------------------------------------- /pophint-sym.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-sym:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | (pophint:defsource :name "symbol" 10 | :description "Symbol." 11 | :source '((shown . "Sym") 12 | (regexp . "\\_<.+?\\_>"))) 13 | 14 | ;;;###autoload 15 | (defun pophint-sym:provision (activate) 16 | (interactive) 17 | (if activate 18 | (add-to-list 'pophint:global-sources 'pophint:source-symbol t) 19 | (setq pophint:global-sources (remove 'pophint:source-symbol pophint:global-sources)))) 20 | 21 | ;;;###autoload 22 | (with-eval-after-load 'pophint 23 | (when pophint-sym:enable (pophint-sym:provision t))) 24 | 25 | 26 | (provide 'pophint-sym) 27 | ;;; pophint-sym.el ends here 28 | -------------------------------------------------------------------------------- /pophint-tags.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'pophint-sym) 3 | 4 | (defvar pophint-tags--current-mode nil) 5 | 6 | ;;;###autoload 7 | (cl-defmacro pophint-tags:advice-command (command &key (point-arg-index nil)) 8 | "Set advice to move the point selected hint-tip before COMMAND. 9 | 10 | If COMMAND receives the point by interactive, 11 | give the argument index as POINT-ARG-INDEX." 12 | (declare (indent 0)) 13 | (let ((advice-name (intern (format "%s-advice-around-do-pophint" command)))) 14 | `(progn 15 | (defun ,advice-name (orig &rest args) 16 | (pophint--trace "start as substitute for %s" (symbol-name ',command)) 17 | (let* ((pophint-tags--current-mode major-mode) 18 | (currwnd (get-buffer-window)) 19 | (currpt (point)) 20 | (startpt (progn 21 | ;; move to head of current symbol 22 | (skip-syntax-backward "w_") 23 | (point))) 24 | (hint (pophint:do :allwindow t 25 | :direction 'around 26 | :source `((activebufferp . (lambda (b) 27 | (eq pophint-tags--current-mode 28 | (buffer-local-value 'major-mode b)))) 29 | ,@pophint:source-symbol) 30 | :action-name "TagJump" 31 | :action 'hint)) 32 | (wnd (when hint (pophint:hint-window hint))) 33 | (beforept (when wnd (window-point wnd)))) 34 | (when wnd 35 | (with-selected-window wnd 36 | (goto-char (pophint:hint-startpt hint)) 37 | (when ,point-arg-index 38 | (setf (nth ,point-arg-index args) (point))) 39 | (apply orig args)) 40 | (when (and (window-live-p wnd) 41 | (eq (window-point wnd) (pophint:hint-startpt hint))) 42 | ;; if jumped into other window, move active window point to before jump 43 | (set-window-point wnd beforept)) 44 | (when (and (window-live-p currwnd) 45 | (eq (window-point currwnd) startpt)) 46 | ;; if jumped into other window, move active window point to before jump 47 | (set-window-point currwnd currpt))))) 48 | (advice-add ',command :around ',advice-name)))) 49 | (define-obsolete-function-alias 'pophint-config:set-tag-jump-command 'pophint-tags:advice-command "1.1.0") 50 | 51 | 52 | (provide 'pophint-tags) 53 | ;;; pophint-tags.el ends here 54 | -------------------------------------------------------------------------------- /pophint-thing.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | (defcustom pophint-thing:enable-on-thing-at-point t 4 | "Whether to do pophint as substitute for the function like `thing-at-point'." 5 | :type 'boolean 6 | :group 'pophint) 7 | (make-obsolete 'pophint-config:thing-at-point-effect-enabled 'pophint-thing:enable-on-thing-at-point "1.1.0") 8 | 9 | ;;;###autoload 10 | (cl-defmacro pophint-thing:advice-thing-at-point-function (function) 11 | "Set advice to get thing by hint-tip as substitute for COMMAND." 12 | (declare (indent 0)) 13 | (let ((advice-name (intern (format "%s-advice-filter-return-do-pophint" function)))) 14 | `(progn 15 | (defun ,advice-name (value) 16 | (if (not pophint-thing:enable-on-thing-at-point) 17 | value 18 | (pophint--trace "start as substitute for %s" (symbol-name ',function)) 19 | (pophint:do-flexibly :action-name "SelectThing" :action 'value))) 20 | (advice-add ',function :filter-return ',advice-name)))) 21 | (define-obsolete-function-alias 'pophint-config:set-thing-at-point-function 'pophint-thing:advice-thing-at-point-function "1.1.0") 22 | 23 | ;;;###autoload 24 | (cl-defmacro pophint-thing:defcommand-noadvice (command) 25 | "Define a command named `pophint-thing:just-COMMAND' to do COMMAND 26 | without `pophint-thing:enable-on-thing-at-point'." 27 | (declare (indent 0)) 28 | (let ((func-sym (intern (format "pophint-thing:just-%s" (symbol-name command)))) 29 | (action-name (mapconcat 'identity 30 | (mapcar 'capitalize (split-string (symbol-name command) "-+")) 31 | "")) 32 | (doc (format "Do `%s' without `pophint-thing:enable-on-thing-at-point'." (symbol-name command)))) 33 | `(defun ,func-sym () 34 | ,doc 35 | (interactive) 36 | (let ((pophint-thing:enable-on-thing-at-point nil)) 37 | (call-interactively ',command))))) 38 | (define-obsolete-function-alias 'pophint-config:thing-def-command-with-toggle-effect 'pophint-thing:defcommand-noadvice "1.1.0") 39 | 40 | 41 | (provide 'pophint-thing) 42 | ;;; pophint-thing.el ends here 43 | -------------------------------------------------------------------------------- /pophint-typescript.el: -------------------------------------------------------------------------------- 1 | (require 'rx) 2 | (require 'pophint) 3 | 4 | ;;;###autoload 5 | (defcustom pophint-typescript:enable t 6 | "Whether to enable feature." 7 | :type 'boolean 8 | :group 'pophint) 9 | 10 | ;;;###autoload 11 | (defun pophint:do-typescript-type () (interactive)) 12 | (with-no-warnings 13 | (pophint:defsource :name "typescript-type" 14 | :description "Typescript Type." 15 | :source `((shown . "Type") 16 | (activebufferp . (lambda (b) 17 | (eq 'typescript-mode 18 | (buffer-local-value 'major-mode b)))) 19 | (regexp . ,(rx-to-string `(and bow (any "A-Z") (+ (any "a-zA-Z0-9.$")))))))) 20 | 21 | (defun pophint-typescript:setup () 22 | (add-to-list 'pophint:sources 'pophint:source-typescript-type)) 23 | 24 | ;;;###autoload 25 | (defun pophint-typescript:provision (activate) 26 | (interactive) 27 | (if activate 28 | (add-hook 'typescript-mode-hook 'pophint-typescript:setup t) 29 | (remove-hook 'typescript-mode-hook 'pophint-typescript:setup))) 30 | 31 | ;;;###autoload 32 | (with-eval-after-load 'pophint 33 | (when pophint-typescript:enable (pophint-typescript:provision t))) 34 | 35 | 36 | (provide 'pophint-typescript) 37 | ;;; pophint-typescript.el ends here 38 | -------------------------------------------------------------------------------- /pophint-url.el: -------------------------------------------------------------------------------- 1 | (require 'rx) 2 | (require 'pophint) 3 | (require 'ffap nil t) 4 | 5 | ;;;###autoload 6 | (defcustom pophint-url:enable t 7 | "Whether to enable feature." 8 | :type 'boolean 9 | :group 'pophint) 10 | 11 | (defvar pophint-url--regexp-url 12 | (rx-to-string `(and (any "a-z") (+ (any "a-z0-9")) "://" (+ (any "a-zA-Z0-9#%&-=~@+:./_"))))) 13 | 14 | (defvar pophint-url--regexp-file-head 15 | (rx-to-string `(and (or (and (any "a-zA-Z") ":/") 16 | (and (? (or "." ".." "~")) "/"))))) 17 | 18 | (pophint:defsource 19 | :name "url-or-path" 20 | :description "Format like URL or Filepath." 21 | :source '((shown . "Url/Path") 22 | (method . (lambda () 23 | (let* ((ffap-machine-p-known 'accept) 24 | (u (save-excursion 25 | (when (re-search-forward pophint-url--regexp-url nil t) 26 | (let ((startpt (match-beginning 0)) 27 | (endpt (match-end 0)) 28 | (value (match-string-no-properties 0))) 29 | (pophint--trace "found url. pt:[%s] value:[%s]" startpt value) 30 | `(:startpt ,startpt :endpt ,endpt :value ,value))))) 31 | (f (when (functionp 'ffap-guesser) 32 | (save-excursion 33 | (cl-loop while (re-search-forward pophint-url--regexp-file-head nil t) 34 | for startpt = (match-beginning 0) 35 | for guess = (ffap-guesser) 36 | if guess 37 | return (progn 38 | (pophint--trace "found path. pt:[%s] value:[%s]" startpt guess) 39 | `(:startpt ,startpt 40 | :endpt ,(+ startpt (length guess)) 41 | :value ,guess)))))) 42 | (next (cond ((not u) f) 43 | ((not f) u) 44 | ((<= (plist-get u :startpt) (plist-get f :startpt)) u) 45 | (t f)))) 46 | (when next (goto-char (plist-get next :endpt))) 47 | next))))) 48 | 49 | ;;;###autoload 50 | (defun pophint-url:provision (activate) 51 | (interactive) 52 | (if activate 53 | (add-to-list 'pophint:global-sources 'pophint:source-url-or-path t) 54 | (setq pophint:global-sources (remove 'pophint:source-url-or-path pophint:global-sources)))) 55 | 56 | ;;;###autoload 57 | (with-eval-after-load 'pophint 58 | (when pophint-url:enable (pophint-url:provision t))) 59 | 60 | 61 | (provide 'pophint-url) 62 | ;;; pophint-url.el ends here 63 | -------------------------------------------------------------------------------- /pophint-vb.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'pophint-quote) 3 | 4 | ;;;###autoload 5 | (defcustom pophint-vb:enable t 6 | "Whether to enable feature." 7 | :type 'boolean 8 | :group 'pophint) 9 | 10 | (defun pophint-vb:setup () 11 | (setq pophint-quote:exclude-quote-chars '("'"))) 12 | (define-obsolete-function-alias 'pophint-config:vb-setup 'pophint-vb:setup "1.1.0") 13 | 14 | ;;;###autoload 15 | (defun pophint-vb:provision (activate) 16 | (interactive) 17 | (if activate 18 | (add-hook 'visual-basic-mode-hook 'pophint-vb:setup t) 19 | (remove-hook 'visual-basic-mode-hook 'pophint-vb:setup))) 20 | 21 | ;;;###autoload 22 | (with-eval-after-load 'visual-basic-mode 23 | (when pophint-vb:enable (pophint-vb:provision t))) 24 | 25 | 26 | (provide 'pophint-vb) 27 | ;;; pophint-vb.el ends here 28 | -------------------------------------------------------------------------------- /pophint-widget.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | ;;;###autoload 4 | (defcustom pophint-widget:enable t 5 | "Whether to enable feature." 6 | :type 'boolean 7 | :group 'pophint) 8 | 9 | (defcustom pophint-widget:not-invoke-types '(editable-field text) 10 | "Types to not invoke `widget-apply' after selection by `pophint:source-widget'." 11 | :type '(repeat symbol) 12 | :group 'pophint) 13 | (define-obsolete-function-alias 'pophint-config:widget-not-invoke-types 'pophint-widget:not-invoke-types "1.1.0") 14 | 15 | (defun pophint-widget--value (w) 16 | (cl-loop for sexp in '((ignore-errors (widget-value w)) 17 | (ignore-errors (widget-get w :value))) 18 | for ret = (eval sexp) 19 | if (stringp ret) return ret 20 | finally return "")) 21 | 22 | ;;;###autoload 23 | (defun pophint:do-widget () (interactive)) 24 | (with-no-warnings 25 | (pophint:defsource 26 | :name "widget" 27 | :description "Widget" 28 | :source '((shown . "Widget") 29 | (requires . 0) 30 | (highlight . nil) 31 | (dedicated . (e2wm)) 32 | (activebufferp . (lambda (buff) 33 | (with-current-buffer buff 34 | (when (where-is-internal 'widget-forward (current-local-map)) 35 | t)))) 36 | (method . (lambda () 37 | (let* ((pt (point)) 38 | (mpt (progn (widget-move 1) (point))) 39 | (w (when (> mpt pt) (widget-at)))) 40 | (when w 41 | (pophint--trace "found widget. value:[%s] " (pophint-widget--value w)) 42 | `(:startpt ,(point) 43 | :endpt ,(+ (point) 1) 44 | :value ,(pophint-widget--value w)))))) 45 | (action . (lambda (hint) 46 | (with-selected-window (pophint:hint-window hint) 47 | (goto-char (pophint:hint-startpt hint)) 48 | (let* ((w (widget-at)) 49 | (type (when w (widget-type w)))) 50 | (when (and w 51 | (not (memq type pophint-widget:not-invoke-types))) 52 | (widget-apply w :action))))))))) 53 | 54 | (defun pophint-widget:setup () 55 | (add-to-list 'pophint:sources 'pophint:source-widget)) 56 | (define-obsolete-function-alias 'pophint-config:widget-setup 'pophint-widget:setup "1.1.0") 57 | 58 | ;;;###autoload 59 | (defun pophint-widget:provision (activate) 60 | (interactive) 61 | (if activate 62 | (add-hook 'Custom-mode-hook 'pophint-widget:setup t) 63 | (remove-hook 'Custom-mode-hook 'pophint-widget:setup))) 64 | 65 | ;;;###autoload 66 | (with-eval-after-load 'pophint 67 | (when pophint-widget:enable (pophint-widget:provision t))) 68 | 69 | 70 | (provide 'pophint-widget) 71 | ;;; pophint-widget.el ends here 72 | -------------------------------------------------------------------------------- /pophint-yank.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | 3 | (defcustom pophint-yank:relayout-on-start-rangeyank-p nil 4 | "Whether relayout when select start of `pophint:source-rangeyank'." 5 | :type 'boolean 6 | :group 'pophint) 7 | (make-obsolete 'pophint-config:set-relayout-when-rangeyank-start 'pophint-yank:relayout-on-start-rangeyank-p "1.1.0") 8 | 9 | (defvar pophint-yank--yank-action 10 | '(lambda (hint) 11 | (kill-new (pophint:hint-value hint)))) 12 | 13 | (defvar pophint-yank--startpt nil) 14 | 15 | (defvar pophint-yank--rangeyank-action 16 | (lambda (hint) 17 | (let ((wnd (pophint:hint-window hint))) 18 | (when (and (windowp wnd) 19 | (window-live-p wnd)) 20 | (save-window-excursion 21 | (save-excursion 22 | (with-selected-window wnd 23 | (goto-char (pophint:hint-startpt hint)) 24 | (setq pophint-yank--startpt (point)) 25 | (when pophint-yank:relayout-on-start-rangeyank-p 26 | (recenter 0) 27 | (delete-other-windows)) 28 | (pophint:do :not-highlight t 29 | :not-switch-window t 30 | :use-pos-tip nil 31 | :direction 'forward 32 | :source `((shown . "Region") 33 | (requires . ,pophint:inch-forward-length) 34 | (init . pophint:inch-forward) 35 | (method . pophint:make-hint-with-inch-forward)) 36 | :action-name "Yank" 37 | :action (lambda (hint) 38 | (let ((wnd (pophint:hint-window hint))) 39 | (when (and (windowp wnd) 40 | (window-live-p wnd) 41 | (number-or-marker-p pophint-yank--startpt)) 42 | (with-selected-window wnd 43 | (kill-new (buffer-substring-no-properties 44 | pophint-yank--startpt 45 | (pophint:hint-startpt hint))))))))))))))) 46 | 47 | ;;;###autoload 48 | (defun pophint:do-flexibly-yank () (interactive)) 49 | (with-no-warnings 50 | (pophint:defaction :key "y" 51 | :name "Yank" 52 | :description "Yank the text of selected hint-tip." 53 | :action pophint-yank--yank-action)) 54 | 55 | ;;;###autoload 56 | (defun pophint:do-flexibly-rangeyank () (interactive)) 57 | (with-no-warnings 58 | (pophint:defaction :key "Y" 59 | :name "RangeYank" 60 | :description "Yank the text getting end point by do pop-up at the selected point." 61 | :action pophint-yank--rangeyank-action)) 62 | 63 | ;;;###autoload 64 | (defun pophint:do-rangeyank () (interactive)) 65 | (with-no-warnings 66 | (pophint:defsource 67 | :name "RangeYank" 68 | :description "Yank the text getting end point by do pop-up at the selected point." 69 | :source `((shown . "RangeYank") 70 | (action . ,pophint-yank--rangeyank-action) 71 | ,@pophint--default-source))) 72 | 73 | 74 | (provide 'pophint-yank) 75 | ;;; pophint-yank.el ends here 76 | -------------------------------------------------------------------------------- /pophint-yaol.el: -------------------------------------------------------------------------------- 1 | (require 'yaol) 2 | (require 'pophint) 3 | 4 | ;;;###autoload 5 | (defcustom pophint-yaol:enable t 6 | "Whether to enable feature." 7 | :type 'boolean 8 | :group 'pophint) 9 | 10 | (defcustom pophint-yaol:head-action 'yaol-fold-clear-current 11 | "Function to invoke on it when hint selected." 12 | :type 'function 13 | :group 'pophint) 14 | 15 | ;;;###autoload 16 | (defun pophint:do-yaol-head () (interactive)) 17 | (with-no-warnings 18 | (pophint:defsource 19 | :name "yaol-head" 20 | :description "Head of yaol." 21 | :source '((shown . "Head") 22 | (highlight . nil) 23 | (requires . 1) 24 | (method . (lambda () 25 | (let* ((startpt (when (yaol-next-head) 26 | (point))) 27 | (endpt (when startpt 28 | (yaol-node-fold-beg (-first-item (yaol-find-deepest-nodes-at (point)))))) 29 | (value (when endpt 30 | (buffer-substring-no-properties startpt endpt)))) 31 | (when (and startpt endpt 32 | (< startpt endpt)) 33 | `(:startpt ,startpt :endpt ,endpt :value ,value))))) 34 | (action . (lambda (hint) 35 | (with-selected-window (pophint:hint-window hint) 36 | (goto-char (pophint:hint-startpt hint)) 37 | (when pophint-yaol:head-action 38 | (funcall pophint-yaol:head-action)))))))) 39 | 40 | ;;;###autoload 41 | (defun pophint-yaol:provision (activate) 42 | (interactive) 43 | (if activate 44 | (progn 45 | (add-to-list 'pophint:global-sources 'pophint:source-yaol-head t)) 46 | (setq pophint:global-sources 47 | (remove 'pophint:source-yaol-head pophint:global-sources)))) 48 | 49 | ;;;###autoload 50 | (with-eval-after-load 'yaol 51 | (when pophint-yaol:enable (pophint-yaol:provision t))) 52 | 53 | 54 | (provide 'pophint-yaol) 55 | ;;; pophint-yaol.el ends here 56 | -------------------------------------------------------------------------------- /pophint.el: -------------------------------------------------------------------------------- 1 | ;;; pophint.el --- Provide navigation using pop-up tips, like Firefox's Vimperator Hint Mode 2 | 3 | ;; Copyright (C) 2013 Hiroaki Otsu 4 | 5 | ;; Author: Hiroaki Otsu 6 | ;; Keywords: popup 7 | ;; URL: https://github.com/aki2o/emacs-pophint 8 | ;; Version: 1.4.0 9 | ;; Package-Requires: ((log4e "0.4.0") (yaxception "1.0.0")) 10 | 11 | ;; This program is free software; you can redistribute it and/or modify 12 | ;; it under the terms of the GNU General Public License as published by 13 | ;; the Free Software Foundation, either version 3 of the License, or 14 | ;; (at your option) any later version. 15 | 16 | ;; This file is distributed in the hope that it will be useful, 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 | ;; GNU General Public License for more details. 20 | 21 | ;; You should have received a copy of the GNU General Public License 22 | ;; along with this program. If not, see . 23 | 24 | ;;; Commentary: 25 | ;; 26 | ;; This extension provides navigation like the Vimperator Hint Mode of Firefox. 27 | ;; The interface has the following flow. 28 | ;; 1. pop-up tip about the matched point for some action which user want. 29 | ;; 2. do some action for the user selecting. 30 | ;; 31 | ;; For detail, see 32 | ;; For configuration, see Configuration section in 33 | ;; 34 | ;; Enjoy!!! 35 | 36 | ;;; Code: 37 | 38 | (require 'cl-lib) 39 | (require 'rx) 40 | (require 'mode-local) 41 | (require 'yaxception) 42 | (require 'log4e) 43 | (require 'pos-tip nil t) 44 | 45 | 46 | (defgroup pophint nil 47 | "Pop-up the hint tip of candidates for doing something" 48 | :group 'popup 49 | :prefix "pophint:") 50 | 51 | (defcustom pophint:popup-chars "hjklyuiopnm" 52 | "Characters for pop-up hint." 53 | :type 'string 54 | :group 'pophint) 55 | 56 | (defcustom pophint:select-source-chars "123456789" 57 | "Characters for selecting source." 58 | :type 'string 59 | :group 'pophint) 60 | 61 | (defcustom pophint:select-source-method 'use-source-char 62 | "Method to select source. 63 | 64 | This value is one of the following symbols. 65 | - use-source-char 66 | Push the key bound to each of sources from `pophint:select-source-chars' 67 | without pushing `pophint:switch-source-char'. 68 | - use-popup-char 69 | Push the key bound to each of sources from `pophint:popup-chars' 70 | after pushing `pophint:switch-source-char'. 71 | - nil 72 | Push `pophint:switch-source-char' only." 73 | :type '(choice (const use-source-char) 74 | (const use-popup-char) 75 | (const nil)) 76 | :group 'pophint) 77 | 78 | (defcustom pophint:switch-source-char "s" 79 | "Character for switching source used to pop-up." 80 | :type 'string 81 | :group 'pophint) 82 | 83 | (defcustom pophint:switch-source-reverse-char "S" 84 | "Character for switching source used to pop-up in reverse." 85 | :type 'string 86 | :group 'pophint) 87 | 88 | (defcustom pophint:switch-source-delay 0.5 89 | "Second for delay to switch source used to pop-up. 90 | 91 | If nil, it means not delay." 92 | :type 'number 93 | :group 'pophint) 94 | 95 | (defcustom pophint:switch-source-selectors nil 96 | "List of dedicated selector for source. 97 | 98 | Example: 99 | \\='((\"Quoted\" . \"q\") 100 | (\"Url/Path\" . \"u\")) 101 | " 102 | :type '(repeat (cons string string)) 103 | :group 'pophint) 104 | 105 | (defcustom pophint:switch-direction-char "d" 106 | "Character for switching direction of pop-up." 107 | :type 'string 108 | :group 'pophint) 109 | 110 | (defcustom pophint:switch-direction-reverse-char "D" 111 | "Character for switching direction of pop-up in reverse." 112 | :type 'string 113 | :group 'pophint) 114 | 115 | (defcustom pophint:switch-window-char "w" 116 | "Character for switching window of pop-up." 117 | :type 'string 118 | :group 'pophint) 119 | 120 | (defcustom pophint:popup-max-tips 200 121 | "Maximum counts of pop-up hint. 122 | 123 | If nil, it means limitless." 124 | :type 'integer 125 | :group 'pophint) 126 | 127 | (defcustom pophint:default-require-length 3 128 | "Default minimum length of matched text for pop-up." 129 | :type 'integer 130 | :group 'pophint) 131 | 132 | (defcustom pophint:switch-direction-p t 133 | "Whether switch direction of pop-up." 134 | :type 'boolean 135 | :group 'pophint) 136 | 137 | (defcustom pophint:do-allwindow-p nil 138 | "Whether do pop-up at all windows." 139 | :type 'boolean 140 | :group 'pophint) 141 | 142 | (defcustom pophint:use-pos-tip nil 143 | "Whether use pos-tip.el to show prompt." 144 | :type 'boolean 145 | :group 'pophint) 146 | 147 | (defcustom pophint:inch-forward-length 3 148 | "Size of chars to make next hint by `'" 149 | :type 'integer 150 | :group 'pophint) 151 | (make-obsolete 'pophint-config:inch-length 'pophint:inch-forward-length "1.1.0") 152 | 153 | (defface pophint:tip-face 154 | '((t (:background "khaki1" :foreground "black" :bold t))) 155 | "Face for the pop-up hint." 156 | :group 'pophint) 157 | 158 | (defface pophint:match-face 159 | '((t (:background "steel blue" :foreground "white"))) 160 | "Face for matched hint text." 161 | :group 'pophint) 162 | 163 | (defface pophint:pos-tip-face 164 | '((((class color) (background dark)) (:background "ivory" :foreground "black")) 165 | (((class color) (background light)) (:background "gray10" :foreground "white")) 166 | (t (:background "ivory" :foreground "black"))) 167 | "Face for the tip of pos-tip.el" 168 | :group 'pophint) 169 | 170 | (defface pophint:prompt-bind-part-face 171 | '((t (:inherit font-lock-keyword-face :bold t))) 172 | "Face for the part of bound key in prompt." 173 | :group 'pophint) 174 | 175 | (defface pophint:prompt-active-part-face 176 | '((t (:bold t))) 177 | "Face for the part of active source/direction in prompt." 178 | :group 'pophint) 179 | 180 | (defvar pophint:sources nil 181 | "Buffer local sources for pop-up hint tip flexibly.") 182 | (make-variable-buffer-local 'pophint:sources) 183 | 184 | (defvar pophint:global-sources nil 185 | "Global sources for pop-up hint tip flexibly") 186 | 187 | (defvar pophint:dedicated-sources nil 188 | "Dedicated sources for pop-up hint tip in particular situation.") 189 | 190 | (cl-defstruct pophint:hint window popup overlay (startpt 0) (endpt 0) (value "")) 191 | (cl-defstruct pophint:action name action) 192 | 193 | 194 | (log4e:deflogger "pophint" "%t [%l] %m" "%H:%M:%S" '((fatal . "fatal") 195 | (error . "error") 196 | (warn . "warn") 197 | (info . "info") 198 | (debug . "debug") 199 | (trace . "trace"))) 200 | (pophint--log-set-level 'trace) 201 | 202 | 203 | (cl-defstruct pophint--condition 204 | source sources action action-name direction window allwindow use-pos-tip 205 | not-highlight not-switch-direction not-switch-window not-switch-source 206 | tip-face) 207 | 208 | (defvar pophint--action-hash (make-hash-table :test 'equal)) 209 | (defvar pophint--enable-allwindow-p nil) 210 | (defvar pophint--disable-allwindow-p nil) 211 | 212 | (defvar pophint--last-hints nil) 213 | (defvar pophint--last-condition nil) 214 | (defvar pophint--last-context-condition-hash (make-hash-table :test 'equal)) 215 | 216 | (defvar pophint--current-context nil) 217 | (defvar pophint--current-window nil) 218 | (defvar pophint--current-point nil) 219 | 220 | (defvar pophint--resumed-input-method nil) 221 | 222 | (defvar pophint--non-alphabet-chars "!\"#$%&'()-=^~\\|@`[{;+:*]},<.>/?_") 223 | 224 | (defvar pophint--default-search-regexp 225 | (let ((min-len pophint:default-require-length)) 226 | (rx-to-string `(and point (or 227 | ;; 連続する空白 228 | (and (group-n 1 (>= ,min-len blank))) 229 | ;; 連続する記号 230 | (and (* blank) 231 | (group-n 1 (>= ,min-len (any ,pophint--non-alphabet-chars)))) 232 | ;; 連続する英数字 233 | (and (* (any ,pophint--non-alphabet-chars blank)) 234 | (group-n 1 (>= ,min-len (any "a-zA-Z0-9")))) 235 | ;; ;; 単語 236 | ;; (and (** 1 ,(1- min-len) (not word)) 237 | ;; (group-n 1 (>= ,min-len word))) 238 | ;; ;; 単語区切りまでの何か 239 | ;; (and (group-n 1 (** ,min-len ,min-len not-newline) (*? not-newline)) 240 | ;; word-boundary) 241 | ;; 改行 242 | (and (* (any ,pophint--non-alphabet-chars blank)) 243 | ;;(and (*? not-newline) 244 | (group-n 1 "\n")) 245 | ))))) 246 | 247 | (defun pophint--default-search () 248 | (if (re-search-forward pophint--default-search-regexp nil t) 249 | `(:startpt ,(match-beginning 1) :endpt ,(match-end 1) :value ,(match-string-no-properties 1)) 250 | (let ((startpt (point)) 251 | (endpt (progn (forward-word) (point)))) 252 | (when (> endpt startpt) 253 | `(:startpt ,startpt :endpt ,endpt :value ,(buffer-substring-no-properties startpt endpt)))))) 254 | 255 | (defvar pophint--default-source '((shown . "Default") 256 | (requires . 1) 257 | (method . pophint--default-search) 258 | (highlight . nil))) 259 | 260 | (defvar pophint--default-action (lambda (hint) 261 | (let ((wnd (pophint:hint-window hint))) 262 | (push-mark) 263 | (when (and (windowp wnd) 264 | (window-live-p wnd) 265 | (not (eq (selected-window) wnd))) 266 | (select-window wnd)) 267 | (goto-char (pophint:hint-startpt hint))))) 268 | 269 | (defvar pophint--default-action-name "Go/SrcAct") 270 | 271 | (defvar pophint--next-window-source 272 | '((shown . "Wnd") 273 | (requires . 0) 274 | (highlight . nil) 275 | (tip-face-attr . (:height 2.0)) 276 | (init . (lambda () 277 | (setq pophint--current-point (point)))) 278 | (method . (lambda () 279 | (cond ((eq pophint--current-window (selected-window)) 280 | (setq pophint--current-window nil)) 281 | ((and (window-minibuffer-p (selected-window)) 282 | (not (minibuffer-window-active-p (selected-window)))) 283 | (setq pophint--current-window nil)) 284 | (t 285 | (setq pophint--current-window (selected-window)) 286 | (when (= (buffer-size) 0) (insert " ")) 287 | (let* ((startpt (min (save-excursion 288 | (goto-char (window-start)) 289 | (forward-line 1) 290 | (while (and (< (- (pos-eol) (point)) (window-hscroll)) 291 | (< (point) (point-max))) 292 | (forward-line 1)) 293 | (+ (point) (window-hscroll))) 294 | (1- (point-max)))) 295 | (endpt (max pophint--current-point (1+ startpt)))) 296 | `(:startpt ,startpt :endpt ,endpt :value "")))))) 297 | (action . hint))) 298 | 299 | 300 | ;;;;;;;;;;;;; 301 | ;; Utility 302 | 303 | (cl-defmacro pophint--aif (test then &rest else) 304 | (declare (indent 2)) 305 | `(let ((it ,test)) (if it ,then ,@else))) 306 | 307 | (cl-defmacro pophint--awhen (test &rest body) 308 | (declare (indent 1)) 309 | `(let ((it ,test)) (when it ,@body))) 310 | 311 | (cl-defun pophint--show-message (msg &rest args) 312 | (apply 'message (concat "[PopHint] " msg) args) 313 | nil) 314 | 315 | (defsubst pophint--current-not-highlight-p (cond) 316 | (or (pophint--condition-not-highlight cond) 317 | (pophint--awhen (assq 'highlight (pophint--condition-source cond)) 318 | (not (cdr-safe it))))) 319 | 320 | (defsubst pophint--current-not-switch-source-p (cond) 321 | (or (pophint--condition-not-switch-source cond) 322 | (< (length (pophint--condition-sources cond)) 2))) 323 | 324 | (defsubst pophint--current-action (cond) 325 | (or (pophint--condition-action cond) 326 | (assoc-default 'action (pophint--condition-source cond)) 327 | pophint--default-action)) 328 | 329 | (defvar pophint--stocked-overlays nil) 330 | 331 | (defsubst pophint--make-overlay (start end) 332 | (or (pophint--awhen (pop pophint--stocked-overlays) 333 | (move-overlay it start end (current-buffer))) 334 | (make-overlay start end (current-buffer)))) 335 | 336 | (defsubst pophint--stock-overlay (ov) 337 | (overlay-put ov 'text nil) 338 | (overlay-put ov 'window nil) 339 | (overlay-put ov 'display nil) 340 | (overlay-put ov 'after-string nil) 341 | (overlay-put ov 'face nil) 342 | (overlay-put ov 'priority nil) 343 | (push ov pophint--stocked-overlays)) 344 | 345 | (defsubst pophint--delete (hint) 346 | (when (pophint:hint-p hint) 347 | (let* ((tip (pophint:hint-popup hint)) 348 | (ov (pophint:hint-overlay hint))) 349 | (when ov 350 | ;; (delete-overlay ov) 351 | (pophint--stock-overlay ov) 352 | (setf (pophint:hint-overlay hint) nil)) 353 | (when tip 354 | ;; (delete-overlay tip) 355 | (pophint--stock-overlay tip) 356 | (setf (pophint:hint-popup hint) nil)) 357 | nil))) 358 | 359 | (defun pophint--deletes (hints) 360 | (pophint--trace "start delete hints. hints:[%s]" (length hints)) 361 | (dolist (hint hints) 362 | (pophint--delete hint)) 363 | nil) 364 | 365 | (defun pophint--compile-to-function (something) 366 | (cond ((functionp something) 367 | something) 368 | ((and (symbolp something) 369 | (boundp something)) 370 | (symbol-value something)) 371 | ((listp something) 372 | something) 373 | (t 374 | nil))) 375 | 376 | (defsubst pophint--compile-source (source) 377 | (cond ((symbolp source) 378 | (symbol-value source)) 379 | ((listp source) 380 | source))) 381 | 382 | (defun pophint--compile-sources (sources) 383 | (cl-loop for s in sources 384 | collect (pophint--compile-source s))) 385 | 386 | (make-face 'pophint--tip-face-temp) 387 | (defsubst pophint--update-tip-face (face-attr) 388 | (if (not face-attr) 389 | 'pophint:tip-face 390 | (copy-face 'pophint:tip-face 'pophint--tip-face-temp) 391 | (apply 'set-face-attribute 'pophint--tip-face-temp nil face-attr) 392 | 'pophint--tip-face-temp)) 393 | 394 | (defsubst pophint--make-index-char-string (idx char-list) 395 | (if (or (not (stringp char-list)) 396 | (string= char-list "")) 397 | "" 398 | (let* ((basei (length char-list))) 399 | (cl-loop with ret = "" 400 | with n = idx 401 | for i = (/ n basei) 402 | for r = (- n (* basei i)) 403 | until (= i 0) 404 | do (setq n i) 405 | do (setq ret (concat (substring char-list r (+ r 1)) ret)) 406 | finally return (concat (substring char-list r (+ r 1)) ret))))) 407 | 408 | (defsubst pophint--make-unique-char-strings (count char-list &optional not-upcase exclude-strings) 409 | (cl-loop with reth = (make-hash-table :test 'equal) 410 | with idx = 0 411 | with currcount = 0 412 | while (< currcount count) 413 | for currstr = (pophint--make-index-char-string idx char-list) 414 | for currstr = (if not-upcase currstr (upcase currstr)) 415 | do (cl-incf idx) 416 | do (when (not (member currstr exclude-strings)) 417 | (puthash currstr t reth) 418 | (cl-incf currcount)) 419 | do (let ((chkvalue (substring currstr 0 (- (length currstr) 1)))) 420 | (when (gethash chkvalue reth) 421 | (remhash chkvalue reth) 422 | (cl-decf currcount))) 423 | finally return (cl-loop for k being the hash-keys in reth collect k))) 424 | 425 | (defun pophint--set-selector-sources (sources) 426 | (cl-loop with char-list = (cl-case pophint:select-source-method 427 | (use-popup-char pophint:popup-chars) 428 | (use-source-char pophint:select-source-chars) 429 | (t nil)) 430 | with excludes = (cl-loop for src in sources 431 | for s = (assoc-default (assoc-default 'shown src) pophint:switch-source-selectors) 432 | if s 433 | append (cl-loop with idx = (length s) 434 | while (> idx 0) 435 | collect (substring s 0 idx) 436 | do (cl-decf idx))) 437 | with selectors = (when char-list 438 | (pophint--make-unique-char-strings (length sources) char-list t excludes)) 439 | for src in sources 440 | for selector = (or (assoc-default (assoc-default 'shown src) pophint:switch-source-selectors) 441 | (when selectors (pop selectors))) 442 | do (pophint--awhen (assq 'selector src) 443 | (setq src (delq it src))) 444 | if selector 445 | do (add-to-list 'src `(selector . ,selector) t) 446 | collect src)) 447 | 448 | (defun pophint--get-available-sources (window) 449 | (let* ((sources (with-current-buffer (or (and (windowp window) 450 | (window-live-p window) 451 | (window-buffer window)) 452 | (current-buffer)) 453 | (pophint--compile-sources pophint:sources)))) 454 | (cl-loop for src in (pophint--compile-sources pophint:global-sources) 455 | do (add-to-list 'sources src t)) 456 | ;; (add-to-list 'sources pophint--default-source t) 457 | sources)) 458 | 459 | (cl-defun pophint--set-last-condition (condition &key context) 460 | (pophint--debug "set last condition of %s\n%s" context condition) 461 | (setq pophint--last-condition condition) 462 | (when context 463 | (puthash context condition pophint--last-context-condition-hash))) 464 | 465 | (defun pophint--get-last-condition-with-context (context) 466 | (gethash context pophint--last-context-condition-hash)) 467 | 468 | (cl-defmacro pophint--with-no-last-condition (&rest body) 469 | (declare (indent 0)) 470 | `(let ((pophint--last-condition nil) 471 | (pophint--last-context-condition-hash (make-hash-table :test 'equal))) 472 | ,@body)) 473 | 474 | (defvar pophint--selected-action nil) 475 | (defvar pophint--selected-hint nil) 476 | 477 | (defun pophint--do-action (hint action) 478 | (when (pophint:hint-p hint) 479 | (let* ((tip (pophint:hint-popup hint)) 480 | (selected (pophint:hint-value hint))) 481 | (pophint--debug "start action. selected:[%s] action:%s" selected action) 482 | (pophint--delete hint) 483 | (cond ((eq action 'value) 484 | (pophint:hint-value hint)) 485 | ((eq action 'point) 486 | (pophint:hint-startpt hint)) 487 | ((eq action 'hint) 488 | hint) 489 | ((functionp action) 490 | (setq pophint--selected-action action) 491 | (setq pophint--selected-hint hint) 492 | (run-at-time 0 nil (lambda () 493 | (let ((action pophint--selected-action) 494 | (hint pophint--selected-hint)) 495 | (setq pophint--selected-action nil) 496 | (setq pophint--selected-hint nil) 497 | (funcall action hint))))) 498 | (t 499 | (error "Unsupported action")))))) 500 | 501 | (cl-defmacro pophint--maybe-kind-mode-buffer-p (buf &rest modes) 502 | (declare (indent 0)) 503 | `(let ((buf-mode (buffer-local-value 'major-mode ,buf))) 504 | (when (or (memq buf-mode (list ,@modes)) 505 | (memq (get-mode-local-parent buf-mode) (list ,@modes))) 506 | t))) 507 | 508 | 509 | ;;;;;;;;;;;;;;;;;;;;; 510 | ;; For Interactive 511 | 512 | (defun pophint--menu-read-key-sequence (prompt use-pos-tip &optional timeout) 513 | (pophint--trace "start menu read key sequence. prompt[%s] use-pos-tip[%s] timeout[%s]" 514 | prompt use-pos-tip timeout) 515 | ;; Coding by referring to popup-menu-read-key-sequence 516 | (catch 'timeout 517 | (let ((timer (and timeout 518 | (run-with-timer timeout nil 519 | (lambda () 520 | (if (zerop (length (this-command-keys))) 521 | (throw 'timeout nil)))))) 522 | (old-global-map (current-global-map)) 523 | (temp-global-map (make-sparse-keymap)) 524 | (overriding-terminal-local-map (make-sparse-keymap))) 525 | (substitute-key-definition 'keyboard-quit 'keyboard-quit temp-global-map old-global-map) 526 | (define-key temp-global-map [menu-bar] (lookup-key old-global-map [menu-bar])) 527 | (define-key temp-global-map [tool-bar] (lookup-key old-global-map [tool-bar])) 528 | (when (current-local-map) 529 | (define-key overriding-terminal-local-map [menu-bar] (lookup-key (current-local-map) [menu-bar]))) 530 | (yaxception:$ 531 | (yaxception:try 532 | (use-global-map temp-global-map) 533 | (clear-this-command-keys) 534 | (if (and use-pos-tip 535 | window-system 536 | (featurep 'pos-tip)) 537 | (progn (pophint--pos-tip-show prompt) 538 | (read-key-sequence nil)) 539 | (with-temp-message prompt 540 | (read-key-sequence nil)))) 541 | (yaxception:finally 542 | (use-global-map old-global-map) 543 | (when timer (cancel-timer timer)) 544 | (when (and use-pos-tip 545 | (featurep 'pos-tip)) 546 | (pos-tip-hide))))))) 547 | 548 | (cl-defun pophint--make-source-selection-prompt (sources &key 549 | (delimiter "|") 550 | highlight-source) 551 | (let ((hsrcnm (or (assoc-default 'shown highlight-source) 552 | ""))) 553 | (mapconcat (lambda (src) 554 | (let* ((srcnm (or (assoc-default 'shown src) "*None*")) 555 | (selector (assoc-default 'selector src))) 556 | (concat (if selector 557 | (concat (propertize selector 'face 'pophint:prompt-bind-part-face) ":") 558 | "") 559 | (if (string= hsrcnm srcnm) 560 | (propertize srcnm 'face 'pophint:prompt-active-part-face) 561 | srcnm)))) 562 | sources 563 | delimiter))) 564 | 565 | (defun pophint--make-prompt (cond hint-count) 566 | (let* ((source (pophint--condition-source cond)) 567 | (sources (pophint--condition-sources cond)) 568 | (actdesc (pophint--condition-action-name cond)) 569 | (direction (pophint--condition-direction cond)) 570 | (not-switch-direction (pophint--condition-not-switch-direction cond)) 571 | (not-switch-window (pophint--condition-not-switch-window cond)) 572 | (not-switch-source (pophint--current-not-switch-source-p cond)) 573 | (swsrctext (cond ((not not-switch-source) 574 | (format "%s%s:SwSrc(%s) " 575 | (propertize pophint:switch-source-char 'face 'pophint:prompt-bind-part-face) 576 | (if pophint:switch-source-reverse-char 577 | (concat "/" 578 | (propertize pophint:switch-source-reverse-char 'face 'pophint:prompt-bind-part-face)) 579 | "") 580 | (pophint--make-source-selection-prompt sources 581 | :highlight-source source))) 582 | ((cl-loop for s in (append (list source) sources) 583 | always (assoc-default 'dedicated s)) 584 | "") 585 | (t 586 | (format "Src[%s] " (or (assoc-default 'shown source) 587 | "*None*"))))) 588 | (swdirtext (cond ((not not-switch-direction) 589 | (format "%s%s:SwDrct(%s) " 590 | (propertize pophint:switch-direction-char 'face 'pophint:prompt-bind-part-face) 591 | (if pophint:switch-direction-reverse-char 592 | (concat "/" 593 | (propertize pophint:switch-direction-reverse-char 'face 'pophint:prompt-bind-part-face)) 594 | "") 595 | (mapconcat (lambda (d) 596 | (let* ((s (format "%s" d))) 597 | (if (eq d direction) 598 | (propertize s 'face 'pophint:prompt-active-part-face) 599 | s))) 600 | '(around forward backward) 601 | "|"))) 602 | (t 603 | ""))) 604 | (swwndtext (cond ((not not-switch-window) 605 | (format "%s:SwWnd " 606 | (propertize pophint:switch-window-char 'face 'pophint:prompt-bind-part-face))) 607 | (t 608 | "")))) 609 | (format "Select ch. Hints[%s] Act[%s] %s%s%s" hint-count actdesc swsrctext swdirtext swwndtext))) 610 | 611 | (defun pophint--make-prompt-interactively () 612 | (let* ((count 1) 613 | (acttext (cl-loop with ret = "" 614 | for k being the hash-keys in pophint--action-hash using (hash-values act) 615 | for desc = (pophint:action-name act) 616 | do (cl-incf count) 617 | do (setq ret (concat ret 618 | (format "%s:%s " 619 | (propertize k 'face 'pophint:prompt-bind-part-face) 620 | desc))) 621 | finally return ret)) 622 | (defact (propertize "" 'face 'pophint:prompt-bind-part-face))) 623 | (format "Select ch. Actions[%s] %s:Default %s" count defact acttext))) 624 | 625 | 626 | ;;;;;;;;;;;;;;;;; 627 | ;; Pop-up Hint 628 | 629 | (cl-defun pophint--let-user-select (cond &key context) 630 | (when (not (pophint--condition-source cond)) 631 | (let ((sources (pophint--condition-sources cond))) 632 | (setf (pophint--condition-source cond) 633 | (or (and (> (length sources) 0) (nth 0 sources)) 634 | pophint--default-source)))) 635 | (let ((pophint--current-context (or context pophint--current-context this-command)) 636 | (hints (pophint--get-hints cond)) 637 | (tip-face-attr (assoc-default 'tip-face-attr (pophint--condition-source cond)))) 638 | (pophint--set-last-condition cond :context pophint--current-context) 639 | (pophint--show-hint-tips hints 640 | (pophint--current-not-highlight-p cond) 641 | (or (pophint--condition-tip-face cond) 642 | (pophint--update-tip-face tip-face-attr))) 643 | (pophint--event-loop hints cond))) 644 | 645 | (defsubst pophint--get-max-tips (source direction) 646 | (let ((ret (or (assoc-default 'limit source) 647 | pophint:popup-max-tips))) 648 | (when (and (eq direction 'around) 649 | ret) 650 | (setq ret (/ ret 2))) 651 | ret)) 652 | 653 | (defsubst pophint--get-hint-regexp (source) 654 | (let ((re (or (assoc-default 'regexp source) 655 | pophint--default-search-regexp))) 656 | (cond ((stringp re) re) 657 | ((boundp re) (symbol-value re)) 658 | ((functionp re) (funcall re)) 659 | (t (eval re))))) 660 | 661 | (defsubst pophint--get-search-function (srcmtd direction) 662 | (cond ((functionp srcmtd) 663 | srcmtd) 664 | ((and (listp srcmtd) 665 | (> (length srcmtd) 0)) 666 | (nth 0 srcmtd)))) 667 | 668 | (defsubst pophint--valid-location-p (lastpt startpt endpt) 669 | (when (and startpt endpt 670 | (> startpt lastpt) 671 | (> endpt startpt)) 672 | t)) 673 | 674 | (defsubst pophint--hintable-location-p (direction currpt startpt endpt) 675 | (when (and (not (ignore-errors (invisible-p startpt))) 676 | (not (ignore-errors (invisible-p (1- endpt)))) 677 | (cl-case direction 678 | (around t) 679 | (forward (>= startpt currpt)) 680 | (backward (< endpt currpt)))) 681 | t)) 682 | 683 | (cl-defun pophint--get-hints (cond) 684 | (let* ((source (pophint--condition-source cond)) 685 | (direction (pophint--condition-direction cond)) 686 | (window (pophint--condition-window cond)) 687 | (allwindow (pophint--condition-allwindow cond)) 688 | (wndchker (pophint--compile-to-function (assoc-default 'activebufferp source))) 689 | (init (pophint--compile-to-function (assoc-default 'init source))) 690 | (requires (or (assoc-default 'requires source) 691 | pophint:default-require-length)) 692 | (re (pophint--get-hint-regexp source)) 693 | (srcmtd (pophint--compile-to-function (assoc-default 'method source))) 694 | (srchfnc (pophint--get-search-function srcmtd direction)) 695 | (maxtips (pophint--get-max-tips source direction)) 696 | forward-hints backward-hints) 697 | (dolist (wnd (or (when allwindow (window-list nil t)) 698 | (and (windowp window) (window-live-p window) (list window)) 699 | (list (nth 0 (get-buffer-window-list))))) 700 | (with-selected-window wnd 701 | (when (or (not (functionp wndchker)) 702 | (funcall wndchker (window-buffer))) 703 | (save-restriction 704 | (yaxception:$ 705 | (yaxception:try (narrow-to-region 706 | (if (eq direction 'forward) (point) (window-start)) 707 | (if (eq direction 'backward) (point) (window-end)))) 708 | (yaxception:catch 'error e 709 | (pophint--warn "failed narrow region : window:%s startpt:%s endpt:%s" wnd (window-start) (window-end)))) 710 | (save-excursion 711 | (cl-loop initially (progn 712 | (pophint--trace 713 | "start searching hint. require:[%s] max:[%s] buffer:[%s] point:[%s]\nregexp: %s\nfunc: %s" 714 | requires maxtips (current-buffer) (point) re srchfnc) 715 | (when (functionp init) (funcall init)) 716 | (goto-char (point-min))) 717 | with currpt = (point) 718 | with lastpt = 0 719 | with cnt = 0 720 | with mtdret 721 | while (and (yaxception:$ 722 | (yaxception:try 723 | (cond (srchfnc (setq mtdret (funcall srchfnc))) 724 | (t (re-search-forward re nil t)))) 725 | (yaxception:catch 'error e 726 | (pophint--error "failed seek next popup point : %s\n%s" 727 | (yaxception:get-text e) (yaxception:get-stack-trace-string e)))) 728 | (or (not maxtips) 729 | (< cnt maxtips))) 730 | for startpt = (cond ((pophint:hint-p mtdret) (pophint:hint-startpt mtdret)) 731 | (mtdret (plist-get mtdret :startpt)) 732 | (t (or (match-beginning 1) (match-beginning 0)))) 733 | for endpt = (cond ((pophint:hint-p mtdret) (pophint:hint-endpt mtdret)) 734 | (mtdret (plist-get mtdret :endpt)) 735 | (t (or (match-end 1) (match-end 0)))) 736 | for value = (cond ((pophint:hint-p mtdret) (pophint:hint-value mtdret)) 737 | (mtdret (plist-get mtdret :value)) 738 | ((match-beginning 1) (match-string-no-properties 1)) 739 | (t (match-string-no-properties 0))) 740 | if (not (pophint--valid-location-p lastpt startpt endpt)) 741 | return (pophint--warn "found hint location is invalid. text:[%s] lastpt:[%s] startpt:[%s] endpt:[%s]" 742 | value lastpt startpt endpt) 743 | if (and (>= (length value) requires) 744 | (pophint--hintable-location-p direction currpt startpt endpt)) 745 | do (let ((hint (cond ((pophint:hint-p mtdret) mtdret) 746 | (t (make-pophint:hint :startpt startpt :endpt endpt :value value))))) 747 | (pophint--trace "found hint. text:[%s] startpt:[%s] endpt:[%s]" value startpt endpt) 748 | (setf (pophint:hint-window hint) (selected-window)) 749 | (cl-incf cnt) 750 | (if (<= endpt currpt) 751 | (setq backward-hints (append (list hint) backward-hints)) 752 | (setq forward-hints (append forward-hints (list hint))))) 753 | do (setq lastpt startpt))))))) 754 | (append forward-hints backward-hints))) 755 | 756 | (make-face 'pophint--minibuf-tip-face) 757 | (defun pophint--show-hint-tips (hints not-highlight &optional tip-face) 758 | (pophint--trace "start show hint tips. count:[%s] not-highlight:[%s] tip-face:[%s]" 759 | (length hints) not-highlight tip-face) 760 | (pophint:delete-last-hints) 761 | (yaxception:$ 762 | (yaxception:try 763 | (cl-loop initially (progn 764 | (copy-face (or tip-face 'pophint:tip-face) 'pophint--minibuf-tip-face) 765 | (set-face-attribute 'pophint--minibuf-tip-face nil :height 1.0)) 766 | with orgwnd = (selected-window) 767 | with wnd = orgwnd 768 | with tiptexts = (pophint--make-unique-char-strings (length hints) pophint:popup-chars) 769 | with minibufp = (window-minibuffer-p wnd) 770 | for hint in hints 771 | for tiptext = (or (when tiptexts (pop tiptexts)) "") 772 | for nextwnd = (pophint:hint-window hint) 773 | if (string= tiptext "") 774 | return nil 775 | if (not (eq wnd nextwnd)) 776 | do (progn (select-window nextwnd t) 777 | (setq wnd (selected-window)) 778 | (setq minibufp (window-minibuffer-p wnd))) 779 | do (let* ((startpt (pophint:hint-startpt hint)) 780 | (endpt (pophint:hint-endpt hint)) 781 | ;; Get a covered part by the pop-up tip 782 | (covered-endpt (+ startpt (length tiptext))) 783 | (covered-v (buffer-substring-no-properties startpt (min covered-endpt (point-max)))) 784 | ;; The range, which the pop-up tip covers, is shrinked if it includes linefeed 785 | (tip-endpt (+ startpt (or (string-match "\n" covered-v) 786 | (length tiptext)))) 787 | (tip-len (- tip-endpt startpt)) 788 | (tip (pophint--make-overlay startpt tip-endpt)) 789 | (ov (when (not not-highlight) 790 | (pophint--make-overlay startpt endpt))) 791 | (tip-face (or (when minibufp 'pophint--minibuf-tip-face) 792 | tip-face 793 | 'pophint:tip-face))) 794 | (put-text-property 0 (length tiptext) 'face tip-face tiptext) 795 | (overlay-put tip 'text tiptext) 796 | (overlay-put tip 'window (selected-window)) 797 | (overlay-put tip 'display (substring tiptext 0 tip-len)) 798 | (overlay-put tip 'after-string (substring tiptext tip-len)) 799 | (overlay-put tip 'priority 99) 800 | (setf (pophint:hint-popup hint) tip) 801 | (when ov 802 | (overlay-put ov 'window (selected-window)) 803 | (overlay-put ov 'face 'pophint:match-face) 804 | (overlay-put ov 'priority 10) 805 | (setf (pophint:hint-overlay hint) ov))) 806 | finally do (select-window orgwnd t))) 807 | (yaxception:catch 'error e 808 | (pophint--deletes hints) 809 | (pophint--error "failed show hint tips : %s\n%s" (yaxception:get-text e) (yaxception:get-stack-trace-string e)) 810 | (yaxception:throw e)))) 811 | 812 | (defsubst pophint--get-next-source (source sources &optional reverse) 813 | (cl-loop with maxidx = (- (length sources) 1) 814 | with i = (if reverse maxidx 0) 815 | with endi = (if reverse 0 maxidx) 816 | while (not (= i endi)) 817 | for currsrc = (nth i sources) 818 | if (equal source currsrc) 819 | return (let* ((nidx (if reverse (- i 1) (+ i 1))) 820 | (nidx (cond ((< nidx 0) maxidx) 821 | ((> nidx maxidx) 0) 822 | (t nidx)))) 823 | (pophint--trace "got next source index : %s" nidx) 824 | (nth nidx sources)) 825 | do (if reverse (cl-decf i) (cl-incf i)) 826 | finally return (let ((nidx (if reverse maxidx 0))) 827 | (nth nidx sources)))) 828 | 829 | (defsubst pophint--get-next-window (window) 830 | (pophint--with-no-last-condition 831 | (let ((basic-getter (lambda (w) 832 | (with-selected-window (or (and (windowp w) (window-live-p w) w) 833 | (get-buffer-window)) 834 | (next-window))))) 835 | (if (<= (length (window-list)) 2) 836 | (funcall basic-getter window) 837 | (or (pophint--awhen (pophint:do :source pophint--next-window-source :allwindow t :use-pos-tip t) 838 | (pophint:hint-window it)) 839 | (progn 840 | (pophint--warn "failed get next window by pophint:do") 841 | (funcall basic-getter window))))))) 842 | 843 | (cl-defun pophint--event-loop (hints cond &optional (inputed "") source-selection) 844 | (yaxception:$ 845 | (yaxception:try 846 | (if (and (= (length hints) 1) 847 | (not (string= inputed ""))) 848 | (pop hints) 849 | (setq pophint--last-hints hints) 850 | (let* ((source (pophint--condition-source cond)) 851 | (sources (pophint--condition-sources cond)) 852 | (action-name (pophint--condition-action-name cond)) 853 | (window (pophint--condition-window cond)) 854 | (allwindow (pophint--condition-allwindow cond)) 855 | (not-switch-direction (pophint--condition-not-switch-direction cond)) 856 | (not-switch-window (pophint--condition-not-switch-window cond)) 857 | (not-switch-source (pophint--current-not-switch-source-p cond)) 858 | (key (pophint--menu-read-key-sequence (pophint--make-prompt cond (length hints)) 859 | (pophint--condition-use-pos-tip cond))) 860 | (gbinding (when key (lookup-key (current-global-map) key))) 861 | (binding (or (when (and key (current-local-map)) 862 | (lookup-key (current-local-map) key)) 863 | gbinding))) 864 | (pophint--trace "got user input. key:[%s] gbinding:[%s] binding:[%s]" key gbinding binding) 865 | 866 | ;; Case by user input 867 | (cond 868 | ;; Error 869 | ((or (null key) (zerop (length key))) 870 | (pophint--warn "can't get user input") 871 | (pophint--deletes hints)) 872 | ;; Quit 873 | ((eq gbinding 'keyboard-quit) 874 | (pophint--debug "user inputed keyboard-quit") 875 | (pophint--deletes hints) 876 | (keyboard-quit) 877 | nil) 878 | ;; Restart loop 879 | ((or (eq gbinding 'backward-delete-char-untabify) 880 | (eq gbinding 'delete-backward-char)) 881 | (pophint--debug "user inputed delete command") 882 | (pophint--deletes hints) 883 | (pophint--let-user-select cond)) 884 | ((or (eq gbinding 'self-insert-command) 885 | (and (stringp key) 886 | (string-match key (mapconcat (lambda (s) (or s "")) 887 | (list pophint:popup-chars 888 | pophint:select-source-chars 889 | pophint:switch-source-char 890 | pophint:switch-source-reverse-char 891 | pophint:switch-direction-char 892 | pophint:switch-direction-reverse-char 893 | pophint:switch-window-char) 894 | "")))) 895 | (cond 896 | ;; Grep hints 897 | ((and (string-match key pophint:popup-chars) 898 | (not source-selection)) 899 | (pophint--debug "user inputed hint char") 900 | (let* ((currinputed (concat inputed (upcase key))) 901 | (nhints (cl-loop with re = (concat "\\`" currinputed) 902 | for hint in hints 903 | for tip = (pophint:hint-popup hint) 904 | for tiptext = (or (when (overlayp tip) (overlay-get tip 'text)) 905 | "") 906 | if (and (string-match re tiptext) 907 | (overlayp tip)) 908 | collect hint 909 | else 910 | do (pophint--delete hint)))) 911 | (pophint--event-loop nhints cond currinputed))) 912 | ;; Select source 913 | ((and (or source-selection 914 | (and (string-match key pophint:select-source-chars) 915 | (eq pophint:select-source-method 'use-source-char))) 916 | (not not-switch-source)) 917 | (pophint--debug "user inputed select source char") 918 | (when (not source-selection) (setq inputed "")) 919 | (let* ((currinputed (concat inputed key)) 920 | (nsource (cl-loop for src in sources 921 | if (string= currinputed (or (assoc-default 'selector src) "")) 922 | return src))) 923 | (if (not nsource) 924 | (pophint--event-loop hints cond currinputed t) 925 | (pophint--deletes hints) 926 | (setf (pophint--condition-source cond) nsource) 927 | (pophint--let-user-select cond)))) 928 | ;; Switch source 929 | ((and (or (string= key pophint:switch-source-char) 930 | (string= key pophint:switch-source-reverse-char)) 931 | (not not-switch-source)) 932 | (pophint--debug "user inputed switch source") 933 | (if (eq pophint:select-source-method 'use-popup-char) 934 | (pophint--event-loop hints cond "" t) 935 | (cl-loop with reverse = (string= key pophint:switch-source-reverse-char) 936 | do (setf (pophint--condition-source cond) 937 | (pophint--get-next-source (pophint--condition-source cond) sources reverse)) 938 | while (and pophint:switch-source-delay 939 | (string= key (pophint--menu-read-key-sequence 940 | (pophint--make-prompt cond (length hints)) 941 | (pophint--condition-use-pos-tip cond) 942 | pophint:switch-source-delay)))) 943 | (pophint--deletes hints) 944 | (pophint--let-user-select cond))) 945 | ;; Switch direction 946 | ((and (or (string= key pophint:switch-direction-char) 947 | (string= key pophint:switch-direction-reverse-char)) 948 | (not not-switch-direction)) 949 | (pophint--debug "user inputed switch direction") 950 | (pophint--deletes hints) 951 | (let* ((reverse (string= key pophint:switch-direction-reverse-char)) 952 | (ndirection (cl-case (pophint--condition-direction cond) 953 | (forward (if reverse 'around 'backward)) 954 | (backward (if reverse 'forward 'around)) 955 | (around (if reverse 'backward 'forward)) 956 | (t 'around)))) 957 | (setf (pophint--condition-direction cond) ndirection) 958 | (pophint--let-user-select cond))) 959 | ;; Switch window 960 | ((and (string= key pophint:switch-window-char) 961 | (not not-switch-window)) 962 | (pophint--debug "user inputed switch window") 963 | (pophint--deletes hints) 964 | (let* ((nwindow (pophint--get-next-window window)) 965 | (nsources (when (not not-switch-source) 966 | (pophint--set-selector-sources (pophint--get-available-sources nwindow))))) 967 | (setf (pophint--condition-window cond) nwindow) 968 | ;; (when (and (> (length nsources) 0) 969 | ;; (not (member source nsources))) 970 | ;; (setf (pophint--condition-source cond) nil)) 971 | (setf (pophint--condition-sources cond) nsources) 972 | (pophint--let-user-select cond))) 973 | ;; Warning 974 | (t 975 | (pophint--debug "user inputed worthless char") 976 | (pophint--show-message "Inputed not hint char.") 977 | (sleep-for 2) 978 | (pophint--event-loop hints cond inputed source-selection)))) 979 | ;; Pass inputed command 980 | ((commandp binding) 981 | (pophint--debug "user inputed command : %s" binding) 982 | (pophint--deletes hints) 983 | (call-interactively binding) 984 | nil) 985 | ;; Abort 986 | (t 987 | (pophint--deletes hints)))))) 988 | (yaxception:catch 'error e 989 | (pophint--deletes hints) 990 | (setq pophint--last-hints nil) 991 | (pophint--error "failed event loop : %s\n%s" (yaxception:get-text e) (yaxception:get-stack-trace-string e)) 992 | (yaxception:throw e)))) 993 | 994 | 995 | ;;;;;;;;;;;;;;;;;;;; 996 | ;; For pos-tip.el 997 | 998 | (defun pophint--pos-tip-show (string) 999 | (copy-face 'pophint:pos-tip-face 'pos-tip-temp) 1000 | (when (eq (face-attribute 'pos-tip-temp :font) 'unspecified) 1001 | (set-face-font 'pos-tip-temp (frame-parameter nil 'font))) 1002 | (set-face-bold 'pos-tip-temp (face-bold-p 'pophint:pos-tip-face)) 1003 | (cl-multiple-value-bind (wnd rightpt bottompt) (pophint--get-pos-tip-location) 1004 | (let* ((max-width (pos-tip-x-display-width)) 1005 | (max-height (pos-tip-x-display-height)) 1006 | (tipsize (pophint--get-pos-tip-size string)) 1007 | (tipsize (cond ((or (> (car tipsize) max-width) 1008 | (> (cdr tipsize) max-height)) 1009 | (setq string (pos-tip-truncate-string string max-width max-height)) 1010 | (pophint--get-pos-tip-size string)) 1011 | (t 1012 | tipsize))) 1013 | (tipwidth (car tipsize)) 1014 | (tipheight (cdr tipsize)) 1015 | (dx (- rightpt tipwidth 10)) 1016 | (dy (- bottompt tipheight))) 1017 | (pos-tip-show-no-propertize 1018 | string 'pos-tip-temp 1 wnd 300 tipwidth tipheight nil dx dy)))) 1019 | 1020 | (defun pophint--get-pos-tip-size (string) 1021 | "Return (WIDTH . HEIGHT) of the tip of pos-tip.el generated from STRING." 1022 | (let* ((w-h (pos-tip-string-width-height string)) 1023 | (width (pos-tip-tooltip-width (car w-h) (frame-char-width))) 1024 | (height (pos-tip-tooltip-height (cdr w-h) (frame-char-height)))) 1025 | (cons width height))) 1026 | 1027 | (defun pophint--get-pos-tip-location () 1028 | "Return (WND RIGHT BOTTOM) as the location to show the tip of pos-tip.el." 1029 | (let ((leftpt 0) 1030 | (toppt 0) 1031 | wnd rightpt bottompt) 1032 | (dolist (w (window-list)) 1033 | (let* ((edges (when (not (minibufferp (window-buffer w))) 1034 | (window-pixel-edges w))) 1035 | (currleftpt (or (nth 0 edges) -1)) 1036 | (currtoppt (or (nth 1 edges) -1))) 1037 | (when (and (= currleftpt 0) 1038 | (= currtoppt 0)) 1039 | (setq wnd w)) 1040 | (when (or (not rightpt) 1041 | (> currleftpt leftpt)) 1042 | (setq rightpt (nth 2 edges)) 1043 | (setq leftpt currleftpt)) 1044 | (when (or (not bottompt) 1045 | (> currtoppt toppt)) 1046 | (setq bottompt (nth 3 edges)) 1047 | (setq toppt currtoppt)))) 1048 | (list wnd rightpt bottompt))) 1049 | 1050 | 1051 | ;;;;;;;;;;;;;;;;;;; 1052 | ;; User Function 1053 | 1054 | ;;;###autoload 1055 | (cl-defmacro pophint:defsource (&key name description source) 1056 | "Define the variable and command to pop-up hint-tip by using given source. 1057 | 1058 | NAME is string. It is used for define variable and command as part of the name. 1059 | DESCRIPTION is string. It is used for define variable as part of the docstring. 1060 | SOURCE is alist. The member is the following. 1061 | 1062 | - shown 1063 | String to use for message in minibuffer when get user input. 1064 | If nil, its value is NAME. 1065 | 1066 | - regexp 1067 | String to use for finding next point of pop-up. 1068 | If nil, its value is `pophint--default-search-regexp'. 1069 | If exist group of matches, next point is beginning of group 1, 1070 | else it is beginning of group 0. 1071 | 1072 | - requires 1073 | Integer of minimum length of matched text as next point. 1074 | If nil, its value is 0. 1075 | 1076 | - limit 1077 | Integer to replace `pophint:popup-max-tips' with it. 1078 | 1079 | - action 1080 | Function to be called when finish hint-tip selection. 1081 | If nil, its value is `pophint--default-action'. 1082 | It receive the object of `pophint:hint' selected by user. 1083 | Also it accepts one of the following symbols, and returns 1084 | - value : `pophint:hint-value' of the selected 1085 | - point : `pophint:hint-startpt' of the selected 1086 | - hint : `pophint:hint' as the selected 1087 | 1088 | - method 1089 | Function to find next point of pop-up. 1090 | If nil, its value is `re-search-forward', and regexp is used. 1091 | 1092 | - init 1093 | Function to be called before finding pop-up points 1094 | for each of window/direction. 1095 | 1096 | - highlight 1097 | Boolean. Default is t. 1098 | If nil, don't highlight matched text when pop-up hint. 1099 | 1100 | - dedicated 1101 | Symbol or list to mean the situation that SOURCE is dedicated for. 1102 | If non-nil, added to `pophint:dedicated-sources'. 1103 | 1104 | - activebufferp 1105 | Function to call for checking if SOURCE is activated in the buffer. 1106 | It is required with `dedicated' option. 1107 | It receives a buffer object and 1108 | needs to return non-nil if the buffer is the target of itself. 1109 | 1110 | - tip-face-attr 1111 | It is plist for customize of `pophint:tip-face' temporarily. 1112 | 1113 | Example: 1114 | (pophint:defsource :name \"sexp-head\" 1115 | :description \"Head word of sexp.\" 1116 | :source \\='((shown . \"SexpHead\") 1117 | (regexp . \"(+\\([^() \t\n]+\\)\") 1118 | (requires . 1))) 1119 | " 1120 | (declare (indent 0)) 1121 | (let* ((symnm (downcase (replace-regexp-in-string " +" "-" name))) 1122 | (var-sym (intern (format "pophint:source-%s" symnm))) 1123 | (var-doc (format "Source for pop-up hint-tip of %s.\n\nDescription:\n%s" 1124 | name (or description "Not documented."))) 1125 | (fnc-sym (intern (format "pophint:do-%s" symnm))) 1126 | (fnc-doc (format "Do pop-up hint-tip using `%s'." var-sym))) 1127 | `(progn 1128 | (defvar ,var-sym nil 1129 | ,var-doc) 1130 | (setq ,var-sym ,source) 1131 | (when (not (assoc-default 'shown ,var-sym)) 1132 | (add-to-list ',var-sym '(shown . ,name))) 1133 | (when (assoc-default 'dedicated ,var-sym) 1134 | (add-to-list 'pophint:dedicated-sources ',var-sym t)) 1135 | (defun ,fnc-sym () 1136 | ,fnc-doc 1137 | (interactive) 1138 | (pophint:do :source ',var-sym))))) 1139 | 1140 | ;;;###autoload 1141 | (cl-defmacro pophint:defaction (&key key name description action) 1142 | "Define the action to be called when finish hint-tip selection. 1143 | 1144 | KEY is string of one character to input on `pophint:do-interactively'. 1145 | NAME is string to be part of the command name and shown on user input. 1146 | DESCRIPTION is string to be part of the docstring of the command. 1147 | ACTION is function. For detail, see action of SOURCE for `pophint:defsource'. 1148 | 1149 | Example: 1150 | (pophint:defaction :key \"y\" 1151 | :name \"Yank\" 1152 | :description \"Yank the text of selected hint-tip.\" 1153 | :action (lambda (hint) 1154 | (kill-new (pophint:hint-value hint)))) 1155 | " 1156 | (declare (indent 0)) 1157 | (let ((fnc-sym (intern (format "pophint:do-flexibly-%s" 1158 | (downcase (replace-regexp-in-string " +" "-" name))))) 1159 | (fnc-doc (format "Do pop-up hint-tip using source in `pophint:sources' and do %s.\n\nDescription:\n%s" 1160 | name (or description "Not documented.")))) 1161 | `(progn 1162 | (let ((key ,key) 1163 | (name ,name) 1164 | (action ,action)) 1165 | (if (or (not (stringp key)) 1166 | (string= key "") 1167 | (not (= (length key) 1))) 1168 | (pophint--show-message "Failed pophint:defaction : key is not one character.") 1169 | (puthash key 1170 | (make-pophint:action :name name :action action) 1171 | pophint--action-hash) 1172 | (defun ,fnc-sym () 1173 | ,fnc-doc 1174 | (interactive) 1175 | (let ((act (gethash ,key pophint--action-hash))) 1176 | (pophint:do-flexibly :action (pophint:action-action act) 1177 | :action-name (pophint:action-name act))))))))) 1178 | 1179 | ;;;###autoload 1180 | (cl-defmacro pophint:defsituation (situation) 1181 | "Define the command to pop-up hint-tip in SITUATION. 1182 | 1183 | SITUATION is symbol. It is used for finding the sources that is dedicated 1184 | for SITUATION from `pophint:dedicated-sources'. 1185 | 1186 | Example: 1187 | (pophint:defsituation e2wm) 1188 | " 1189 | (declare (indent 0)) 1190 | (let* ((symnm (downcase (replace-regexp-in-string " +" "-" (symbol-name situation)))) 1191 | (fnc-sym (intern (format "pophint:do-situationally-%s" symnm))) 1192 | (fnc-doc (format "Do `pophint:do-situationally' for '%s'." symnm))) 1193 | `(progn 1194 | (defun ,fnc-sym () 1195 | ,fnc-doc 1196 | (interactive) 1197 | (pophint:do-situationally ',situation))))) 1198 | 1199 | ;;;###autoload 1200 | (cl-defmacro pophint:set-allwindow-command (func) 1201 | "Define advice to FUNC for doing pop-up at all windows. 1202 | 1203 | FUNC is symbol not quoted. 1204 | 1205 | e.g. (pophint:set-allwindow-command pophint:do-flexibly)" 1206 | `(defadvice ,func (around pophint-allwindow activate) 1207 | (let ((pophint--enable-allwindow-p t)) 1208 | ad-do-it))) 1209 | 1210 | ;;;###autoload 1211 | (cl-defmacro pophint:set-not-allwindow-command (func) 1212 | "Define advice to FUNC for doing pop-up at one window. 1213 | 1214 | FUNC is symbol not quoted. 1215 | 1216 | e.g. (pophint:set-not-allwindow-command pophint:do-flexibly)" 1217 | `(defadvice ,func (around pophint-not-allwindow activate) 1218 | (let ((pophint--disable-allwindow-p t)) 1219 | ad-do-it))) 1220 | 1221 | ;;;###autoload 1222 | (cl-defmacro pophint:defcommand-determinate (&key source-name 1223 | action-name 1224 | other-windows-p 1225 | all-windows-p 1226 | ignore-already-defined) 1227 | "Define a determinate command using SOURCE-NAME, ACTION-NAME." 1228 | (declare (indent 0)) 1229 | (let* ((wnd-typenm (cond (all-windows-p "all-windows") 1230 | (other-windows-p "other-windows") 1231 | (t "current-window"))) 1232 | (source-sym-name (downcase (replace-regexp-in-string " +" "-" source-name))) 1233 | (action-sym-name (downcase (replace-regexp-in-string " +" "-" action-name))) 1234 | (fnc-sym (intern (format "pophint:%s-%s-on-%s" 1235 | action-sym-name source-sym-name wnd-typenm))) 1236 | (fnc-doc (format "Do pop-up hint-tip using `pophint:source-%s' to %s in %s" 1237 | source-sym-name action-name wnd-typenm)) 1238 | (opt-source-parts (when other-windows-p 1239 | '((activebufferp . (lambda (b) 1240 | (not (eql b (current-buffer)))))))) 1241 | (source (symbol-value (intern (format "pophint:source-%s" source-sym-name))))) 1242 | `(progn 1243 | (when (or (not ,ignore-already-defined) 1244 | (not (commandp ',fnc-sym))) 1245 | (defun ,fnc-sym () 1246 | ,fnc-doc 1247 | (interactive) 1248 | (let ((action-func (cl-loop for act being the hash-values in pophint--action-hash 1249 | if (string= ,action-name (pophint:action-name act)) 1250 | return (pophint:action-action act)))) 1251 | (pophint:do :source '(,@opt-source-parts ,@source) 1252 | :action action-func 1253 | :action-name ,action-name 1254 | :not-switch-window t 1255 | :allwindow ,all-windows-p))))))) 1256 | 1257 | ;;;###autoload 1258 | (cl-defun pophint:defcommand-exhaustively (&key feature) 1259 | "Do `pophint:defcommand-determinate' for all sources/actions/windows." 1260 | (cl-loop for var-sym in (apropos-internal "\\`pophint:source-") 1261 | for varnm = (replace-regexp-in-string "\\`pophint:source-" "" (symbol-name var-sym)) 1262 | for commands = (cl-loop for act being the hash-values in pophint--action-hash 1263 | for actnm = (pophint:action-name act) 1264 | collect (eval `(pophint:defcommand-determinate :source-name ,varnm 1265 | :action-name ,actnm 1266 | :ignore-already-defined t)) 1267 | collect (eval `(pophint:defcommand-determinate :source-name ,varnm 1268 | :action-name ,actnm 1269 | :ignore-already-defined t 1270 | :other-windows-p t)) 1271 | collect (eval `(pophint:defcommand-determinate :source-name ,varnm 1272 | :action-name ,actnm 1273 | :ignore-already-defined t 1274 | :all-windows-p t))) 1275 | if feature 1276 | do (cl-loop for cmd in commands 1277 | if cmd 1278 | do (autoload cmd feature)))) 1279 | 1280 | ;;;###autoload 1281 | (defun pophint:get-current-direction () 1282 | "Get current direction of searching next point for pop-up hint-tip." 1283 | (when (pophint--condition-p pophint--last-condition) 1284 | (pophint--condition-direction pophint--last-condition))) 1285 | 1286 | ;;;###autoload 1287 | (cl-defun pophint:inch-forward (&key (length pophint:inch-forward-length)) 1288 | (let* ((currpt (point)) 1289 | (pt1 (save-excursion 1290 | (cl-loop for pt = (progn (forward-word 1) (point)) 1291 | until (or (>= (- pt currpt) length) 1292 | (= pt (point-max)))) 1293 | (point))) 1294 | (pt2 (save-excursion 1295 | (cl-loop for re in '("\\w+" "\\s-+" "\\W+" "\\w+") 1296 | for pt = (progn (re-search-forward (concat "\\=" re) nil t) 1297 | (point)) 1298 | if (>= (- pt currpt) length) 1299 | return pt 1300 | finally return pt1)))) 1301 | (goto-char (if (> pt1 pt2) pt2 pt1)))) 1302 | (define-obsolete-function-alias 'pophint-config:inch-forward 'pophint:inch-forward "1.1.0") 1303 | 1304 | ;;;###autoload 1305 | (cl-defun pophint:make-hint-with-inch-forward (&key limit (length pophint:inch-forward-length)) 1306 | (let ((currpt (point)) 1307 | (nextpt (progn (pophint:inch-forward) (point)))) 1308 | (when (and (or (not limit) 1309 | (<= currpt limit)) 1310 | (>= (- nextpt currpt) length)) 1311 | `(:startpt ,currpt :endpt ,nextpt :value ,(buffer-substring-no-properties currpt nextpt))))) 1312 | (define-obsolete-function-alias 'pophint-config:make-hint-with-inch-forward 'pophint:make-hint-with-inch-forward "1.1.0") 1313 | 1314 | 1315 | ;;;;;;;;;;;;;;;;;; 1316 | ;; User Command 1317 | 1318 | ;;;###autoload 1319 | (cl-defun pophint:do (&key source 1320 | sources 1321 | action 1322 | action-name 1323 | direction 1324 | not-highlight 1325 | window 1326 | not-switch-window 1327 | allwindow 1328 | (use-pos-tip 'global) 1329 | tip-face-attr 1330 | context) 1331 | "Do pop-up hint-tip using given source on target to direction. 1332 | 1333 | SOURCE is alist or symbol of alist. About its value, see `pophint:defsource'. 1334 | If nil, its value is the first of SOURCES or `pophint--default-source'. 1335 | If non-nil, `pophint--default-source' isn't used for SOURCES. 1336 | 1337 | SOURCES is list of SOURCE. 1338 | If this length more than 1, enable switching SOURCE when pop-up hint. 1339 | 1340 | ACTION is function or symbol. 1341 | About this, see action of SOURCE for `pophint:defsource'. If nil, it's used. 1342 | 1343 | ACTION-NAME is string. 1344 | About this, see name of `pophint:defaction'. 1345 | 1346 | DIRECTION is symbol to be strategy of finding the pop-up points. 1347 | - forward : moving forward until `pophint:popup-max-tips'. 1348 | - backward : moving backward until `pophint:popup-max-tips'. 1349 | - around : moving both until half of `pophint:popup-max-tips'. 1350 | If nil, enable switching DIRECTION when pop-up hint. 1351 | 1352 | NOT-HIGHLIGHT is t or nil. 1353 | If non-nil, don't highlight matched text when pop-up hint. 1354 | 1355 | WINDOW is window to find next point of pop-up in the window. 1356 | If nil, its value is `selected-window'. 1357 | 1358 | NOT-SWITCH-WINDOW is t or nil. 1359 | If non-nil, disable switching window when select shown hint. 1360 | 1361 | ALLWINDOW is t or nil. 1362 | If non-nil, pop-up at all windows in frame. 1363 | 1364 | USE-POS-TIP is t or nil. 1365 | If omitted, inherit `pophint:use-pos-tip'. 1366 | 1367 | TIP-FACE-ATTR is plist for customize of `pophint:tip-face' temporarily." 1368 | (interactive) 1369 | (let ((pophint--resumed-input-method current-input-method)) 1370 | 1371 | (ignore-errors (deactivate-input-method)) 1372 | 1373 | (yaxception:$ 1374 | (yaxception:try 1375 | (pophint--debug 1376 | "start do.\ndirection:%s\nnot-highlight:%s\nwindow:%s\nnot-switch-window:%s\nallwindow:%s\naction-name:%s\naction:%s\nsource:%s\nsources:%s" 1377 | direction not-highlight window not-switch-window allwindow action-name action source sources) 1378 | (let* (;; (current-input-method nil) 1379 | (case-fold-search nil) 1380 | (allwindow-p (and (or allwindow 1381 | pophint--enable-allwindow-p 1382 | pophint:do-allwindow-p) 1383 | (not pophint--disable-allwindow-p) 1384 | (not window))) 1385 | (c (make-pophint--condition :source (pophint--compile-source source) 1386 | :sources (pophint--set-selector-sources (pophint--compile-sources sources)) 1387 | :action action 1388 | :action-name (or action-name pophint--default-action-name) 1389 | :direction (or direction 1390 | (when (not pophint:switch-direction-p) 'around) 1391 | (pophint:get-current-direction) 1392 | 'around) 1393 | :window window 1394 | :allwindow allwindow-p 1395 | :use-pos-tip (if (eq use-pos-tip 'global) pophint:use-pos-tip use-pos-tip) 1396 | :not-highlight not-highlight 1397 | :not-switch-direction (or (when direction t) 1398 | (not pophint:switch-direction-p)) 1399 | :not-switch-window (or not-switch-window (one-window-p) allwindow-p) 1400 | :not-switch-source (and source (not sources)) 1401 | :tip-face (when tip-face-attr 1402 | (pophint--update-tip-face tip-face-attr)))) 1403 | (hint (pophint--let-user-select c :context context))) 1404 | (pophint--do-action hint (pophint--current-action c)))) 1405 | (yaxception:catch 'error e 1406 | (pophint--show-message "Failed pophint:do : %s" (yaxception:get-text e)) 1407 | (pophint--fatal "failed do : %s\n%s" (yaxception:get-text e) (yaxception:get-stack-trace-string e)) 1408 | (pophint--log-open-log-if-debug)) 1409 | (yaxception:finally 1410 | (pophint--awhen pophint--resumed-input-method 1411 | (activate-input-method it)))))) 1412 | 1413 | ;;;###autoload 1414 | (cl-defun pophint:do-flexibly (&key action action-name window) 1415 | "Do pop-up hint-tip using source in `pophint:sources'. 1416 | 1417 | For detail, see `pophint:do'." 1418 | (interactive) 1419 | (pophint--debug "start do flexibly. window:[%s] action-name:[%s]\naction:%s" window action-name action) 1420 | (let* ((pophint--current-context (format "pophint:do-flexibly-%s" 1421 | (downcase (replace-regexp-in-string " +" "-" (or action-name ""))))) 1422 | (lastc (pophint--get-last-condition-with-context pophint--current-context)) 1423 | (window (or window 1424 | (when (pophint--condition-p lastc) 1425 | (pophint--condition-window lastc)))) 1426 | (sources (pophint--get-available-sources window)) 1427 | (lastsrc (when (pophint--condition-p lastc) 1428 | (pophint--condition-source lastc))) 1429 | (compsrc (pophint--aif (assq 'selector lastsrc) 1430 | (delq it (copy-sequence lastsrc)) 1431 | lastsrc)) 1432 | (source (when (and compsrc 1433 | (member compsrc sources)) 1434 | lastsrc))) 1435 | (pophint:do :source source 1436 | :sources sources 1437 | :action action 1438 | :action-name action-name 1439 | :window window))) 1440 | 1441 | ;;;###autoload 1442 | (defun pophint:do-interactively () 1443 | "Do pop-up hint-tip asking about what to do after select hint-tip." 1444 | (interactive) 1445 | (yaxception:$ 1446 | (yaxception:try 1447 | (let* ((key (pophint--menu-read-key-sequence (pophint--make-prompt-interactively) 1448 | pophint:use-pos-tip)) 1449 | (gbinding (lookup-key (current-global-map) key)) 1450 | (binding (or (when (current-local-map) 1451 | (lookup-key (current-local-map) key)) 1452 | gbinding))) 1453 | (pophint--trace "got user input. key:[%s] gbinding:[%s] binding:[%s]" key gbinding binding) 1454 | (cond ((or (null key) (zerop (length key))) 1455 | (pophint--warn "can't get user input")) 1456 | ((eq gbinding 'keyboard-quit) 1457 | (pophint--debug "user inputed keyboard-quit") 1458 | (pophint--show-message "Quit do-interactively.")) 1459 | ((eq gbinding 'newline) 1460 | (pophint--debug "user inputed newline") 1461 | (pophint:do-flexibly)) 1462 | ((eq gbinding 'self-insert-command) 1463 | (let* ((action (gethash key pophint--action-hash))) 1464 | (cond ((pophint:action-p action) 1465 | (pophint:do-flexibly :action (pophint:action-action action) 1466 | :action-name (pophint:action-name action))) 1467 | (t 1468 | (pophint--show-message "Inputed not start key of action.") 1469 | (sleep-for 2) 1470 | (pophint:do-interactively))))) 1471 | ((commandp binding) 1472 | (pophint--debug "user inputed command : %s" binding) 1473 | (call-interactively binding) 1474 | (pophint:do-interactively))))) 1475 | (yaxception:catch 'error e 1476 | (pophint--show-message "Failed pophint:do-interactively : %s" (yaxception:get-text e)) 1477 | (pophint--fatal "failed do-interactively : %s\n%s" (yaxception:get-text e) (yaxception:get-stack-trace-string e)) 1478 | (pophint--log-open-log-if-debug)))) 1479 | 1480 | ;;;###autoload 1481 | (defun pophint:do-situationally (situation) 1482 | "Do pop-up hint-tip for SITUATION. 1483 | 1484 | SITUATION is symbol to be defined on `pophint:defsituation'." 1485 | (interactive 1486 | (list (intern 1487 | (completing-read "Select situation: " 1488 | (cl-loop with ret = nil 1489 | for src in (pophint--compile-sources pophint:dedicated-sources) 1490 | for dedicated = (assoc-default 'dedicated src) 1491 | if dedicated 1492 | do (cond ((symbolp dedicated) (cl-pushnew dedicated ret)) 1493 | ((listp dedicated) (cl-loop for e in dedicated do (cl-pushnew e ret)))) 1494 | finally return ret) 1495 | nil t nil '())))) 1496 | (yaxception:$ 1497 | (yaxception:try 1498 | (pophint--trace "start do situationally. situation[%s]" situation) 1499 | (let* ((current-input-method nil) 1500 | (sources (cl-loop for src in (pophint--compile-sources pophint:dedicated-sources) 1501 | for dedicated = (assoc-default 'dedicated src) 1502 | if (or (and dedicated 1503 | (symbolp dedicated) 1504 | (eq dedicated situation)) 1505 | (and dedicated 1506 | (listp dedicated) 1507 | (memq situation dedicated))) 1508 | collect src)) 1509 | (not-highlight (cl-loop for src in sources 1510 | always (and (assq 'highlight src) 1511 | (not (assoc-default 'highlight src))))) 1512 | (actionh (make-hash-table :test 'equal)) 1513 | (cond (make-pophint--condition :sources sources 1514 | :action-name (upcase (symbol-name situation)) 1515 | :direction 'around 1516 | :use-pos-tip pophint:use-pos-tip 1517 | :not-highlight not-highlight 1518 | :not-switch-direction t 1519 | :not-switch-window t 1520 | :not-switch-source t)) 1521 | (hints (cl-loop for wnd in (window-list nil nil) 1522 | do (setf (pophint--condition-window cond) wnd) 1523 | append (with-selected-window wnd 1524 | (cl-loop with buff = (window-buffer) 1525 | for src in sources 1526 | for chker = (assoc-default 'activebufferp src) 1527 | if (and (functionp chker) 1528 | (funcall chker buff)) 1529 | return (progn 1530 | (puthash (buffer-name buff) (assoc-default 'action src) actionh) 1531 | (setf (pophint--condition-source cond) src) 1532 | (pophint--get-hints cond)))))) 1533 | (hint (progn (pophint--show-hint-tips hints not-highlight) 1534 | (pophint--event-loop hints cond))) 1535 | (action (or (when hint 1536 | (gethash (buffer-name (window-buffer (pophint:hint-window hint))) actionh)) 1537 | pophint--default-action))) 1538 | (pophint--do-action hint action))) 1539 | (yaxception:catch 'error e 1540 | (pophint--show-message "Failed pophint:do situationally : %s" (yaxception:get-text e)) 1541 | (pophint--fatal "failed do situationally : %s\n%s" 1542 | (yaxception:get-text e) (yaxception:get-stack-trace-string e)) 1543 | (pophint--log-open-log-if-debug)))) 1544 | 1545 | ;;;###autoload 1546 | (defun pophint:redo () 1547 | "Redo last pop-up hint-tip using any sources." 1548 | (interactive) 1549 | (yaxception:$ 1550 | (yaxception:try 1551 | (if (not (pophint--condition-p pophint--last-condition)) 1552 | (pophint--show-message "Failed pophint:redo : Maybe pophint:do done not yet") 1553 | (let ((hint (pophint--let-user-select pophint--last-condition))) 1554 | (pophint--do-action hint (pophint--current-action pophint--last-condition))))) 1555 | (yaxception:catch 'error e 1556 | (pophint--show-message "Failed pophint:redo : %s" (yaxception:get-text e)) 1557 | (pophint--fatal "failed redo : %s\n%s" (yaxception:get-text e) (yaxception:get-stack-trace-string e)) 1558 | (pophint--log-open-log-if-debug)))) 1559 | 1560 | ;;;###autoload 1561 | (defun pophint:toggle-use-pos-tip () 1562 | "Toggle the status of `pophint:use-pos-tip'." 1563 | (interactive) 1564 | (setq pophint:use-pos-tip (not pophint:use-pos-tip))) 1565 | 1566 | ;;;###autoload 1567 | (defun pophint:delete-last-hints () 1568 | "Delete last hint-tip." 1569 | (interactive) 1570 | (when pophint--last-hints 1571 | (pophint--deletes pophint--last-hints) 1572 | (setq pophint--last-hints nil))) 1573 | 1574 | 1575 | (defadvice keyboard-quit (before pophint:delete-last-hints activate) 1576 | (ignore-errors (pophint:delete-last-hints))) 1577 | 1578 | 1579 | (provide 'pophint) 1580 | ;;; pophint.el ends here 1581 | -------------------------------------------------------------------------------- /test/compile-source.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "compile-source symbol") 6 | (expect '((shown . "hoge") (regexp . "\\`hoge\\'")) 7 | (pophint:defsource :name "hoge" 8 | :source '((regexp . "\\`hoge\\'"))) 9 | (pophint--compile-source 'pophint:source-hoge)) 10 | (desc "compile-source alist") 11 | (expect '((shown . "hoge") (regexp . "\\`hoge\\'")) 12 | (pophint:defsource :name "hoge" 13 | :source '((regexp . "\\`hoge\\'"))) 14 | (pophint--compile-source pophint:source-hoge)) 15 | (desc "compile-source list of symbol") 16 | (expect '(((shown . "hoge") (regexp . "\\`hoge\\'"))) 17 | (pophint:defsource :name "hoge" 18 | :source '((regexp . "\\`hoge\\'"))) 19 | (setq pophint:sources '(pophint:source-hoge)) 20 | (pophint--compile-sources pophint:sources)) 21 | (desc "compile-source nil") 22 | (expect nil 23 | (pophint--compile-source nil)) 24 | (desc "compile-source symbol of nil") 25 | (expect nil 26 | (setq hoge nil) 27 | (pophint--compile-source 'hoge)) 28 | ) 29 | 30 | -------------------------------------------------------------------------------- /test/compile-to-function.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "compile-to-function nil") 6 | (expect nil 7 | (pophint--compile-to-function nil)) 8 | (desc "compile-to-function lambda") 9 | (expect '(lambda () (message "")) 10 | (and (functionp (lambda () (message ""))) 11 | (pophint--compile-to-function (lambda () (message ""))))) 12 | (desc "compile-to-function quoted lambda") 13 | (expect '(lambda () (message "")) 14 | (and (functionp '(lambda () (message ""))) 15 | (pophint--compile-to-function '(lambda () (message ""))))) 16 | (desc "compile-to-function variable") 17 | (expect '(lambda () (message "")) 18 | (let* ((var (lambda () (message "")))) 19 | (pophint--compile-to-function var))) 20 | (desc "compile-to-function quoted variable") 21 | (expect '(lambda () (message "")) 22 | (let* ((var (lambda () (message "")))) 23 | (pophint--compile-to-function 'var))) 24 | (desc "compile-to-function function") 25 | (expect 'hoge 26 | (defun hoge () (message "")) 27 | (and (functionp 'hoge) 28 | (pophint--compile-to-function 'hoge))) 29 | (desc "compile-to-function lambda list") 30 | (expect '((lambda nil (message "a")) (lambda nil (message "b"))) 31 | (pophint--compile-to-function '((lambda () (message "a")) 32 | (lambda () (message "b"))))) 33 | (desc "compile-to-function variable list") 34 | (expect '((lambda nil (message "a")) (lambda nil (message "b"))) 35 | (let* ((var '((lambda () (message "a")) 36 | (lambda () (message "b"))))) 37 | (pophint--compile-to-function var))) 38 | (desc "compile-to-function quoted variable list") 39 | (expect '((lambda nil (message "a")) (lambda nil (message "b"))) 40 | (let* ((var '((lambda () (message "a")) 41 | (lambda () (message "b"))))) 42 | (pophint--compile-to-function 'var))) 43 | ) 44 | 45 | -------------------------------------------------------------------------------- /test/defaction.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "defaction name") 6 | (expect "Hoge" 7 | (pophint:defaction :key "h" 8 | :name "Hoge" 9 | :action (lambda (hint) (message "hoge"))) 10 | (let* ((ret (gethash "h" pophint--action-hash))) 11 | (and (pophint:action-p ret) 12 | (pophint:action-name ret))))) 13 | 14 | (expectations 15 | (desc "defaction action") 16 | (expect '(lambda (hint) (message "hoge")) 17 | (pophint:defaction :key "h" 18 | :name "Hoge" 19 | :action (lambda (hint) (message "hoge"))) 20 | (let* ((ret (gethash "h" pophint--action-hash))) 21 | (and (pophint:action-p ret) 22 | (pophint:action-action ret))))) 23 | 24 | (expectations 25 | (desc "defaction function") 26 | (expect t 27 | (pophint:defaction :key "h" 28 | :name "Hoge" 29 | :action (lambda (hint) (message "hoge"))) 30 | (fboundp 'pophint:do-flexibly-hoge))) 31 | 32 | -------------------------------------------------------------------------------- /test/defsituation.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "defsituation") 6 | (expect t 7 | (pophint:defsituation hoge) 8 | (commandp 'pophint:do-situationally-hoge)) 9 | ) 10 | 11 | -------------------------------------------------------------------------------- /test/defsource.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "defsource have not shown") 6 | (expect "hoge" 7 | (let ((pophint:dedicated-sources nil)) 8 | (pophint:defsource :name "hoge" 9 | :source '((regexp . "^hoge$"))) 10 | (and (boundp 'pophint:source-hoge) 11 | (listp pophint:source-hoge) 12 | (commandp 'pophint:do-hoge) 13 | (not pophint:dedicated-sources) 14 | (assoc-default 'shown pophint:source-hoge)))) 15 | (desc "defsource has shown") 16 | (expect "bar" 17 | (pophint:defsource :name "fuga" 18 | :source '((shown . "bar") 19 | (regexp . "^fuga$"))) 20 | (and (boundp 'pophint:source-fuga) 21 | (listp pophint:source-fuga) 22 | (commandp 'pophint:do-fuga) 23 | (assoc-default 'shown pophint:source-fuga))) 24 | (desc "defsource has space in name") 25 | (expect "this is test" 26 | (pophint:defsource :name "this is test" 27 | :description "" 28 | :source '((regexp . "^ThisIsTest$"))) 29 | (and (boundp 'pophint:source-this-is-test) 30 | (listp pophint:source-this-is-test) 31 | (commandp 'pophint:do-this-is-test) 32 | (assoc-default 'shown pophint:source-this-is-test))) 33 | (desc "defsource have dedicated") 34 | (expect '(pophint:source-test-dedicated) 35 | (let ((pophint:dedicated-sources nil)) 36 | (pophint:defsource :name "test dedicated" 37 | :source '((regexp . "^Dedicated$") 38 | (dedicated . bar))) 39 | (and (boundp 'pophint:source-test-dedicated) 40 | (listp pophint:source-test-dedicated) 41 | (commandp 'pophint:do-test-dedicated) 42 | pophint:dedicated-sources))) 43 | ) 44 | 45 | -------------------------------------------------------------------------------- /test/do-action.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "do-action not hint") 6 | (expect nil 7 | (pophint--do-action nil '(lambda (hint) (forward-char))))) 8 | 9 | (expectations 10 | (desc "do-action hint") 11 | (expect (mock (forward-char)) 12 | (pophint--do-action (make-pophint:hint) '(lambda (hint) (forward-char))))) 13 | 14 | -------------------------------------------------------------------------------- /test/do-flexibly.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "do-flexibly not argument") 6 | (expect (mock (pophint:do :source nil 7 | :sources '(pophint--default-source) 8 | :action nil 9 | :action-name nil 10 | :window nil)) 11 | (stub pophint--get-available-sources => '(pophint--default-source)) 12 | (let* ((pophint--last-source) 13 | (pophint--last-window)) 14 | (pophint:do-flexibly)))) 15 | 16 | (expectations 17 | (desc "do-flexibly has argument") 18 | (expect (mock (pophint:do :source nil 19 | :sources '(pophint--default-source) 20 | :action '(lambda (hint) (message "test")) 21 | :action-name "It'sTest" 22 | :window 'hogewindow)) 23 | (stub pophint--get-available-sources => '(pophint--default-source)) 24 | (let* ((pophint--last-source) 25 | (pophint--last-window)) 26 | (pophint:do-flexibly :action '(lambda (hint) (message "test")) 27 | :action-name "It'sTest" 28 | :window 'hogewindow)))) 29 | 30 | -------------------------------------------------------------------------------- /test/do-interactively.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "do-interactively null") 6 | (expect nil 7 | (stub pophint--menu-read-key-sequence => nil) 8 | (pophint:do-interactively))) 9 | 10 | (expectations 11 | (desc "do-interactively empty") 12 | (expect nil 13 | (stub pophint--menu-read-key-sequence => (kbd "")) 14 | (pophint:do-interactively))) 15 | 16 | (expectations 17 | (desc "do-interactively quit") 18 | (expect (mock (message *)) 19 | (stub pophint--menu-read-key-sequence => (kbd "q")) 20 | (stub lookup-key => 'keyboard-quit) 21 | (pophint:do-interactively))) 22 | 23 | (expectations 24 | (desc "do-interactively return") 25 | (expect (mock (pophint:do-flexibly *)) 26 | (stub pophint--menu-read-key-sequence => (kbd "q")) 27 | (stub lookup-key => 'newline) 28 | (pophint:do-interactively))) 29 | 30 | (expectations 31 | (desc "do-interactively action") 32 | (expect (mock (pophint:do-flexibly :action '(lambda (hint) (message "test")) 33 | :action-name "test")) 34 | (stub pophint--menu-read-key-sequence => (kbd "q")) 35 | (pophint:defaction :key "q" 36 | :name "test" 37 | :action (lambda (hint) (message "test"))) 38 | (pophint:do-interactively))) 39 | 40 | -------------------------------------------------------------------------------- /test/do.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "do get-hint not argument") 6 | (expect (mock (pophint--get-hints 7 | (make-pophint--condition :source pophint--default-source 8 | :action-name pophint--default-action-name 9 | :direction 'around 10 | :allwindow t 11 | :not-switch-window t))) 12 | (stub pophint--event-loop => nil) 13 | (let ((pophint:switch-direction-p t) 14 | (pophint:do-allwindow-p t) 15 | (pophint:select-source-method nil)) 16 | (pophint:do))) 17 | (desc "do get-hint has sources") 18 | (expect (mock (pophint--get-hints 19 | (make-pophint--condition :source '((regexp . "hoge")) 20 | :sources '(((regexp . "hoge")) 21 | ((regexp . "fuga"))) 22 | :action-name pophint--default-action-name 23 | :direction 'around 24 | :allwindow t 25 | :not-switch-window t))) 26 | (stub pophint--event-loop => nil) 27 | (let ((pophint:switch-direction-p t) 28 | (pophint:do-allwindow-p t) 29 | (pophint:select-source-method nil)) 30 | (pophint:do :sources '(((regexp . "hoge")) 31 | ((regexp . "fuga")))))) 32 | (desc "do get-hint has source") 33 | (expect (mock (pophint--get-hints 34 | (make-pophint--condition :source '((regexp . "fuga")) 35 | :action-name pophint--default-action-name 36 | :direction 'around 37 | :allwindow t 38 | :not-switch-window t 39 | :not-switch-source t))) 40 | (stub pophint--event-loop => nil) 41 | (let ((pophint:switch-direction-p t) 42 | (pophint:do-allwindow-p t) 43 | (pophint:select-source-method nil)) 44 | (pophint:do :source '((regexp . "fuga"))))) 45 | (desc "do get-hint has sources/source") 46 | (expect (mock (pophint--get-hints 47 | (make-pophint--condition :source '((regexp . "hoge")) 48 | :sources '(((regexp . "fuga")) 49 | ((regexp . "bar"))) 50 | :action-name pophint--default-action-name 51 | :direction 'around 52 | :allwindow t 53 | :not-switch-window t))) 54 | (stub pophint--event-loop => nil) 55 | (let ((pophint:switch-direction-p t) 56 | (pophint:do-allwindow-p t) 57 | (pophint:select-source-method nil)) 58 | (pophint:do :source '((regexp . "hoge")) 59 | :sources '(((regexp . "fuga")) 60 | ((regexp . "bar")))))) 61 | (desc "do get-hint not-switch-direction when not pophint:switch-direction-p") 62 | (expect (mock (pophint--get-hints 63 | (make-pophint--condition :source pophint--default-source 64 | :action-name pophint--default-action-name 65 | :direction 'around 66 | :allwindow t 67 | :not-switch-direction t 68 | :not-switch-window t))) 69 | (stub pophint--event-loop => nil) 70 | (let ((pophint:switch-direction-p nil) 71 | (pophint:do-allwindow-p t) 72 | (pophint:select-source-method nil)) 73 | (pophint:do))) 74 | (desc "do get-hint use current direction when pophint:switch-direction-p") 75 | (expect (mock (pophint--get-hints 76 | (make-pophint--condition :source pophint--default-source 77 | :action-name pophint--default-action-name 78 | :direction 'forward 79 | :allwindow t 80 | :not-switch-window t))) 81 | (stub pophint--event-loop => nil) 82 | (stub pophint:get-current-direction => 'forward) 83 | (let ((pophint:switch-direction-p t) 84 | (pophint:do-allwindow-p t) 85 | (pophint:select-source-method nil)) 86 | (pophint:do))) 87 | (desc "do get-hint has direction") 88 | (expect (mock (pophint--get-hints 89 | (make-pophint--condition :source pophint--default-source 90 | :action-name pophint--default-action-name 91 | :direction 'hogedirection 92 | :allwindow t 93 | :not-switch-direction t 94 | :not-switch-window t))) 95 | (stub pophint--event-loop => nil) 96 | (let ((pophint:switch-direction-p t) 97 | (pophint:do-allwindow-p t) 98 | (pophint:select-source-method nil)) 99 | (pophint:do :direction 'hogedirection))) 100 | (desc "do get-hint has window") 101 | (expect (mock (pophint--get-hints 102 | (make-pophint--condition :source pophint--default-source 103 | :action-name pophint--default-action-name 104 | :direction 'around 105 | :window 'hogewnd 106 | :not-switch-window t))) 107 | (stub pophint--event-loop => nil) 108 | (setq pophint--last-condition nil) 109 | (let ((pophint:switch-direction-p t) 110 | (pophint:do-allwindow-p t) 111 | (pophint:select-source-method nil)) 112 | (pophint:do :window 'hogewnd))) 113 | (desc "do get-hint in single window when not pophint:do-allwindow-p") 114 | (expect (mock (pophint--get-hints 115 | (make-pophint--condition :source pophint--default-source 116 | :action-name pophint--default-action-name 117 | :direction 'around 118 | :not-switch-window t))) 119 | (stub pophint--event-loop => nil) 120 | (let ((pophint:switch-direction-p t) 121 | (pophint:do-allwindow-p nil) 122 | (pophint:select-source-method nil)) 123 | (pophint:do))) 124 | (desc "do get-hint in multi window when not pophint:do-allwindow-p") 125 | (expect (mock (pophint--get-hints 126 | (make-pophint--condition :source pophint--default-source 127 | :action-name pophint--default-action-name 128 | :direction 'around))) 129 | (stub pophint--event-loop => nil) 130 | (let ((pophint:switch-direction-p t) 131 | (pophint:do-allwindow-p nil) 132 | (pophint:select-source-method nil)) 133 | (split-window) 134 | (pophint:do))) 135 | (desc "do get-hint in multi window when pophint:do-allwindow-p") 136 | (expect (mock (pophint--get-hints 137 | (make-pophint--condition :source pophint--default-source 138 | :action-name pophint--default-action-name 139 | :direction 'around 140 | :allwindow t 141 | :not-switch-window t))) 142 | (stub pophint--event-loop => nil) 143 | (let ((pophint:switch-direction-p t) 144 | (pophint:do-allwindow-p t) 145 | (pophint:select-source-method nil)) 146 | (pophint:do))) 147 | (desc "do get-hint pophint--enable-allwindow-p") 148 | (expect (mock (pophint--get-hints 149 | (make-pophint--condition :source pophint--default-source 150 | :action-name pophint--default-action-name 151 | :direction 'around 152 | :allwindow t 153 | :not-switch-window t))) 154 | (stub pophint--event-loop => nil) 155 | (let ((pophint:switch-direction-p t) 156 | (pophint:do-allwindow-p nil) 157 | (pophint--enable-allwindow-p t) 158 | (pophint:select-source-method nil)) 159 | (pophint:do))) 160 | (desc "do get-hint allwindow option") 161 | (expect (mock (pophint--get-hints 162 | (make-pophint--condition :source pophint--default-source 163 | :action-name pophint--default-action-name 164 | :direction 'around 165 | :allwindow t 166 | :not-switch-window t))) 167 | (stub pophint--event-loop => nil) 168 | (let ((pophint:switch-direction-p t) 169 | (pophint:do-allwindow-p nil) 170 | (pophint:select-source-method nil)) 171 | (pophint:do :allwindow t))) 172 | (desc "do get-hint allwindow option") 173 | (expect (mock (pophint--get-hints 174 | (make-pophint--condition :source pophint--default-source 175 | :action-name pophint--default-action-name 176 | :direction 'around))) 177 | (stub pophint--event-loop => nil) 178 | (let ((pophint:switch-direction-p t) 179 | (pophint:do-allwindow-p nil) 180 | (pophint--disable-allwindow-p t) 181 | (pophint:select-source-method nil)) 182 | (pophint:do :allwindow t))) 183 | ) 184 | 185 | 186 | (expectations 187 | (desc "do event-loop not argument") 188 | (expect (mock (pophint--event-loop 189 | 'hogehints 190 | (make-pophint--condition :source pophint--default-source 191 | :sources nil 192 | :action nil 193 | :action-name pophint--default-action-name 194 | :direction 'around 195 | :not-switch-direction t 196 | :not-switch-window t))) 197 | (stub pophint--get-hints => 'hogehints) 198 | (stub pophint--show-hint-tips => nil) 199 | (stub pophint--do-action => nil) 200 | (let ((pophint:switch-direction-p nil) 201 | (pophint:do-allwindow-p nil)) 202 | (delete-other-windows) 203 | (pophint:do))) 204 | (desc "do event-loop has argument") 205 | (expect (mock (pophint--event-loop 206 | 'hogehints 207 | (make-pophint--condition :source '((regexp . "hoge")) 208 | :sources '(((regexp . "fuga")) 209 | ((regexp . "bar"))) 210 | :action '(lambda (hint) (message "hoge")) 211 | :action-name "Test" 212 | :direction 'hogedirection 213 | :window 'hogewnd 214 | :not-switch-direction t 215 | :not-switch-window t))) 216 | (stub pophint--get-hints => 'hogehints) 217 | (stub pophint--show-hint-tips => nil) 218 | (stub pophint--do-action => nil) 219 | (let ((pophint:switch-direction-p t) 220 | (pophint:do-allwindow-p nil) 221 | (pophint:select-source-method nil)) 222 | (split-window) 223 | (pophint:do :source '((regexp . "hoge")) 224 | :sources '(((regexp . "fuga")) 225 | ((regexp . "bar"))) 226 | :action '(lambda (hint) (message "hoge")) 227 | :action-name "Test" 228 | :direction 'hogedirection 229 | :window 'hogewnd 230 | :not-switch-window t))) 231 | ) 232 | 233 | 234 | (expectations 235 | (desc "do do-action not argument") 236 | (expect (mock (pophint--do-action 'hogehint pophint--default-action)) 237 | (stub pophint--get-hints => nil) 238 | (stub pophint--show-hint-tips => nil) 239 | (stub pophint--event-loop => 'hogehint) 240 | (pophint:do)) 241 | (desc "do do-action not has action source") 242 | (expect (mock (pophint--do-action 'hogehint pophint--default-action)) 243 | (stub pophint--get-hints => nil) 244 | (stub pophint--show-hint-tips => nil) 245 | (stub pophint--event-loop => 'hogehint) 246 | (pophint:do :source '((regexp . "hoge")))) 247 | (desc "do do-action has action source") 248 | (expect (mock (pophint--do-action 'hogehint '(lambda (hint) (message "hoge")))) 249 | (stub pophint--get-hints => nil) 250 | (stub pophint--show-hint-tips => nil) 251 | (stub pophint--event-loop => 'hogehint) 252 | (pophint:do :source '((regexp . "hoge") 253 | (action . (lambda (hint) (message "hoge")))))) 254 | (desc "do do-action has action and has action source") 255 | (expect (mock (pophint--do-action 'hogehint '(lambda (hint) (message "fuga")))) 256 | (stub pophint--get-hints => nil) 257 | (stub pophint--show-hint-tips => nil) 258 | (stub pophint--event-loop => 'hogehint) 259 | (pophint:do :source '((regexp . "hoge") 260 | (action . (lambda (hint) (message "hoge")))) 261 | :action '(lambda (hint) (message "fuga")))) 262 | ) 263 | 264 | -------------------------------------------------------------------------------- /test/event-loop.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "event-loop nil") 6 | (expect (mock (pophint--deletes *)) 7 | (stub pophint--menu-read-key-sequence => nil) 8 | (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2)) 9 | (make-pophint--condition))) 10 | (desc "event-loop empty") 11 | (expect (mock (pophint--deletes *)) 12 | (stub pophint--menu-read-key-sequence => (kbd "")) 13 | (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2)) 14 | (make-pophint--condition))) 15 | (desc "event-loop quit") 16 | (expect (mock (keyboard-quit)) 17 | (stub pophint--menu-read-key-sequence => (kbd "q")) 18 | (stub lookup-key => 'keyboard-quit) 19 | (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2)) 20 | (make-pophint--condition))) 21 | (desc "event-loop return first hint no return from no input") 22 | (expect nil 23 | (stub pophint--menu-read-key-sequence => (kbd "q")) 24 | (stub lookup-key => 'newline) 25 | (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2) 26 | (make-pophint:hint :value "fuga" :startpt 1 :endpt 2)) 27 | (make-pophint--condition))) 28 | (desc "event-loop return first hint return when inputed") 29 | (expect nil 30 | (stub pophint--menu-read-key-sequence => (kbd "q")) 31 | (stub lookup-key => 'newline) 32 | (let* ((ret (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2) 33 | (make-pophint:hint :value "fuga" :startpt 1 :endpt 2)) 34 | (make-pophint--condition) 35 | "q"))) 36 | (and (pophint:hint-p ret) 37 | (pophint:hint-value ret)))) 38 | (desc "event-loop restart hint") 39 | (expect (mock (pophint--let-user-select 40 | (make-pophint--condition :source '((regexp . "hoge"))))) 41 | (stub pophint--menu-read-key-sequence => (kbd "q")) 42 | (stub lookup-key => 'delete-backward-char) 43 | (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2)) 44 | (make-pophint--condition :source '((regexp . "hoge"))))) 45 | (desc "event-loop switch direction from forward") 46 | (expect (mock (pophint--let-user-select 47 | (make-pophint--condition :source '((regexp . "hoge")) 48 | :direction 'backward))) 49 | (stub pophint--menu-read-key-sequence => (kbd "d")) 50 | (pophint--event-loop nil 51 | (make-pophint--condition :source '((regexp . "hoge")) 52 | :direction 'forward))) 53 | (desc "event-loop switch direction from backward") 54 | (expect (mock (pophint--let-user-select 55 | (make-pophint--condition :source '((regexp . "hoge")) 56 | :direction 'around))) 57 | (stub pophint--menu-read-key-sequence => (kbd "d")) 58 | (pophint--event-loop nil 59 | (make-pophint--condition :source '((regexp . "hoge")) 60 | :direction 'backward))) 61 | (desc "event-loop switch direction from around") 62 | (expect (mock (pophint--let-user-select 63 | (make-pophint--condition :source '((regexp . "hoge")) 64 | :direction 'forward))) 65 | (stub pophint--menu-read-key-sequence => (kbd "d")) 66 | (pophint--event-loop nil 67 | (make-pophint--condition :source '((regexp . "hoge")) 68 | :direction 'around))) 69 | (desc "event-loop switch direction from else") 70 | (expect (mock (pophint--let-user-select 71 | (make-pophint--condition :source '((regexp . "hoge")) 72 | :direction 'around))) 73 | (stub pophint--menu-read-key-sequence => (kbd "d")) 74 | (pophint--event-loop nil 75 | (make-pophint--condition :source '((regexp . "hoge"))))) 76 | ;; (desc "event-loop switch window not exist source") 77 | ;; (expect (mock (pophint--let-user-select 78 | ;; (make-pophint--condition :source nil 79 | ;; :sources '(((regexp . "HOGEGE")) 80 | ;; ((regexp . "FUGAGA"))) 81 | ;; :window 'hogewnd))) 82 | ;; (stub pophint--menu-read-key-sequence => (kbd "w")) 83 | ;; (stub next-window => 'hogewnd) 84 | ;; (stub pophint--get-available-sources => '(((regexp . "HOGEGE")) 85 | ;; ((regexp . "FUGAGA")))) 86 | ;; (save-window-excursion 87 | ;; (delete-other-windows) 88 | ;; (switch-to-buffer-other-window "*Messages*") 89 | ;; (let ((pophint:select-source-method nil) 90 | ;; (pophint:switch-source-delay nil)) 91 | ;; (pophint--event-loop nil 92 | ;; (make-pophint--condition :source '((regexp . "fuga")) 93 | ;; :sources '(((regexp . "fuga")) 94 | ;; ((regexp . "bar")))))))) 95 | (desc "event-loop switch window exist source") 96 | (expect (mock (pophint--let-user-select 97 | (make-pophint--condition :source '((regexp . "FUGAGA")) 98 | :sources '(((regexp . "HOGEGE")) 99 | ((regexp . "FUGAGA"))) 100 | :window 'hogewnd))) 101 | (stub pophint--menu-read-key-sequence => (kbd "w")) 102 | (stub next-window => 'hogewnd) 103 | (stub pophint--get-available-sources => '(((regexp . "HOGEGE")) 104 | ((regexp . "FUGAGA")))) 105 | (save-window-excursion 106 | (delete-other-windows) 107 | (switch-to-buffer-other-window "*Messages*") 108 | (let ((pophint:select-source-method nil) 109 | (pophint:switch-source-delay nil)) 110 | (pophint--event-loop nil 111 | (make-pophint--condition :source '((regexp . "FUGAGA")) 112 | :sources '(((regexp . "fuga")) 113 | ((regexp . "bar")))))))) 114 | (desc "event-loop switch source not match") 115 | (expect (mock (pophint--let-user-select 116 | (make-pophint--condition :source '((regexp . "fuga")) 117 | :sources '(((regexp . "fuga")) 118 | ((regexp . "bar")))))) 119 | (stub pophint--menu-read-key-sequence => (kbd "s")) 120 | (let ((pophint:select-source-method nil) 121 | (pophint:switch-source-delay nil)) 122 | (pophint--event-loop nil 123 | (make-pophint--condition :source '((regexp . "hoge")) 124 | :sources '(((regexp . "fuga")) 125 | ((regexp . "bar"))))))) 126 | (desc "event-loop switch source match") 127 | (expect (mock (pophint--let-user-select 128 | (make-pophint--condition :source '((regexp . "bar")) 129 | :sources '(((regexp . "fuga")) 130 | ((regexp . "bar")))))) 131 | (stub pophint--menu-read-key-sequence => (kbd "s")) 132 | (let ((pophint:select-source-method nil) 133 | (pophint:switch-source-delay nil)) 134 | (pophint--event-loop nil 135 | (make-pophint--condition :source '((regexp . "fuga")) 136 | :sources '(((regexp . "fuga")) 137 | ((regexp . "bar"))))))) 138 | (desc "event-loop select source use-source-char") 139 | (expect (mock (pophint--let-user-select 140 | (make-pophint--condition :source '((regexp . "bar") (selector . "2")) 141 | :sources '(((regexp . "fuga") (selector . "1")) 142 | ((regexp . "bar") (selector . "2")))))) 143 | (stub pophint--menu-read-key-sequence => (kbd "2")) 144 | (let ((pophint:select-source-method 'use-source-char)) 145 | (pophint--event-loop nil 146 | (make-pophint--condition :source '((regexp . "hoge")) 147 | :sources '(((regexp . "fuga") (selector . "1")) 148 | ((regexp . "bar") (selector . "2"))))))) 149 | (desc "event-loop select source use-popup-char") 150 | (expect (mock (pophint--let-user-select 151 | (make-pophint--condition :source '((regexp . "fuga") (selector . "h")) 152 | :sources '(((regexp . "fuga") (selector . "h")) 153 | ((regexp . "bar") (selector . "j")))))) 154 | (stub pophint--menu-read-key-sequence => (kbd "h")) 155 | (let ((pophint:select-source-method 'use-popup-char)) 156 | (pophint--event-loop nil 157 | (make-pophint--condition :source '((regexp . "hoge")) 158 | :sources '(((regexp . "fuga") (selector . "h")) 159 | ((regexp . "bar") (selector . "j")))) 160 | "" 161 | t))) 162 | (desc "event-loop some command") 163 | (expect (mock (call-interactively 'forward-char)) 164 | (stub pophint--menu-read-key-sequence => (kbd "q")) 165 | (stub lookup-key => 'forward-char) 166 | (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2)) 167 | (make-pophint--condition))) 168 | (desc "event-loop detect hint") 169 | (expect "hoge" 170 | (let* ((ret (pophint--event-loop (list (make-pophint:hint :value "hoge" :startpt 1 :endpt 2)) 171 | (make-pophint--condition) 172 | "q"))) 173 | (and (pophint:hint-p ret) 174 | (pophint:hint-value ret)))) 175 | ) 176 | 177 | -------------------------------------------------------------------------------- /test/get-hints.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'tenv) 3 | (require 'el-expectations) 4 | 5 | (expectations 6 | (desc "get-hints around") 7 | (expect 3 8 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" t t)) 9 | (buff (progn (tenv-update-file tfile t 10 | "This is a hoge.\n" 11 | "This is a fuga.\n" 12 | "This is a bar.\n") 13 | (find-file-noselect tfile))) 14 | (ret (save-window-excursion 15 | (switch-to-buffer-other-window buff) 16 | (with-current-buffer buff 17 | (goto-char (point-min)) 18 | (forward-line) 19 | (pophint--get-hints 20 | (make-pophint--condition :source '((regexp . "a\\s-+[a-z]+")) 21 | :direction 'around)))))) 22 | (length ret))) 23 | (desc "get-hints forward") 24 | (expect 2 25 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" nil nil)) 26 | (buff (find-file-noselect tfile)) 27 | (ret (save-window-excursion 28 | (switch-to-buffer-other-window buff) 29 | (with-current-buffer buff 30 | (goto-char (point-min)) 31 | (forward-line) 32 | (pophint--get-hints 33 | (make-pophint--condition :source '((regexp . "a\\s-+[a-z]+")) 34 | :direction 'forward)))))) 35 | (length ret))) 36 | (desc "get-hints backward") 37 | (expect 1 38 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" nil nil)) 39 | (buff (find-file-noselect tfile)) 40 | (ret (save-window-excursion 41 | (switch-to-buffer-other-window buff) 42 | (with-current-buffer buff 43 | (goto-char (point-min)) 44 | (forward-line) 45 | (pophint--get-hints 46 | (make-pophint--condition :source '((regexp . "a\\s-+[a-z]+")) 47 | :direction 'backward)))))) 48 | (length ret))) 49 | (desc "get-hints value startpt endpt") 50 | (expect '("a hoge" 9 15) 51 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" nil nil)) 52 | (buff (find-file-noselect tfile)) 53 | (ret (save-window-excursion 54 | (switch-to-buffer-other-window buff) 55 | (with-current-buffer buff 56 | (goto-char (point-min)) 57 | (forward-line) 58 | (pophint--get-hints 59 | (make-pophint--condition :source '((regexp . "a\\s-+[a-z]+")) 60 | :direction 'backward))))) 61 | (hint (pop ret))) 62 | (and (pophint:hint-p hint) 63 | (list (pophint:hint-value hint) 64 | (pophint:hint-startpt hint) 65 | (pophint:hint-endpt hint))))) 66 | (desc "get-hints has group regexp") 67 | (expect '("hoge" 11 15) 68 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" nil nil)) 69 | (buff (find-file-noselect tfile)) 70 | (ret (save-window-excursion 71 | (switch-to-buffer-other-window buff) 72 | (with-current-buffer buff 73 | (goto-char (point-min)) 74 | (forward-line) 75 | (pophint--get-hints 76 | (make-pophint--condition :source '((regexp . "a\\s-+\\([a-z]+\\)")) 77 | :direction 'backward))))) 78 | (hint (pop ret))) 79 | (and (pophint:hint-p hint) 80 | (list (pophint:hint-value hint) 81 | (pophint:hint-startpt hint) 82 | (pophint:hint-endpt hint))))) 83 | (desc "get-hints use method") 84 | (expect '("fuga" 2 7) 85 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" nil nil)) 86 | (buff (find-file-noselect tfile)) 87 | (ret (save-window-excursion 88 | (switch-to-buffer-other-window buff) 89 | (with-current-buffer buff 90 | (goto-char (point-min)) 91 | (forward-line) 92 | (pophint--get-hints 93 | (make-pophint--condition :source '((regexp . "a\\s-+\\([a-z]+\\)") 94 | (method . (lambda () 95 | (when (re-search-backward "hoge" nil t) 96 | (make-pophint:hint :value "fuga" 97 | :startpt 2 98 | :endpt 7))))) 99 | :direction 'backward))))) 100 | (hint (pop ret))) 101 | (and (pophint:hint-p hint) 102 | (list (pophint:hint-value hint) 103 | (pophint:hint-startpt hint) 104 | (pophint:hint-endpt hint))))) 105 | (desc "get-hints window") 106 | (expect 0 107 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" nil nil)) 108 | (tfile2 (tenv-get-tmp-file "pophint" "test2.txt" t t)) 109 | (buff (find-file-noselect tfile)) 110 | (buff2 (find-file-noselect tfile2)) 111 | (ret (save-window-excursion 112 | (switch-to-buffer-other-window buff2) 113 | (switch-to-buffer-other-window buff) 114 | (with-current-buffer buff 115 | (goto-char (point-min)) 116 | (forward-line) 117 | (pophint--get-hints 118 | (make-pophint--condition :source '((regexp . "a\\s-+\\([a-z]+\\)")) 119 | :direction 'backward 120 | :window (get-buffer-window buff2))))))) 121 | (length ret))) 122 | (desc "get-hints popup created") 123 | (expect t 124 | (let* ((tfile (tenv-get-tmp-file "pophint" "test.txt" nil nil)) 125 | (tfile2 (tenv-get-tmp-file "pophint" "test2.txt" t t)) 126 | (buff (find-file-noselect tfile)) 127 | (buff2 (find-file-noselect tfile2)) 128 | (hints (save-window-excursion 129 | (switch-to-buffer-other-window buff2) 130 | (switch-to-buffer-other-window buff) 131 | (with-current-buffer buff 132 | (goto-char (point-min)) 133 | (forward-line) 134 | (let ((hints (pophint--get-hints 135 | (make-pophint--condition :source '((regexp . "a\\s-+\\([a-z]+\\)")) 136 | :direction 'backward)))) 137 | (pophint--show-hint-tips hints nil) 138 | hints)))) 139 | (hint (pop hints))) 140 | (and (pophint:hint-p hint) 141 | (popup-p (pophint:hint-popup hint))))) 142 | ) 143 | 144 | -------------------------------------------------------------------------------- /test/make-index-char-string.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "make-index-char-string first") 6 | (expect "h" 7 | (pophint--make-index-char-string 0 "hjkl")) 8 | (desc "make-index-char-string next") 9 | (expect "j" 10 | (pophint--make-index-char-string 1 "hjkl")) 11 | (desc "make-index-char-string 2 length") 12 | (expect "kk" 13 | (pophint--make-index-char-string 10 "hjkl")) 14 | (desc "make-index-char-string 3 length") 15 | (expect "jkjh" 16 | (pophint--make-index-char-string 100 "hjkl")) 17 | (desc "make-index-char-string not char-list") 18 | (expect "" 19 | (pophint--make-index-char-string 1 "")) 20 | ) 21 | 22 | -------------------------------------------------------------------------------- /test/make-prompt-interactively.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "make-prompt-interactively default") 6 | (expect "Select ch. Actions[1] :Default " 7 | (setq pophint--action-hash (make-hash-table :test 'equal)) 8 | (pophint--make-prompt-interactively)) 9 | (desc "make-prompt-interactively 1 action") 10 | (expect "Select ch. Actions[2] :Default y:Yank " 11 | (pophint:defaction :key "y" 12 | :name "Yank" 13 | :action '(lambda (hint) (yank))) 14 | (pophint--make-prompt-interactively)) 15 | (desc "make-prompt-interactively 2 action") 16 | (expect "Select ch. Actions[3] :Default y:Yank T:Test of PopHint " 17 | (pophint:defaction :key "T" 18 | :name "Test of PopHint" 19 | :action '(lambda (hint) (message "test"))) 20 | (pophint--make-prompt-interactively)) 21 | ) 22 | 23 | -------------------------------------------------------------------------------- /test/make-prompt.el: -------------------------------------------------------------------------------- 1 | (require 'pophint) 2 | (require 'el-expectations) 3 | 4 | (expectations 5 | (desc "make-prompt default") 6 | (expect "Select ch. Hints[0] Act[Go/SrcAct] Src[*None*] d/D:SwDrct(around|forward|backward) w:SwWnd " 7 | (pophint--make-prompt (make-pophint--condition 8 | :action-name pophint--default-action-name) 9 | 0)) 10 | (desc "make-prompt action-name") 11 | (expect "Select ch. Hints[0] Act[HogeAct] Src[*None*] d/D:SwDrct(around|forward|backward) w:SwWnd " 12 | (pophint--make-prompt (make-pophint--condition 13 | :action-name "HogeAct") 14 | 0)) 15 | (desc "make-prompt sources") 16 | (expect "Select ch. Hints[789] Act[Go/SrcAct] s/S:SwSrc(hoge|fuga|bar) d/D:SwDrct(around|forward|backward) w:SwWnd " 17 | (pophint--make-prompt (make-pophint--condition 18 | :source '((shown . "hoge")) 19 | :sources '(((shown . "hoge")) ((shown . "fuga")) ((shown . "bar"))) 20 | :action-name pophint--default-action-name) 21 | 789)) 22 | (desc "make-prompt source has not shown") 23 | (expect "Select ch. Hints[789] Act[Go/SrcAct] s/S:SwSrc(hoge|*None*|bar) d/D:SwDrct(around|forward|backward) w:SwWnd " 24 | (pophint--make-prompt (make-pophint--condition 25 | :source '((regexp . "hoge")) 26 | :sources '(((shown . "hoge")) ((regexp . "fuga")) ((shown . "bar"))) 27 | :action-name pophint--default-action-name) 28 | 789)) 29 | (desc "make-prompt not-switch-source") 30 | (expect "Select ch. Hints[789] Act[Go/SrcAct] Src[hoge] d/D:SwDrct(around|forward|backward) w:SwWnd " 31 | (pophint--make-prompt (make-pophint--condition 32 | :source '((shown . "hoge")) 33 | :sources '(((shown . "hoge")) ((shown . "fuga")) ((shown . "bar"))) 34 | :action-name pophint--default-action-name 35 | :not-switch-source t) 36 | 789)) 37 | (desc "make-prompt not-switch-source and source has not shown") 38 | (expect "Select ch. Hints[789] Act[Go/SrcAct] Src[*None*] d/D:SwDrct(around|forward|backward) w:SwWnd " 39 | (pophint--make-prompt (make-pophint--condition 40 | :source '((regexp . "hoge")) 41 | :sources '(((shown . "hoge")) ((regexp . "fuga")) ((shown . "bar"))) 42 | :action-name pophint--default-action-name 43 | :not-switch-source t) 44 | 789)) 45 | (desc "make-prompt not-switch-direction") 46 | (expect "Select ch. Hints[789] Act[Go/SrcAct] s/S:SwSrc(hoge|fuga|bar) w:SwWnd " 47 | (pophint--make-prompt (make-pophint--condition 48 | :source '((shown . "hoge")) 49 | :sources '(((shown . "hoge")) ((shown . "fuga")) ((shown . "bar"))) 50 | :action-name pophint--default-action-name 51 | :not-switch-direction t) 52 | 789)) 53 | (desc "make-prompt not-switch-window") 54 | (expect "Select ch. Hints[789] Act[Go/SrcAct] s/S:SwSrc(hoge|fuga|bar) d/D:SwDrct(around|forward|backward) " 55 | (pophint--make-prompt (make-pophint--condition 56 | :source '((shown . "hoge")) 57 | :sources '(((shown . "hoge")) ((shown . "fuga")) ((shown . "bar"))) 58 | :action-name pophint--default-action-name 59 | :not-switch-window t) 60 | 789)) 61 | (desc "make-prompt sources has selector") 62 | (expect "Select ch. Hints[789] Act[Go/SrcAct] s/S:SwSrc(A:hoge|b:fuga|9:bar) d/D:SwDrct(around|forward|backward) w:SwWnd " 63 | (pophint--make-prompt (make-pophint--condition 64 | :source '((shown . "hoge")) 65 | :sources '(((shown . "hoge") (selector . "A")) 66 | ((shown . "fuga") (selector . "b")) 67 | ((shown . "bar") (selector . "9"))) 68 | :action-name pophint--default-action-name) 69 | 789)) 70 | (desc "make-prompt not pophint:switch-source-reverse-char") 71 | (expect "Select ch. Hints[789] Act[Go/SrcAct] s:SwSrc(hoge|fuga|bar) d/D:SwDrct(around|forward|backward) w:SwWnd " 72 | (let ((pophint:switch-source-reverse-char nil)) 73 | (pophint--make-prompt (make-pophint--condition 74 | :source '((shown . "hoge")) 75 | :sources '(((shown . "hoge")) ((shown . "fuga")) ((shown . "bar"))) 76 | :action-name pophint--default-action-name) 77 | 789))) 78 | ) 79 | 80 | --------------------------------------------------------------------------------