Klimi's new dotfiles with stow.
選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

1078 行
44 KiB

  1. ;;; helm-utils.el --- Utilities Functions for helm. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2012 ~ 2019 Thierry Volpiatto <thierry.volpiatto@gmail.com>
  3. ;; This program is free software; you can redistribute it and/or modify
  4. ;; it under the terms of the GNU General Public License as published by
  5. ;; the Free Software Foundation, either version 3 of the License, or
  6. ;; (at your option) any later version.
  7. ;; This program is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  10. ;; GNU General Public License for more details.
  11. ;; You should have received a copy of the GNU General Public License
  12. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  13. ;;; Code:
  14. (require 'cl-lib)
  15. (require 'helm)
  16. (require 'helm-help)
  17. (eval-when-compile (require 'dired))
  18. (declare-function helm-find-files-1 "helm-files.el" (fname &optional preselect))
  19. (declare-function popup-tip "ext:popup")
  20. (declare-function markdown-show-subtree "outline.el")
  21. (declare-function outline-show-subtree "outline.el")
  22. (declare-function org-reveal "org.el")
  23. (declare-function tab-bar-tabs "tab-bar.el")
  24. (declare-function tab-bar-select-tab "tab-bar.el")
  25. (defvar org-directory)
  26. (defvar winner-boring-buffers)
  27. (defvar helm-show-completion-overlay)
  28. (defgroup helm-utils nil
  29. "Utilities routines for Helm."
  30. :group 'helm)
  31. (defcustom helm-su-or-sudo "sudo"
  32. "What command to use for root access."
  33. :type 'string
  34. :group 'helm-utils)
  35. (defcustom helm-default-kbsize 1024.0
  36. "Default Kbsize to use for showing files size.
  37. It is a float, usually 1024.0 but could be 1000.0 on some systems."
  38. :group 'helm-utils
  39. :type 'float)
  40. (define-obsolete-variable-alias
  41. 'helm-highlight-number-lines-around-point
  42. 'helm-highlight-matches-around-point-max-lines
  43. "20160119")
  44. (defcustom helm-highlight-matches-around-point-max-lines 15
  45. "Number of lines around point where matched items are highlighted."
  46. :group 'helm-utils
  47. :type 'integer)
  48. (defcustom helm-buffers-to-resize-on-pa nil
  49. "A list of helm buffers where the helm-window should be reduced on persistent actions."
  50. :group 'helm-utils
  51. :type '(repeat (choice string)))
  52. (defcustom helm-resize-on-pa-text-height 12
  53. "The size of the helm-window when resizing on persistent action."
  54. :group 'helm-utils
  55. :type 'integer)
  56. (defcustom helm-sources-using-help-echo-popup '("Moccur" "Imenu in all buffers"
  57. "Ack-Grep" "AG" "RG" "Gid" "Git-Grep")
  58. "Show the buffer name or the filename in a popup at selection."
  59. :group 'helm-utils
  60. :type '(repeat (choice string)))
  61. (defcustom helm-html-decode-entities-function #'helm-html-decode-entities-string
  62. "Function used to decode html entities in html bookmarks.
  63. Helm comes by default with `helm-html-decode-entities-string', if you need something
  64. more sophisticated you can use `w3m-decode-entities-string' if available.
  65. In emacs itself org-entities seems broken and `xml-substitute-numeric-entities'
  66. supports only numeric entities."
  67. :group 'helm-utils
  68. :type 'function)
  69. (defvar helm-goto-line-before-hook '(helm-save-current-pos-to-mark-ring)
  70. "Run before jumping to line.
  71. This hook run when jumping from `helm-goto-line', `helm-etags-default-action',
  72. and `helm-imenu-default-action'.
  73. This allow you to retrieve a previous position after using the different helm
  74. tools for searching (etags, grep, gid, (m)occur etc...).
  75. By default positions are added to `mark-ring' you can also add to register
  76. by using instead (or adding) `helm-save-pos-to-register-before-jump'.
  77. In this case last position is added to the register
  78. `helm-save-pos-before-jump-register'.")
  79. (defvar helm-save-pos-before-jump-register ?_
  80. "The register where `helm-save-pos-to-register-before-jump' save position.")
  81. (defconst helm-html-entities-alist
  82. '(("&quot;" . 34) ;; "
  83. ("&gt;" . 62) ;; >
  84. ("&lt;" . 60) ;; <
  85. ("&amp;" . 38) ;; &
  86. ("&euro;" . 8364) ;; €
  87. ("&Yuml;" . 89) ;; Y
  88. ("&iexcl;" . 161) ;; ¡
  89. ("&cent;" . 162) ;; ¢
  90. ("&pound;" . 163) ;; £
  91. ("&curren;" . 164) ;; ¤
  92. ("&yen" . 165) ;; ¥
  93. ("&brvbar;" . 166) ;; ¦
  94. ("&sect;" . 167) ;; §
  95. ("&uml;" . 32) ;; SPC
  96. ("&copy;" . 169) ;; ©
  97. ("&ordf;" . 97) ;; a
  98. ("&laquo;" . 171) ;; «
  99. ("&not;" . 172) ;; ¬
  100. ("&masr;" . 174) ;; ®
  101. ("&deg;" . 176) ;; °
  102. ("&plusmn;" . 177) ;; ±
  103. ("&sup2;" . 50) ;; 2
  104. ("&sup3;" . 51) ;; 3
  105. ("&acute;" . 39) ;; '
  106. ("&micro;" . 956) ;; μ
  107. ("&para;" . 182) ;; ¶
  108. ("&middot;" . 183) ;; ·
  109. ("&cedil;" . 32) ;; SPC
  110. ("&sup1;" . 49) ;; 1
  111. ("&ordm;" . 111) ;; o
  112. ("&raquo;" . 187) ;; »
  113. ("&frac14;" . 49) ;; 1
  114. ("&frac12;" . 49) ;; 1
  115. ("&frac34;" . 51) ;; 3
  116. ("&iquest;" . 191) ;; ¿
  117. ("&Agrave;" . 192) ;; À
  118. ("&Aacute;" . 193) ;; Á
  119. ("&Acirc;" . 194) ;; Â
  120. ("&Atilde;" . 195) ;; Ã
  121. ("&Auml;" . 196) ;; Ä
  122. ("&Aring;" . 197) ;; Å
  123. ("&Aelig" . 198) ;; Æ
  124. ("&Ccedil;" . 199) ;; Ç
  125. ("&Egrave;" . 200) ;; È
  126. ("&Eacute;" . 201) ;; É
  127. ("&Ecirc;" . 202) ;; Ê
  128. ("&Euml;" . 203) ;; Ë
  129. ("&Igrave;" . 204) ;; Ì
  130. ("&Iacute;" . 205) ;; Í
  131. ("&Icirc;" . 206) ;; Î
  132. ("&Iuml;" . 207) ;; Ï
  133. ("&eth;" . 208) ;; Ð
  134. ("&Ntilde;" . 209) ;; Ñ
  135. ("&Ograve;" . 210) ;; Ò
  136. ("&Oacute;" . 211) ;; Ó
  137. ("&Ocirc;" . 212) ;; Ô
  138. ("&Otilde;" . 213) ;; Õ
  139. ("&Ouml;" . 214) ;; Ö
  140. ("&times;" . 215) ;; ×
  141. ("&Oslash;" . 216) ;; Ø
  142. ("&Ugrave;" . 217) ;; Ù
  143. ("&Uacute;" . 218) ;; Ú
  144. ("&Ucirc;" . 219) ;; Û
  145. ("&Uuml;" . 220) ;; Ü
  146. ("&Yacute;" . 221) ;; Ý
  147. ("&thorn;" . 222) ;; Þ
  148. ("&szlig;" . 223) ;; ß
  149. ("&agrave;" . 224) ;; à
  150. ("&aacute;" . 225) ;; á
  151. ("&acirc;" . 226) ;; â
  152. ("&atilde;" . 227) ;; ã
  153. ("&auml;" . 228) ;; ä
  154. ("&aring;" . 229) ;; å
  155. ("&aelig;" . 230) ;; æ
  156. ("&ccedil;" . 231) ;; ç
  157. ("&egrave;" . 232) ;; è
  158. ("&eacute;" . 233) ;; é
  159. ("&ecirc;" . 234) ;; ê
  160. ("&euml;" . 235) ;; ë
  161. ("&igrave;" . 236) ;; ì
  162. ("&iacute;" . 237) ;; í
  163. ("&icirc;" . 238) ;; î
  164. ("&iuml;" . 239) ;; ï
  165. ("&eth;" . 240) ;; ð
  166. ("&ntilde;" . 241) ;; ñ
  167. ("&ograve;" . 242) ;; ò
  168. ("&oacute;" . 243) ;; ó
  169. ("&ocirc;" . 244) ;; ô
  170. ("&otilde;" . 245) ;; õ
  171. ("&ouml;" . 246) ;; ö
  172. ("&divide;" . 247) ;; ÷
  173. ("&oslash;" . 248) ;; ø
  174. ("&ugrave;" . 249) ;; ù
  175. ("&uacute;" . 250) ;; ú
  176. ("&ucirc;" . 251) ;; û
  177. ("&uuml;" . 252) ;; ü
  178. ("&yacute;" . 253) ;; ý
  179. ("&thorn;" . 254) ;; þ
  180. ("&yuml;" . 255) ;; ÿ
  181. ("&reg;" . 174) ;; ®
  182. ("&shy;" . 173)) ;; ­
  183. "Table of html character entities and values.")
  184. (defvar helm-find-many-files-after-hook nil
  185. "Hook that run at end of `helm-find-many-files'.")
  186. ;;; Faces.
  187. ;;
  188. (defface helm-selection-line
  189. '((t (:inherit highlight :distant-foreground "black")))
  190. "Face used in the `helm-current-buffer' when jumping to candidate."
  191. :group 'helm-faces)
  192. (defface helm-match-item
  193. '((t (:inherit isearch)))
  194. "Face used to highlight item matched in a selected line."
  195. :group 'helm-faces)
  196. ;;; Utils functions
  197. ;;
  198. ;;
  199. (defcustom helm-window-prefer-horizontal-split nil
  200. "Maybe switch to other window vertically when non nil.
  201. Possible values are t, nil and `decide'.
  202. When t switch vertically.
  203. When nil switch horizontally.
  204. When `decide' try to guess if it is possible to switch vertically
  205. according to the setting of `split-width-threshold' and the size of
  206. the window from where splitting is done.
  207. Note that when using `decide' and `split-width-threshold' is nil, the
  208. behavior is the same that with a nil value."
  209. :group 'helm-utils
  210. :type '(choice
  211. (const :tag "Split window vertically" t)
  212. (const :tag "Split window horizontally" nil)
  213. (symbol :tag "Guess how to split window" 'decide)))
  214. (defcustom helm-window-show-buffers-function #'helm-window-default-split-fn
  215. "The default function to use when opening several buffers at once.
  216. It is typically used to rearrange windows."
  217. :group 'helm-utils
  218. :type '(choice
  219. (function :tag "Split windows vertically or horizontally"
  220. helm-window-default-split-fn)
  221. (function :tag "Split in alternate windows"
  222. helm-window-alternate-split-fn)
  223. (function :tag "Split windows in mosaic"
  224. helm-window-mosaic-fn)))
  225. (defun helm-window-show-buffers (buffers &optional other-window)
  226. "Show BUFFERS.
  227. If more than one buffer marked switch to these buffers in separate windows.
  228. If OTHER-WINDOW is non-nil, keep current buffer and switch to others buffers
  229. in separate windows.
  230. If a prefix arg is given split windows vertically."
  231. (let ((initial-ow-fn (if (cdr (window-list))
  232. #'switch-to-buffer-other-window
  233. #'helm-window-other-window)))
  234. (if (cdr buffers)
  235. (funcall helm-window-show-buffers-function buffers
  236. (and other-window initial-ow-fn))
  237. (if other-window
  238. (funcall initial-ow-fn (car buffers))
  239. (helm-buffers-switch-to-buffer-or-tab (car buffers))))))
  240. (defvar tab-bar-tab-name-function)
  241. (declare-function tab-bar-switch-to-tab "tab-bar.el")
  242. (declare-function tab-bar-tab-name-all "tab-bar.el")
  243. (defun helm-buffers-switch-to-buffer-or-tab (buffer)
  244. "Switch to BUFFER in its tab if some."
  245. (if (and (fboundp 'tab-bar-mode)
  246. helm-buffers-maybe-switch-to-tab)
  247. (let* ((tab-bar-tab-name-function #'tab-bar-tab-name-all)
  248. (tabs (tab-bar-tabs))
  249. (tab-names (mapcar (lambda (tab)
  250. (cdr (assq 'name tab)))
  251. tabs))
  252. (bname (buffer-name (get-buffer buffer)))
  253. (tab (helm-buffers--get-tab-from-name bname tabs)))
  254. (if (helm-buffers--buffer-in-tab-p bname tab-names)
  255. (progn
  256. (tab-bar-switch-to-tab (alist-get 'name tab))
  257. (select-window (get-buffer-window bname)))
  258. (switch-to-buffer buffer)))
  259. (switch-to-buffer buffer)))
  260. (defun helm-buffers--get-tab-from-name (tab-name tabs)
  261. "Return tab from TABS when it contains TAB-NAME."
  262. (cl-loop for tab in tabs
  263. when (member tab-name (split-string (cdr (assq 'name tab)) ", " t))
  264. return tab))
  265. (defun helm-buffers--buffer-in-tab-p (buffer-name tab-names)
  266. "Check if BUFFER-NAME is in TAB-NAMES list."
  267. (cl-loop for name in tab-names
  268. ;; Buf names are separated with "," in TAB-NAMES
  269. ;; e.g. '("tab-bar.el" "*scratch*, helm-buffers.el").
  270. thereis (member buffer-name (split-string name ", " t))))
  271. (defun helm-window-default-split-fn (candidates &optional other-window-fn)
  272. "Split windows in one direction and balance them.
  273. Direction can be controlled via `helm-window-prefer-horizontal-split'.
  274. If a prefix arg is given split windows the other direction.
  275. This function is suitable for `helm-window-show-buffers-function'."
  276. (if other-window-fn
  277. (funcall other-window-fn (car candidates))
  278. (switch-to-buffer (car candidates)))
  279. (save-selected-window
  280. (cl-loop with nosplit
  281. for b in (cdr candidates)
  282. when nosplit return
  283. (message "Too many buffers to visit simultaneously")
  284. do (condition-case _err
  285. (helm-window-other-window b 'balance)
  286. (error (setq nosplit t) nil)))))
  287. (defun helm-window-alternate-split-fn (candidates &optional other-window-fn)
  288. "Split windows horizontally and vertically in alternate fashion.
  289. Direction can be controlled via `helm-window-prefer-horizontal-split'.
  290. If a prefix arg is given split windows the other direction.
  291. This function is suitable for `helm-window-show-buffers-function'."
  292. (if other-window-fn
  293. (funcall other-window-fn (car candidates))
  294. (switch-to-buffer (car candidates)))
  295. (let (right-side)
  296. (save-selected-window
  297. (cl-loop with nosplit
  298. for b in (cdr candidates)
  299. when nosplit return
  300. (message "Too many buffers to visit simultaneously")
  301. do (condition-case _err
  302. (let ((helm-current-prefix-arg right-side))
  303. (helm-window-other-window b)
  304. (setq right-side (not right-side)))
  305. (error (setq nosplit t) nil))))))
  306. (defun helm-window-mosaic-fn (candidates &optional other-window-fn)
  307. "Make an as-square-as-possible window mosaic of the CANDIDATES buffers.
  308. If rectangular, the long side is in the direction given by
  309. `helm-window-prefer-horizontal-split': if non-nil, it is horizontal, vertical
  310. otherwise.
  311. If OTHER-WINDOW-FN is non-nil, current windows are included in the mosaic.
  312. This function is suitable for `helm-window-show-buffers-function'."
  313. (when other-window-fn
  314. (setq candidates (append (mapcar 'window-buffer (window-list)) candidates)))
  315. (delete-other-windows)
  316. (let* ((helm-window-prefer-horizontal-split
  317. (if (eq helm-window-prefer-horizontal-split 'decide)
  318. (and (numberp split-width-threshold)
  319. (>= (window-width (selected-window))
  320. split-width-threshold))
  321. helm-window-prefer-horizontal-split))
  322. mosaic-length-tile-count
  323. mosaic-width-tile-count
  324. mosaic-length-tile-size
  325. mosaic-width-tile-size
  326. next-window)
  327. ;; If 4 tiles, make 2x2 mosaic.
  328. ;; If 5-6 tiles, make 2x3 mosaic with direction depending on `helm-window-prefer-horizontal-split'.
  329. ;; If 7-9 tiles, make 3x3 mosaic. And so on.
  330. (setq mosaic-length-tile-count (ceiling (sqrt (length candidates))))
  331. (setq mosaic-width-tile-count
  332. (if (<= (length candidates) (* mosaic-length-tile-count (1- mosaic-length-tile-count)))
  333. (1- mosaic-length-tile-count)
  334. mosaic-length-tile-count))
  335. ;; We lower-bound the tile size, otherwise the function would
  336. ;; fail during the first inner split.
  337. ;; There is consequently no need to check for errors when
  338. ;; splitting.
  339. (let ((frame-mosaic-length-direction-size (frame-height))
  340. (frame-mosaic-width-direction-size (frame-width))
  341. (window-mosaic-length-direction-min-size window-min-height)
  342. (window-mosaic-width-direction-min-size window-min-width))
  343. (if helm-window-prefer-horizontal-split
  344. (setq frame-mosaic-length-direction-size (frame-width)
  345. frame-mosaic-width-direction-size (frame-height)
  346. window-mosaic-length-direction-min-size window-min-width
  347. window-mosaic-width-direction-min-size window-min-height))
  348. (setq mosaic-length-tile-size (max
  349. (/ frame-mosaic-length-direction-size mosaic-length-tile-count)
  350. window-mosaic-length-direction-min-size)
  351. mosaic-width-tile-size (max
  352. (/ frame-mosaic-width-direction-size mosaic-width-tile-count)
  353. window-mosaic-width-direction-min-size))
  354. ;; Shorten `candidates' to `max-tiles' elements.
  355. (let ((max-tiles (* (/ frame-mosaic-length-direction-size mosaic-length-tile-size)
  356. (/ frame-mosaic-width-direction-size mosaic-width-tile-size))))
  357. (when (> (length candidates) max-tiles)
  358. (message "Too many buffers to visit simultaneously")
  359. (setcdr (nthcdr (- max-tiles 1) candidates) nil))))
  360. ;; Make the mosaic.
  361. (while candidates
  362. (when (> (length candidates) mosaic-length-tile-count)
  363. (setq next-window (split-window nil
  364. mosaic-width-tile-size
  365. (not helm-window-prefer-horizontal-split))))
  366. (switch-to-buffer (pop candidates))
  367. (dotimes (_ (min (1- mosaic-length-tile-count) (length candidates)))
  368. (select-window (split-window nil
  369. mosaic-length-tile-size
  370. helm-window-prefer-horizontal-split))
  371. (switch-to-buffer (pop candidates)))
  372. (when next-window
  373. (select-window next-window)))))
  374. (defun helm-window-other-window (buffer-or-name &optional balance)
  375. "Switch to BUFFER-OR-NAME in other window.
  376. Direction can be controlled via `helm-window-prefer-horizontal-split'.
  377. If a prefix arg is given split windows the other direction.
  378. When argument BALANCE is provided `balance-windows'."
  379. (let* ((helm-window-prefer-horizontal-split
  380. (if (eq helm-window-prefer-horizontal-split 'decide)
  381. (and (numberp split-width-threshold)
  382. (>= (window-width (selected-window))
  383. split-width-threshold))
  384. helm-window-prefer-horizontal-split))
  385. (right-side (if helm-window-prefer-horizontal-split
  386. (not helm-current-prefix-arg)
  387. helm-current-prefix-arg)))
  388. (select-window (split-window nil nil right-side))
  389. (and balance (balance-windows))
  390. (switch-to-buffer buffer-or-name)))
  391. (cl-defun helm-current-buffer-narrowed-p (&optional
  392. (buffer helm-current-buffer))
  393. "Check if BUFFER is narrowed.
  394. Default is `helm-current-buffer'."
  395. (with-current-buffer buffer
  396. (let ((beg (point-min))
  397. (end (point-max))
  398. (total (buffer-size)))
  399. (or (/= beg 1) (/= end (1+ total))))))
  400. (defun helm-goto-char (loc)
  401. "Go to char, revealing if necessary."
  402. (goto-char loc)
  403. (let ((fn (cond ((eq major-mode 'org-mode)
  404. ;; On some old Emacs versions org may not be loaded.
  405. (require 'org)
  406. #'org-reveal)
  407. ((and (boundp 'outline-minor-mode)
  408. outline-minor-mode)
  409. #'outline-show-subtree)
  410. ((and (boundp 'markdown-mode-map)
  411. (derived-mode-p 'markdown-mode))
  412. #'markdown-show-subtree))))
  413. ;; outline may fail in some conditions e.g. with markdown enabled
  414. ;; (issue #1919).
  415. (condition-case nil
  416. (and fn (funcall fn))
  417. (error nil))))
  418. (defun helm-goto-line (lineno &optional noanim)
  419. "Goto LINENO opening only outline headline if needed.
  420. Animation is used unless NOANIM is non--nil."
  421. (helm-log-run-hook 'helm-goto-line-before-hook)
  422. (helm-match-line-cleanup)
  423. (unless helm-alive-p
  424. (with-helm-current-buffer
  425. (unless helm-yank-point (setq helm-yank-point (point)))))
  426. (goto-char (point-min))
  427. (helm-goto-char (point-at-bol lineno))
  428. (unless noanim
  429. (helm-highlight-current-line)))
  430. (defun helm-save-pos-to-register-before-jump ()
  431. "Save current buffer position to `helm-save-pos-before-jump-register'.
  432. To use this add it to `helm-goto-line-before-hook'."
  433. (with-helm-current-buffer
  434. (unless helm-in-persistent-action
  435. (point-to-register helm-save-pos-before-jump-register))))
  436. (defun helm-save-current-pos-to-mark-ring ()
  437. "Save current buffer position to mark ring.
  438. To use this add it to `helm-goto-line-before-hook'."
  439. (with-helm-current-buffer
  440. (unless helm-in-persistent-action
  441. (set-marker (mark-marker) (point))
  442. (push-mark (point) 'nomsg))))
  443. (defun helm-show-all-candidates-in-source (arg)
  444. "Toggle all or only candidate-number-limit cands in current source.
  445. With a numeric prefix arg show only the ARG number of candidates.
  446. The prefix arg have no effect when toggling to only
  447. candidate-number-limit."
  448. (interactive "p")
  449. (with-helm-alive-p
  450. (with-helm-buffer
  451. (if helm-source-filter
  452. (progn
  453. (setq-local helm-candidate-number-limit
  454. (default-value 'helm-candidate-number-limit))
  455. (helm-set-source-filter nil))
  456. (with-helm-default-directory (helm-default-directory)
  457. (setq-local helm-candidate-number-limit (and (> arg 1) arg))
  458. (helm-set-source-filter
  459. (list (helm-get-current-source))))))))
  460. (put 'helm-show-all-candidates-in-source 'helm-only t)
  461. (defun helm-display-all-sources ()
  462. "Display all sources previously hidden by `helm-set-source-filter'."
  463. (interactive)
  464. (with-helm-alive-p
  465. (helm-set-source-filter nil)))
  466. (put 'helm-display-all-sources 'helm-only t)
  467. (defun helm-displaying-source-names ()
  468. "Return the list of sources name for this helm session."
  469. (with-current-buffer helm-buffer
  470. (goto-char (point-min))
  471. (cl-loop with pos
  472. while (setq pos (next-single-property-change (point) 'helm-header))
  473. do (goto-char pos)
  474. collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
  475. do (forward-line 1))))
  476. (defun helm-handle-winner-boring-buffers ()
  477. "Add `helm-buffer' to `winner-boring-buffers' when quitting/exiting helm.
  478. Add this function to `helm-cleanup-hook' when you don't want to see helm buffers
  479. after running winner-undo/redo."
  480. (require 'winner)
  481. (cl-pushnew helm-buffer winner-boring-buffers :test 'equal))
  482. (add-hook 'helm-cleanup-hook #'helm-handle-winner-boring-buffers)
  483. (defun helm-quit-and-find-file ()
  484. "Drop into `helm-find-files' from `helm'.
  485. If current selection is a buffer or a file, `helm-find-files'
  486. from its directory."
  487. (interactive)
  488. (with-helm-alive-p
  489. (require 'helm-grep)
  490. (require 'helm-elisp)
  491. (helm-run-after-exit
  492. (lambda (f)
  493. ;; Ensure specifics `helm-execute-action-at-once-if-one'
  494. ;; fns don't run here.
  495. (let (helm-execute-action-at-once-if-one
  496. helm-actions-inherit-frame-settings) ; use this-command
  497. (if (file-exists-p f)
  498. (helm-find-files-1 (file-name-directory f)
  499. (concat
  500. "^"
  501. (regexp-quote
  502. (if helm-ff-transformer-show-only-basename
  503. (helm-basename f) f))))
  504. (helm-find-files-1 f))))
  505. (let* ((sel (helm-get-selection))
  506. (marker (and (consp sel) (markerp (cdr sel))))
  507. (grep-line (and (stringp sel)
  508. (helm-grep-split-line sel)))
  509. (occur-fname (helm-aand (numberp sel)
  510. (helm-attr 'buffer-name)
  511. (buffer-file-name (get-buffer it))))
  512. (bmk-name (and (stringp sel)
  513. (not grep-line)
  514. (replace-regexp-in-string "\\`\\*" "" sel)))
  515. (bmk (and bmk-name (assoc bmk-name bookmark-alist)))
  516. (buf (helm-aif (and (bufferp sel) (get-buffer sel))
  517. (buffer-name it)))
  518. (pkg (and (stringp sel)
  519. (get-text-property 0 'tabulated-list-id sel)))
  520. (default-preselection (or (buffer-file-name helm-current-buffer)
  521. default-directory)))
  522. (cond
  523. ;; Buffer.
  524. (buf (or (buffer-file-name sel)
  525. (car (rassoc buf dired-buffers))
  526. (and (with-current-buffer buf
  527. (eq major-mode 'org-agenda-mode))
  528. org-directory
  529. (expand-file-name org-directory))
  530. (with-current-buffer buf
  531. (expand-file-name default-directory))))
  532. ;; imenu (marker).
  533. (marker
  534. (or (buffer-file-name (marker-buffer (cdr sel)))
  535. default-preselection))
  536. ;; Bookmark.
  537. (bmk (helm-aif (bookmark-get-filename bmk)
  538. (if (and helm--url-regexp
  539. (string-match helm--url-regexp it))
  540. it (expand-file-name it))
  541. (expand-file-name default-directory)))
  542. ((and (stringp sel) (or (file-remote-p sel)
  543. (file-exists-p sel)))
  544. (expand-file-name sel))
  545. ;; Grep.
  546. ((and grep-line (file-exists-p (car grep-line)))
  547. (expand-file-name (car grep-line)))
  548. ;; Occur.
  549. ((and occur-fname (file-exists-p occur-fname))
  550. (expand-file-name occur-fname))
  551. ;; Package (installed).
  552. ((and pkg (package-installed-p pkg))
  553. (expand-file-name (package-desc-dir pkg)))
  554. ;; Url.
  555. ((and (stringp sel) helm--url-regexp (string-match helm--url-regexp sel)) sel)
  556. ;; Exit brutally from a `with-helm-show-completion'
  557. ((and helm-show-completion-overlay
  558. (overlayp helm-show-completion-overlay))
  559. (delete-overlay helm-show-completion-overlay)
  560. (remove-hook 'helm-move-selection-after-hook 'helm-show-completion)
  561. (expand-file-name default-preselection))
  562. ;; Default.
  563. (t (expand-file-name default-preselection)))))))
  564. (put 'helm-quit-and-find-file 'helm-only t)
  565. (defun helm-generic-sort-fn (s1 s2)
  566. "Sort predicate function for helm candidates.
  567. Args S1 and S2 can be single or \(display . real\) candidates,
  568. that is sorting is done against real value of candidate."
  569. (let* ((qpattern (regexp-quote helm-pattern))
  570. (reg1 (concat "\\_<" qpattern "\\_>"))
  571. (reg2 (concat "\\_<" qpattern))
  572. (reg3 helm-pattern)
  573. (split (helm-remove-if-match
  574. "\\`!" (helm-mm-split-pattern helm-pattern)))
  575. (str1 (if (consp s1) (cdr s1) s1))
  576. (str2 (if (consp s2) (cdr s2) s2))
  577. (score (lambda (str r1 r2 r3 lst)
  578. (+ (if (string-match (concat "\\`" qpattern) str) 1 0)
  579. (cond ((string-match r1 str) 5)
  580. ((and (string-match " " qpattern)
  581. (string-match
  582. (concat "\\_<" (regexp-quote (car lst))) str)
  583. (cl-loop for r in (cdr lst)
  584. always (string-match r str)))
  585. 4)
  586. ((and (string-match " " qpattern)
  587. (cl-loop for r in lst
  588. always (string-match r str)))
  589. 3)
  590. ((string-match r2 str) 2)
  591. ((string-match r3 str) 1)
  592. (t 0)))))
  593. (sc1 (get-text-property 0 'completion-score str1))
  594. (sc2 (get-text-property 0 'completion-score str2))
  595. (sc3 (if sc1 0 (funcall score str1 reg1 reg2 reg3 split)))
  596. (sc4 (if sc2 0 (funcall score str2 reg1 reg2 reg3 split))))
  597. (cond ((and sc1 sc2) ; helm-flex style.
  598. (> sc1 sc2))
  599. ((or (zerop (string-width qpattern))
  600. (and (zerop sc3) (zerop sc4)))
  601. (string-lessp str1 str2))
  602. ((= sc3 sc4)
  603. (< (length str1) (length str2)))
  604. (t (> sc3 sc4)))))
  605. (cl-defun helm-file-human-size (size &optional (kbsize helm-default-kbsize))
  606. "Return a string showing SIZE of a file in human readable form.
  607. SIZE can be an integer or a float depending it's value.
  608. `file-attributes' will take care of that to avoid overflow error.
  609. KBSIZE is a floating point number, defaulting to `helm-default-kbsize'."
  610. (cl-loop with result = (cons "B" size)
  611. for i in '("k" "M" "G" "T" "P" "E" "Z" "Y")
  612. while (>= (cdr result) kbsize)
  613. do (setq result (cons i (/ (cdr result) kbsize)))
  614. finally return
  615. (helm-acase (car result)
  616. ("B" (format "%s" size))
  617. (t (format "%.1f%s" (cdr result) it)))))
  618. (cl-defun helm-file-attributes
  619. (file &key type links uid gid access-time modif-time
  620. status size mode gid-change inode device-num dired human-size
  621. mode-type mode-owner mode-group mode-other (string t))
  622. "Return `file-attributes' elements of FILE separately according to key value.
  623. Availables keys are:
  624. - TYPE: Same as nth 0 `files-attributes' if STRING is nil
  625. otherwise return either symlink, directory or file (default).
  626. - LINKS: See nth 1 `files-attributes'.
  627. - UID: See nth 2 `files-attributes'.
  628. - GID: See nth 3 `files-attributes'.
  629. - ACCESS-TIME: See nth 4 `files-attributes', however format time
  630. when STRING is non--nil (the default).
  631. - MODIF-TIME: See nth 5 `files-attributes', same as above.
  632. - STATUS: See nth 6 `files-attributes', same as above.
  633. - SIZE: See nth 7 `files-attributes'.
  634. - MODE: See nth 8 `files-attributes'.
  635. - GID-CHANGE: See nth 9 `files-attributes'.
  636. - INODE: See nth 10 `files-attributes'.
  637. - DEVICE-NUM: See nth 11 `files-attributes'.
  638. - DIRED: A line similar to what 'ls -l' return.
  639. - HUMAN-SIZE: The size in human form, see `helm-file-human-size'.
  640. - MODE-TYPE, mode-owner,mode-group, mode-other: Split what
  641. nth 7 `files-attributes' return in four categories.
  642. - STRING: When non--nil (default) `helm-file-attributes' return
  643. more friendly values.
  644. If you want the same behavior as `files-attributes' ,
  645. \(but with return values in proplist\) use a nil value for STRING.
  646. However when STRING is non--nil, time and type value are different from what
  647. you have in `file-attributes'."
  648. (helm-aif (file-attributes file string)
  649. (let* ((all (cl-destructuring-bind
  650. (type links uid gid access-time modif-time
  651. status size mode gid-change inode device-num)
  652. it
  653. (list :type (if string
  654. (cond ((stringp type) "symlink") ; fname
  655. (type "directory") ; t
  656. (t "file")) ; nil
  657. type)
  658. :links links
  659. :uid uid
  660. :gid gid
  661. :access-time (if string
  662. (format-time-string
  663. "%Y-%m-%d %R" access-time)
  664. access-time)
  665. :modif-time (if string
  666. (format-time-string
  667. "%Y-%m-%d %R" modif-time)
  668. modif-time)
  669. :status (if string
  670. (format-time-string
  671. "%Y-%m-%d %R" status)
  672. status)
  673. :size size
  674. :mode mode
  675. :gid-change gid-change
  676. :inode inode
  677. :device-num device-num)))
  678. (modes (helm-split-mode-file-attributes (cl-getf all :mode))))
  679. (cond (type (cl-getf all :type))
  680. (links (cl-getf all :links))
  681. (uid (cl-getf all :uid))
  682. (gid (cl-getf all :gid))
  683. (access-time (cl-getf all :access-time))
  684. (modif-time (cl-getf all :modif-time))
  685. (status (cl-getf all :status))
  686. (size (cl-getf all :size))
  687. (mode (cl-getf all :mode))
  688. (gid-change (cl-getf all :gid-change))
  689. (inode (cl-getf all :inode))
  690. (device-num (cl-getf all :device-num))
  691. (dired (concat
  692. (helm-split-mode-file-attributes
  693. (cl-getf all :mode) t) " "
  694. (number-to-string (cl-getf all :links)) " "
  695. (cl-getf all :uid) ":"
  696. (cl-getf all :gid) " "
  697. (if human-size
  698. (helm-file-human-size (cl-getf all :size))
  699. (int-to-string (cl-getf all :size))) " "
  700. (cl-getf all :modif-time)))
  701. (human-size (helm-file-human-size (cl-getf all :size)))
  702. (mode-type (cl-getf modes :mode-type))
  703. (mode-owner (cl-getf modes :user))
  704. (mode-group (cl-getf modes :group))
  705. (mode-other (cl-getf modes :other))
  706. (t (append all modes))))))
  707. (defun helm-split-mode-file-attributes (str &optional string)
  708. "Split mode file attributes STR into a proplist.
  709. If STRING is non--nil return instead a space separated string."
  710. (cl-loop with type = (substring str 0 1)
  711. with cdr = (substring str 1)
  712. for i across cdr
  713. for count from 1
  714. if (<= count 3)
  715. concat (string i) into user
  716. if (and (> count 3) (<= count 6))
  717. concat (string i) into group
  718. if (and (> count 6) (<= count 9))
  719. concat (string i) into other
  720. finally return
  721. (if string
  722. (mapconcat 'identity (list type user group other) " ")
  723. (list :mode-type type :user user :group group :other other))))
  724. (defun helm-format-columns-of-files (files)
  725. "Same as `dired-format-columns-of-files'.
  726. Inlined here for compatibility."
  727. (let ((beg (point)))
  728. (completion--insert-strings files)
  729. (put-text-property beg (point) 'mouse-face nil)))
  730. (defmacro with-helm-display-marked-candidates (buffer-or-name candidates &rest body)
  731. (declare (indent 0) (debug t))
  732. (helm-with-gensyms (buffer window)
  733. `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name))
  734. (helm-always-two-windows t)
  735. (helm-split-window-default-side
  736. (if (eq helm-split-window-default-side 'same)
  737. 'below helm-split-window-default-side))
  738. helm-split-window-inside-p
  739. helm-reuse-last-window-split-state
  740. ,window)
  741. (with-current-buffer ,buffer
  742. (helm-format-columns-of-files ,candidates))
  743. (unwind-protect
  744. (with-selected-window
  745. (setq ,window (temp-buffer-window-show
  746. ,buffer
  747. '(display-buffer-below-selected
  748. (window-height . fit-window-to-buffer))))
  749. (progn ,@body))
  750. (quit-window 'kill ,window)))))
  751. ;;; Persistent Action Helpers
  752. ;;
  753. ;;
  754. ;; Internal
  755. (defvar helm-match-line-overlay nil)
  756. (defvar helm--match-item-overlays nil)
  757. (defun helm-highlight-current-line (&optional start end buf face)
  758. "Highlight and underline current position"
  759. (let* ((start (or start (line-beginning-position)))
  760. (end (or end (1+ (line-end-position))))
  761. start-match end-match
  762. (args (list start end buf))
  763. (case-fold-search (if helm-alive-p
  764. (helm-set-case-fold-search)
  765. case-fold-search)))
  766. ;; Highlight the current line.
  767. (if (not helm-match-line-overlay)
  768. (setq helm-match-line-overlay (apply 'make-overlay args))
  769. (apply 'move-overlay helm-match-line-overlay args))
  770. (overlay-put helm-match-line-overlay
  771. 'face (or face 'helm-selection-line))
  772. ;; Now highlight matches only if we are in helm session, we are
  773. ;; maybe coming from helm-grep-mode or helm-moccur-mode buffers.
  774. (when helm-alive-p
  775. (if (or (null helm-highlight-matches-around-point-max-lines)
  776. (zerop helm-highlight-matches-around-point-max-lines))
  777. (setq start-match start
  778. end-match end)
  779. (setq start-match
  780. (save-excursion
  781. (forward-line
  782. (- helm-highlight-matches-around-point-max-lines))
  783. (point-at-bol))
  784. end-match
  785. (save-excursion
  786. (forward-line
  787. helm-highlight-matches-around-point-max-lines)
  788. (point-at-bol))))
  789. (catch 'empty-line
  790. (cl-loop with ov
  791. for r in (helm-remove-if-match
  792. "\\`!" (helm-mm-split-pattern
  793. (if (with-helm-buffer
  794. ;; Needed for highlighting AG matches.
  795. (assq 'pcre (helm-get-current-source)))
  796. (helm--translate-pcre-to-elisp helm-input)
  797. helm-input)))
  798. do (save-excursion
  799. (goto-char start-match)
  800. (while (condition-case _err
  801. (if helm-migemo-mode
  802. (helm-mm-migemo-forward r end-match t)
  803. (re-search-forward r end-match t))
  804. (invalid-regexp nil))
  805. (let ((s (match-beginning 0))
  806. (e (match-end 0)))
  807. (if (= s e)
  808. (throw 'empty-line nil)
  809. (push (setq ov (make-overlay s e))
  810. helm--match-item-overlays)
  811. (overlay-put ov 'face 'helm-match-item)
  812. (overlay-put ov 'priority 1))))))))
  813. (recenter)))
  814. (defun helm--translate-pcre-to-elisp (regexp)
  815. "Should translate pcre REGEXP to elisp regexp.
  816. Assume regexp is a pcre based regexp."
  817. (with-temp-buffer
  818. (insert " " regexp " ")
  819. (goto-char (point-min))
  820. (save-excursion
  821. ;; match (){}| unquoted
  822. (helm-awhile (and (re-search-forward "\\([(){}|]\\)" nil t)
  823. (match-string 1))
  824. (let ((pos (match-beginning 1)))
  825. (if (eql (char-before pos) ?\\)
  826. (delete-region pos (1- pos))
  827. (replace-match (concat "\\" it) t t nil 1)))))
  828. ;; match \s or \S
  829. (helm-awhile (and (re-search-forward "\\S\\?\\(\\s\\[sS]\\)[^-]" nil t)
  830. (match-string 1))
  831. (replace-match (concat it "-") t t nil 1))
  832. (buffer-substring (1+ (point-min)) (1- (point-max)))))
  833. (defun helm-match-line-cleanup ()
  834. (when helm-match-line-overlay
  835. (delete-overlay helm-match-line-overlay)
  836. (setq helm-match-line-overlay nil))
  837. (when helm--match-item-overlays
  838. (mapc 'delete-overlay helm--match-item-overlays)))
  839. (defun helm-match-line-cleanup-maybe ()
  840. (when (helm-empty-buffer-p)
  841. (helm-match-line-cleanup)))
  842. (defun helm-match-line-update ()
  843. (when helm-match-line-overlay
  844. (delete-overlay helm-match-line-overlay)
  845. (helm-highlight-current-line)))
  846. (defun helm-persistent-autoresize-hook ()
  847. (when (and helm-buffers-to-resize-on-pa
  848. (member helm-buffer helm-buffers-to-resize-on-pa)
  849. (eq helm-split-window-state 'vertical))
  850. (set-window-text-height (helm-window) helm-resize-on-pa-text-height)))
  851. (defun helm-match-line-cleanup-pulse ()
  852. (run-with-timer 0.3 nil #'helm-match-line-cleanup))
  853. (add-hook 'helm-after-update-hook 'helm-match-line-cleanup-maybe)
  854. (add-hook 'helm-after-persistent-action-hook 'helm-persistent-autoresize-hook)
  855. (add-hook 'helm-cleanup-hook 'helm-match-line-cleanup)
  856. (add-hook 'helm-after-action-hook 'helm-match-line-cleanup-pulse)
  857. (add-hook 'helm-after-persistent-action-hook 'helm-match-line-update)
  858. ;;; Popup buffer-name or filename in grep/moccur/imenu-all.
  859. ;;
  860. (defvar helm--show-help-echo-timer nil)
  861. (defun helm-cancel-help-echo-timer ()
  862. (when helm--show-help-echo-timer
  863. (cancel-timer helm--show-help-echo-timer)
  864. (setq helm--show-help-echo-timer nil)))
  865. (defun helm-maybe-show-help-echo ()
  866. (when helm--show-help-echo-timer
  867. (cancel-timer helm--show-help-echo-timer)
  868. (setq helm--show-help-echo-timer nil))
  869. (when (and helm-alive-p
  870. helm-popup-tip-mode
  871. (member (assoc-default 'name (helm-get-current-source))
  872. helm-sources-using-help-echo-popup))
  873. (setq helm--show-help-echo-timer
  874. (run-with-timer
  875. 1 nil
  876. (lambda ()
  877. (save-selected-window
  878. (with-helm-window
  879. (helm-aif (get-text-property (point-at-bol) 'help-echo)
  880. (popup-tip (concat " " (abbreviate-file-name
  881. (replace-regexp-in-string "\n.*" "" it)))
  882. :around nil
  883. :point (save-excursion
  884. (end-of-visual-line) (point)))))))))))
  885. ;;;###autoload
  886. (define-minor-mode helm-popup-tip-mode
  887. "Show help-echo informations in a popup tip at end of line."
  888. :global t
  889. (require 'popup)
  890. (if helm-popup-tip-mode
  891. (progn
  892. (add-hook 'helm-move-selection-after-hook 'helm-maybe-show-help-echo)
  893. (add-hook 'helm-cleanup-hook 'helm-cancel-help-echo-timer))
  894. (remove-hook 'helm-move-selection-after-hook 'helm-maybe-show-help-echo)
  895. (remove-hook 'helm-cleanup-hook 'helm-cancel-help-echo-timer)))
  896. (defun helm-open-file-with-default-tool (file)
  897. "Open FILE with the default tool on this platform."
  898. (let (process-connection-type)
  899. (if (eq system-type 'windows-nt)
  900. (helm-w32-shell-execute-open-file file)
  901. (start-process "helm-open-file-with-default-tool"
  902. nil
  903. (cond ((eq system-type 'gnu/linux)
  904. "xdg-open")
  905. ((or (eq system-type 'darwin) ;; Mac OS X
  906. (eq system-type 'macos)) ;; Mac OS 9
  907. "open"))
  908. file))))
  909. (defun helm-open-dired (file)
  910. "Opens a dired buffer in FILE's directory. If FILE is a
  911. directory, open this directory."
  912. (if (file-directory-p file)
  913. (dired file)
  914. (dired (file-name-directory file))
  915. (dired-goto-file file)))
  916. (defun helm-require-or-error (feature function)
  917. (or (require feature nil t)
  918. (error "Need %s to use `%s'." feature function)))
  919. (defun helm-find-file-as-root (candidate)
  920. (let* ((buf (helm-basename candidate))
  921. (host (file-remote-p candidate 'host))
  922. (remote-path (format "/%s:%s:%s"
  923. helm-su-or-sudo
  924. (or host "")
  925. (expand-file-name
  926. (if host
  927. (file-remote-p candidate 'localname)
  928. candidate))))
  929. non-essential)
  930. (if (buffer-live-p (get-buffer buf))
  931. (progn
  932. (set-buffer buf)
  933. (find-alternate-file remote-path))
  934. (find-file remote-path))))
  935. (defun helm-find-many-files (_ignore)
  936. "Simple action that run `find-file' on marked candidates.
  937. Run `helm-find-many-files-after-hook' at end"
  938. (let ((helm--reading-passwd-or-string t))
  939. (mapc 'find-file (helm-marked-candidates))
  940. (helm-log-run-hook 'helm-find-many-files-after-hook)))
  941. (defun helm-read-repeat-string (prompt &optional count)
  942. "Prompt as many time PROMPT is not empty.
  943. If COUNT is non--nil add a number after each prompt."
  944. (cl-loop with elm
  945. while (not (string= elm ""))
  946. for n from 1
  947. do (when count
  948. (setq prompt (concat prompt (int-to-string n) ": ")))
  949. collect (setq elm (helm-read-string prompt)) into lis
  950. finally return (remove "" lis)))
  951. (defun helm-html-bookmarks-to-alist (file url-regexp bmk-regexp)
  952. "Parse html bookmark FILE and return an alist with (title . url) as elements."
  953. (let (bookmarks-alist url title)
  954. (with-temp-buffer
  955. (insert-file-contents file)
  956. (goto-char (point-min))
  957. (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
  958. (forward-line 0)
  959. (when (re-search-forward url-regexp nil t)
  960. (setq url (match-string 0)))
  961. (when (re-search-forward bmk-regexp nil t)
  962. (setq title (url-unhex-string
  963. (funcall helm-html-decode-entities-function
  964. (match-string 1)))))
  965. (push (cons title url) bookmarks-alist)
  966. (forward-line)))
  967. (nreverse bookmarks-alist)))
  968. (defun helm-html-entity-to-string (entity)
  969. "Replace an html ENTITY by its string value.
  970. When unable to decode ENTITY returns nil."
  971. (helm-aif (assoc entity helm-html-entities-alist)
  972. (string (cdr it))
  973. (save-match-data
  974. (when (string-match "[0-9]+" entity)
  975. (string (string-to-number (match-string 0 entity)))))))
  976. (defun helm-html-decode-entities-string (str)
  977. "Decode entities in the string STR."
  978. (save-match-data
  979. (with-temp-buffer
  980. (insert str)
  981. (goto-char (point-min))
  982. (while (re-search-forward "&#?\\([^;]*\\);" nil t)
  983. (helm-aif (helm-html-entity-to-string (match-string 0))
  984. (replace-match it)))
  985. (buffer-string))))
  986. (provide 'helm-utils)
  987. ;; Local Variables:
  988. ;; byte-compile-warnings: (not obsolete)
  989. ;; coding: utf-8
  990. ;; indent-tabs-mode: nil
  991. ;; End:
  992. ;;; helm-utils.el ends here