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