.emacs.d.git - Gitblit

Chizi123

2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957

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	'((""" . 34) ;; "
	99	(">" . 62) ;; >
	100	("<" . 60) ;; <
	101	("&" . 38) ;; &
	102	("€" . 8364) ;; €
	103	("&Yuml;" . 89) ;; Y
	104	("¡" . 161) ;; ¡
	105	("¢" . 162) ;; ¢
	106	("£" . 163) ;; £
	107	("¤" . 164) ;; ¤
	108	("&yen" . 165) ;; ¥
	109	("¦" . 166) ;; ¦
	110	("§" . 167) ;; §
	111	("¨" . 32) ;; SPC
	112	("©" . 169) ;; ©
	113	("ª" . 97) ;; a
	114	("«" . 171) ;; «
	115	("¬" . 172) ;; ¬
	116	("&masr;" . 174) ;; ®
	117	("°" . 176) ;; °
	118	("±" . 177) ;; ±
	119	("²" . 50) ;; 2
	120	("³" . 51) ;; 3
	121	("´" . 39) ;; '
	122	("µ" . 956) ;; μ
	123	("¶" . 182) ;; ¶
	124	("·" . 183) ;; ·
	125	("¸" . 32) ;; SPC
	126	("¹" . 49) ;; 1
	127	("º" . 111) ;; o
	128	("»" . 187) ;; »
	129	("¼" . 49) ;; 1
	130	("½" . 49) ;; 1
	131	("¾" . 51) ;; 3
	132	("¿" . 191) ;; ¿
	133	("À" . 192) ;; À
	134	("Á" . 193) ;; Á
	135	("Â" . 194) ;; Â
	136	("Ã" . 195) ;; Ã
	137	("Ä" . 196) ;; Ä
	138	("Å" . 197) ;; Å
	139	("&Aelig" . 198) ;; Æ
	140	("Ç" . 199) ;; Ç
	141	("È" . 200) ;; È
	142	("É" . 201) ;; É
	143	("Ê" . 202) ;; Ê
	144	("Ë" . 203) ;; Ë
	145	("Ì" . 204) ;; Ì
	146	("Í" . 205) ;; Í
	147	("Î" . 206) ;; Î
	148	("Ï" . 207) ;; Ï
	149	("ð" . 208) ;; Ð
	150	("Ñ" . 209) ;; Ñ
	151	("Ò" . 210) ;; Ò
	152	("Ó" . 211) ;; Ó
	153	("Ô" . 212) ;; Ô
	154	("Õ" . 213) ;; Õ
	155	("Ö" . 214) ;; Ö
	156	("×" . 215) ;; ×
	157	("Ø" . 216) ;; Ø
	158	("Ù" . 217) ;; Ù
	159	("Ú" . 218) ;; Ú
	160	("Û" . 219) ;; Û
	161	("Ü" . 220) ;; Ü
	162	("Ý" . 221) ;; Ý
	163	("þ" . 222) ;; Þ
	164	("ß" . 223) ;; ß
	165	("à" . 224) ;; à
	166	("á" . 225) ;; á
	167	("â" . 226) ;; â
	168	("ã" . 227) ;; ã
	169	("ä" . 228) ;; ä
	170	("å" . 229) ;; å
	171	("æ" . 230) ;; æ
	172	("ç" . 231) ;; ç
	173	("è" . 232) ;; è
	174	("é" . 233) ;; é
	175	("ê" . 234) ;; ê
	176	("ë" . 235) ;; ë
	177	("ì" . 236) ;; ì
	178	("í" . 237) ;; í
	179	("î" . 238) ;; î
	180	("ï" . 239) ;; ï
	181	("ð" . 240) ;; ð
	182	("ñ" . 241) ;; ñ
	183	("ò" . 242) ;; ò
	184	("ó" . 243) ;; ó
	185	("ô" . 244) ;; ô
	186	("õ" . 245) ;; õ
	187	("ö" . 246) ;; ö
	188	("÷" . 247) ;; ÷
	189	("ø" . 248) ;; ø
	190	("ù" . 249) ;; ù
	191	("ú" . 250) ;; ú
	192	("û" . 251) ;; û
	193	("ü" . 252) ;; ü
	194	("ý" . 253) ;; ý
	195	("þ" . 254) ;; þ
	196	("ÿ" . 255) ;; ÿ
	197	("®" . 174) ;; ®
	198	("" . 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