(when (and (eq system-type 'windows-nt)
(or (display-graphic-p)
(daemonp)))
(ignore-error 'file-missing
;; 把 DLL 加到 `load-path' 里.
(load-library "pop_select.dll")))自行编译的话c++编译器至少需要支持c++17。可以直接用Release里编译好的64位dll。
本Emacs module专为windows设计。主要功能有：
(!!文档更新可能不及时，请自行F1 f搜索查看pop-select/开头的函数定义)
有两种方式
- 设置整个emacs透明。
(pop-select/transparent-set-all-frame ALPHA) ;; 对所有frame设置透明，ALPHA范围0-255，0全透明，255不透明
(pop-select/transparent-set-current-frame ALPHA) ;; 只对当前frame设置透明，其它同上示例设置：
(when (functionp 'pop-select/transparent-set-all-frame)
(pop-select/transparent-set-all-frame 220))- [有bug不建议使用!]设置文字不透明，背景透明。由于实现的限制，该功能打开时会使Emacs置顶，当设置为255即不透明时取消置顶
(pop-select/transparent-set-background ALPHA R G B) ;; ALPHA范围0-255，0全透明，255不透明。R G B为rgb拆分数值。示例设置，用CTRL+鼠标滚轮调整当前的透明度：
(ignore-errors (module-load "pop_select.dll全路径，如果没有加入bin路径的话"))
(when (functionp 'pop-select/transparent-set-background)
(defvar cur-transparent 255)
(defconst step-transparent 20)
(defun dec-transparent()
(interactive)
(setq cur-transparent (min 255 (+ cur-transparent step-transparent)))
(let* ((rgb (color-name-to-rgb (face-background 'default)))
(r (round (*(nth 0 rgb) 255)))
(g (round (*(nth 1 rgb) 255)))
(b (round (*(nth 2 rgb) 255))))
(pop-select/transparent-set-background cur-transparent r g b)
)
)
(defun inc-transparent()
(interactive)
(setq cur-transparent (max 0 (- cur-transparent step-transparent)))
(let* ((rgb (color-name-to-rgb (face-background 'default)))
(r (round (*(nth 0 rgb) 255)))
(g (round (*(nth 1 rgb) 255)))
(b (round (*(nth 2 rgb) 255))))
(pop-select/transparent-set-background cur-transparent r g b)
))
(global-set-key (kbd "<C-wheel-up>") 'dec-transparent)
(global-set-key (kbd "<C-wheel-down>") 'inc-transparent)
)后面这种效果图：
pop-select/pop-select弹出一个竖型列表窗口，然后可以按ctrl+tab切换到下一项，ctrl+tab+shift切换到上一项，释放按键后返回所选项给emacs
(pop-select/pop-select NAME TO-SEL) ;; NAME为vector列表，TO-SEL是初始选中哪项(when (fboundp 'pop-select/pop-select)
(defun my-pop-select(&optional backward)
(interactive)
(let* ((myswitch-buffer-list (copy-sequence (buffer-list)
)
) (vec_name [])
sel
)
(cl-dolist (buf myswitch-buffer-list)
(setq vec_name (vconcat vec_name (list (buffer-name buf)))))
;; 返回序号
(setq sel (pop-select/pop-select vec_name (if backward
(1- (length vec_name))
1
)))
(let ((buf (switch-to-buffer (nth sel myswitch-buffer-list))))
(when (and (bufferp buf) (featurep 'wcy-desktop))
(with-current-buffer buf
(when (eq major-mode 'not-loaded-yet)
(wcy-desktop-load-file))))
)
)
)
(global-set-key (kbd "<C-tab>") 'my-pop-select)
(global-set-key (if (string-equal system-type "windows-nt")
(kbd "<C-S-tab>")
(kbd "<C-S-iso-lefttab>"))
(lambda ()(interactive)
(my-pop-select t)))
)效果图：
用于替换beacon的闪烁效果，完全不卡Emacs窗口，因为是另起了一个专门的ui线程来画beacon。实现函数pop-select/beacon-blink和pop-select/beacon-set-parameters
(pop-select/beacon-set-parameters WIDTH HEIGHT R G B DURATION-STEP) ;; 可设置宽度，高度，rgb色，以及blink效果显示时间
(pop-select/beacon-blink X Y TIMER DELAY) ;; 在X, Y坐标显示TIMER时长，DELAY是延迟显示时间(when (fboundp 'pop-select/beacon-set-parameters)
;; 51afef
(pop-select/beacon-set-parameters 300 20 #x51 #xaf #xef 50)
(use-package beacon
:defer 1.5
:init
(setq beacon-blink-when-focused t)
(setq beacon-blink-delay 0.01)
(setq beacon-blink-duration 0.2)
(setq beacon-blink-when-window-scrolls nil) ; 开启了auto save，保存时都会闪故而屏蔽
:config
(beacon-mode 1)
(defadvice beacon-blink (around my-beacon-blink activate)
;; 目前偶尔不是emacs时也弹窗
;; (message (concat (symbol-name this-command) " " (symbol-name last-command)))
(when (frame-visible-p (window-frame)) ;; 可以阻止最小化时弹窗
(let ((p (window-absolute-pixel-position)))
(when p
(pop-select/beacon-blink (car p) ; x
(cdr p) ; y
(truncate (* beacon-blink-duration 1000)) ; timer
(truncate (* beacon-blink-delay 1000)) ; delay
))))))
)效果图跟上面一样：
调用(pop-select/ensure-all-window-dark-mode)即可，不过目前标题可能不会立即刷新，建议加个(w32-send-sys-command #xf030)最大化就可以了
弹出shell右键菜单
(pop-select/popup-shell-menu PATHS X Y SHOW-EXTRA-HEAD) ; PATHS是路径vector，X、Y即屏幕座标，如果都是0，那么会在当前鼠标指针位置弹出。SHOW-EXTRA-HEAD是不否显示额外的菜单。参考配置，仅供参考，我自用的不会及时更新在这里：
(when (functionp 'pop-select/popup-shell-menu)
(defun get-region-select-path()
"获取选中的路径，抄的dired-mark和dired-mark-files-in-region"
(let (paths)
(when (region-active-p)
(setq paths [])
(save-excursion
(let* ((beg (region-beginning))
(end (region-end))
(start (progn (goto-char beg) (line-beginning-position)))
(end (progn (goto-char end)
(if (if (eq dired-mark-region 'line)
(not (bolp))
(get-text-property (1- (point)) 'dired-filename))
(line-end-position)
(line-beginning-position))))
)
(goto-char start) ; assumed at beginning of line
(while (< (point) end)
;; Skip subdir line and following garbage like the `total' line:
(while (and (< (point) end) (dired-between-files))
(forward-line 1))
(if (and (not (looking-at-p dired-re-dot))
(dired-get-filename nil t))
(setq paths (vconcat paths (list (replace-regexp-in-string "/" "\\\\" (dired-get-filename nil t)))))
)
(forward-line 1))
)))
paths))
(defun get-select-or-current-path()
(let ((paths (get-region-select-path))
current)
(unless paths
(setq current (dired-get-filename nil t))
(when current
(setq paths [])
(setq paths (vconcat paths (list (replace-regexp-in-string "/" "\\\\" current)))))
)
paths))
(define-key dired-mode-map (kbd "<mouse-3>")
(lambda (event)
(interactive "e")
(let ((pt (posn-point (event-end event)))
(paths (get-region-select-path))
path)
(if paths
(pop-select/popup-shell-menu paths 0 0 1)
;; 单个文件直接跳过去
(select-window (posn-window (event-end event)))
(goto-char pt)
(setq path (dired-get-filename nil t))
(unless path ;可能是点击了空白处，那么就取当前目录
(setq path (dired-current-directory)))
(setq paths (vconcat paths (list (replace-regexp-in-string "/" "\\\\" path))))
;; 延迟调用使当前选中项更新hl-line等
(run-at-time 0.1 nil (lambda ()
(pop-select/popup-shell-menu paths 0 0 1)
))))))
(defun print-paths(vec)
(let ((len (length vec))
(s "")
(i 0))
(while (< i len)
(setq s (concat s "\n" (file-name-nondirectory (aref vec i)) ))
(setq i (1+ i)))
s))
(define-key dired-mode-map "c"
(lambda()
(interactive)
(let ((paths (get-select-or-current-path)))
(when paths
(pop-select/shell-copyfiles paths)
(message (concat "Copy: " (print-paths paths)))))))
(define-key dired-mode-map (kbd "C-w")
(lambda()
(interactive)
(let ((paths (get-select-or-current-path)))
(when paths
(pop-select/shell-cutfiles paths)
(message (concat "Cut: " (print-paths paths)))))))
(define-key dired-mode-map "v"
(lambda()
(interactive)
(let ((current-dir (dired-current-directory)))
(when current-dir
(pop-select/shell-pastefiles current-dir)
(message "Paste in: %S" current-dir)))))
)效果图：
shell copy功能，即explorer里按CTRL+C一样的效果：
(pop-select/shell-copyfiles PATHS) ; PATHS是路径vectorshell cut功能，即explorer里剪切功能：
(pop-select/shell-cutfiles PATHS) ; PATHS是路径vectorshell paste功能，即explorer里的CTRL+V一样的效果：
(pop-select/shell-pastefiles PATH) ; PATH目标路径(pop-select/beacon-animation X Y W H TIMER STEP R G B DIFF-MIN)
X: 坐标x值
Y: 坐标y值
W: 光标宽度
H: 光标高度
TIMER: 动画持续时间
STEP: 动画持续时间按多少份处理
R: 光标颜色RGB的R值
G: 光标颜色RGB的G值
B: 光标颜色RGB的B值
DIFF-MIN: 坐标差值最小值，小于这个值就不显示动画，可以排除光标小范围移动时显示动画
注意R G B不能设置为0 0 0即黑色，这是透明色会看不见
(pop-select/beacon-animation-update-pos X Y W H)
更新光标位置，比如一些命令你不想让它显示动画，就需要调用该函数更新位置，不然下次有光标动画时起始位置不对
配置参考：
(when (fboundp 'pop-select/beacon-animation)
(defun show-cursor-animation ()
(ignore-errors
(let* ((p (window-absolute-pixel-position))
(pp (point))
(x (car p))
(w
(if (equal cursor-type 'bar)
1
(if-let ((glyph
(when (< pp (point-max))
(aref
(font-get-glyphs
(font-at pp) pp (1+ pp))
0))))
(aref glyph 4)
(window-font-width))))
(h (line-pixel-height))
(y
(if header-line-format
(- (cdr p) h) ;; 修复开启`header-line-format'时y值不正确
(cdr p))))
(when p
(if (memq
this-command
'(mwheel-scroll
move-beginning-of-line
move-end-of-line)) ;; 某些命令不显示动画
(pop-select/beacon-animation-update-pos x y w h) ;; 不显示动画时只更新位置
(pop-select/beacon-animation
x y w h
100 ; timer
50 ; timer step
233 86 120 ; r g b
20 ; diff min，根据自己需要试验
))))))
(add-hook 'post-command-hook #'show-cursor-animation))根据背景色调整光标的残影的颜色
;;; -*- lexical-binding: t; -*-
(require 'cl-lib)
(when (and (eq system-type 'windows-nt)
(or (display-graphic-p)
(daemonp)))
(ignore-error 'file-missing
;; 把 DLL 加到 `load-path' 里.
(load-library "pop_select.dll")))
(with-eval-after-load "pop_select.dll"
(let ((cursor-animation-color-R 0)
(cursor-animation-color-G 0)
(cursor-animation-color-B 0)
cursor-animation?) ; 是否开启光标残影.
(add-hook 'window-scroll-functions
(lambda (_window _position)
"滚屏时关闭残影: 1. 节约性能; 2. 设置 `scroll-margin' 后, 滚屏时残影位置不准确."
(setq cursor-animation? nil)))
(add-hook 'post-command-hook
(lambda ()
(when-let ((window-absolute-pixel-position
(when (or cursor-animation?
(eq this-command 'recenter-top-bottom))
(window-absolute-pixel-position))))
(let ((line-pixel-height (line-pixel-height)))
(pop-select/beacon-animation
(car window-absolute-pixel-position) (if header-line-format
(- (cdr window-absolute-pixel-position)
line-pixel-height)
(cdr window-absolute-pixel-position))
(if (eq cursor-type 'bar)
1
(if-let ((glyph (let ((point (point)))
(when (< point (point-max))
(aref (font-get-glyphs (font-at point)
point (1+ point)) 0)))))
(aref glyph 4)
(window-font-width))) line-pixel-height
180 100
cursor-animation-color-R cursor-animation-color-G cursor-animation-color-B
;; 排除大约是单个半角字符的距离:
24)))
(setq cursor-animation? t)))
(letrec ((cursor-animation-color-setter
(lambda ()
(remove-hook 'server-after-make-frame-hook cursor-animation-color-setter)
(let ((cursor-animation-color-RGB
(cl-mapcar (let* ((ratio 0.5) ; 只需要修改此值.
(1-ratio (- 1 ratio)))
(lambda (cursor-color default-color)
"按照 ratio:(1-ratio) 的比例混合光标颜色和背景色."
(floor (* (+ (* ratio cursor-color)
(* 1-ratio default-color))
255.9999999999999))))
(color-name-to-rgb (face-background 'cursor))
(color-name-to-rgb (face-background 'default)))))
(setq cursor-animation-color-R (cl-first cursor-animation-color-RGB)
cursor-animation-color-G (cl-second cursor-animation-color-RGB)
cursor-animation-color-B (cl-third cursor-animation-color-RGB))))))
;; 如果是 daemon, 则必须等到第一个 visible frame 创建之后再设置残影的颜色.
(add-hook 'server-after-make-frame-hook cursor-animation-color-setter)
(unless (daemonp)
;; 如果不是 daemon, 确保大部分有关 face 的设置生效后再设置残影的颜色.
(add-hook 'emacs-startup-hook cursor-animation-color-setter 90))
(when (eq this-command 'eval-buffer)
;; 若要测试本文件, 直接将其拷贝到单独的 buffer, 然后执行 `eval-buffer'.
(funcall cursor-animation-color-setter)))))效果图：
