.emacs.d.git - Gitblit

Chizi123

2018-11-19 a4b9172aefa91861b587831e06f55b1e19f3f3be

commit \| author \| age
5cb5f7	1	;;; helm-buffers.el --- helm support for buffers. -- 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-types)
	23	(require 'helm-utils)
	24	(require 'helm-grep)
	25	(require 'helm-regexp)
	26	(require 'helm-help)
	27
	28	(declare-function ido-make-buffer-list "ido" (default))
	29	(declare-function ido-add-virtual-buffers-to-list "ido")
	30	(declare-function helm-comp-read "helm-mode")
	31	(declare-function helm-browse-project "helm-files")
	32
	33
	34	(defgroup helm-buffers nil
	35	"Buffers related Applications and libraries for Helm."
	36	:group 'helm)
	37
	38	(defcustom helm-boring-buffer-regexp-list
	39	'("\\` " "\\`\\helm" "\\`\\Echo Area" "\\`\\*Minibuf")
	40	"The regexp list that match boring buffers.
	41	Buffer candidates matching these regular expression will be
	42	filtered from the list of candidates if the
	43	`helm-skip-boring-buffers' candidate transformer is used."
	44	:type '(repeat (choice regexp))
	45	:group 'helm-buffers)
	46
	47	(defcustom helm-white-buffer-regexp-list nil
	48	"The regexp list of not boring buffers.
	49	These buffers will be displayed even if they match one of
	50	`helm-boring-buffer-regexp-list'."
	51	:type '(repeat (choice regexp))
	52	:group 'helm-buffers)
	53
	54	(defcustom helm-buffers-favorite-modes '(lisp-interaction-mode
	55	emacs-lisp-mode
	56	text-mode
	57	org-mode)
	58	"List of preferred mode to open new buffers with."
	59	:type '(repeat (choice function))
	60	:group 'helm-buffers)
	61
	62	(defcustom helm-buffer-max-length 20
	63	"Max length of buffer names before truncate.
	64	When disabled (nil) use the longest buffer-name length found."
	65	:group 'helm-buffers
	66	:type '(choice (const :tag "Disabled" nil)
	67	(integer :tag "Length before truncate")))
	68
	69	(defcustom helm-buffer-details-flag t
	70	"Always show details in buffer list when non--nil."
	71	:group 'helm-buffers
	72	:type 'boolean)
	73
	74	(defcustom helm-buffers-fuzzy-matching nil
	75	"Fuzzy matching buffer names when non--nil.
	76	Only buffer names are fuzzy matched when this is enabled,
	77	`major-mode' matching is not affected by this."
	78	:group 'helm-buffers
	79	:type 'boolean)
	80
	81	(defcustom helm-buffer-skip-remote-checking nil
	82	"Ignore checking for `file-exists-p' on remote files."
	83	:group 'helm-buffers
	84	:type 'boolean)
	85
	86	(defcustom helm-buffers-truncate-lines t
	87	"Truncate lines in `helm-buffers-list' when non--nil."
	88	:group 'helm-buffers
	89	:type 'boolean)
	90
	91	(defcustom helm-mini-default-sources '(helm-source-buffers-list
	92	helm-source-recentf
	93	helm-source-buffer-not-found)
	94	"Default sources list used in `helm-mini'.
	95
	96	When adding a source here it is up to you to ensure the library of
	97	this source is accessible and properly loaded."
	98	:group 'helm-buffers
	99	:type '(repeat (choice symbol)))
	100
	101	(defcustom helm-buffers-end-truncated-string "..."
	102	"The string to display at end of truncated buffer names."
	103	:type 'string
	104	:group 'helm-buffers)
	105
	106	(defcustom helm-buffers-column-separator " "
	107	"Separator for columns in buffer listing."
	108	:type 'string
	109	:group 'helm-buffers)
	110
	111	(defcustom helm-buffer--pretty-names '((dired-mode . "Dired")
	112	(lisp-interaction-mode . "Lisp Inter"))
	113	"An alist specifying pretty names for modes.
	114	Most of the time buffer's `mode-name' is a string so no need to add it
	115	here as there is no need to compute it, but sometimes it may be a
	116	mode-line specification which may be costly to compute, in this case
	117	add here the pretty name as a string to avoid this costly computation.
	118	Also if some pretty names are too long you can add your own
	119	abbreviation here."
	120	:type '(alist :key-type symbol :value-type string)
	121	:group 'helm-buffers)
	122
	123	;;; Faces
	124	;;
	125	;;
	126	(defgroup helm-buffers-faces nil
	127	"Customize the appearance of helm-buffers."
	128	:prefix "helm-"
	129	:group 'helm-buffers
	130	:group 'helm-faces)
	131
	132	(defface helm-buffer-saved-out
	133	'((t (:foreground "red" :background "black")))
	134	"Face used for buffer files modified outside of emacs."
	135	:group 'helm-buffers-faces)
	136
	137	(defface helm-buffer-not-saved
	138	'((t (:foreground "Indianred2")))
	139	"Face used for buffer files not already saved on disk."
	140	:group 'helm-buffers-faces)
	141
	142	(defface helm-buffer-modified
	143	'((t :inherit font-lock-comment-face))
	144	"Face used for modified buffers."
	145	:group 'helm-buffers-faces)
	146
	147	(defface helm-buffer-size
	148	'((((background dark)) :foreground "RosyBrown")
	149	(((background light)) :foreground "SlateGray"))
	150	"Face used for buffer size."
	151	:group 'helm-buffers-faces)
	152
	153	(defface helm-buffer-process
	154	'((t (:foreground "Sienna3")))
	155	"Face used for process status in buffer."
	156	:group 'helm-buffers-faces)
	157
	158	(defface helm-buffer-directory
	159	'((t (:foreground "DarkRed" :background "LightGray")))
	160	"Face used for directories in `helm-buffers-list'."
	161	:group 'helm-buffers-faces)
	162
	163	(defface helm-buffer-file
	164	'((t :inherit font-lock-builtin-face))
	165	"Face for buffer file names in `helm-buffers-list'."
	166	:group 'helm-buffers-faces)
	167
	168	(defface helm-buffer-archive
	169	'((t (:foreground "Gold")))
	170	"Face for archive file names in `helm-buffers-list'."
	171	:group 'helm-buffers-faces)
	172
	173	(defface helm-non-file-buffer
	174	'((t (:inherit italic)))
	175	"Face used for non-file buffers in `helm-buffers-list'."
	176	:group 'helm-buffers-faces)
	177
	178	(defvar helm-buffers-tick-counter nil
	179	"Allows recording local changes to a non-file buffer.
	180	Typical usage of this var is for modes that want to see if
	181	their buffers have changed since last visit.
	182	Such programs may want to record tick counter after visiting their
	183	buffers like this:
	184
	185	(setq helm-buffers-tick-counter (buffer-modified-tick))
	186
	187	Note that this variable is buffer-local.")
	188	(make-variable-buffer-local 'helm-buffers-tick-counter)
	189
	190
	191	;;; Buffers keymap
	192	;;
	193	(defvar helm-buffer-map
	194	(let ((map (make-sparse-keymap)))
	195	(set-keymap-parent map helm-map)
	196	;; No need to have separate command for grep and zgrep
	197	;; as we don't use recursivity for buffers.
	198	;; So use zgrep for both as it is capable to handle non--compressed files.
	199	(define-key map (kbd "M-g s") 'helm-buffer-run-zgrep)
	200	(define-key map (kbd "C-s") 'helm-buffers-run-multi-occur)
	201	(define-key map (kbd "C-x C-d") 'helm-buffers-run-browse-project)
	202	(define-key map (kbd "C-c o") 'helm-buffer-switch-other-window)
	203	(define-key map (kbd "C-c C-o") 'helm-buffer-switch-other-frame)
	204	(define-key map (kbd "C-c =") 'helm-buffer-run-ediff)
	205	(define-key map (kbd "M-=") 'helm-buffer-run-ediff-merge)
	206	(define-key map (kbd "C-=") 'helm-buffer-diff-persistent)
	207	(define-key map (kbd "M-G") 'helm-buffer-revert-persistent)
	208	(define-key map (kbd "C-c d") 'helm-buffer-run-kill-persistent)
	209	(define-key map (kbd "M-D") 'helm-buffer-run-kill-buffers)
	210	(define-key map (kbd "C-x C-s") 'helm-buffer-save-persistent)
	211	(define-key map (kbd "C-M-%") 'helm-buffer-run-query-replace-regexp)
	212	(define-key map (kbd "M-%") 'helm-buffer-run-query-replace)
	213	(define-key map (kbd "M-R") 'helm-buffer-run-rename-buffer)
	214	(define-key map (kbd "M-m") 'helm-toggle-all-marks)
	215	(define-key map (kbd "M-a") 'helm-mark-all)
	216	(define-key map (kbd "C-]") 'helm-toggle-buffers-details)
	217	(define-key map (kbd "C-c a") 'helm-buffers-toggle-show-hidden-buffers)
	218	(define-key map (kbd "C-M-SPC") 'helm-buffers-mark-similar-buffers)
	219	map)
	220	"Keymap for buffer sources in helm.")
	221
	222	(defvar helm-buffers-ido-virtual-map
	223	(let ((map (make-sparse-keymap)))
	224	(set-keymap-parent map helm-map)
	225	(define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window)
	226	(define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame)
	227	(define-key map (kbd "M-g s") 'helm-ff-run-grep)
	228	(define-key map (kbd "M-g z") 'helm-ff-run-zgrep)
	229	(define-key map (kbd "M-D") 'helm-ff-run-delete-file)
	230	(define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally)
	231	map))
	232
	233
	234	(defvar helm-buffer-max-len-mode nil)
	235	(defvar helm-buffers-in-project-p nil)
	236	(defvar helm-source-buffers-list nil)
	237
	238	(defun helm-buffers-list--init ()
	239	(require 'dired)
	240	;; Issue #51 Create the list before `helm-buffer' creation.
	241	;; We were using a global cache in the past and 'candidates was
	242	;; bound to this cache, this was a problem when using more than one
	243	;; source with a different 'buffer-list fn as the same cache was
	244	;; reused in each source (issue #1907), now 'candidates attr is set
	245	;; directly so that each list of candidates is local to source.
	246	(helm-attrset 'candidates (funcall (helm-attr 'buffer-list)))
	247	(let ((result (cl-loop with allbufs = (memq 'helm-shadow-boring-buffers
	248	(helm-attr
	249	'filtered-candidate-transformer
	250	helm-source-buffers-list))
	251	for b in (if allbufs
	252	(helm-attr 'candidates)
	253	(helm-skip-boring-buffers
	254	(helm-attr 'candidates)
	255	helm-source-buffers-list))
	256	maximize (length b) into len-buf
	257	maximize (length (helm-buffer--format-mode-name b))
	258	into len-mode
	259	finally return (cons len-buf len-mode))))
	260	(unless (default-value 'helm-buffer-max-length)
	261	(helm-set-local-variable 'helm-buffer-max-length (car result)))
	262	(unless (default-value 'helm-buffer-max-len-mode)
	263	(helm-set-local-variable 'helm-buffer-max-len-mode (cdr result)))))
	264
	265	(defclass helm-source-buffers (helm-source-sync helm-type-buffer)
	266	((buffer-list
	267	:initarg :buffer-list
	268	:initform #'helm-buffer-list
	269	:custom function
	270	:documentation
	271	" A function with no arguments to create buffer list.")
	272	(init :initform 'helm-buffers-list--init)
	273	(multimatch :initform nil)
	274	(match :initform 'helm-buffers-match-function)
	275	(persistent-action :initform 'helm-buffers-list-persistent-action)
	276	(keymap :initform helm-buffer-map)
	277	(migemo :initform 'nomultimatch)
	278	(volatile :initform t)
	279	(nohighlight :initform t)
	280	(resume :initform (lambda () (setq helm-buffers-in-project-p nil)))
	281	(help-message :initform 'helm-buffer-help-message)))
	282
	283	(defvar helm-source-buffer-not-found
	284	(helm-build-dummy-source
	285	"Create buffer"
	286	:action (helm-make-actions
	287	"Create buffer (C-u choose mode)"
	288	(lambda (candidate)
	289	(let ((mjm (or (and helm-current-prefix-arg
	290	(intern-soft (helm-comp-read
	291	"Major-mode: "
	292	helm-buffers-favorite-modes)))
	293	(cl-loop for (r . m) in auto-mode-alist
	294	when (string-match r candidate)
	295	return m)))
	296	(buffer (get-buffer-create candidate)))
	297	(if mjm
	298	(with-current-buffer buffer (funcall mjm))
	299	(set-buffer-major-mode buffer))
	300	(switch-to-buffer buffer))))))
	301
	302	(defvar ido-temp-list)
	303	(defvar ido-ignored-list)
	304	(defvar ido-process-ignore-lists)
	305	(defvar ido-use-virtual-buffers)
	306	(defvar ido-virtual-buffers)
	307
	308	(defvar helm-source-ido-virtual-buffers
	309	(helm-build-sync-source "Ido virtual buffers"
	310	:candidates (lambda ()
	311	(let (ido-temp-list
	312	ido-ignored-list
	313	(ido-process-ignore-lists t))
	314	(when ido-use-virtual-buffers
	315	(ido-add-virtual-buffers-to-list)
	316	ido-virtual-buffers)))
	317	:fuzzy-match helm-buffers-fuzzy-matching
	318	:keymap helm-buffers-ido-virtual-map
	319	:help-message 'helm-buffers-ido-virtual-help-message
	320	:action '(("Find file" . helm-find-many-files)
	321	("Find file other window" . find-file-other-window)
	322	("Find file other frame" . find-file-other-frame)
	323	("Find file as root" . helm-find-file-as-root)
	324	("Grep File(s) `C-u recurse'" . helm-find-files-grep)
	325	("Zgrep File(s) `C-u Recurse'" . helm-ff-zgrep)
	326	("View file" . view-file)
	327	("Delete file(s)" . helm-delete-marked-files)
	328	("Open file externally (C-u to choose)"
	329	. helm-open-file-externally))))
	330
	331
	332	(defvar ido-use-virtual-buffers)
	333	(defvar ido-ignore-buffers)
	334	(defun helm-buffer-list ()
	335	"Return the current list of buffers.
	336	Currently visible buffers are put at the end of the list.
	337	See `ido-make-buffer-list' for more infos."
	338	(require 'ido)
	339	(let ((ido-process-ignore-lists t)
	340	ido-ignored-list
	341	ido-ignore-buffers
	342	ido-use-virtual-buffers)
	343	(ido-make-buffer-list nil)))
	344
	345	(defun helm-buffer-size (buffer)
	346	"Return size of BUFFER."
	347	(with-current-buffer buffer
	348	(save-restriction
	349	(widen)
	350	(helm-file-human-size
	351	(- (position-bytes (point-max))
	352	(position-bytes (point-min)))))))
	353
	354	(defun helm-buffer--show-details (buf-name prefix help-echo
	355	size mode dir face1 face2
	356	proc details type)
	357	(append
	358	(list
	359	(concat prefix
	360	(propertize buf-name 'face face1
	361	'help-echo help-echo
	362	'type type)))
	363	(and details
	364	(list size mode
	365	(propertize
	366	(if proc
	367	(format "(%s %s in `%s')"
	368	(process-name proc)
	369	(process-status proc) dir)
	370	(format "(in `%s')" dir))
	371	'face face2)))))
	372
	373	(defun helm-buffer--format-mode-name (buf)
	374	"Prevent using `format-mode-line' as much as possible."
	375	(with-current-buffer buf
	376	(helm-acond ((assq major-mode helm-buffer--pretty-names)
	377	(cdr it))
	378	((stringp mode-name) mode-name)
	379	(t (format-mode-line mode-name)))))
	380
	381	(defun helm-buffer--details (buffer &optional details)
	382	(require 'dired)
	383	(let* ((mode (helm-buffer--format-mode-name buffer))
	384	(buf (get-buffer buffer))
	385	(size (propertize (helm-buffer-size buf)
	386	'face 'helm-buffer-size))
	387	(proc (get-buffer-process buf))
	388	(dir (with-current-buffer buffer
	389	(helm-aif default-directory (abbreviate-file-name it))))
	390	(file-name (helm-aif (buffer-file-name buf) (abbreviate-file-name it)))
	391	(name (buffer-name buf))
	392	(name-prefix (when (and dir (file-remote-p dir))
	393	(propertize "@ " 'face 'helm-ff-prefix)))
	394	(archive-p (and (fboundp 'tramp-archive-file-name-p)
	395	(tramp-archive-file-name-p dir))))
	396	(when name-prefix
	397	;; Remote tramp buffer names may be hexified, make them more readable.
	398	(setq dir (helm-url-unhex-string dir)
	399	name (helm-url-unhex-string name)))
	400	;; Handle tramp archive buffers specially.
	401	(if archive-p
	402	(helm-buffer--show-details
	403	name name-prefix file-name size mode dir
	404	'helm-buffer-archive 'helm-buffer-process nil details 'filebuf)
	405	;; No fancy things on remote buffers.
	406	(if (and name-prefix helm-buffer-skip-remote-checking)
	407	(helm-buffer--show-details
	408	name name-prefix file-name size mode dir
	409	'helm-buffer-file 'helm-buffer-process nil details 'filebuf)
	410	(cond
	411	(;; A dired buffer.
	412	(rassoc buf dired-buffers)
	413	(helm-buffer--show-details
	414	name name-prefix dir size mode dir
	415	'helm-buffer-directory 'helm-buffer-process nil details 'dired))
	416	;; A buffer file modified somewhere outside of emacs.=>red
	417	((and file-name
	418	(file-exists-p file-name)
	419	(not (verify-visited-file-modtime buf)))
	420	(helm-buffer--show-details
	421	name name-prefix file-name size mode dir
	422	'helm-buffer-saved-out 'helm-buffer-process nil details 'modout))
	423	;; A new buffer file not already saved on disk (or a deleted file) .=>indianred2
	424	((and file-name (not (file-exists-p file-name)))
	425	(helm-buffer--show-details
	426	name name-prefix file-name size mode dir
	427	'helm-buffer-not-saved 'helm-buffer-process nil details 'notsaved))
	428	;; A buffer file modified and not saved on disk.=>orange
	429	((and file-name (buffer-modified-p buf))
	430	(helm-buffer--show-details
	431	name name-prefix file-name size mode dir
	432	'helm-buffer-modified 'helm-buffer-process nil details 'mod))
	433	;; A buffer file not modified and saved on disk.=>green
	434	(file-name
	435	(helm-buffer--show-details
	436	name name-prefix file-name size mode dir
	437	'helm-buffer-file 'helm-buffer-process nil details 'filebuf))
	438	;; A non-file, modified buffer
	439	((with-current-buffer name
	440	(and helm-buffers-tick-counter
	441	(/= helm-buffers-tick-counter (buffer-modified-tick))))
	442	(helm-buffer--show-details
	443	name (and proc name-prefix) dir size mode dir
	444	'helm-buffer-modified 'helm-buffer-process proc details 'nofile-mod))
	445	;; Any non--file buffer.=>italic
	446	(t
	447	(helm-buffer--show-details
	448	name (and proc name-prefix) dir size mode dir
	449	'helm-non-file-buffer 'helm-buffer-process proc details 'nofile)))))))
	450
	451	(defun helm-highlight-buffers (buffers _source)
	452	"Transformer function to highlight BUFFERS list.
	453	Should be called after others transformers i.e (boring buffers)."
	454	(cl-loop for i in buffers
	455	for (name size mode meta) = (if helm-buffer-details-flag
	456	(helm-buffer--details i 'details)
	457	(helm-buffer--details i))
	458	for truncbuf = (if (> (string-width name) helm-buffer-max-length)
	459	(helm-substring-by-width
	460	name helm-buffer-max-length
	461	helm-buffers-end-truncated-string)
	462	(concat name
	463	(make-string
	464	(- (+ helm-buffer-max-length
	465	(length
	466	helm-buffers-end-truncated-string))
	467	(string-width name))
	468	? )))
	469	for len = (length mode)
	470	when (> len helm-buffer-max-len-mode)
	471	do (setq helm-buffer-max-len-mode len)
	472	for fmode = (concat (make-string
	473	(- (max helm-buffer-max-len-mode len) len) ? )
	474	mode)
	475	;; The max length of a number should be 1023.9X where X is the
	476	;; units, this is 7 characters.
	477	for formatted-size = (and size (format "%7s" size))
	478	collect (let ((helm-pattern (helm-buffers--pattern-sans-filters
	479	(and helm-buffers-fuzzy-matching ""))))
	480	(cons (if helm-buffer-details-flag
	481	(concat
	482	(funcall helm-fuzzy-matching-highlight-fn
	483	truncbuf)
	484	helm-buffers-column-separator
	485	formatted-size
	486	helm-buffers-column-separator
	487	fmode
	488	helm-buffers-column-separator
	489	meta)
	490	(funcall helm-fuzzy-matching-highlight-fn name))
	491	(get-buffer i)))))
	492
	493	(defun helm-buffer--get-preselection (buffer)
	494	(let ((bufname (buffer-name buffer)))
	495	(when (and bufname
	496	(file-remote-p (with-current-buffer bufname
	497	default-directory)))
	498	(setq bufname (concat "@ " (helm-url-unhex-string bufname))))
	499	(concat "^"
	500	(if (and (null helm-buffer-details-flag)
	501	(numberp helm-buffer-max-length)
	502	(> (string-width bufname)
	503	helm-buffer-max-length))
	504	(regexp-quote
	505	(helm-substring-by-width
	506	bufname helm-buffer-max-length
	507	helm-buffers-end-truncated-string))
	508	(concat (regexp-quote bufname)
	509	(if helm-buffer-details-flag
	510	"$" "[[:blank:]]+"))))))
	511
	512	(defun helm-toggle-buffers-details ()
	513	(interactive)
	514	(with-helm-alive-p
	515	(let* ((buf (helm-get-selection))
	516	(preselect (helm-buffer--get-preselection buf)))
	517	(setq helm-buffer-details-flag (not helm-buffer-details-flag))
	518	(helm-update (lambda ()
	519	(helm-awhile (re-search-forward preselect nil t)
	520	(helm-mark-current-line)
	521	(when (equal buf (helm-get-selection))
	522	(cl-return t))))))))
	523	(put 'helm-toggle-buffers-details 'helm-only t)
	524
	525	(defun helm-buffers--pattern-sans-filters (&optional separator)
	526	(cl-loop for p in (helm-mm-split-pattern helm-pattern)
	527	unless (member (substring p 0 1) '("*" "/" "@" "!"))
	528	collect p into lst
	529	finally return (mapconcat 'identity lst (or separator " "))))
	530
	531	(defun helm-buffers-sort-transformer (candidates source)
	532	(if (string= helm-pattern "")
	533	candidates
	534	(if helm-buffers-fuzzy-matching
	535	(let ((helm-pattern (helm-buffers--pattern-sans-filters)))
	536	(funcall helm-fuzzy-sort-fn candidates source))
	537	(sort candidates
	538	(lambda (s1 s2)
	539	(< (string-width s1) (string-width s2)))))))
	540
	541	(defun helm-buffers-mark-similar-buffers-1 ()
	542	(with-helm-window
	543	(let* ((src (helm-get-current-source))
	544	(type (get-text-property
	545	0 'type (helm-get-selection nil 'withprop src))))
	546	(save-excursion
	547	(goto-char (helm-get-previous-header-pos))
	548	(helm-next-line)
	549	(let* ((next-head (helm-get-next-header-pos))
	550	(end (and next-head
	551	(save-excursion
	552	(goto-char next-head)
	553	(forward-line -1)
	554	(point))))
	555	(maxpoint (or end (point-max))))
	556	(while (< (point) maxpoint)
	557	(helm-mark-current-line)
	558	(let ((cand (helm-get-selection nil 'withprop src)))
	559	(when (and (not (helm-this-visible-mark))
	560	(eq (get-text-property 0 'type cand) type))
	561	(helm-make-visible-mark)))
	562	(forward-line 1) (end-of-line))))
	563	(helm-mark-current-line)
	564	(helm-display-mode-line src t)
	565	(message "%s candidates marked" (length helm-marked-candidates)))))
	566
	567	(defun helm-buffers-mark-similar-buffers ()
	568	"Mark All buffers that have same property `type' than current.
	569	i.e same color."
	570	(interactive)
	571	(with-helm-alive-p
	572	(let ((marked (helm-marked-candidates)))
	573	(if (and (>= (length marked) 1)
	574	(with-helm-window helm-visible-mark-overlays))
	575	(helm-unmark-all)
	576	(helm-buffers-mark-similar-buffers-1)))))
	577	(put 'helm-buffers-mark-similar-buffers 'helm-only t)
	578
	579
	580	;;; match functions
	581	;;
	582	(defun helm-buffer--match-mjm (pattern mjm)
	583	(when (string-match "\\`\\*" pattern)
	584	(cl-loop with patterns = (split-string (substring pattern 1) ",")
	585	for pat in patterns
	586	if (string-match "\\`!" pat)
	587	collect (string-match (substring pat 1) mjm) into neg
	588	else collect (string-match pat mjm) into pos
	589	finally return
	590	(let ((neg-test (cl-loop for i in neg thereis (numberp i)))
	591	(pos-test (cl-loop for i in pos thereis (numberp i))))
	592	(or
	593	(and neg (not pos) (not neg-test))
	594	(and pos pos-test)
	595	(and neg neg-test (not neg-test)))))))
	596
	597	(defvar helm-buffer--memo-hash (make-hash-table :test 'equal))
	598	(defun helm-buffer--memo-pattern (pattern)
	599	(or (gethash pattern helm-buffer--memo-hash)
	600	(puthash pattern (helm--mapconcat-pattern pattern)
	601	helm-buffer--memo-hash)))
	602
	603	(defun helm-buffer--match-pattern (pattern candidate &optional nofuzzy)
	604	(let ((bfn (if (and helm-buffers-fuzzy-matching
	605	(not nofuzzy)
	606	(not helm-migemo-mode)
	607	(not (string-match "\\`\\^" pattern)))
	608	#'helm-buffer--memo-pattern
	609	#'identity))
	610	(mfn (if helm-migemo-mode
	611	#'helm-mm-migemo-string-match #'string-match)))
	612	(if (string-match "\\`!" pattern)
	613	(not (funcall mfn (funcall bfn (substring pattern 1))
	614	candidate))
	615	(funcall mfn (funcall bfn pattern) candidate))))
	616
	617	(defun helm-buffers--match-from-mjm (candidate)
	618	(let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
	619	(buf (get-buffer cand))
	620	(regexp (cl-loop with pattern = helm-pattern
	621	for p in (helm-mm-split-pattern pattern)
	622	when (string-match "\\`\\*" p)
	623	return p)))
	624	(if regexp
	625	(when buf
	626	(with-current-buffer buf
	627	(let ((mjm (symbol-name major-mode)))
	628	(helm-buffer--match-mjm regexp mjm))))
	629	t)))
	630
	631	(defun helm-buffers--match-from-pat (candidate)
	632	(let* ((regexp-list (cl-loop with pattern = helm-pattern
	633	for p in (helm-mm-split-pattern pattern)
	634	unless (string-match
	635	"\\`\$\\*\\\|/\\\|@\$" p)
	636	collect p))
	637	(nofuzzy (cdr regexp-list)))
	638	(if regexp-list
	639	(cl-loop for re in regexp-list
	640	always (helm-buffer--match-pattern re candidate nofuzzy))
	641	t)))
	642
	643	(defun helm-buffers--match-from-inside (candidate)
	644	(let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
	645	(buf (get-buffer cand))
	646	(regexp (cl-loop with pattern = helm-pattern
	647	for p in (helm-mm-split-pattern pattern)
	648	when (string-match "\\`@\$.*\$" p)
	649	return (match-string 1 p))))
	650	(if (and buf regexp)
	651	(with-current-buffer buf
	652	(save-excursion
	653	(goto-char (point-min))
	654	(if helm-migemo-mode
	655	(helm-mm-migemo-forward regexp nil t)
	656	(re-search-forward regexp nil t))))
	657	t)))
	658
	659	(defun helm-buffers--match-from-directory (candidate)
	660	(let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
	661	(buf (get-buffer cand))
	662	(buf-fname (or (buffer-file-name buf)
	663	(car-safe (rassoc buf dired-buffers))))
	664	(regexps (cl-loop with pattern = helm-pattern
	665	for p in (helm-mm-split-pattern pattern)
	666	when (string-match "\\`/" p)
	667	collect p)))
	668	(if regexps
	669	(cl-loop for re in regexps
	670	thereis
	671	(and buf-fname
	672	(string-match
	673	(substring re 1) (helm-basedir buf-fname))))
	674	t)))
	675
	676	(defun helm-buffers-match-function (candidate)
	677	"Default function to match buffers."
	678	(and (helm-buffers--match-from-pat candidate)
	679	(helm-buffers--match-from-mjm candidate)
	680	(helm-buffers--match-from-inside candidate)
	681	(helm-buffers--match-from-directory candidate)))
	682
	683
	684	(defun helm-buffer-query-replace-1 (&optional regexp-flag buffers)
	685	"Query replace in marked buffers.
	686	If REGEXP-FLAG is given use `query-replace-regexp'."
	687	(let ((prompt (if regexp-flag "Query replace regexp" "Query replace"))
	688	(bufs (or buffers (helm-marked-candidates)))
	689	(helm--reading-passwd-or-string t))
	690	(cl-loop with args = (query-replace-read-args prompt regexp-flag t)
	691	for buf in bufs
	692	do
	693	(save-window-excursion
	694	(switch-to-buffer buf)
	695	(save-excursion
	696	(let ((case-fold-search t))
	697	(goto-char (point-min))
	698	(apply #'perform-replace
	699	(list (nth 0 args) (nth 1 args)
	700	t regexp-flag (nth 2 args) nil
	701	multi-query-replace-map))))))))
	702
	703	(defun helm-buffer-query-replace-regexp (_candidate)
	704	(helm-buffer-query-replace-1 'regexp))
	705
	706	(defun helm-buffer-query-replace (_candidate)
	707	(helm-buffer-query-replace-1))
	708
	709	(defun helm-buffer-toggle-diff (candidate)
	710	"Toggle diff buffer CANDIDATE with it's file."
	711	(helm-aif (get-buffer-window "Diff" 'visible)
	712	(progn (kill-buffer "Diff")
	713	(set-window-buffer it helm-current-buffer))
	714	(diff-buffer-with-file (get-buffer candidate))))
	715
	716	(defun helm-buffer-diff-persistent ()
	717	"Toggle diff buffer without quitting helm."
	718	(interactive)
	719	(with-helm-alive-p
	720	(helm-attrset 'diff-action 'helm-buffer-toggle-diff)
	721	(helm-execute-persistent-action 'diff-action)))
	722	(put 'helm-buffer-diff-persistent 'helm-only t)
	723
	724	(defun helm-revert-buffer (candidate)
	725	(with-current-buffer candidate
	726	(helm-aif (buffer-file-name)
	727	(and (file-exists-p it) (revert-buffer t t)))))
	728
	729	(defun helm-revert-marked-buffers (_ignore)
	730	(mapc 'helm-revert-buffer (helm-marked-candidates)))
	731
	732	(defun helm-buffer-revert-and-update (_candidate)
	733	(with-helm-buffer
	734	(let ((marked (helm-marked-candidates))
	735	(preselect (helm-buffers--quote-truncated-buffer
	736	(helm-get-selection))))
	737	(cl-loop for buf in marked do (helm-revert-buffer buf))
	738	(when helm-marked-candidates (helm-unmark-all))
	739	(helm-update preselect))))
	740
	741	(defun helm-buffer-revert-persistent ()
	742	"Revert buffer without quitting helm."
	743	(interactive)
	744	(with-helm-alive-p
	745	(helm-attrset 'revert-action '(helm-buffer-revert-and-update . never-split))
	746	(helm-execute-persistent-action 'revert-action)))
	747	(put 'helm-buffer-revert-persistent 'helm-only t)
	748
	749	(defun helm-buffer-save-and-update (_candidate)
	750	(with-helm-buffer
	751	(let ((marked (helm-marked-candidates))
	752	(preselect (helm-get-selection nil t))
	753	(enable-recursive-minibuffers t))
	754	(cl-loop for buf in marked do
	755	(with-current-buffer (get-buffer buf)
	756	(when (buffer-file-name) (save-buffer))))
	757	(when helm-marked-candidates (helm-unmark-all))
	758	(helm-update (regexp-quote preselect)))))
	759
	760	(defun helm-buffer-save-persistent ()
	761	"Save buffer without quitting helm."
	762	(interactive)
	763	(with-helm-alive-p
	764	(helm-attrset 'save-action '(helm-buffer-save-and-update . never-split))
	765	(helm-execute-persistent-action 'save-action)))
	766	(put 'helm-buffer-save-persistent 'helm-only t)
	767
	768	(defun helm-buffers-rename-buffer (candidate)
	769	(with-current-buffer candidate
	770	(rename-buffer (helm-read-string "New name: " (buffer-name)) t)))
	771
	772	(defun helm-buffer-run-rename-buffer ()
	773	"Run rename buffer action from `helm-source-buffers-list'."
	774	(interactive)
	775	(with-helm-alive-p
	776	(helm-exit-and-execute-action 'helm-buffers-rename-buffer)))
	777	(put 'helm-buffer-run-rename-buffer 'helm-only t)
	778
	779	(defun helm-buffer-run-kill-persistent ()
	780	"Kill buffer without quitting helm."
	781	(interactive)
	782	(with-helm-alive-p
	783	(helm-attrset 'kill-action '(helm-buffers-persistent-kill . never-split))
	784	(helm-execute-persistent-action 'kill-action)))
	785	(put 'helm-buffer-run-kill-persistent 'helm-only t)
	786
	787	(defun helm-kill-marked-buffers (_ignore)
	788	(let* ((bufs (helm-marked-candidates))
	789	(killed-bufs (cl-count-if 'kill-buffer bufs)))
	790	(when (buffer-live-p helm-buffer)
	791	(with-helm-buffer
	792	(setq helm-marked-candidates nil
	793	helm-visible-mark-overlays nil)))
	794	(message "Killed %s buffer(s)" killed-bufs)))
	795
	796	(defun helm-buffer-run-kill-buffers ()
	797	"Run kill buffer action from `helm-source-buffers-list'."
	798	(interactive)
	799	(with-helm-alive-p
	800	(helm-exit-and-execute-action 'helm-kill-marked-buffers)))
	801	(put 'helm-buffer-run-kill-buffers 'helm-only t)
	802
	803	(defun helm-buffer-run-grep ()
	804	"Run Grep action from `helm-source-buffers-list'."
	805	(interactive)
	806	(with-helm-alive-p
	807	(helm-exit-and-execute-action 'helm-grep-buffers)))
	808	(put 'helm-buffer-run-grep 'helm-only t)
	809
	810	(defun helm-buffer-run-zgrep ()
	811	"Run Grep action from `helm-source-buffers-list'."
	812	(interactive)
	813	(with-helm-alive-p
	814	(helm-exit-and-execute-action 'helm-zgrep-buffers)))
	815	(put 'helm-buffer-run-zgrep 'helm-only t)
	816
	817	(defun helm-buffer-run-query-replace-regexp ()
	818	"Run Query replace regexp action from `helm-source-buffers-list'."
	819	(interactive)
	820	(with-helm-alive-p
	821	(helm-exit-and-execute-action 'helm-buffer-query-replace-regexp)))
	822	(put 'helm-buffer-run-query-replace-regexp 'helm-only t)
	823
	824	(defun helm-buffer-run-query-replace ()
	825	"Run Query replace action from `helm-source-buffers-list'."
	826	(interactive)
	827	(with-helm-alive-p
	828	(helm-exit-and-execute-action 'helm-buffer-query-replace)))
	829	(put 'helm-buffer-run-query-replace 'helm-only t)
	830
	831	(defun helm-buffer-switch-other-window ()
	832	"Run switch to other window action from `helm-source-buffers-list'."
	833	(interactive)
	834	(with-helm-alive-p
	835	(helm-exit-and-execute-action 'helm-buffer-switch-buffers-other-window)))
	836	(put 'helm-buffer-switch-other-window 'helm-only t)
	837
	838	(defun helm-buffer-switch-other-frame ()
	839	"Run switch to other frame action from `helm-source-buffers-list'."
	840	(interactive)
	841	(with-helm-alive-p
	842	(helm-exit-and-execute-action 'switch-to-buffer-other-frame)))
	843	(put 'helm-buffer-switch-other-frame 'helm-only t)
	844
	845	(defun helm-buffer-switch-buffers (_candidate)
	846	"Switch to buffer candidates and replace current buffer.
	847
	848	If more than one buffer marked switch to these buffers in separate windows.
	849	If a prefix arg is given split windows vertically."
	850	(let ((buffers (helm-marked-candidates)))
	851	(helm-window-show-buffers buffers)))
	852
	853	(defun helm-buffer-switch-buffers-other-window (_candidate)
	854	"Switch to marked buffers in other windows."
	855	(let ((buffers (helm-marked-candidates)))
	856	(helm-window-show-buffers buffers t)))
	857
	858	(defun helm-buffer-run-ediff ()
	859	"Run ediff action from `helm-source-buffers-list'."
	860	(interactive)
	861	(with-helm-alive-p
	862	(helm-exit-and-execute-action 'helm-ediff-marked-buffers)))
	863	(put 'helm-buffer-run-ediff 'helm-only t)
	864
	865	(defun helm-buffer-run-ediff-merge ()
	866	"Run ediff action from `helm-source-buffers-list'."
	867	(interactive)
	868	(with-helm-alive-p
	869	(helm-exit-and-execute-action 'helm-ediff-marked-buffers-merge)))
	870	(put 'helm-buffer-run-ediff-merge 'helm-only t)
	871
	872	(defun helm-buffers-persistent-kill-1 (buffer-or-name)
	873	"Persistent action to kill buffer."
	874	(let ((buf (get-buffer buffer-or-name)) helm-buf-or-cur)
	875	(if (or (and (eql buf (get-buffer helm-current-buffer))
	876	(setq helm-buf-or-cur "helm-current-buffer"))
	877	(and (eql buf (get-buffer helm-buffer))
	878	(setq helm-buf-or-cur "helm-buffer")))
	879	(progn
	880	(message "Can't kill `%s' without quitting session" helm-buf-or-cur)
	881	(sit-for 1))
	882	(kill-buffer buf)
	883	(helm-delete-current-selection))))
	884
	885	(defun helm-buffers--quote-truncated-buffer (buffer)
	886	(let ((bufname (and (bufferp buffer)
	887	(buffer-name buffer))))
	888	(when (and bufname
	889	(file-remote-p (with-current-buffer bufname
	890	default-directory)))
	891	(setq bufname (concat "@ " (helm-url-unhex-string bufname))))
	892	(when bufname
	893	(regexp-quote
	894	(if (and helm-buffer-max-length
	895	helm-buffer-details-flag)
	896	(helm-substring-by-width
	897	bufname helm-buffer-max-length
	898	"")
	899	bufname)))))
	900
	901	(defun helm-buffers-persistent-kill (_buffer)
	902	(let ((marked (helm-marked-candidates))
	903	(sel (helm-get-selection)))
	904	(unwind-protect
	905	(cl-loop for b in marked
	906	do (progn
	907	;; We need to preselect each marked because
	908	;; helm-buffers-persistent-kill is deleting
	909	;; current selection.
	910	(helm-preselect
	911	(format "^%s"
	912	(helm-buffers--quote-truncated-buffer b)))
	913	(helm-buffers-persistent-kill-1 b)
	914	(message nil)
	915	(helm--remove-marked-and-update-mode-line b)))
	916	(with-helm-buffer
	917	(setq helm-marked-candidates nil
	918	helm-visible-mark-overlays nil))
	919	(helm-force-update (helm-buffers--quote-truncated-buffer sel)))))
	920
	921	(defun helm-buffers-list-persistent-action (candidate)
	922	(let ((current (window-buffer helm-persistent-action-display-window)))
	923	(if (or (helm-follow-mode-p)
	924	(eql current (get-buffer helm-current-buffer))
	925	(not (eql current (get-buffer candidate))))
	926	(switch-to-buffer candidate)
	927	(if (and helm-persistent-action-display-window
	928	(window-dedicated-p
	929	(next-window helm-persistent-action-display-window 1)))
	930	(delete-window helm-persistent-action-display-window)
	931	(switch-to-buffer helm-current-buffer)))))
	932
	933	(defun helm-ediff-marked-buffers (_candidate &optional merge)
	934	"Ediff 2 marked buffers or CANDIDATE and `helm-current-buffer'.
	935	With optional arg MERGE call `ediff-merge-buffers'."
	936	(let ((lg-lst (length (helm-marked-candidates)))
	937	buf1 buf2)
	938	(cl-case lg-lst
	939	(0
	940	(error "Error:You have to mark at least 1 buffer"))
	941	(1
	942	(setq buf1 helm-current-buffer
	943	buf2 (cl-first (helm-marked-candidates))))
	944	(2
	945	(setq buf1 (cl-first (helm-marked-candidates))
	946	buf2 (cl-second (helm-marked-candidates))))
	947	(t
	948	(error "Error:Too many buffers marked!")))
	949	(if merge
	950	(ediff-merge-buffers buf1 buf2)
	951	(ediff-buffers buf1 buf2))))
	952
	953	(defun helm-ediff-marked-buffers-merge (candidate)
	954	"Ediff merge `helm-current-buffer' with CANDIDATE.
	955	See `helm-ediff-marked-buffers'."
	956	(helm-ediff-marked-buffers candidate t))
	957
	958	(defun helm-multi-occur-as-action (_candidate)
	959	"Multi occur action for `helm-source-buffers-list'.
	960	Can be used by any source that list buffers."
	961	(let ((helm-moccur-always-search-in-current
	962	(if helm-current-prefix-arg
	963	(not helm-moccur-always-search-in-current)
	964	helm-moccur-always-search-in-current))
	965	(buffers (helm-marked-candidates))
	966	(input (cl-loop for i in (split-string helm-pattern " " t)
	967	thereis (and (string-match "\\`@\$.*\$" i)
	968	(match-string 1 i)))))
	969	(helm-multi-occur-1 buffers input)))
	970
	971	(defun helm-buffers-run-multi-occur ()
	972	"Run `helm-multi-occur-as-action' by key."
	973	(interactive)
	974	(with-helm-alive-p
	975	(helm-exit-and-execute-action 'helm-multi-occur-as-action)))
	976	(put 'helm-buffers-run-multi-occur 'helm-only t)
	977
	978	(defun helm-buffers-toggle-show-hidden-buffers ()
	979	(interactive)
	980	(with-helm-alive-p
	981	(let ((filter-attrs (helm-attr 'filtered-candidate-transformer
	982	helm-source-buffers-list)))
	983	(if (memq 'helm-shadow-boring-buffers filter-attrs)
	984	(helm-attrset 'filtered-candidate-transformer
	985	(cons 'helm-skip-boring-buffers
	986	(remove 'helm-shadow-boring-buffers
	987	filter-attrs))
	988	helm-source-buffers-list)
	989	(helm-attrset 'filtered-candidate-transformer
	990	(cons 'helm-shadow-boring-buffers
	991	(remove 'helm-skip-boring-buffers
	992	filter-attrs))
	993	helm-source-buffers-list))
	994	(helm-force-update))))
	995	(put 'helm-buffers-toggle-show-hidden-buffers 'helm-only t)
	996
	997	(defun helm-buffers-browse-project (buf)
	998	"Browse project from buffer."
	999	(with-current-buffer buf
	1000	(helm-browse-project helm-current-prefix-arg)))
	1001
	1002	(defun helm-buffers-run-browse-project ()
	1003	"Run `helm-buffers-browse-project' from key."
	1004	(interactive)
	1005	(with-helm-alive-p
	1006	(if helm-buffers-in-project-p
	1007	(user-error "You are already browsing this project")
	1008	(helm-exit-and-execute-action 'helm-buffers-browse-project))))
	1009
	1010	;;; Candidate Transformers
	1011	;;
	1012	;;
	1013	(defun helm-skip-boring-buffers (buffers _source)
	1014	(helm-skip-entries buffers
	1015	helm-boring-buffer-regexp-list
	1016	helm-white-buffer-regexp-list))
	1017
	1018	(defun helm-shadow-boring-buffers (buffers _source)
	1019	"Buffers matching `helm-boring-buffer-regexp' will be
	1020	displayed with the `file-name-shadow' face if available."
	1021	(helm-shadow-entries buffers helm-boring-buffer-regexp-list))
	1022
	1023
	1024	;;;###autoload
	1025	(defun helm-buffers-list ()
	1026	"Preconfigured `helm' to list buffers."
	1027	(interactive)
	1028	(unless helm-source-buffers-list
	1029	(setq helm-source-buffers-list
	1030	(helm-make-source "Buffers" 'helm-source-buffers)))
	1031	(helm :sources '(helm-source-buffers-list
	1032	helm-source-ido-virtual-buffers
	1033	helm-source-buffer-not-found)
	1034	:buffer "helm buffers"
	1035	:keymap helm-buffer-map
	1036	:truncate-lines helm-buffers-truncate-lines))
	1037
	1038	;;;###autoload
	1039	(defun helm-mini ()
	1040	"Preconfigured `helm' lightweight version $buffer -> recentf$."
	1041	(interactive)
	1042	(require 'helm-x-files)
	1043	(unless helm-source-buffers-list
	1044	(setq helm-source-buffers-list
	1045	(helm-make-source "Buffers" 'helm-source-buffers)))
	1046	(helm :sources helm-mini-default-sources
	1047	:buffer "helm mini"
	1048	:ff-transformer-show-only-basename nil
	1049	:truncate-lines helm-buffers-truncate-lines))
	1050
	1051	(defun helm-quit-and-helm-mini ()
	1052	"Drop into `helm-mini' from `helm'."
	1053	(interactive)
	1054	(with-helm-alive-p
	1055	(helm-run-after-exit 'helm-mini)))
	1056
	1057	(provide 'helm-buffers)
	1058
	1059	;; Local Variables:
	1060	;; byte-compile-warnings: (not obsolete)
	1061	;; coding: utf-8
	1062	;; indent-tabs-mode: nil
	1063	;; End:
	1064
	1065	;;; helm-buffers.el ends here