.emacs.d.git - Gitblit

Chizi123

2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957

commit \| author \| age
5cb5f7	1	;;; helm-lib.el --- Helm routines. -- lexical-binding: t --
C	2
	3	;; Copyright (C) 2015 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com>
	4
	5	;; Author: Thierry Volpiatto <thierry.volpiatto@gmail.com>
	6	;; URL: http://github.com/emacs-helm/helm
	7
	8	;; This program is free software; you can redistribute it and/or modify
	9	;; it under the terms of the GNU General Public License as published by
	10	;; the Free Software Foundation, either version 3 of the License, or
	11	;; (at your option) any later version.
	12
	13	;; This program is distributed in the hope that it will be useful,
	14	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	15	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	;; GNU General Public License for more details.
	17
	18	;; You should have received a copy of the GNU General Public License
	19	;; along with this program. If not, see <http://www.gnu.org/licenses/>.
	20
	21	;;; Commentary:
	22	;; All helm functions that don't require specific helm code should go here.
	23
	24	;;; Code:
	25
	26	(require 'cl-lib)
	27	(eval-when-compile (require 'wdired))
	28
	29	(declare-function helm-get-sources "helm.el")
	30	(declare-function helm-marked-candidates "helm.el")
	31	(declare-function helm-follow-mode-p "helm.el")
	32	(declare-function helm-attr "helm.el")
	33	(declare-function helm-attrset "helm.el")
	34	(declare-function org-open-at-point "org.el")
	35	(declare-function org-content "org.el")
	36	(declare-function org-mark-ring-goto "org.el")
	37	(declare-function org-mark-ring-push "org.el")
	38	(declare-function helm-interpret-value "helm.el")
	39	(declare-function helm-get-current-source "helm.el")
	40	(defvar helm-sources)
	41	(defvar helm-initial-frame)
	42	(defvar helm-current-position)
	43	(defvar wdired-old-marks)
	44	(defvar helm-persistent-action-display-window)
	45
	46	;;; User vars.
	47	;;
	48	(defcustom helm-file-globstar t
	49	"Same as globstar bash shopt option.
	50	When non--nil a pattern beginning with two stars will expand recursively.
	51	Directories expansion is not supported yet."
	52	:group 'helm
	53	:type 'boolean)
	54
	55	(defcustom helm-yank-text-at-point-function nil
	56	"The function used to forward point with `helm-yank-text-at-point'.
	57	With a nil value, fallback to default `forward-word'.
	58	The function should take one arg, an integer like `forward-word'.
	59	NOTE: Using `forward-symbol' here is not very useful as it is already
	60	provided by \\<helm-map>\\[next-history-element]."
	61	:type 'function
	62	:group 'helm)
	63
	64	(defcustom helm-scroll-amount nil
	65	"Scroll amount when scrolling other window in a helm session.
	66	It is used by `helm-scroll-other-window'
	67	and `helm-scroll-other-window-down'.
	68
	69	If you prefer scrolling line by line, set this value to 1."
	70	:group 'helm
	71	:type 'integer)
	72
	73	(defcustom helm-help-full-frame t
	74	"Display help window in full frame when non nil.
	75
	76	Even when `nil' probably the same result (full frame)
	77	can be reach by tweaking `display-buffer-alist' but it is
	78	much more convenient to use a simple boolean value here."
	79	:type 'boolean
	80	:group 'helm-help)
	81
	82	(defvar helm-ff--boring-regexp nil)
	83	(defun helm-ff--setup-boring-regex (var val)
	84	(set var val)
	85	(setq helm-ff--boring-regexp
	86	(cl-loop with last = (car (last val))
	87	for r in (butlast val)
	88	if (string-match "\\$\\'" r)
	89	concat (concat r "\\\|") into result
	90	else concat (concat r "$\\\|") into result
	91	finally return
	92	(concat result last
	93	(if (string-match "\\$\\'" last) "" "$")))))
	94
	95	(defcustom helm-boring-file-regexp-list
	96	(mapcar (lambda (f)
	97	(let ((rgx (regexp-quote f)))
	98	(if (string-match-p "[^/]$" f)
	99	;; files: e.g .o => \\.o$
	100	(concat rgx "$")
	101	;; directories: e.g .git/ => \.git\$/\\\|$\$
	102	(concat (substring rgx 0 -1) "\$/\\\|$\$"))))
	103	completion-ignored-extensions)
	104	"A list of regexps matching boring files.
	105
	106	This list is build by default on `completion-ignored-extensions'.
	107	The directory names should end with \"/?\" e.g. \"\\.git/?\" and the
	108	file names should end with \"$\" e.g. \"\\.o$\".
	109
	110	These regexps may be used to match the entire path, not just the file
	111	name, so for example to ignore files with a prefix \".bak.\", use
	112	\"\\.bak\\..*$\" as the regexp.
	113
	114	NOTE: When modifying this, be sure to use customize interface or the
	115	customize functions e.g. `customize-set-variable' and NOT `setq'."
	116	:group 'helm-files
	117	:type '(repeat (choice regexp))
	118	:set 'helm-ff--setup-boring-regex)
	119
	120
	121	;;; Internal vars
	122	;;
	123	(defvar helm-yank-point nil)
	124	(defvar helm-pattern ""
	125	"The input pattern used to update the helm buffer.")
	126	(defvar helm-buffer "helm"
	127	"Buffer showing completions.")
	128	(defvar helm-current-buffer nil
	129	"Current buffer when `helm' is invoked.")
	130	(defvar helm-suspend-update-flag nil)
	131	(defvar helm-action-buffer "helm action"
	132	"Buffer showing actions.")
	133
	134
	135	;;; Compatibility
	136	;;
	137	(defun helm-add-face-text-properties (beg end face &optional append object)
	138	"Add the face property to the text from START to END.
	139	It is a compatibility function which behave exactly like
	140	`add-face-text-property' if available otherwise like `add-text-properties'.
	141	When only `add-text-properties' is available APPEND is ignored."
	142	(if (fboundp 'add-face-text-property)
	143	(add-face-text-property beg end face append object)
	144	(add-text-properties beg end `(face ,face) object)))
	145
	146	;; Override `wdired-finish-edit'.
	147	;; Fix emacs bug in `wdired-finish-edit' where
	148	;; Wdired is not handling the case where `dired-directory' is a cons
	149	;; cell instead of a string.
	150	(defun helm--advice-wdired-finish-edit ()
	151	(interactive)
	152	(wdired-change-to-dired-mode)
	153	(let ((changes nil)
	154	(errors 0)
	155	files-deleted
	156	files-renamed
	157	some-file-names-unchanged
	158	file-old file-new tmp-value)
	159	(save-excursion
	160	(when (and wdired-allow-to-redirect-links
	161	(fboundp 'make-symbolic-link))
	162	(setq tmp-value (wdired-do-symlink-changes))
	163	(setq errors (cdr tmp-value))
	164	(setq changes (car tmp-value)))
	165	(when (and wdired-allow-to-change-permissions
	166	(boundp 'wdired-col-perm)) ; could have been changed
	167	(setq tmp-value (wdired-do-perm-changes))
	168	(setq errors (+ errors (cdr tmp-value)))
	169	(setq changes (or changes (car tmp-value))))
	170	(goto-char (point-max))
	171	(while (not (bobp))
	172	(setq file-old (wdired-get-filename nil t))
	173	(when file-old
	174	(setq file-new (wdired-get-filename))
	175	(if (equal file-new file-old)
	176	(setq some-file-names-unchanged t)
	177	(setq changes t)
	178	(if (not file-new) ;empty filename!
	179	(push file-old files-deleted)
	180	(when wdired-keep-marker-rename
	181	(let ((mark (cond ((integerp wdired-keep-marker-rename)
	182	wdired-keep-marker-rename)
	183	(wdired-keep-marker-rename
	184	(cdr (assoc file-old wdired-old-marks)))
	185	(t nil))))
	186	(when mark
	187	(push (cons (substitute-in-file-name file-new) mark)
	188	wdired-old-marks))))
	189	(push (cons file-old (substitute-in-file-name file-new))
	190	files-renamed))))
	191	(forward-line -1)))
	192	(when files-renamed
	193	(setq errors (+ errors (wdired-do-renames files-renamed))))
	194	(if changes
	195	(progn
	196	;; If we are displaying a single file (rather than the
	197	;; contents of a directory), change dired-directory if that
	198	;; file was renamed. (This ought to be generalized to
	199	;; handle the multiple files case, but that's less trivial)
	200	;; fixit [1].
	201	(cond ((and (stringp dired-directory)
	202	(not (file-directory-p dired-directory))
	203	(null some-file-names-unchanged)
	204	(= (length files-renamed) 1))
	205	(setq dired-directory (cdr (car files-renamed))))
	206	;; Fix [1] i.e dired buffers created with
	207	;; (dired '(foo f1 f2 f3)).
	208	((and (consp dired-directory)
	209	(cdr dired-directory)
	210	files-renamed)
	211	(setcdr dired-directory
	212	;; Replace in `dired-directory' files that have
	213	;; been modified with their new name keeping
	214	;; the ones that are unmodified at the same place.
	215	(cl-loop with old-to-rename = (mapcar 'car files-renamed)
	216	for f in (cdr dired-directory)
	217	if (member f old-to-rename)
	218	collect (assoc-default f files-renamed)
	219	else collect f))))
	220	;; Re-sort the buffer if all went well.
	221	(unless (> errors 0) (revert-buffer))
	222	(let ((inhibit-read-only t))
	223	(dired-mark-remembered wdired-old-marks)))
	224	(let ((inhibit-read-only t))
	225	(remove-text-properties (point-min) (point-max)
	226	'(old-name nil end-name nil old-link nil
	227	end-link nil end-perm nil
	228	old-perm nil perm-changed nil))
	229	(message "(No changes to be performed)")))
	230	(when files-deleted
	231	(wdired-flag-for-deletion files-deleted))
	232	(when (> errors 0)
	233	(dired-log-summary (format "%d rename actions failed" errors) nil)))
	234	(set-buffer-modified-p nil)
	235	(setq buffer-undo-list nil))
	236
	237	;; Override `wdired-get-filename'.
	238	;; Fix emacs bug in `wdired-get-filename' which returns the current
	239	;; directory concatened with the filename i.e
	240	;; "/home/you//home/you/foo" when filename is absolute in dired
	241	;; buffer.
	242	;; In consequence Wdired try to rename files even when buffer have
	243	;; been modified and corrected, e.g delete one char and replace it so
	244	;; that no change to file is done.
	245	;; This also lead to ask confirmation for every files even when not
	246	;; modified and when `wdired-use-interactive-rename' is nil.
	247	(defun helm--advice-wdired-get-filename (&optional no-dir old)
	248	;; FIXME: Use dired-get-filename's new properties.
	249	(let (beg end file)
	250	(save-excursion
	251	(setq end (line-end-position))
	252	(beginning-of-line)
	253	(setq beg (next-single-property-change (point) 'old-name nil end))
	254	(unless (eq beg end)
	255	(if old
	256	(setq file (get-text-property beg 'old-name))
	257	;; In the following form changed `(1+ beg)' to `beg' so that
	258	;; the filename end is found even when the filename is empty.
	259	;; Fixes error and spurious newlines when marking files for
	260	;; deletion.
	261	(setq end (next-single-property-change beg 'end-name))
	262	(setq file (buffer-substring-no-properties (1+ beg) end)))
	263	;; Don't unquote the old name, it wasn't quoted in the first place
	264	(and file (setq file (condition-case _err
	265	;; emacs-25+
	266	(apply #'wdired-normalize-filename
	267	(list file (not old)))
	268	(wrong-number-of-arguments
	269	;; emacs-24
	270	(wdired-normalize-filename file))))))
	271	(if (or no-dir old (and file (file-name-absolute-p file)))
	272	file
	273	(and file (> (length file) 0)
	274	(expand-file-name file (dired-current-directory)))))))
	275
	276	;;; Override `push-mark'
	277	;;
	278	;; Fix duplicates in `mark-ring' and `global-mark-ring' and update
	279	;; buffers in `global-mark-ring' to recentest mark.
	280	(defun helm--advice-push-mark (&optional location nomsg activate)
	281	(unless (null (mark t))
	282	(let ((marker (copy-marker (mark-marker))))
	283	(setq mark-ring (cons marker (delete marker mark-ring))))
	284	(when (> (length mark-ring) mark-ring-max)
	285	;; Move marker to nowhere.
	286	(set-marker (car (nthcdr mark-ring-max mark-ring)) nil)
	287	(setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))
	288	(set-marker (mark-marker) (or location (point)) (current-buffer))
	289	;; Now push the mark on the global mark ring.
	290	(setq global-mark-ring (cons (copy-marker (mark-marker))
	291	;; Avoid having multiple entries
	292	;; for same buffer in `global-mark-ring'.
	293	(cl-loop with mb = (current-buffer)
	294	for m in global-mark-ring
	295	for nmb = (marker-buffer m)
	296	unless (eq mb nmb)
	297	collect m)))
	298	(when (> (length global-mark-ring) global-mark-ring-max)
	299	(set-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
	300	(setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))
	301	(or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
	302	(message "Mark set"))
	303	(when (or activate (not transient-mark-mode))
	304	(set-mark (mark t)))
	305	nil)
	306
	307	(defcustom helm-advice-push-mark t
	308	"Override `push-mark' with a version avoiding duplicates when non nil."
	309	:group 'helm
	310	:type 'boolean
	311	:set (lambda (var val)
	312	(set var val)
	313	(if val
	314	(advice-add 'push-mark :override #'helm--advice-push-mark)
	315	(advice-remove 'push-mark #'helm--advice-push-mark))))
	316
	317	;;; Macros helper.
	318	;;
	319	(defmacro helm-with-gensyms (symbols &rest body)
	320	"Bind the SYMBOLS to fresh uninterned symbols and eval BODY."
	321	(declare (indent 1))
	322	`(let ,(mapcar (lambda (s)
	323	;; Use cl-gensym here instead of make-symbol
	324	;; to ensure a symbol that have a live that go
	325	;; beyond the live of its macro have different name.
	326	;; i.e symbols created with `with-helm-temp-hook'
	327	;; should have random names.
	328	`(,s (cl-gensym (symbol-name ',s))))
	329	symbols)
	330	,@body))
	331
	332	;;; Command loop helper
	333	;;
	334	(defun helm-this-command ()
	335	"Returns the actual command in action.
	336	Like `this-command' but return the real command,
	337	and not `exit-minibuffer' or other unwanted functions."
	338	(cl-loop with bl = '(helm-maybe-exit-minibuffer
	339	helm-confirm-and-exit-minibuffer
	340	helm-exit-minibuffer
	341	exit-minibuffer)
	342	for count from 1 to 50
	343	for btf = (backtrace-frame count)
	344	for fn = (cl-second btf)
	345	if (and
	346	;; In some case we may have in the way an
	347	;; advice compiled resulting in byte-code,
	348	;; ignore it (Issue #691).
	349	(symbolp fn)
	350	(commandp fn)
	351	(not (memq fn bl)))
	352	return fn
	353	else
	354	if (and (eq fn 'call-interactively)
	355	(> (length btf) 2))
	356	return (cadr (cdr btf))))
	357
	358
	359	;;; Iterators
	360	;;
	361	(cl-defmacro helm-position (item seq &key test all)
	362	"A simple and faster replacement of CL `position'.
	363
	364	Returns ITEM first occurence position found in SEQ.
	365	When SEQ is a string, ITEM have to be specified as a char.
	366	Argument TEST when unspecified default to `eq'.
	367	When argument ALL is non--nil return a list of all ITEM positions
	368	found in SEQ."
	369	(let ((key (if (stringp seq) 'across 'in)))
	370	`(cl-loop with deftest = 'eq
	371	for c ,key ,seq
	372	for index from 0
	373	when (funcall (or ,test deftest) c ,item)
	374	if ,all collect index into ls
	375	else return index
	376	finally return ls)))
	377
	378	(defun helm-iter-list (seq)
	379	"Return an iterator object from SEQ."
	380	(let ((lis seq))
	381	(lambda ()
	382	(let ((elm (car lis)))
	383	(setq lis (cdr lis))
	384	elm))))
	385
	386	(defun helm-iter-circular (seq)
	387	"Infinite iteration on SEQ."
	388	(let ((lis seq))
	389	(lambda ()
	390	(let ((elm (car lis)))
	391	(setq lis (pcase lis (`(,_ . ,ll) (or ll seq))))
	392	elm))))
	393
	394	(cl-defun helm-iter-sub-next-circular (seq elm &key (test 'eq))
	395	"Infinite iteration of SEQ starting at ELM."
	396	(let* ((pos (1+ (helm-position elm seq :test test)))
	397	(sub (append (nthcdr pos seq) (cl-subseq seq 0 pos)))
	398	(iterator (helm-iter-circular sub)))
	399	(lambda ()
	400	(helm-iter-next iterator))))
	401
	402	(defun helm-iter-next (iterator)
	403	"Return next elm of ITERATOR."
	404	(and iterator (funcall iterator)))
	405
	406
	407	;;; Anaphoric macros.
	408	;;
	409	(defmacro helm-aif (test-form then-form &rest else-forms)
	410	"Anaphoric version of `if'.
	411	Like `if' but set the result of TEST-FORM in a temporary variable called `it'.
	412	THEN-FORM and ELSE-FORMS are then excuted just like in `if'."
	413	(declare (indent 2) (debug t))
	414	`(let ((it ,test-form))
	415	(if it ,then-form ,@else-forms)))
	416
	417	(defmacro helm-awhile (sexp &rest body)
	418	"Anaphoric version of `while'.
	419	Same usage as `while' except that SEXP is bound to
	420	a temporary variable called `it' at each turn.
	421	An implicit nil block is bound to the loop so usage
	422	of `cl-return' is possible to exit the loop."
	423	(declare (indent 1) (debug t))
	424	(helm-with-gensyms (flag)
	425	`(let ((,flag t))
	426	(cl-block nil
	427	(while ,flag
	428	(helm-aif ,sexp
	429	(progn ,@body)
	430	(setq ,flag nil)))))))
	431
	432	(defmacro helm-acond (&rest clauses)
	433	"Anaphoric version of `cond'.
	434	In each clause of CLAUSES, the result of the car of clause
	435	is stored in a temporary variable called `it' and usable in the cdr
	436	of this same clause. Each `it' variable is independent of its clause.
	437	The usage is the same as `cond'."
	438	(declare (debug cond))
	439	(unless (null clauses)
	440	(helm-with-gensyms (sym)
	441	(let ((clause1 (car clauses)))
	442	`(let ((,sym ,(car clause1)))
	443	(helm-aif ,sym
	444	(if (cdr ',clause1)
	445	(progn ,@(cdr clause1))
	446	it)
	447	(helm-acond ,@(cdr clauses))))))))
	448
	449	(defmacro helm-aand (&rest conditions)
	450	"Anaphoric version of `and'.
	451	Each condition is bound to a temporary variable called `it' which is
	452	usable in next condition."
	453	(declare (debug (&rest form)))
	454	(cond ((null conditions) t)
	455	((null (cdr conditions)) (car conditions))
	456	(t `(helm-aif ,(car conditions)
	457	(helm-aand ,@(cdr conditions))))))
	458
	459	(defmacro helm-acase (expr &rest clauses)
	460	"A simple anaphoric `cl-case' implementation handling strings.
	461	EXPR is bound to a temporary variable called `it' which is usable in
	462	CLAUSES to refer to EXPR.
	463	NOTE: Duplicate keys in CLAUSES are deliberately not handled."
	464	(declare (indent 1) (debug t))
	465	(unless (null clauses)
	466	(let ((clause1 (car clauses)))
	467	`(let ((key ',(car clause1))
	468	(it ,expr))
	469	(if (or (equal it key)
	470	(eq key t)
	471	(and (listp key) (member it key)))
	472	(progn ,@(cdr clause1))
	473	(helm-acase it ,@(cdr clauses)))))))
	474
	475	;;; Fuzzy matching routines
	476	;;
	477	(defsubst helm--mapconcat-pattern (pattern)
	478	"Transform string PATTERN in regexp for further fuzzy matching.
	479	e.g helm.el$
	480	=> \"[^h]h[^e]e[^l]l[^m]m[^.][.][^e]e[^l]*l$\"
	481	^helm.el$
	482	=> \"helm[.]el$\"."
	483	(let ((ls (split-string-and-unquote pattern "")))
	484	(if (string= "^" (car ls))
	485	;; Exact match.
	486	(mapconcat (lambda (c)
	487	(if (and (string= c "$")
	488	(string-match "$\\'" pattern))
	489	c (regexp-quote c)))
	490	(cdr ls) "")
	491	;; Fuzzy match.
	492	(mapconcat (lambda (c)
	493	(if (and (string= c "$")
	494	(string-match "$\\'" pattern))
	495	c (format "[^%s]*%s" c (regexp-quote c))))
	496	ls ""))))
	497
	498	(defsubst helm--collect-pairs-in-string (string)
	499	(cl-loop for str on (split-string string "" t) by 'cdr
	500	when (cdr str)
	501	collect (list (car str) (cadr str))))
	502
	503	;;; Help routines.
	504	;;
	505	(defun helm-help-internal (bufname insert-content-fn)
	506	"Show long message during `helm' session in BUFNAME.
	507	INSERT-CONTENT-FN is the function that insert
	508	text to be displayed in BUFNAME."
	509	(let ((winconf (current-frame-configuration))
	510	(hframe (selected-frame)))
	511	(with-selected-frame helm-initial-frame
	512	(select-frame-set-input-focus helm-initial-frame)
	513	(unwind-protect
	514	(progn
	515	(setq helm-suspend-update-flag t)
	516	(set-buffer (get-buffer-create bufname))
	517	(switch-to-buffer bufname)
	518	(when helm-help-full-frame (delete-other-windows))
	519	(delete-region (point-min) (point-max))
	520	(org-mode)
	521	(org-mark-ring-push) ; Put mark at bob
	522	(save-excursion
	523	(funcall insert-content-fn))
	524	(buffer-disable-undo)
	525	(helm-help-event-loop))
	526	(raise-frame hframe)
	527	(setq helm-suspend-update-flag nil)
	528	(set-frame-configuration winconf)))))
	529
	530	(defun helm-help-scroll-up (amount)
	531	(condition-case _err
	532	(scroll-up-command amount)
	533	(beginning-of-buffer nil)
	534	(end-of-buffer nil)))
	535
	536	(defun helm-help-scroll-down (amount)
	537	(condition-case _err
	538	(scroll-down-command amount)
	539	(beginning-of-buffer nil)
	540	(end-of-buffer nil)))
	541
	542	(defun helm-help-next-line ()
	543	(condition-case _err
	544	(call-interactively #'next-line)
	545	(beginning-of-buffer nil)
	546	(end-of-buffer nil)))
	547
	548	(defun helm-help-previous-line ()
	549	(condition-case _err
	550	(call-interactively #'previous-line)
	551	(beginning-of-buffer nil)
	552	(end-of-buffer nil)))
	553
	554	(defun helm-help-toggle-mark ()
	555	(if (region-active-p)
	556	(deactivate-mark)
	557	(push-mark nil nil t)))
	558
	559	;; For movement of cursor in help buffer we need to call interactively
	560	;; commands for impaired people using a synthetizer (#1347).
	561	(defun helm-help-event-loop ()
	562	(let ((prompt (propertize
	563	"[SPC,C-v,next:ScrollUp b,M-v,prior:ScrollDown TAB:Cycle M-TAB:All C-s/r:Isearch q:Quit]"
	564	'face 'helm-helper))
	565	scroll-error-top-bottom
	566	(iter-org-state (helm-iter-circular '(1 (16) (64)))))
	567	(helm-awhile (read-key prompt)
	568	(cl-case it
	569	((?\C-v ? next) (helm-help-scroll-up helm-scroll-amount))
	570	((?\M-v ?b prior) (helm-help-scroll-down helm-scroll-amount))
	571	(?\C-s (isearch-forward))
	572	(?\C-r (isearch-backward))
	573	(?\C-a (call-interactively #'move-beginning-of-line))
	574	(?\C-e (call-interactively #'move-end-of-line))
	575	((?\C-f right) (call-interactively #'forward-char))
	576	((?\C-b left) (call-interactively #'backward-char))
	577	((?\C-n down) (helm-help-next-line))
	578	((?\C-p up) (helm-help-previous-line))
	579	(?\M-a (call-interactively #'backward-sentence))
	580	(?\M-e (call-interactively #'forward-sentence))
	581	(?\M-f (call-interactively #'forward-word))
	582	(?\M-b (call-interactively #'backward-word))
	583	(?\M-> (call-interactively #'end-of-buffer))
	584	(?\M-< (call-interactively #'beginning-of-buffer))
	585	(?\C- (helm-help-toggle-mark))
	586	(?\t (org-cycle))
	587	(?\C-m (ignore-errors (call-interactively #'org-open-at-point)))
	588	(?\C-& (ignore-errors (call-interactively #'org-mark-ring-goto)))
	589	(?\C-% (call-interactively #'org-mark-ring-push))
	590	(?\M-\t (pcase (helm-iter-next iter-org-state)
	591	((pred numberp) (org-content))
	592	((and state) (org-cycle state))))
	593	(?\M-w (copy-region-as-kill
	594	(region-beginning) (region-end))
	595	(deactivate-mark))
	596	(?q (cl-return))
	597	(t (ignore))))))
	598
	599
	600	;;; Multiline transformer
	601	;;
	602	(defun helm-multiline-transformer (candidates _source)
	603	(cl-loop with offset = (helm-interpret-value
	604	(assoc-default 'multiline (helm-get-current-source)))
	605	for i in candidates
	606	if (numberp offset)
	607	collect (cons (helm--multiline-get-truncated-candidate i offset) i)
	608	else collect i))
	609
	610	(defun helm--multiline-get-truncated-candidate (candidate offset)
	611	"Truncate CANDIDATE when its length is > than OFFSET."
	612	(with-temp-buffer
	613	(insert candidate)
	614	(goto-char (point-min))
	615	(if (and offset
	616	(> (buffer-size) offset))
	617	(let ((end-str "[...]"))
	618	(concat
	619	(buffer-substring
	620	(point)
	621	(save-excursion
	622	(forward-char offset)
	623	(setq end-str (if (looking-at "\n")
	624	end-str (concat "\n" end-str)))
	625	(point)))
	626	end-str))
	627	(buffer-string))))
	628
	629	;;; List processing
	630	;;
	631	(defun helm-flatten-list (seq &optional omit-nulls)
	632	"Return a list of all single elements of sublists in SEQ."
	633	(let (result)
	634	(cl-labels ((flatten (seq)
	635	(cl-loop
	636	for elm in seq
	637	if (and (or elm
	638	(null omit-nulls))
	639	(or (atom elm)
	640	(functionp elm)
	641	(and (consp elm)
	642	(cdr elm)
	643	(atom (cdr elm)))))
	644	do (push elm result)
	645	else do (flatten elm))))
	646	(flatten seq))
	647	(nreverse result)))
	648
	649	(defun helm-mklist (obj)
	650	"If OBJ is a list $but not lambda$, return itself.
	651	Otherwise make a list with one element."
	652	(if (and (listp obj) (not (functionp obj)))
	653	obj
	654	(list obj)))
	655
	656	(cl-defun helm-fast-remove-dups (seq &key (test 'eq))
	657	"Remove duplicates elements in list SEQ.
	658
	659	This is same as `remove-duplicates' but with memoisation.
	660	It is much faster, especially in large lists.
	661	A test function can be provided with TEST argument key.
	662	Default is `eq'.
	663	NOTE: Comparison of special elisp objects (e.g. markers etc...) fails
	664	because their printed representations which are stored in hash-table
	665	can't be compared with with the real object in SEQ.
	666	This is a bug in `puthash' which store the printable representation of
	667	object instead of storing the object itself, this to provide at the
	668	end a printable representation of hashtable itself."
	669	(cl-loop with cont = (make-hash-table :test test)
	670	for elm in seq
	671	unless (gethash elm cont)
	672	collect (puthash elm elm cont)))
	673
	674	(defsubst helm--string-join (strings &optional separator)
	675	"Join all STRINGS using SEPARATOR."
	676	(mapconcat 'identity strings separator))
	677
	678	(defun helm--concat-regexps (regexp-list)
	679	"Return a regexp which matches any of the regexps in REGEXP-LIST."
	680	(if regexp-list
	681	(concat "\$?:" (helm--string-join regexp-list "\$\\\|\$?:") "\$")
	682	"\\<\\>")) ; Match nothing
	683
	684	(defun helm-skip-entries (seq black-regexp-list &optional white-regexp-list)
	685	"Remove entries which matches one of REGEXP-LIST from SEQ."
	686	(let ((black-regexp (helm--concat-regexps black-regexp-list))
	687	(white-regexp (helm--concat-regexps white-regexp-list)))
	688	(cl-loop for i in seq
	689	unless (and (stringp i)
	690	(string-match-p black-regexp i)
	691	(null
	692	(string-match-p white-regexp i)))
	693	collect i)))
	694
	695	(defun helm-boring-directory-p (directory black-list)
	696	"Check if one regexp in BLACK-LIST match DIRECTORY."
	697	(helm-awhile (helm-basedir (directory-file-name
	698	(expand-file-name directory)))
	699	(when (string= it "/") (cl-return nil))
	700	(when (cl-loop for r in black-list
	701	thereis (string-match-p
	702	r (directory-file-name directory)))
	703	(cl-return t))
	704	(setq directory it)))
	705
	706	(defun helm-shadow-entries (seq regexp-list)
	707	"Put shadow property on entries in SEQ matching a regexp in REGEXP-LIST."
	708	(let ((face 'italic))
	709	(cl-loop for i in seq
	710	if (cl-loop for regexp in regexp-list
	711	thereis (and (stringp i)
	712	(string-match regexp i)))
	713	collect (propertize i 'face face)
	714	else collect i)))
	715
	716	(defun helm-remove-if-not-match (regexp seq)
	717	"Remove all elements of SEQ that don't match REGEXP."
	718	(cl-loop for s in seq
	719	for str = (cond ((symbolp s)
	720	(symbol-name s))
	721	((consp s)
	722	(car s))
	723	(t s))
	724	when (string-match-p regexp str)
	725	collect s))
	726
	727	(defun helm-remove-if-match (regexp seq)
	728	"Remove all elements of SEQ that match REGEXP."
	729	(cl-loop for s in seq
	730	for str = (cond ((symbolp s)
	731	(symbol-name s))
	732	((consp s)
	733	(car s))
	734	(t s))
	735	unless (string-match-p regexp str)
	736	collect s))
	737
	738	(defun helm-transform-mapcar (function args)
	739	"`mapcar' for candidate-transformer.
	740
	741	ARGS is (cand1 cand2 ...) or ((disp1 . real1) (disp2 . real2) ...)
	742
	743	\(helm-transform-mapcar 'upcase '(\"foo\" \"bar\"))
	744	=> (\"FOO\" \"BAR\")
	745	\(helm-transform-mapcar 'upcase '((\"1st\" . \"foo\") (\"2nd\" . \"bar\")))
	746	=> ((\"1st\" . \"FOO\") (\"2nd\" . \"BAR\"))
	747	"
	748	(cl-loop for arg in args
	749	if (consp arg)
	750	collect (cons (car arg) (funcall function (cdr arg)))
	751	else
	752	collect (funcall function arg)))
	753
	754	(defun helm-append-at-nth (seq elm index)
	755	"Append ELM at INDEX in SEQ."
	756	(let ((len (length seq)))
	757	(cond ((> index len) (setq index len))
	758	((< index 0) (setq index 0)))
	759	(if (zerop index)
	760	(append elm seq)
	761	(cl-loop for i in seq
	762	for count from 1 collect i
	763	when (= count index)
	764	if (listp elm) append elm
	765	else collect elm))))
	766
	767	(defun helm-source-by-name (name &optional sources)
	768	"Get a Helm source in SOURCES by NAME.
	769
	770	Optional argument SOURCES is a list of Helm sources which default to
	771	`helm-sources'."
	772	(cl-loop with src-list = (if sources
	773	(cl-loop for src in sources
	774	collect (if (listp src)
	775	src
	776	(symbol-value src)))
	777	helm-sources)
	778	for source in src-list
	779	thereis (and (string= name (assoc-default 'name source)) source)))
	780
	781	(defun helm-make-actions (&rest args)
	782	"Build an alist with (NAME . ACTION) elements with each pairs in ARGS.
	783	Where NAME is a string or a function returning a string or nil and ACTION
	784	a function.
	785	If NAME returns nil the pair is skipped.
	786
	787	\(fn NAME ACTION ...)"
	788	(cl-loop for (name fn) on args by #'cddr
	789	when (functionp name)
	790	do (setq name (funcall name))
	791	when name
	792	collect (cons name fn)))
	793
	794	;;; Strings processing.
	795	;;
	796	(defun helm-stringify (elm)
	797	"Return the representation of ELM as a string.
	798	ELM can be a string, a number or a symbol."
	799	(cl-typecase elm
	800	(string elm)
	801	(number (number-to-string elm))
	802	(symbol (symbol-name elm))))
	803
	804	(defun helm-substring (str width)
	805	"Return the substring of string STR from 0 to WIDTH.
	806	Handle multibyte characters by moving by columns."
	807	(with-temp-buffer
	808	(save-excursion
	809	(insert str))
	810	(move-to-column width)
	811	(buffer-substring (point-at-bol) (point))))
	812
	813	(defun helm-substring-by-width (str width &optional endstr)
	814	"Truncate string STR to end at column WIDTH.
	815	Similar to `truncate-string-to-width'.
	816	Add ENDSTR at end of truncated STR.
	817	Add spaces at end if needed to reach WIDTH when STR is shorter than WIDTH."
	818	(cl-loop for ini-str = str
	819	then (substring ini-str 0 (1- (length ini-str)))
	820	for sw = (string-width ini-str)
	821	when (<= sw width) return
	822	(concat ini-str endstr (make-string (- width sw) ? ))))
	823
	824	(defun helm-string-multibyte-p (str)
	825	"Check if string STR contains multibyte characters."
	826	(cl-loop for c across str
	827	thereis (> (char-width c) 1)))
	828
	829	(defun helm-get-pid-from-process-name (process-name)
	830	"Get pid from running process PROCESS-NAME."
	831	(cl-loop with process-list = (list-system-processes)
	832	for pid in process-list
	833	for process = (assoc-default 'comm (process-attributes pid))
	834	when (and process (string-match process-name process))
	835	return pid))
	836
	837	(defun helm-ff-find-printers ()
	838	"Return a list of available printers on Unix systems."
	839	(when (executable-find "lpstat")
	840	(let ((printer-list (with-temp-buffer
	841	(call-process "lpstat" nil t nil "-a")
	842	(split-string (buffer-string) "\n"))))
	843	(cl-loop for p in printer-list
	844	for printer = (car (split-string p))
	845	when printer
	846	collect printer))))
	847
	848	(defun helm-region-active-p ()
	849	(and transient-mark-mode mark-active (/= (mark) (point))))
	850
	851	(defun helm-quote-whitespace (candidate)
	852	"Quote whitespace, if some, in string CANDIDATE."
	853	(replace-regexp-in-string " " "\\\\ " candidate))
	854
	855	(defun helm-current-line-contents ()
	856	"Current line string without properties."
	857	(buffer-substring-no-properties (point-at-bol) (point-at-eol)))
	858
	859	(defun helm--replace-regexp-in-buffer-string (regexp rep str &optional fixedcase literal subexp start)
	860	"Replace REGEXP by REP in string STR.
	861
	862	Same as `replace-regexp-in-string' but handle properly REP as
	863	function with SUBEXP specified.
	864
	865	e.g
	866
	867	(helm--replace-regexp-in-buffer-string \"e\\\$m\\\$acs\" 'upcase \"emacs\" t nil 1)
	868	=> \"eMacs\"
	869
	870	(replace-regexp-in-string \"e\\\$m\\\$acs\" 'upcase \"emacs\" t nil 1)
	871	=> \"eEMACSacs\"
	872
	873	Also START argument behave as expected unlike
	874	`replace-regexp-in-string'.
	875
	876	e.g
	877
	878	(helm--replace-regexp-in-buffer-string \"f\" \"r\" \"foofoo\" t nil nil 3)
	879	=> \"fooroo\"
	880
	881	(replace-regexp-in-string \"f\" \"r\" \"foofoo\" t nil nil 3)
	882	=> \"roo\"
	883
	884	Unlike `replace-regexp-in-string' this function is buffer-based
	885	implemented i.e replacement is computed inside a temp buffer, so
	886	REGEXP should be used differently than with
	887	`replace-regexp-in-string'.
	888
	889	NOTE: This function is used internally for
	890	`helm-ff-query-replace-on-filenames' and builded for this.
	891	You should use `replace-regexp-in-string' instead unless the behavior
	892	of this function is really needed."
	893	(with-temp-buffer
	894	(insert str)
	895	(goto-char (or start (point-min)))
	896	(while (re-search-forward regexp nil t)
	897	(replace-match (cond ((and (functionp rep) subexp)
	898	(funcall rep (match-string subexp)))
	899	((functionp rep)
	900	(funcall rep str))
	901	(t rep))
	902	fixedcase literal nil subexp))
	903	(buffer-string)))
	904
	905	(defun helm-url-unhex-string (str)
	906	"Same as `url-unhex-string' but ensure STR is completely decoded."
	907	(setq str (or str ""))
	908	(with-temp-buffer
	909	(save-excursion (insert str))
	910	(while (re-search-forward "%[A-Za-z0-9]\\{2\\}" nil t)
	911	(replace-match (byte-to-string (string-to-number
	912	(substring (match-string 0) 1)
	913	16))
	914	t t)
	915	;; Restart from beginning until string is completely decoded.
	916	(goto-char (point-min)))
	917	(decode-coding-string (buffer-string) 'utf-8)))
	918
	919	(defun helm-read-answer (prompt answer-list)
	920	"Prompt user for an answer.
	921	Arg PROMPT is the prompt to present user the different possible
	922	answers, ANSWER-LIST is a list of strings.
	923	If user enter an answer which is one of ANSWER-LIST return this
	924	answer, otherwise keep prompting for a valid answer.
	925	Note that answer should be a single char, only short answer are
	926	accepted.
	927
	928	Example:
	929
	930	(let ((answer (helm-read-answer
	931	\"answer [y,n,!,q]: \"
	932	'(\"y\" \"n\" \"!\" \"q\"))))
	933	(pcase answer
	934	(\"y\" \"yes\")
	935	(\"n\" \"no\")
	936	(\"!\" \"all\")
	937	(\"q\" \"quit\")))
	938
	939	"
	940	(helm-awhile (string
	941	(read-key (propertize prompt 'face 'minibuffer-prompt)))
	942	(if (member it answer-list)
	943	(cl-return it)
	944	(message "Please answer by %s" (mapconcat 'identity answer-list ", "))
	945	(sit-for 1))))
	946
	947	;;; Symbols routines
	948	;;
	949	(defun helm-symbolify (str-or-sym)
	950	"Get symbol of STR-OR-SYM."
	951	(if (symbolp str-or-sym)
	952	str-or-sym
	953	(intern str-or-sym)))
	954
	955	(defun helm-symbol-name (obj)
	956	(if (or (and (consp obj) (functionp obj))
	957	(byte-code-function-p obj))
	958	"Anonymous"
	959	(symbol-name obj)))
	960
	961	(defun helm-describe-function (func)
	962	"FUNC is symbol or string."
	963	(cl-letf (((symbol-function 'message) #'ignore))
	964	(describe-function (helm-symbolify func))))
	965
	966	(defun helm-describe-variable (var)
	967	"VAR is symbol or string."
	968	(cl-letf (((symbol-function 'message) #'ignore))
	969	(describe-variable (helm-symbolify var))))
	970
	971	(defun helm-describe-face (face)
	972	"FACE is symbol or string."
	973	(let ((faces (helm-marked-candidates)))
	974	(cl-letf (((symbol-function 'message) #'ignore))
	975	(describe-face (if (cdr faces)
	976	(mapcar 'helm-symbolify faces)
	977	(helm-symbolify face))))))
	978
	979	(defun helm-elisp--persistent-help (candidate fun &optional name)
	980	"Used to build persistent actions describing CANDIDATE with FUN.
	981	Argument NAME is used internally to know which command to use when
	982	symbol CANDIDATE refers at the same time to variable and a function.
	983	See `helm-elisp-show-help'."
	984	(let ((hbuf (get-buffer (help-buffer))))
	985	(cond ((helm-follow-mode-p)
	986	(if name
	987	(funcall fun candidate name)
	988	(funcall fun candidate)))
	989	((or (and (helm-attr 'help-running-p)
	990	(string= candidate (helm-attr 'help-current-symbol))))
	991	(progn
	992	;; When started from a help buffer,
	993	;; Don't kill this buffer as it is helm-current-buffer.
	994	(unless (equal hbuf helm-current-buffer)
	995	(set-window-buffer (get-buffer-window hbuf)
	996	helm-current-buffer)
	997	(kill-buffer hbuf))
	998	(helm-attrset 'help-running-p nil)))
	999	(t
	1000	(if name
	1001	(funcall fun candidate name)
	1002	(funcall fun candidate))
	1003	(helm-attrset 'help-running-p t)))
	1004	(helm-attrset 'help-current-symbol candidate)))
	1005
	1006	(defun helm-find-function (func)
	1007	"FUNC is symbol or string."
	1008	(find-function (helm-symbolify func)))
	1009
	1010	(defun helm-find-variable (var)
	1011	"VAR is symbol or string."
	1012	(find-variable (helm-symbolify var)))
	1013
	1014	(defun helm-find-face-definition (face)
	1015	"FACE is symbol or string."
	1016	(find-face-definition (helm-symbolify face)))
	1017
	1018	(defun helm-kill-new (candidate &optional replace)
	1019	"CANDIDATE is symbol or string.
	1020	See `kill-new' for argument REPLACE."
	1021	(kill-new (helm-stringify candidate) replace))
	1022
	1023
	1024	;;; Modes
	1025	;;
	1026	(defun helm-same-major-mode-p (start-buffer alist)
	1027	"Decide if current-buffer is related to START-BUFFER.
	1028	Argument ALIST is an alist of associated major modes."
	1029	;; START-BUFFER is the current-buffer where we start searching.
	1030	;; Determine the major-mode of START-BUFFER as `cur-maj-mode'.
	1031	;; Each time the loop go in another buffer we try from this buffer
	1032	;; to determine if its `major-mode' is:
	1033	;; - same as the `cur-maj-mode'
	1034	;; - derived from `cur-maj-mode' and from
	1035	;; START-BUFFER if its mode is derived from the one in START-BUFFER.
	1036	;; - have an assoc entry (major-mode . cur-maj-mode)
	1037	;; - have an rassoc entry (cur-maj-mode . major-mode)
	1038	;; - check if one of these entries inherit from another one in
	1039	;; `alist'.
	1040	(let* ((cur-maj-mode (with-current-buffer start-buffer major-mode))
	1041	(maj-mode major-mode)
	1042	(c-assoc-mode (assq cur-maj-mode alist))
	1043	(c-rassoc-mode (rassq cur-maj-mode alist))
	1044	(o-assoc-mode (assq major-mode alist))
	1045	(o-rassoc-mode (rassq major-mode alist))
	1046	(cdr-c-assoc-mode (cdr c-assoc-mode))
	1047	(cdr-o-assoc-mode (cdr o-assoc-mode)))
	1048	(or (eq major-mode cur-maj-mode)
	1049	(derived-mode-p cur-maj-mode)
	1050	(with-current-buffer start-buffer
	1051	(derived-mode-p maj-mode))
	1052	(or (eq cdr-c-assoc-mode major-mode)
	1053	(eq (car c-rassoc-mode) major-mode)
	1054	(eq (cdr (assq cdr-c-assoc-mode alist))
	1055	major-mode)
	1056	(eq (car (rassq cdr-c-assoc-mode alist))
	1057	major-mode))
	1058	(or (eq cdr-o-assoc-mode cur-maj-mode)
	1059	(eq (car o-rassoc-mode) cur-maj-mode)
	1060	(eq (cdr (assq cdr-o-assoc-mode alist))
	1061	cur-maj-mode)
	1062	(eq (car (rassq cdr-o-assoc-mode alist))
	1063	cur-maj-mode)))))
	1064
	1065	;;; Files routines
	1066	;;
	1067	(defun helm-file-name-sans-extension (filename)
	1068	"Same as `file-name-sans-extension' but remove all extensions."
	1069	(helm-aif (file-name-sans-extension filename)
	1070	;; Start searching at index 1 for files beginning with a dot (#1335).
	1071	(if (string-match "\\." (helm-basename it) 1)
	1072	(helm-file-name-sans-extension it)
	1073	it)))
	1074
	1075	(defun helm-basename (fname &optional ext)
	1076	"Print FNAME with any leading directory components removed.
	1077	If specified, also remove filename extension EXT.
	1078	Arg EXT can be specified as a string with or without dot,
	1079	in this case it should match file-name-extension.
	1080	It can also be non-nil (`t') in this case no checking
	1081	of file-name-extension is done and the extension is removed
	1082	unconditionally."
	1083	(let ((non-essential t))
	1084	(if (and ext (or (string= (file-name-extension fname) ext)
	1085	(string= (file-name-extension fname t) ext)
	1086	(eq ext t))
	1087	(not (file-directory-p fname)))
	1088	(file-name-sans-extension (file-name-nondirectory fname))
	1089	(file-name-nondirectory (directory-file-name fname)))))
	1090
	1091	(defun helm-basedir (fname)
	1092	"Return the base directory of filename ending by a slash."
	1093	(helm-aif (and fname
	1094	(or (and (string= fname "~") "~")
	1095	(file-name-directory fname)))
	1096	(file-name-as-directory it)))
	1097
	1098	(defun helm-current-directory ()
	1099	"Return current-directory name at point.
	1100	Useful in dired buffers when there is inserted subdirs."
	1101	(expand-file-name
	1102	(if (eq major-mode 'dired-mode)
	1103	(dired-current-directory)
	1104	default-directory)))
	1105
	1106	(defun helm-shadow-boring-files (files)
	1107	"Files matching `helm-boring-file-regexp' will be
	1108	displayed with the `file-name-shadow' face if available."
	1109	(helm-shadow-entries files helm-boring-file-regexp-list))
	1110
	1111	(defun helm-skip-boring-files (files)
	1112	"Files matching `helm-boring-file-regexp' will be skipped."
	1113	(helm-skip-entries files helm-boring-file-regexp-list))
	1114
	1115	(defun helm-skip-current-file (files)
	1116	"Current file will be skipped."
	1117	(remove (buffer-file-name helm-current-buffer) files))
	1118
	1119	(defun helm-w32-pathname-transformer (args)
	1120	"Change undesirable features of windows pathnames to ones more acceptable to
	1121	other candidate transformers."
	1122	(if (eq system-type 'windows-nt)
	1123	(helm-transform-mapcar
	1124	(lambda (x)
	1125	(replace-regexp-in-string
	1126	"/cygdrive/\$.\$" "\\1:"
	1127	(replace-regexp-in-string "\\\\" "/" x)))
	1128	args)
	1129	args))
	1130
	1131	(defun helm-w32-prepare-filename (file)
	1132	"Convert filename FILE to something usable by external w32 executables."
	1133	(replace-regexp-in-string ; For UNC paths
	1134	"/" "\\"
	1135	(replace-regexp-in-string ; Strip cygdrive paths
	1136	"/cygdrive/\$.\$" "\\1:"
	1137	file nil nil) nil t))
	1138
	1139	(defun helm-w32-shell-execute-open-file (file)
	1140	(with-no-warnings
	1141	(w32-shell-execute "open" (helm-w32-prepare-filename file))))
	1142
	1143	;; Same as `vc-directory-exclusion-list'.
	1144	(defvar helm-walk-ignore-directories
	1145	'("SCCS/" "RCS/" "CVS/" "MCVS/" ".svn/" ".git/" ".hg/" ".bzr/"
	1146	"_MTN/" "_darcs/" "{arch}/" ".gvfs/"))
	1147
	1148	(defsubst helm--dir-file-name (file dir)
	1149	(expand-file-name
	1150	(substring file 0 (1- (length file))) dir))
	1151
	1152	(defsubst helm--dir-name-p (str)
	1153	(char-equal (aref str (1- (length str))) ?/))
	1154
	1155	(cl-defun helm-walk-directory (directory &key (path 'basename)
	1156	directories
	1157	match skip-subdirs)
	1158	"Walk through DIRECTORY tree.
	1159
	1160	Argument PATH can be one of basename, relative, full, or a function
	1161	called on file name, default to basename.
	1162
	1163	Argument DIRECTORIES when non--nil (default) return also directories names,
	1164	otherwise skip directories names, with a value of 'only returns
	1165	only subdirectories, i.e files are skipped.
	1166
	1167	Argument MATCH is a regexp matching files or directories.
	1168
	1169	Argument SKIP-SUBDIRS when `t' will skip `helm-walk-ignore-directories'
	1170	otherwise if it is given as a list of directories, this list will be used
	1171	instead of `helm-walk-ignore-directories'."
	1172	(let ((fn (cl-case path
	1173	(basename 'file-name-nondirectory)
	1174	(relative 'file-relative-name)
	1175	(full 'identity)
	1176	(t path)))) ; A function.
	1177	(setq skip-subdirs (if (listp skip-subdirs)
	1178	skip-subdirs
	1179	helm-walk-ignore-directories))
	1180	(cl-labels ((ls-rec (dir)
	1181	(unless (file-symlink-p dir)
	1182	(cl-loop for f in (sort (file-name-all-completions "" dir)
	1183	'string-lessp)
	1184	unless (member f '("./" "../"))
	1185	;; A directory.
	1186	;; Use `helm--dir-file-name' to remove the final slash.
	1187	;; Needed to avoid infloop on directory symlinks.
	1188	if (and (helm--dir-name-p f)
	1189	(helm--dir-file-name f dir))
	1190	nconc
	1191	(unless (member f skip-subdirs)
	1192	(if (and directories
	1193	(or (null match)
	1194	(string-match match f)))
	1195	(nconc (list (concat (funcall fn it) "/"))
	1196	(ls-rec it))
	1197	(ls-rec it)))
	1198	;; A regular file.
	1199	else nconc
	1200	(when (and (null (eq directories 'only))
	1201	(or (null match) (string-match match f)))
	1202	(list (funcall fn (expand-file-name f dir))))))))
	1203	(ls-rec directory))))
	1204
	1205	(defun helm-file-expand-wildcards (pattern &optional full)
	1206	"Same as `file-expand-wildcards' but allow recursion.
	1207	Recursion happen when PATTERN starts with two stars.
	1208	Directories expansion is not supported."
	1209	(let ((bn (helm-basename pattern))
	1210	(case-fold-search nil))
	1211	(if (and helm-file-globstar
	1212	(string-match "\\`\\\\{2\\}\$.\$" bn))
	1213	(helm-walk-directory (helm-basedir pattern)
	1214	:path (cl-case full
	1215	(full 'full)
	1216	(relative 'relative)
	1217	((basename nil) 'basename)
	1218	(t 'full))
	1219	:directories nil
	1220	:match (wildcard-to-regexp bn)
	1221	:skip-subdirs t)
	1222	(file-expand-wildcards pattern full))))
	1223
	1224	;;; helm internals
	1225	;;
	1226	(defun helm-set-pattern (pattern &optional noupdate)
	1227	"Set minibuffer contents to PATTERN.
	1228	if optional NOUPDATE is non-nil, helm buffer is not changed."
	1229	(with-selected-window (or (active-minibuffer-window) (minibuffer-window))
	1230	(delete-minibuffer-contents)
	1231	(insert pattern))
	1232	(when noupdate
	1233	(setq helm-pattern pattern)))
	1234
	1235	(defun helm-minibuffer-completion-contents ()
	1236	"Return the user input in a minibuffer before point as a string.
	1237	That is what completion commands operate on."
	1238	(buffer-substring (field-beginning) (point)))
	1239
	1240	(defmacro with-helm-buffer (&rest body)
	1241	"Eval BODY inside `helm-buffer'."
	1242	(declare (indent 0) (debug t))
	1243	`(with-current-buffer (helm-buffer-get)
	1244	,@body))
	1245
	1246	(defmacro with-helm-current-buffer (&rest body)
	1247	"Eval BODY inside `helm-current-buffer'."
	1248	(declare (indent 0) (debug t))
	1249	`(with-current-buffer (or (and (buffer-live-p helm-current-buffer)
	1250	helm-current-buffer)
	1251	(setq helm-current-buffer
	1252	(current-buffer)))
	1253	,@body))
	1254
	1255	(defun helm-buffer-get ()
	1256	"Return `helm-action-buffer' if shown otherwise `helm-buffer'."
	1257	(if (helm-action-window)
	1258	helm-action-buffer
	1259	helm-buffer))
	1260
	1261	(defun helm-window ()
	1262	"Window of `helm-buffer'."
	1263	(get-buffer-window (helm-buffer-get) 0))
	1264
	1265	(defun helm-action-window ()
	1266	"Window of `helm-action-buffer'."
	1267	(get-buffer-window helm-action-buffer 'visible))
	1268
	1269	(defmacro with-helm-window (&rest body)
	1270	"Be sure BODY is excuted in the helm window."
	1271	(declare (indent 0) (debug t))
	1272	`(with-selected-window (helm-window)
	1273	,@body))
	1274
	1275
	1276	;; Yank text at point.
	1277	;;
	1278	;;
	1279	(defun helm-yank-text-at-point (arg)
	1280	"Yank text at point in `helm-current-buffer' into minibuffer."
	1281	(interactive "p")
	1282	(with-helm-current-buffer
	1283	(let ((fwd-fn (or helm-yank-text-at-point-function #'forward-word))
	1284	diff)
	1285	;; Start to initial point if C-w have never been hit.
	1286	(unless helm-yank-point
	1287	(setq helm-yank-point (car helm-current-position)))
	1288	(save-excursion
	1289	(goto-char helm-yank-point)
	1290	(helm-set-pattern
	1291	(if (< arg 0)
	1292	(with-temp-buffer
	1293	(insert helm-pattern)
	1294	(let ((end (point-max)))
	1295	(goto-char end)
	1296	(funcall fwd-fn -1)
	1297	(setq diff (- end (point)))
	1298	(delete-region (point) end)
	1299	(buffer-string)))
	1300	(funcall fwd-fn arg)
	1301	(concat
	1302	;; Allow yankink beyond eol allow inserting e.g long
	1303	;; urls in mail buffers.
	1304	helm-pattern (replace-regexp-in-string
	1305	"\\`\n" ""
	1306	(buffer-substring-no-properties
	1307	helm-yank-point (point))))))
	1308	(setq helm-yank-point (if diff (- (point) diff) (point)))))))
	1309	(put 'helm-yank-text-at-point 'helm-only t)
	1310
	1311	(defun helm-undo-yank-text-at-point ()
	1312	"Undo last entry added by `helm-yank-text-at-point'."
	1313	(interactive)
	1314	(helm-yank-text-at-point -1))
	1315	(put 'helm-undo-yank-text-at-point 'helm-only t)
	1316
	1317	(defun helm-reset-yank-point ()
	1318	(setq helm-yank-point nil))
	1319
	1320	(add-hook 'helm-cleanup-hook 'helm-reset-yank-point)
	1321	(add-hook 'helm-after-initialize-hook 'helm-reset-yank-point)
	1322
	1323	;;; Ansi
	1324	;;
	1325	;;
	1326	(defvar helm--ansi-color-regexp
	1327	"\033\\[\$K\\\|[0-9;]*m\$")
	1328	(defvar helm--ansi-color-drop-regexp
	1329	"\033\\[\$[ABCDsuK]\\\|[12][JK]\\\|=[0-9]+[hI]\\\|[0-9;]*[Hf]\$")
	1330	(defun helm--ansi-color-apply (string)
	1331	"A version of `ansi-color-apply' immune to upstream changes.
	1332
	1333	Similar to the emacs-24.5 version without support to `ansi-color-context'
	1334	which is buggy in emacs.
	1335
	1336	Modify also `ansi-color-regexp' by using own variable `helm--ansi-color-regexp'
	1337	that match whole STRING.
	1338
	1339	This is needed to provide compatibility for both emacs-25 and emacs-24.5
	1340	as emacs-25 version of `ansi-color-apply' is partially broken."
	1341	(let ((start 0)
	1342	codes end escape-sequence
	1343	result colorized-substring)
	1344	;; Find the next escape sequence.
	1345	(while (setq end (string-match helm--ansi-color-regexp string start))
	1346	(setq escape-sequence (match-string 1 string))
	1347	;; Colorize the old block from start to end using old face.
	1348	(when codes
	1349	(put-text-property
	1350	start end 'font-lock-face (ansi-color--find-face codes) string))
	1351	(setq colorized-substring (substring string start end)
	1352	start (match-end 0))
	1353	;; Eliminate unrecognized ANSI sequences.
	1354	(while (string-match helm--ansi-color-drop-regexp colorized-substring)
	1355	(setq colorized-substring
	1356	(replace-match "" nil nil colorized-substring)))
	1357	(push colorized-substring result)
	1358	;; Create new face, by applying escape sequence parameters.
	1359	(setq codes (ansi-color-apply-sequence escape-sequence codes)))
	1360	;; If the rest of the string should have a face, put it there.
	1361	(when codes
	1362	(put-text-property
	1363	start (length string)
	1364	'font-lock-face (ansi-color--find-face codes) string))
	1365	;; Save the remainder of the string to the result.
	1366	(if (string-match "\033" string start)
	1367	(push (substring string start (match-beginning 0)) result)
	1368	(push (substring string start) result))
	1369	(apply 'concat (nreverse result))))
	1370
	1371	(provide 'helm-lib)
	1372
	1373	;; Local Variables:
	1374	;; byte-compile-warnings: (not obsolete)
	1375	;; coding: utf-8
	1376	;; indent-tabs-mode: nil
	1377	;; End:
	1378
	1379	;;; helm-lib ends here