Compare commits
No commits in common. "998811c3579013b9c3d3447abf377b68eb4c8022" and "089f253c42643ffdca46aa07db86415bb8a7aa10" have entirely different histories.
998811c357
...
089f253c42
File diff suppressed because it is too large
Load diff
14
code/elpa/f-20230116.1032/f-pkg.el
Normal file
14
code/elpa/f-20230116.1032/f-pkg.el
Normal file
|
@ -0,0 +1,14 @@
|
|||
(define-package "f" "20230116.1032" "Modern API for working with files and directories"
|
||||
'((emacs "24.1")
|
||||
(s "1.7.0")
|
||||
(dash "2.2.0"))
|
||||
:commit "8a70ba3002197e3c6421181492b60b37d4d4af7b" :authors
|
||||
'(("Johan Andersson" . "johan.rejeep@gmail.com"))
|
||||
:maintainer
|
||||
'("Lucien Cartier-Tilet" . "lucien@phundrak.com")
|
||||
:keywords
|
||||
'("files" "directories")
|
||||
:url "http://github.com/rejeep/f.el")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
793
code/elpa/f-20230116.1032/f.el
Normal file
793
code/elpa/f-20230116.1032/f.el
Normal file
|
@ -0,0 +1,793 @@
|
|||
;;; f.el --- Modern API for working with files and directories -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2013 Johan Andersson
|
||||
|
||||
;; Author: Johan Andersson <johan.rejeep@gmail.com>
|
||||
;; Maintainer: Lucien Cartier-Tilet <lucien@phundrak.com>
|
||||
;; Version: 0.20.0
|
||||
;; Package-Requires: ((emacs "24.1") (s "1.7.0") (dash "2.2.0"))
|
||||
;; Keywords: files, directories
|
||||
;; Homepage: http://github.com/rejeep/f.el
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 3, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Much inspired by magnar's excellent s.el and dash.el, f.el is a
|
||||
;; modern API for working with files and directories in Emacs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
|
||||
(require 's)
|
||||
(require 'dash)
|
||||
(when (version<= "28.1" emacs-version)
|
||||
(require 'f-shortdoc))
|
||||
|
||||
(put 'f-guard-error 'error-conditions '(error f-guard-error))
|
||||
(put 'f-guard-error 'error-message "Destructive operation outside sandbox")
|
||||
|
||||
(defvar f--guard-paths nil
|
||||
"List of allowed paths to modify when guarded.
|
||||
|
||||
Do not modify this variable.")
|
||||
|
||||
(defmacro f--destructive (path &rest body)
|
||||
"If PATH is allowed to be modified, yield BODY.
|
||||
|
||||
If PATH is not allowed to be modified, throw error."
|
||||
(declare (indent 1))
|
||||
`(if f--guard-paths
|
||||
(if (--any? (or (f-same-p it ,path)
|
||||
(f-ancestor-of-p it ,path)) f--guard-paths)
|
||||
(progn ,@body)
|
||||
(signal 'f-guard-error (list ,path f--guard-paths)))
|
||||
,@body))
|
||||
|
||||
|
||||
;;;; Paths
|
||||
|
||||
(defun f-join (&rest args)
|
||||
"Join ARGS to a single path.
|
||||
|
||||
Be aware if one of the arguments is an absolute path, `f-join'
|
||||
will discard all the preceeding arguments and make this absolute
|
||||
path the new root of the generated path."
|
||||
(let (path
|
||||
(relative (f-relative-p (car args))))
|
||||
(-map
|
||||
(lambda (arg)
|
||||
(setq path (cond ((not path) arg)
|
||||
((f-absolute-p arg)
|
||||
(progn
|
||||
(setq relative nil)
|
||||
arg))
|
||||
(t (f-expand arg path)))))
|
||||
args)
|
||||
(if relative (f-relative path) path)))
|
||||
|
||||
(defun f-split (path)
|
||||
"Split PATH and return list containing parts."
|
||||
(let ((parts (split-string path (f-path-separator) 'omit-nulls)))
|
||||
(if (string= (s-left 1 path) (f-path-separator))
|
||||
(push (f-path-separator) parts)
|
||||
parts)))
|
||||
|
||||
(defun f-expand (path &optional dir)
|
||||
"Expand PATH relative to DIR (or `default-directory').
|
||||
PATH and DIR can be either a directory names or directory file
|
||||
names. Return a directory name if PATH is a directory name, and
|
||||
a directory file name otherwise. File name handlers are
|
||||
ignored."
|
||||
(let (file-name-handler-alist)
|
||||
(expand-file-name path dir)))
|
||||
|
||||
(defun f-filename (path)
|
||||
"Return the name of PATH."
|
||||
(file-name-nondirectory (directory-file-name path)))
|
||||
|
||||
(defalias 'f-parent 'f-dirname)
|
||||
|
||||
(defun f-dirname (path)
|
||||
"Return the parent directory to PATH."
|
||||
(let ((parent (file-name-directory
|
||||
(directory-file-name (f-expand path default-directory)))))
|
||||
(unless (f-same-p path parent)
|
||||
(if (f-relative-p path)
|
||||
(f-relative parent)
|
||||
(directory-file-name parent)))))
|
||||
|
||||
(defun f-common-parent (paths)
|
||||
"Return the deepest common parent directory of PATHS."
|
||||
(cond
|
||||
((not paths) nil)
|
||||
((not (cdr paths)) (f-parent (car paths)))
|
||||
(:otherwise
|
||||
(let* ((paths (-map 'f-split paths))
|
||||
(common (caar paths))
|
||||
(re nil))
|
||||
(while (and (not (null (car paths))) (--all? (equal (car it) common) paths))
|
||||
(setq paths (-map 'cdr paths))
|
||||
(push common re)
|
||||
(setq common (caar paths)))
|
||||
(cond
|
||||
((null re) "")
|
||||
((and (= (length re) 1) (f-root-p (car re)))
|
||||
(f-root))
|
||||
(:otherwise
|
||||
(concat (apply 'f-join (nreverse re)) "/")))))))
|
||||
|
||||
(defalias 'f-ext 'file-name-extension)
|
||||
|
||||
(defalias 'f-no-ext 'file-name-sans-extension)
|
||||
|
||||
(defun f-swap-ext (path ext)
|
||||
"Return PATH but with EXT as the new extension.
|
||||
EXT must not be nil or empty."
|
||||
(if (s-blank-p ext)
|
||||
(error "Extension cannot be empty or nil")
|
||||
(concat (f-no-ext path) "." ext)))
|
||||
|
||||
(defun f-base (path)
|
||||
"Return the name of PATH, excluding the extension of file."
|
||||
(f-no-ext (f-filename path)))
|
||||
|
||||
(defalias 'f-relative 'file-relative-name)
|
||||
|
||||
(defalias 'f-short 'abbreviate-file-name)
|
||||
(defalias 'f-abbrev 'abbreviate-file-name)
|
||||
|
||||
(defun f-long (path)
|
||||
"Return long version of PATH."
|
||||
(f-expand path))
|
||||
|
||||
(defalias 'f-canonical 'file-truename)
|
||||
|
||||
(defun f-slash (path)
|
||||
"Append slash to PATH unless one already.
|
||||
|
||||
Some functions, such as `call-process' requires there to be an
|
||||
ending slash."
|
||||
(if (f-dir-p path)
|
||||
(file-name-as-directory path)
|
||||
path))
|
||||
|
||||
(defun f-full (path)
|
||||
"Return absolute path to PATH, with ending slash."
|
||||
(f-slash (f-long path)))
|
||||
|
||||
(defun f--uniquify (paths)
|
||||
"Helper for `f-uniquify' and `f-uniquify-alist'."
|
||||
(let* ((files-length (length paths))
|
||||
(uniq-filenames (--map (cons it (f-filename it)) paths))
|
||||
(uniq-filenames-next (-group-by 'cdr uniq-filenames)))
|
||||
(while (/= files-length (length uniq-filenames-next))
|
||||
(setq uniq-filenames-next
|
||||
(-group-by 'cdr
|
||||
(--mapcat
|
||||
(let ((conf-files (cdr it)))
|
||||
(if (> (length conf-files) 1)
|
||||
(--map (cons
|
||||
(car it)
|
||||
(concat
|
||||
(f-filename (s-chop-suffix (cdr it)
|
||||
(car it)))
|
||||
(f-path-separator) (cdr it)))
|
||||
conf-files)
|
||||
conf-files))
|
||||
uniq-filenames-next))))
|
||||
uniq-filenames-next))
|
||||
|
||||
(defun f-uniquify (files)
|
||||
"Return unique suffixes of FILES.
|
||||
|
||||
This function expects no duplicate paths."
|
||||
(-map 'car (f--uniquify files)))
|
||||
|
||||
(defun f-uniquify-alist (files)
|
||||
"Return alist mapping FILES to unique suffixes of FILES.
|
||||
|
||||
This function expects no duplicate paths."
|
||||
(-map 'cadr (f--uniquify files)))
|
||||
|
||||
|
||||
;;;; I/O
|
||||
|
||||
(defun f-read-bytes (path &optional beg end)
|
||||
"Read binary data from PATH.
|
||||
|
||||
Return the binary data as unibyte string. The optional second
|
||||
and third arguments BEG and END specify what portion of the file
|
||||
to read."
|
||||
(with-temp-buffer
|
||||
(set-buffer-multibyte nil)
|
||||
(setq buffer-file-coding-system 'binary)
|
||||
(insert-file-contents-literally path nil beg end)
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
(defalias 'f-read 'f-read-text)
|
||||
(defun f-read-text (path &optional coding)
|
||||
"Read text with PATH, using CODING.
|
||||
|
||||
CODING defaults to `utf-8'.
|
||||
|
||||
Return the decoded text as multibyte string."
|
||||
(decode-coding-string (f-read-bytes path) (or coding 'utf-8)))
|
||||
|
||||
(defalias 'f-write 'f-write-text)
|
||||
(defun f-write-text (text coding path)
|
||||
"Write TEXT with CODING to PATH.
|
||||
|
||||
TEXT is a multibyte string. CODING is a coding system to encode
|
||||
TEXT with. PATH is a file name to write to."
|
||||
(f-write-bytes (encode-coding-string text coding) path))
|
||||
|
||||
(defun f-unibyte-string-p (s)
|
||||
"Determine whether S is a unibyte string."
|
||||
(not (multibyte-string-p s)))
|
||||
|
||||
(defun f-write-bytes (data path)
|
||||
"Write binary DATA to PATH.
|
||||
|
||||
DATA is a unibyte string. PATH is a file name to write to."
|
||||
(f--write-bytes data path nil))
|
||||
|
||||
(defalias 'f-append 'f-append-text)
|
||||
(defun f-append-text (text coding path)
|
||||
"Append TEXT with CODING to PATH.
|
||||
|
||||
If PATH does not exist, it is created."
|
||||
(f-append-bytes (encode-coding-string text coding) path))
|
||||
|
||||
(defun f-append-bytes (data path)
|
||||
"Append binary DATA to PATH.
|
||||
|
||||
If PATH does not exist, it is created."
|
||||
(f--write-bytes data path :append))
|
||||
|
||||
(defun f--write-bytes (data filename append)
|
||||
"Write binary DATA to FILENAME.
|
||||
If APPEND is non-nil, append the DATA to the existing contents."
|
||||
(f--destructive filename
|
||||
(unless (f-unibyte-string-p data)
|
||||
(signal 'wrong-type-argument (list 'f-unibyte-string-p data)))
|
||||
(let ((coding-system-for-write 'binary)
|
||||
(write-region-annotate-functions nil)
|
||||
(write-region-post-annotation-function nil))
|
||||
(write-region data nil filename append :silent)
|
||||
nil)))
|
||||
|
||||
|
||||
;;;; Destructive
|
||||
|
||||
(defun f-mkdir (&rest dirs)
|
||||
"Create directories DIRS.
|
||||
|
||||
DIRS should be a successive list of directories forming together
|
||||
a full path. The easiest way to call this function with a fully
|
||||
formed path is using `f-split' alongside it:
|
||||
|
||||
(apply #\\='f-mkdir (f-split \"path/to/file\"))
|
||||
|
||||
Although it works sometimes, it is not recommended to use fully
|
||||
formed paths in the function. In this case, it is recommended to
|
||||
use `f-mkdir-full-path' instead."
|
||||
(let (path)
|
||||
(-each
|
||||
dirs
|
||||
(lambda (dir)
|
||||
(setq path (f-expand dir path))
|
||||
(unless (f-directory-p path)
|
||||
(f--destructive path (make-directory path)))))))
|
||||
|
||||
(defun f-mkdir-full-path (dir)
|
||||
"Create DIR from a full path.
|
||||
|
||||
This function is similar to `f-mkdir' except it can accept a full
|
||||
path instead of requiring several successive directory names."
|
||||
(apply #'f-mkdir (f-split dir)))
|
||||
|
||||
(defun f-delete (path &optional force)
|
||||
"Delete PATH, which can be file or directory.
|
||||
|
||||
If FORCE is t, a directory will be deleted recursively."
|
||||
(f--destructive path
|
||||
(if (or (f-file-p path) (f-symlink-p path))
|
||||
(delete-file path)
|
||||
(delete-directory path force))))
|
||||
|
||||
(defun f-symlink (source path)
|
||||
"Create a symlink to SOURCE from PATH."
|
||||
(f--destructive path (make-symbolic-link source path)))
|
||||
|
||||
(defun f-move (from to)
|
||||
"Move or rename FROM to TO.
|
||||
If TO is a directory name, move FROM into TO."
|
||||
(f--destructive to (rename-file from to t)))
|
||||
|
||||
(defun f-copy (from to)
|
||||
"Copy file or directory FROM to TO.
|
||||
If FROM names a directory and TO is a directory name, copy FROM
|
||||
into TO as a subdirectory."
|
||||
(f--destructive to
|
||||
(if (f-file-p from)
|
||||
(copy-file from to)
|
||||
;; The behavior of `copy-directory' differs between Emacs 23 and
|
||||
;; 24 in that in Emacs 23, the contents of `from' is copied to
|
||||
;; `to', while in Emacs 24 the directory `from' is copied to
|
||||
;; `to'. We want the Emacs 24 behavior.
|
||||
(if (> emacs-major-version 23)
|
||||
(copy-directory from to)
|
||||
(if (f-dir-p to)
|
||||
(progn
|
||||
(apply 'f-mkdir (f-split to))
|
||||
(let ((new-to (f-expand (f-filename from) to)))
|
||||
(copy-directory from new-to)))
|
||||
(copy-directory from to))))))
|
||||
|
||||
(defun f-copy-contents (from to)
|
||||
"Copy contents in directory FROM, to directory TO."
|
||||
(unless (f-exists-p to)
|
||||
(error "Cannot copy contents to non existing directory %s" to))
|
||||
(unless (f-dir-p from)
|
||||
(error "Cannot copy contents as %s is a file" from))
|
||||
(--each (f-entries from)
|
||||
(f-copy it (file-name-as-directory to))))
|
||||
|
||||
(defun f-touch (path)
|
||||
"Update PATH last modification date or create if it does not exist."
|
||||
(f--destructive path
|
||||
(if (f-file-p path)
|
||||
(set-file-times path)
|
||||
(f-write-bytes "" path))))
|
||||
|
||||
|
||||
;;;; Predicates
|
||||
|
||||
(defalias 'f-exists-p 'file-exists-p)
|
||||
(defalias 'f-exists? 'file-exists-p)
|
||||
|
||||
(defalias 'f-directory-p 'file-directory-p)
|
||||
(defalias 'f-directory? 'file-directory-p)
|
||||
(defalias 'f-dir-p 'file-directory-p)
|
||||
(defalias 'f-dir? 'file-directory-p)
|
||||
|
||||
|
||||
(defalias 'f-file-p 'file-regular-p)
|
||||
(defalias 'f-file? 'file-regular-p)
|
||||
|
||||
(defun f-symlink-p (path)
|
||||
"Return t if PATH is symlink, false otherwise."
|
||||
(not (not (file-symlink-p path))))
|
||||
|
||||
(defalias 'f-symlink? 'f-symlink-p)
|
||||
|
||||
(defalias 'f-readable-p 'file-readable-p)
|
||||
(defalias 'f-readable? 'file-readable-p)
|
||||
|
||||
(defalias 'f-writable-p 'file-writable-p)
|
||||
(defalias 'f-writable? 'file-writable-p)
|
||||
|
||||
(defalias 'f-executable-p 'file-executable-p)
|
||||
(defalias 'f-executable? 'file-executable-p)
|
||||
|
||||
(defalias 'f-absolute-p 'file-name-absolute-p)
|
||||
(defalias 'f-absolute? 'file-name-absolute-p)
|
||||
|
||||
(defun f-relative-p (path)
|
||||
"Return t if PATH is relative, false otherwise."
|
||||
(not (f-absolute-p path)))
|
||||
|
||||
(defalias 'f-relative? 'f-relative-p)
|
||||
|
||||
(defun f-root-p (path)
|
||||
"Return t if PATH is root directory, false otherwise."
|
||||
(not (f-parent path)))
|
||||
|
||||
(defalias 'f-root? 'f-root-p)
|
||||
|
||||
(defun f-ext-p (path &optional ext)
|
||||
"Return t if extension of PATH is EXT, false otherwise.
|
||||
|
||||
If EXT is nil or omitted, return t if PATH has any extension,
|
||||
false otherwise.
|
||||
|
||||
The extension, in a file name, is the part that follows the last
|
||||
'.', excluding version numbers and backup suffixes."
|
||||
(if ext
|
||||
(string= (f-ext path) ext)
|
||||
(not (eq (f-ext path) nil))))
|
||||
|
||||
(defalias 'f-ext? 'f-ext-p)
|
||||
|
||||
(defalias 'f-equal-p 'f-same-p)
|
||||
(defalias 'f-equal? 'f-same-p)
|
||||
|
||||
(defun f-same-p (path-a path-b)
|
||||
"Return t if PATH-A and PATH-B are references to same file."
|
||||
(equal
|
||||
(f-canonical (directory-file-name (f-expand path-a)))
|
||||
(f-canonical (directory-file-name (f-expand path-b)))))
|
||||
|
||||
(defalias 'f-same? 'f-same-p)
|
||||
|
||||
(defun f-parent-of-p (path-a path-b)
|
||||
"Return t if PATH-A is parent of PATH-B."
|
||||
(--when-let (f-parent path-b)
|
||||
(f-same-p path-a it)))
|
||||
|
||||
(defalias 'f-parent-of? 'f-parent-of-p)
|
||||
|
||||
(defun f-child-of-p (path-a path-b)
|
||||
"Return t if PATH-A is child of PATH-B."
|
||||
(--when-let (f-parent path-a)
|
||||
(f-same-p it path-b)))
|
||||
|
||||
(defalias 'f-child-of? 'f-child-of-p)
|
||||
|
||||
(defun f-ancestor-of-p (path-a path-b)
|
||||
"Return t if PATH-A is ancestor of PATH-B."
|
||||
(unless (f-same-p path-a path-b)
|
||||
(string-prefix-p (f-full path-a)
|
||||
(f-full path-b))))
|
||||
|
||||
(defalias 'f-ancestor-of? 'f-ancestor-of-p)
|
||||
|
||||
(defun f-descendant-of-p (path-a path-b)
|
||||
"Return t if PATH-A is desendant of PATH-B."
|
||||
(unless (f-same-p path-a path-b)
|
||||
(string-prefix-p (f-full path-b)
|
||||
(f-full path-a))))
|
||||
|
||||
(defalias 'f-descendant-of? 'f-descendant-of-p)
|
||||
|
||||
(defun f-hidden-p (path &optional behavior)
|
||||
"Return t if PATH is hidden, nil otherwise.
|
||||
|
||||
BEHAVIOR controls when a path should be considered as hidden
|
||||
depending on its value. Beware, if PATH begins with \"./\", the
|
||||
current dir \".\" will not be considered as hidden.
|
||||
|
||||
When BEHAVIOR is nil, it will only check if the path begins with
|
||||
a dot, as in .a/b/c, and return t if there is one. This is the
|
||||
old behavior of f.el left as default for backward-compatibility
|
||||
purposes.
|
||||
|
||||
When BEHAVIOR is ANY, return t if any of the elements of PATH is
|
||||
hidden, nil otherwise.
|
||||
|
||||
When BEHAVIOR is LAST, return t only if the last element of PATH
|
||||
is hidden, nil otherwise.
|
||||
|
||||
TODO: Hidden directories and files on Windows are marked
|
||||
differently than on *NIX systems. This should be properly
|
||||
implemented."
|
||||
(let ((split-path (f-split path))
|
||||
(check-hidden (lambda (elt)
|
||||
(and (string= (substring elt 0 1) ".")
|
||||
(not (member elt '("." "..")))))))
|
||||
(pcase behavior
|
||||
('any (-any check-hidden split-path))
|
||||
('last (apply check-hidden (last split-path)))
|
||||
(otherwise (if (null otherwise)
|
||||
(funcall check-hidden (car split-path))
|
||||
(error "Invalid value %S for argument BEHAVIOR" otherwise))))))
|
||||
|
||||
(defalias 'f-hidden? 'f-hidden-p)
|
||||
|
||||
(defun f-empty-p (path)
|
||||
"If PATH is a file, return t if the file in PATH is empty, nil otherwise.
|
||||
If PATH is directory, return t if directory has no files, nil otherwise."
|
||||
(if (f-directory-p path)
|
||||
(equal (f-files path nil t) nil)
|
||||
(= (f-size path) 0)))
|
||||
|
||||
(defalias 'f-empty? 'f-empty-p)
|
||||
|
||||
|
||||
;;;; Stats
|
||||
|
||||
(defun f-size (path)
|
||||
"Return size of PATH.
|
||||
|
||||
If PATH is a file, return size of that file. If PATH is
|
||||
directory, return sum of all files in PATH."
|
||||
(if (f-directory-p path)
|
||||
(-sum (-map 'f-size (f-files path nil t)))
|
||||
(nth 7 (file-attributes path))))
|
||||
|
||||
(defun f-depth (path)
|
||||
"Return the depth of PATH.
|
||||
|
||||
At first, PATH is expanded with `f-expand'. Then the full path is used to
|
||||
detect the depth.
|
||||
'/' will be zero depth, '/usr' will be one depth. And so on."
|
||||
(- (length (f-split (f-expand path))) 1))
|
||||
|
||||
;; For Emacs 28 and below, forward-declare ‘current-time-list’, which was
|
||||
;; introduced in Emacs 29.
|
||||
(defvar current-time-list)
|
||||
|
||||
(defun f--get-time (path timestamp-p fn)
|
||||
"Helper function, get time-related information for PATH.
|
||||
Helper for `f-change-time', `f-modification-time',
|
||||
`f-access-time'. It is meant to be called internally, avoid
|
||||
calling it manually unless you have to.
|
||||
|
||||
If TIMESTAMP-P is non-nil, return the date requested as a
|
||||
timestamp. If the value is \\='seconds, return the timestamp as
|
||||
a timestamp with a one-second precision. Otherwise, the
|
||||
timestamp is returned in a (TICKS . HZ) format, see
|
||||
`current-time' if using Emacs 29 or newer.
|
||||
|
||||
Otherwise, if TIMESTAMP-P is nil, return the default style of
|
||||
`current-time'.
|
||||
|
||||
FN is the function specified by the caller function to retrieve
|
||||
the correct data from PATH."
|
||||
(let* ((current-time-list (not timestamp-p))
|
||||
(date (apply fn (list (file-attributes path))))
|
||||
(emacs29-or-newer-p (version<= "29" emacs-version)))
|
||||
(cond
|
||||
((and (eq timestamp-p 'seconds) emacs29-or-newer-p)
|
||||
(/ (car date) (cdr date)))
|
||||
((or (and (not (eq timestamp-p 'seconds)) emacs29-or-newer-p)
|
||||
(and (not timestamp-p) (not emacs29-or-newer-p)))
|
||||
date)
|
||||
((and (eq timestamp-p 'seconds) (not emacs29-or-newer-p))
|
||||
(+ (* (nth 0 date) (expt 2 16))
|
||||
(nth 1 date)))
|
||||
((and timestamp-p (not emacs29-or-newer-p))
|
||||
`(,(+ (* (nth 0 date) (expt 2 16) 1000)
|
||||
(* (nth 1 date) 1000)
|
||||
(nth 3 date))
|
||||
. 1000)))))
|
||||
|
||||
(defun f-change-time (path &optional timestamp-p)
|
||||
"Return the last status change time of PATH.
|
||||
|
||||
The status change time (ctime) of PATH in the same format as
|
||||
`current-time'. For details on TIMESTAMP-P and the format of the
|
||||
returned value, see `f--get-time'."
|
||||
(f--get-time path
|
||||
timestamp-p
|
||||
(if (fboundp 'file-attribute-status-change-time)
|
||||
#'file-attribute-status-change-time
|
||||
(lambda (f) (nth 6 f)))))
|
||||
|
||||
(defun f-modification-time (path &optional timestamp-p)
|
||||
"Return the last modification time of PATH.
|
||||
The modification time (mtime) of PATH in the same format as
|
||||
`current-time'. For details on TIMESTAMP-P and the format of the
|
||||
returned value, see `f--get-time'."
|
||||
(f--get-time path
|
||||
timestamp-p
|
||||
(if (fboundp 'file-attribute-modification-time)
|
||||
#'file-attribute-modification-time
|
||||
(lambda (f) (nth 5 f)))))
|
||||
|
||||
(defun f-access-time (path &optional timestamp-p)
|
||||
"Return the last access time of PATH.
|
||||
The access time (atime) of PATH is in the same format as
|
||||
`current-time'. For details on TIMESTAMP-P and the format of the
|
||||
returned value, see `f--get-time'."
|
||||
(f--get-time path
|
||||
timestamp-p
|
||||
(if (fboundp 'file-attribute-access-time)
|
||||
#'file-attribute-access-time
|
||||
(lambda (f) (nth 4 f)))))
|
||||
|
||||
(defun f--three-way-compare (a b)
|
||||
"Three way comparison.
|
||||
|
||||
Return -1 if A < B.
|
||||
Return 0 if A = B.
|
||||
Return 1 if A > B."
|
||||
(cond ((< a b) -1)
|
||||
((= a b) 0)
|
||||
((> a b) 1)))
|
||||
|
||||
;; TODO: How to properly test this function?
|
||||
(defun f--date-compare (file other method)
|
||||
"Three-way comparison of the date of FILE and OTHER.
|
||||
|
||||
This function can return three values:
|
||||
* 1 means FILE is newer than OTHER
|
||||
* 0 means FILE and NEWER share the same date
|
||||
* -1 means FILE is older than OTHER
|
||||
|
||||
The statistics used for the date comparison depends on METHOD.
|
||||
When METHOD is null, compare their modification time. Otherwise,
|
||||
compare their change time when METHOD is \\='change, or compare
|
||||
their last access time when METHOD is \\='access."
|
||||
(let* ((fn-method (cond
|
||||
((eq 'change method) #'f-change-time)
|
||||
((eq 'access method) #'f-access-time)
|
||||
((null method) #'f-modification-time)
|
||||
(t (error "Unknown method %S" method))))
|
||||
(date-file (apply fn-method (list file)))
|
||||
(date-other (apply fn-method (list other)))
|
||||
(dates (-zip-pair date-file date-other)))
|
||||
(message "[DEBUG]: file: %s\t\tother: %s" file other)
|
||||
(message "[DEBUG]: dates: %S" dates)
|
||||
(-reduce-from (lambda (acc elt)
|
||||
(if (= acc 0)
|
||||
(f--three-way-compare (car elt) (cdr elt))
|
||||
acc))
|
||||
0
|
||||
dates)))
|
||||
|
||||
(defun f-older-p (file other &optional method)
|
||||
"Compare if FILE is older than OTHER.
|
||||
|
||||
For more info on METHOD, see `f--date-compare'."
|
||||
(< (f--date-compare file other method) 0))
|
||||
|
||||
(defalias 'f-older? #'f-older-p)
|
||||
|
||||
(defun f-newer-p (file other &optional method)
|
||||
"Compare if FILE is newer than OTHER.
|
||||
|
||||
For more info on METHOD, see `f--date-compare'."
|
||||
(> (f--date-compare file other method) 0))
|
||||
|
||||
(defalias 'f-newer? #'f-newer-p)
|
||||
|
||||
(defun f-same-time-p (file other &optional method)
|
||||
"Check if FILE and OTHER share the same access or modification time.
|
||||
|
||||
For more info on METHOD, see `f--date-compare'."
|
||||
(= (f--date-compare file other method) 0))
|
||||
|
||||
(defalias 'f-same-time? #'f-same-time-p)
|
||||
|
||||
|
||||
;;;; Misc
|
||||
|
||||
(defun f-this-file ()
|
||||
"Return path to this file."
|
||||
(cond
|
||||
(load-in-progress load-file-name)
|
||||
((and (boundp 'byte-compile-current-file) byte-compile-current-file)
|
||||
byte-compile-current-file)
|
||||
(:else (buffer-file-name))))
|
||||
|
||||
(defvar f--path-separator nil
|
||||
"A variable to cache result of `f-path-separator'.")
|
||||
|
||||
(defun f-path-separator ()
|
||||
"Return path separator."
|
||||
(or f--path-separator
|
||||
(setq f--path-separator (substring (f-join "x" "y") 1 2))))
|
||||
|
||||
(defun f-glob (pattern &optional path)
|
||||
"Find PATTERN in PATH."
|
||||
(file-expand-wildcards
|
||||
(f-join (or path default-directory) pattern)))
|
||||
|
||||
(defun f--collect-entries (path recursive)
|
||||
(let (result
|
||||
(entries
|
||||
(-reject
|
||||
(lambda (file)
|
||||
(member (f-filename file) '("." "..")))
|
||||
(directory-files path t))))
|
||||
(cond (recursive
|
||||
(-map
|
||||
(lambda (entry)
|
||||
(if (f-file-p entry)
|
||||
(setq result (cons entry result))
|
||||
(when (f-directory-p entry)
|
||||
(setq result (cons entry result))
|
||||
(if (f-readable-p entry)
|
||||
(setq result (append result (f--collect-entries entry recursive)))
|
||||
result))))
|
||||
entries))
|
||||
(t (setq result entries)))
|
||||
result))
|
||||
|
||||
(defmacro f--entries (path body &optional recursive)
|
||||
"Anaphoric version of `f-entries'."
|
||||
`(f-entries
|
||||
,path
|
||||
(lambda (path)
|
||||
(let ((it path))
|
||||
,body))
|
||||
,recursive))
|
||||
|
||||
(defun f-entries (path &optional fn recursive)
|
||||
"Find all files and directories in PATH.
|
||||
|
||||
FN - called for each found file and directory. If FN returns a thruthy
|
||||
value, file or directory will be included.
|
||||
RECURSIVE - Search for files and directories recursive."
|
||||
(let ((entries (f--collect-entries path recursive)))
|
||||
(if fn (-select fn entries) entries)))
|
||||
|
||||
(defmacro f--directories (path body &optional recursive)
|
||||
"Anaphoric version of `f-directories'."
|
||||
`(f-directories
|
||||
,path
|
||||
(lambda (path)
|
||||
(let ((it path))
|
||||
,body))
|
||||
,recursive))
|
||||
|
||||
(defun f-directories (path &optional fn recursive)
|
||||
"Find all directories in PATH. See `f-entries'."
|
||||
(let ((directories (-select 'f-directory-p (f--collect-entries path recursive))))
|
||||
(if fn (-select fn directories) directories)))
|
||||
|
||||
(defmacro f--files (path body &optional recursive)
|
||||
"Anaphoric version of `f-files'."
|
||||
`(f-files
|
||||
,path
|
||||
(lambda (path)
|
||||
(let ((it path))
|
||||
,body))
|
||||
,recursive))
|
||||
|
||||
(defun f-files (path &optional fn recursive)
|
||||
"Find all files in PATH. See `f-entries'."
|
||||
(let ((files (-select 'f-file-p (f--collect-entries path recursive))))
|
||||
(if fn (-select fn files) files)))
|
||||
|
||||
(defmacro f--traverse-upwards (body &optional path)
|
||||
"Anaphoric version of `f-traverse-upwards'."
|
||||
`(f-traverse-upwards
|
||||
(lambda (dir)
|
||||
(let ((it dir))
|
||||
,body))
|
||||
,path))
|
||||
|
||||
(defun f-traverse-upwards (fn &optional path)
|
||||
"Traverse up as long as FN return nil, starting at PATH.
|
||||
|
||||
If FN returns a non-nil value, the path sent as argument to FN is
|
||||
returned. If no function callback return a non-nil value, nil is
|
||||
returned."
|
||||
(unless path
|
||||
(setq path default-directory))
|
||||
(when (f-relative-p path)
|
||||
(setq path (f-expand path)))
|
||||
(if (funcall fn path)
|
||||
path
|
||||
(unless (f-root-p path)
|
||||
(f-traverse-upwards fn (f-parent path)))))
|
||||
|
||||
(defun f-root ()
|
||||
"Return absolute root."
|
||||
(f-traverse-upwards 'f-root-p))
|
||||
|
||||
(defmacro f-with-sandbox (path-or-paths &rest body)
|
||||
"Only allow PATH-OR-PATHS and descendants to be modified in BODY."
|
||||
(declare (indent 1))
|
||||
`(let ((paths (if (listp ,path-or-paths)
|
||||
,path-or-paths
|
||||
(list ,path-or-paths))))
|
||||
(unwind-protect
|
||||
(let ((f--guard-paths paths))
|
||||
,@body)
|
||||
(setq f--guard-paths nil))))
|
||||
|
||||
(provide 'f)
|
||||
|
||||
;;; f.el ends here
|
|
@ -1,8 +1,8 @@
|
|||
(define-package "f" "20230823.1159" "Modern API for working with files and directories"
|
||||
(define-package "f" "20230704.1346" "Modern API for working with files and directories"
|
||||
'((emacs "24.1")
|
||||
(s "1.7.0")
|
||||
(dash "2.2.0"))
|
||||
:commit "ab3ee3811c53f9c2144ff45130361f3da242ffa2" :authors
|
||||
:commit "19e1da061e759b05e8c480b426287a063ca39484" :authors
|
||||
'(("Johan Andersson" . "johan.rejeep@gmail.com"))
|
||||
:maintainers
|
||||
'(("Lucien Cartier-Tilet" . "lucien@phundrak.com"))
|
|
@ -633,6 +633,8 @@ their last access time when METHOD is \\='access."
|
|||
(date-file (apply fn-method (list file)))
|
||||
(date-other (apply fn-method (list other)))
|
||||
(dates (-zip-pair date-file date-other)))
|
||||
(message "[DEBUG]: file: %s\t\tother: %s" file other)
|
||||
(message "[DEBUG]: dates: %S" dates)
|
||||
(-reduce-from (lambda (acc elt)
|
||||
(if (= acc 0)
|
||||
(f--three-way-compare (car elt) (cdr elt))
|
|
@ -1,9 +1,9 @@
|
|||
(define-package "git-commit" "20230821.1659" "Edit Git commit messages."
|
||||
(define-package "git-commit" "20230521.2344" "Edit Git commit messages."
|
||||
'((emacs "25.1")
|
||||
(compat "29.1.3.4")
|
||||
(transient "20230201")
|
||||
(with-editor "20230118"))
|
||||
:commit "6f54443aaaa0a822cc245dc6c66d2033c7dc0900" :authors
|
||||
:commit "d81db78a0611d21048c1e2ff069a83f964092f10" :authors
|
||||
'(("Jonas Bernoulli" . "jonas@bernoul.li")
|
||||
("Sebastian Wiesner" . "lunaryorn@gmail.com")
|
||||
("Florian Ragwitz" . "rafl@debian.org")
|
|
@ -446,15 +446,15 @@ This is only used if Magit is available."
|
|||
(add-to-list 'with-editor-file-name-history-exclude git-commit-filename-regexp)
|
||||
|
||||
(defun git-commit-setup-font-lock-in-buffer ()
|
||||
(when (and buffer-file-name
|
||||
(string-match-p git-commit-filename-regexp buffer-file-name))
|
||||
(and buffer-file-name
|
||||
(string-match-p git-commit-filename-regexp buffer-file-name)
|
||||
(git-commit-setup-font-lock)))
|
||||
|
||||
(add-hook 'after-change-major-mode-hook #'git-commit-setup-font-lock-in-buffer)
|
||||
|
||||
(defun git-commit-setup-check-buffer ()
|
||||
(when (and buffer-file-name
|
||||
(string-match-p git-commit-filename-regexp buffer-file-name))
|
||||
(and buffer-file-name
|
||||
(string-match-p git-commit-filename-regexp buffer-file-name)
|
||||
(git-commit-setup)))
|
||||
|
||||
(defvar git-commit-mode)
|
||||
|
@ -534,15 +534,8 @@ Used as the local value of `header-line-format', in buffer using
|
|||
(hack-dir-local-variables)
|
||||
(hack-local-variables-apply)))
|
||||
(when git-commit-major-mode
|
||||
(let ((auto-mode-alist
|
||||
;; `set-auto-mode--apply-alist' removes the remote part from
|
||||
;; the file-name before looking it up in `auto-mode-alist'.
|
||||
;; For our temporary entry to be found, we have to modify the
|
||||
;; file-name the same way.
|
||||
(list (cons (concat "\\`"
|
||||
(regexp-quote
|
||||
(or (file-remote-p buffer-file-name 'localname)
|
||||
buffer-file-name))
|
||||
(let ((auto-mode-alist (list (cons (concat "\\`"
|
||||
(regexp-quote buffer-file-name)
|
||||
"\\'")
|
||||
git-commit-major-mode)))
|
||||
;; The major-mode hook might want to consult these minor
|
||||
|
@ -798,13 +791,12 @@ Save current message first."
|
|||
(unless (eq (char-before) ?\n)
|
||||
(insert ?\n))
|
||||
(setq str (buffer-string)))
|
||||
(and (not (string-match "\\`[ \t\n\r]*\\'" str))
|
||||
(progn
|
||||
(unless (string-match "\\`[ \t\n\r]*\\'" str)
|
||||
(when (string-match "\\`\n\\{2,\\}" str)
|
||||
(setq str (replace-match "\n" t t str)))
|
||||
(when (string-match "\n\\{2,\\}\\'" str)
|
||||
(setq str (replace-match "\n" t t str)))
|
||||
str))))
|
||||
str)))
|
||||
|
||||
;;; Utilities
|
||||
|
||||
|
@ -1076,16 +1068,8 @@ Added to `font-lock-extend-region-functions'."
|
|||
(buffer-substring (point) (line-end-position)))))
|
||||
"#"))
|
||||
(setq-local comment-start-skip (format "^%s+[\s\t]*" comment-start))
|
||||
(setq-local comment-end "")
|
||||
(setq-local comment-end-skip "\n")
|
||||
(setq-local comment-use-syntax nil)
|
||||
(when (and (derived-mode-p 'markdown-mode)
|
||||
(fboundp 'markdown-fill-paragraph))
|
||||
(setq-local fill-paragraph-function
|
||||
(lambda (&optional justify)
|
||||
(and (not (= (char-after (line-beginning-position))
|
||||
(aref comment-start 0)))
|
||||
(markdown-fill-paragraph justify)))))
|
||||
(setq-local git-commit--branch-name-regexp
|
||||
(if (and (featurep 'magit-git)
|
||||
;; When using cygwin git, we may end up in a
|
118
code/elpa/go-mode-20221228.1706/go-mode-autoloads.el
Normal file
118
code/elpa/go-mode-20221228.1706/go-mode-autoloads.el
Normal file
|
@ -0,0 +1,118 @@
|
|||
;;; go-mode-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
|
||||
|
||||
;;;### (autoloads nil "go-mode" "go-mode.el" (0 0 0 0))
|
||||
;;; Generated autoloads from go-mode.el
|
||||
|
||||
(autoload 'go-mode "go-mode" "\
|
||||
Major mode for editing Go source text.
|
||||
|
||||
This mode provides (not just) basic editing capabilities for
|
||||
working with Go code. It offers almost complete syntax
|
||||
highlighting, indentation that is almost identical to gofmt and
|
||||
proper parsing of the buffer content to allow features such as
|
||||
navigation by function, manipulation of comments or detection of
|
||||
strings.
|
||||
|
||||
In addition to these core features, it offers various features to
|
||||
help with writing Go code. You can directly run buffer content
|
||||
through gofmt, read godoc documentation from within Emacs, modify
|
||||
and clean up the list of package imports or interact with the
|
||||
Playground (uploading and downloading pastes).
|
||||
|
||||
The following extra functions are defined:
|
||||
|
||||
- `gofmt'
|
||||
- `godoc' and `godoc-at-point'
|
||||
- `go-import-add'
|
||||
- `go-goto-arguments'
|
||||
- `go-goto-docstring'
|
||||
- `go-goto-function'
|
||||
- `go-goto-function-name'
|
||||
- `go-goto-imports'
|
||||
- `go-goto-return-values'
|
||||
- `go-goto-method-receiver'
|
||||
- `go-play-buffer' and `go-play-region'
|
||||
- `go-download-play'
|
||||
- `godef-describe' and `godef-jump'
|
||||
- `go-coverage'
|
||||
|
||||
If you want to automatically run `gofmt' before saving a file,
|
||||
add the following hook to your Emacs configuration:
|
||||
|
||||
\(add-hook 'before-save-hook #'gofmt-before-save)
|
||||
|
||||
If you want to use `godef-jump' instead of etags (or similar),
|
||||
consider binding godef-jump to `M-.', which is the default key
|
||||
for `find-tag':
|
||||
|
||||
\(add-hook 'go-mode-hook (lambda ()
|
||||
(local-set-key (kbd \"M-.\") #'godef-jump)))
|
||||
|
||||
Please note that godef is an external dependency. You can install
|
||||
it with
|
||||
|
||||
go get github.com/rogpeppe/godef
|
||||
|
||||
|
||||
If you're looking for even more integration with Go, namely
|
||||
on-the-fly syntax checking, auto-completion and snippets, it is
|
||||
recommended that you look at flycheck
|
||||
\(see URL `https://github.com/flycheck/flycheck') or flymake in combination
|
||||
with goflymake (see URL `https://github.com/dougm/goflymake'), gocode
|
||||
\(see URL `https://github.com/nsf/gocode'), go-eldoc
|
||||
\(see URL `github.com/syohex/emacs-go-eldoc') and yasnippet-go
|
||||
\(see URL `https://github.com/dominikh/yasnippet-go')
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(add-to-list 'auto-mode-alist (cons "\\.go\\'" 'go-mode))
|
||||
|
||||
(autoload 'gofmt-before-save "go-mode" "\
|
||||
Add this to .emacs to run gofmt on the current buffer when saving:
|
||||
\(add-hook 'before-save-hook 'gofmt-before-save).
|
||||
|
||||
Note that this will cause ‘go-mode’ to get loaded the first time
|
||||
you save any file, kind of defeating the point of autoloading." t nil)
|
||||
|
||||
(autoload 'godoc "go-mode" "\
|
||||
Show Go documentation for QUERY, much like \\<go-mode-map>\\[man].
|
||||
|
||||
\(fn QUERY)" t nil)
|
||||
|
||||
(autoload 'go-download-play "go-mode" "\
|
||||
Download a paste from the playground and insert it in a Go buffer.
|
||||
Tries to look for a URL at point.
|
||||
|
||||
\(fn URL)" t nil)
|
||||
|
||||
(autoload 'go-dot-mod-mode "go-mode" "\
|
||||
A major mode for editing go.mod files.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(add-to-list 'auto-mode-alist '("go\\.mod\\'" . go-dot-mod-mode))
|
||||
|
||||
(autoload 'go-dot-work-mode "go-mode" "\
|
||||
A major mode for editor go.work files.
|
||||
|
||||
\(fn)" t nil)
|
||||
|
||||
(add-to-list 'auto-mode-alist '("go\\.work\\'" . go-dot-work-mode))
|
||||
|
||||
(register-definition-prefixes "go-mode" '("go-" "god" "gofmt"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; go-mode-autoloads.el ends here
|
2
code/elpa/go-mode-20221228.1706/go-mode-pkg.el
Normal file
2
code/elpa/go-mode-20221228.1706/go-mode-pkg.el
Normal file
|
@ -0,0 +1,2 @@
|
|||
;;; Generated package description from go-mode.el -*- no-byte-compile: t -*-
|
||||
(define-package "go-mode" "20221228.1706" "Major mode for the Go programming language" '((emacs "26.1")) :commit "166dfb1e090233c4609a50c2ec9f57f113c1da72" :authors '(("The go-mode Authors")) :maintainer '("The go-mode Authors") :keywords '("languages" "go") :url "https://github.com/dominikh/go-mode.el")
|
3057
code/elpa/go-mode-20221228.1706/go-mode.el
Normal file
3057
code/elpa/go-mode-20221228.1706/go-mode.el
Normal file
File diff suppressed because it is too large
Load diff
|
@ -1,6 +1,6 @@
|
|||
(define-package "go-mode" "20230823.2304" "Major mode for the Go programming language"
|
||||
(define-package "go-mode" "20230624.2315" "Major mode for the Go programming language"
|
||||
'((emacs "26.1"))
|
||||
:commit "8dce1e3ba1cdc34a856ad53c8421413cfe33660e" :authors
|
||||
:commit "f21347ae9cf68ea33031bf5125896e8f16c8183c" :authors
|
||||
'(("The go-mode Authors"))
|
||||
:maintainers
|
||||
'(("The go-mode Authors"))
|
|
@ -2841,7 +2841,7 @@ If BUFFER, return the number of characters in that buffer instead."
|
|||
"Syntax table for `go-dot-mod-mode'.")
|
||||
|
||||
(defconst go-dot-mod-mode-keywords
|
||||
'("module" "go" "toolchain" "require" "exclude" "replace" "retract")
|
||||
'("module" "go" "require" "replace" "exclude")
|
||||
"All keywords for go.mod files. Used for font locking.")
|
||||
|
||||
(defgroup go-dot-mod nil
|
||||
|
@ -2891,7 +2891,7 @@ If BUFFER, return the number of characters in that buffer instead."
|
|||
(add-to-list 'auto-mode-alist '("go\\.mod\\'" . go-dot-mod-mode))
|
||||
|
||||
(defconst go-dot-work-mode-keywords
|
||||
'("go" "toolchain" "use" "replace")
|
||||
'("go" "replace" "use")
|
||||
"All keywords for go.work files. Used for font locking.")
|
||||
|
||||
;;;###autoload
|
261
code/elpa/helm-20230406.839/emacs-helm.sh
Normal file
261
code/elpa/helm-20230406.839/emacs-helm.sh
Normal file
|
@ -0,0 +1,261 @@
|
|||
#!/usr/bin/env sh
|
||||
|
||||
|
||||
## Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
##
|
||||
## This program is free software; you can redistribute it and/or modify
|
||||
## it under the terms of the GNU General Public License as published by
|
||||
## the Free Software Foundation, either version 3 of the License, or
|
||||
## (at your option) any later version.
|
||||
##
|
||||
## This program is distributed in the hope that it will be useful,
|
||||
## but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
## GNU General Public License for more details.
|
||||
##
|
||||
## You should have received a copy of the GNU General Public License
|
||||
## along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
## Commentary:
|
||||
# Preconfigured `emacs -Q' with a basic Helm configuration.
|
||||
|
||||
|
||||
# If TEMP env var exists, use it, otherwise declare it.
|
||||
test -z "$TEMP" && TEMP="/tmp"
|
||||
|
||||
CONF_FILE="$TEMP/helm-cfg.el"
|
||||
EMACS=emacs
|
||||
TOOLBARS=-1
|
||||
LOAD_PACKAGES=
|
||||
|
||||
usage () {
|
||||
cat >&1 <<EOF
|
||||
Usage: ${0##*/} [-P PATH] [--toolbars] [--load-packages pkgs] [-h] [EMACS-OPTIONS-OR-FILENAME]
|
||||
|
||||
-P --path Specify path to emacs
|
||||
-B --toolbars Display Menu bar, scroll bar etc...
|
||||
--load-packages Load specified M/Elpa packages (separate with ",")
|
||||
-h Display this help and exit
|
||||
|
||||
Any other Emacs options or filename must come after.
|
||||
|
||||
Emacs options:
|
||||
|
||||
Initialization options:
|
||||
|
||||
--chdir DIR change to directory DIR
|
||||
--daemon, --bg-daemon[=NAME] start a (named) server in the background
|
||||
--fg-daemon[=NAME] start a (named) server in the foreground
|
||||
--debug-init enable Emacs Lisp debugger for init file
|
||||
--display, -d DISPLAY use X server DISPLAY
|
||||
--no-build-details do not add build details such as time stamps
|
||||
--no-loadup, -nl do not load loadup.el into bare Emacs
|
||||
--no-site-file do not load site-start.el
|
||||
--no-x-resources do not load X resources
|
||||
--no-window-system, -nw do not communicate with X, ignoring $DISPLAY
|
||||
--script FILE run FILE as an Emacs Lisp script
|
||||
--terminal, -t DEVICE use DEVICE for terminal I/O
|
||||
|
||||
Action options:
|
||||
|
||||
FILE visit FILE
|
||||
+LINE go to line LINE in next FILE
|
||||
+LINE:COLUMN go to line LINE, column COLUMN, in next FILE
|
||||
--directory, -L DIR prepend DIR to load-path (with :DIR, append DIR)
|
||||
--file FILE visit FILE
|
||||
--find-file FILE visit FILE
|
||||
--funcall, -f FUNC call Emacs Lisp function FUNC with no arguments
|
||||
--insert FILE insert contents of FILE into current buffer
|
||||
--load, -l FILE load Emacs Lisp FILE using the load function
|
||||
--visit FILE visit FILE
|
||||
|
||||
Display options:
|
||||
|
||||
--background-color, -bg COLOR window background color
|
||||
--basic-display, -D disable many display features;
|
||||
used for debugging Emacs
|
||||
--border-color, -bd COLOR main border color
|
||||
--border-width, -bw WIDTH width of main border
|
||||
--color, --color=MODE override color mode for character terminals;
|
||||
MODE defaults to \`auto', and
|
||||
can also be \`never', \`always',
|
||||
or a mode name like \`ansi8'
|
||||
--cursor-color, -cr COLOR color of the Emacs cursor indicating point
|
||||
--font, -fn FONT default font; must be fixed-width
|
||||
--foreground-color, -fg COLOR window foreground color
|
||||
--fullheight, -fh make the first frame high as the screen
|
||||
--fullscreen, -fs make the first frame fullscreen
|
||||
--fullwidth, -fw make the first frame wide as the screen
|
||||
--maximized, -mm make the first frame maximized
|
||||
--geometry, -g GEOMETRY window geometry
|
||||
--iconic start Emacs in iconified state
|
||||
--internal-border, -ib WIDTH width between text and main border
|
||||
--line-spacing, -lsp PIXELS additional space to put between lines
|
||||
--mouse-color, -ms COLOR mouse cursor color in Emacs window
|
||||
--name NAME title for initial Emacs frame
|
||||
--reverse-video, -r, -rv switch foreground and background
|
||||
--title, -T TITLE title for initial Emacs frame
|
||||
--vertical-scroll-bars, -vb enable vertical scroll bars
|
||||
--xrm XRESOURCES set additional X resources
|
||||
--parent-id XID set parent window
|
||||
--help display this help and exit
|
||||
--version output version information and exit
|
||||
|
||||
You can generally also specify long option names with a single -; for
|
||||
example, -batch as well as --batch. You can use any unambiguous
|
||||
abbreviation for a --option.
|
||||
|
||||
Various environment variables and window system resources also affect
|
||||
the operation of Emacs. See the main documentation.
|
||||
EOF
|
||||
}
|
||||
|
||||
for a in "$@"; do
|
||||
case $a in
|
||||
--path | -P)
|
||||
shift 1
|
||||
EMACS="$1"
|
||||
shift 1
|
||||
;;
|
||||
--toolbars | -B)
|
||||
shift 1
|
||||
TOOLBARS=1
|
||||
;;
|
||||
--load-packages)
|
||||
shift 1
|
||||
LOAD_PACKAGES="$1"
|
||||
shift 1
|
||||
;;
|
||||
-h)
|
||||
usage
|
||||
exit 1
|
||||
;;
|
||||
esac
|
||||
done
|
||||
|
||||
LOAD_PATH=$($EMACS -q -batch --eval "(prin1 load-path)")
|
||||
|
||||
cd "${0%/*}" || exit 1
|
||||
|
||||
# Check if autoload file exists.
|
||||
# It may be in a different directory if emacs-helm.sh is a symlink.
|
||||
TRUENAME=$(find "${0%/*}" -path "$0" -printf "%l")
|
||||
if [ -n "$TRUENAME" ]; then
|
||||
AUTO_FILE="${TRUENAME%/*}/helm-autoloads.el"
|
||||
else
|
||||
AUTO_FILE="helm-autoloads.el"
|
||||
fi
|
||||
if [ ! -e "$AUTO_FILE" ]; then
|
||||
echo No autoloads found, please run make first to generate autoload file
|
||||
exit 1
|
||||
fi
|
||||
|
||||
|
||||
cat > $CONF_FILE <<EOF
|
||||
(setq initial-scratch-message (concat initial-scratch-message
|
||||
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\
|
||||
;; This Emacs is Powered by \`HELM' using\\n\
|
||||
;; emacs program \"$EMACS\".\\n\
|
||||
;; This is a minimal \`helm' configuration to discover \`helm' or debug it.\\n\
|
||||
;; You can retrieve this minimal configuration in \"$CONF_FILE\".\\n\
|
||||
;;
|
||||
;; Some original Emacs commands are replaced by their \`helm' counterparts:\\n\\n\
|
||||
;; - \`find-file'(C-x C-f) =>\`helm-find-files'\\n\
|
||||
;; - \`occur'(M-s o) =>\`helm-occur'\\n\
|
||||
;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\n\
|
||||
;; - \`completion-at-point'(M-tab) =>\`helm-lisp-completion-at-point'[1]\\n\
|
||||
;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\
|
||||
;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\
|
||||
;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\\n
|
||||
;; Some other Emacs commands are \"helmized\" by \`helm-mode'.\\n\
|
||||
;; [1] Coming with emacs-24.4, \`completion-at-point' is \"helmized\" by \`helm-mode'\\n\
|
||||
|
||||
;; which provides Helm completion in many places like \`shell-mode'.\\n\
|
||||
;; Find context help for most Helm commands with \`C-h m'.\\n\
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n"))
|
||||
|
||||
(setq load-path (quote $LOAD_PATH))
|
||||
|
||||
(defvar default-package-manager nil)
|
||||
;; /home/you/.emacs.d/.local/straight/build-27.1/helm
|
||||
(defvar initial-package-directory (file-name-directory (file-truename "$0")))
|
||||
|
||||
(defvar bootstrap-version)
|
||||
(let* ((packages "$LOAD_PACKAGES")
|
||||
(pkg-list (and packages
|
||||
(not (equal packages ""))
|
||||
(split-string packages ",")))
|
||||
;; /home/you/.emacs.d/.local/straight/build-27.1
|
||||
(straight-path (file-name-directory (directory-file-name initial-package-directory)))
|
||||
;; /home/you/.emacs.d/.local/straight/build-27.1/async
|
||||
(async-path (expand-file-name "async" straight-path))
|
||||
;; /home/you/.emacs.d/.local/straight/repos/straight.el/bootstrap.el
|
||||
(bootstrap-file
|
||||
(expand-file-name "repos/straight.el/bootstrap.el"
|
||||
(file-name-directory (directory-file-name straight-path))))
|
||||
(bootstrap-version 5))
|
||||
(when (file-exists-p bootstrap-file)
|
||||
(setq default-package-manager 'straight)
|
||||
(load bootstrap-file nil 'nomessage)
|
||||
(add-to-list 'load-path async-path)
|
||||
(when pkg-list
|
||||
(dolist (pkg pkg-list)
|
||||
(let* ((pkg-path (expand-file-name pkg straight-path))
|
||||
(autoload-file (expand-file-name
|
||||
(format "%s-autoloads.el" pkg)
|
||||
pkg-path)))
|
||||
(add-to-list 'load-path pkg-path)
|
||||
(if (file-exists-p autoload-file)
|
||||
(load autoload-file nil 'nomessage)
|
||||
(straight-use-package (intern pkg))))))))
|
||||
|
||||
(unless (eq default-package-manager 'straight)
|
||||
(require 'package)
|
||||
;; User may be using a non standard \`package-user-dir'.
|
||||
;; Modify \`package-directory-list' instead of \`package-user-dir'
|
||||
;; in case the user starts Helm from a non-ELPA installation.
|
||||
(unless (file-equal-p package-user-dir (locate-user-emacs-file "elpa"))
|
||||
;; Something like /home/you/.emacs.d/somedir/else/elpa/
|
||||
;; starting from default-directory is wrong in case helm.sh is a symlink
|
||||
;; or e.g. helm --chdir foo have been used.
|
||||
(add-to-list 'package-directory-list (directory-file-name
|
||||
(file-name-directory
|
||||
(directory-file-name initial-package-directory)))))
|
||||
|
||||
(let* ((str-lst "$LOAD_PACKAGES")
|
||||
(load-packages (and str-lst
|
||||
(not (string= str-lst ""))
|
||||
(split-string str-lst ","))))
|
||||
(setq package-load-list
|
||||
(if (equal load-packages '("all"))
|
||||
'(all)
|
||||
(append '((helm-core t) (helm t) (async t) (popup t))
|
||||
(mapcar (lambda (p) (list (intern p) t)) load-packages)))))
|
||||
|
||||
(package-initialize))
|
||||
|
||||
(add-to-list 'load-path initial-package-directory)
|
||||
|
||||
(unless (> $TOOLBARS 0)
|
||||
(setq default-frame-alist '((vertical-scroll-bars . nil)
|
||||
(tool-bar-lines . 0)
|
||||
(menu-bar-lines . 0)
|
||||
(fullscreen . nil))))
|
||||
(blink-cursor-mode -1)
|
||||
(load "helm-autoloads" nil t)
|
||||
(helm-mode 1)
|
||||
(with-eval-after-load 'tramp-cache (setq tramp-cache-read-persistent-data t))
|
||||
(with-eval-after-load 'auth-source (setq auth-source-save-behavior nil))
|
||||
(define-key global-map [remap find-file] 'helm-find-files)
|
||||
(define-key global-map [remap occur] 'helm-occur)
|
||||
(define-key global-map [remap list-buffers] 'helm-buffers-list)
|
||||
(define-key global-map [remap dabbrev-expand] 'helm-dabbrev)
|
||||
(define-key global-map [remap execute-extended-command] 'helm-M-x)
|
||||
(define-key global-map [remap apropos-command] 'helm-apropos)
|
||||
(unless (boundp 'completion-in-region-function)
|
||||
(define-key lisp-interaction-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point)
|
||||
(define-key emacs-lisp-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point))
|
||||
(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE"))))
|
||||
EOF
|
||||
|
||||
$EMACS -Q -l "$CONF_FILE" "$@"
|
1187
code/elpa/helm-20230406.839/helm-autoloads.el
Normal file
1187
code/elpa/helm-20230406.839/helm-autoloads.el
Normal file
File diff suppressed because it is too large
Load diff
823
code/elpa/helm-20230406.839/helm-bookmark.el
Normal file
823
code/elpa/helm-20230406.839/helm-bookmark.el
Normal file
|
@ -0,0 +1,823 @@
|
|||
;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'bookmark)
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-help)
|
||||
(require 'helm-types)
|
||||
(require 'helm-utils)
|
||||
(require 'helm-info)
|
||||
(require 'helm-adaptive)
|
||||
(require 'helm-net)
|
||||
|
||||
(declare-function helm-browse-project "helm-files" (arg))
|
||||
(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark))
|
||||
(declare-function all-the-icons-fileicon "ext:all-the-icons.el")
|
||||
(declare-function all-the-icons-icon-for-file"ext:all-the-icons.el")
|
||||
(declare-function all-the-icons-octicon "ext:all-the-icons.el")
|
||||
|
||||
|
||||
(defgroup helm-bookmark nil
|
||||
"Predefined configurations for `helm.el'."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-bookmark-show-location nil
|
||||
"Show location of bookmark on display."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-bookmark-default-filtered-sources
|
||||
(append '(helm-source-bookmark-org
|
||||
helm-source-bookmark-files&dirs
|
||||
helm-source-bookmark-helm-find-files
|
||||
helm-source-bookmark-info
|
||||
helm-source-bookmark-gnus
|
||||
helm-source-bookmark-mu4e
|
||||
helm-source-bookmark-man
|
||||
helm-source-bookmark-images
|
||||
helm-source-bookmark-w3m)
|
||||
(list 'helm-source-bookmark-uncategorized
|
||||
'helm-source-bookmark-set))
|
||||
"List of sources to use in `helm-filtered-bookmarks'."
|
||||
:type '(repeat (choice symbol)))
|
||||
|
||||
(defcustom helm-bookmark-use-icon nil
|
||||
"Display candidates with an icon with `all-the-icons' when non nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-bookmark-default-sort-method 'adaptive
|
||||
"Sort method for `helm-filtered-bookmarks'.
|
||||
|
||||
Value can be either \\='native' or \\='adaptive'.
|
||||
|
||||
Once you use \\='native' the bookmark variable `bookmark-sort-flag'
|
||||
will be honored."
|
||||
:type '(choice
|
||||
(symbol :tag "Helm adaptive sort method" adaptive)
|
||||
(symbol :tag "Native bookmark sort method" native))
|
||||
;; Don't use the :set function until functions and variables below
|
||||
;; are not loaded i.e. use set-default only for now.
|
||||
:initialize 'custom-initialize-changed
|
||||
:set (lambda (var val)
|
||||
(set var val)
|
||||
(cl-loop for s in (remove 'helm-source-bookmark-set
|
||||
helm-bookmark-default-filtered-sources)
|
||||
for fn = (intern (format "%s-builder" s))
|
||||
do (set s (funcall fn)))))
|
||||
|
||||
(defgroup helm-bookmark-faces nil
|
||||
"Customize the appearance of helm-bookmark."
|
||||
:prefix "helm-"
|
||||
:group 'helm-bookmark
|
||||
:group 'helm-faces)
|
||||
|
||||
(defface helm-bookmark-info
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "green"))
|
||||
"Face used for W3m Emacs bookmarks (not w3m bookmarks)."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
(defface helm-bookmark-w3m
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "yellow"))
|
||||
"Face used for W3m Emacs bookmarks (not w3m bookmarks)."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
(defface helm-bookmark-gnus
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "magenta"))
|
||||
"Face used for Gnus bookmarks."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
(defface helm-bookmark-man
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "Orange4"))
|
||||
"Face used for Woman/man bookmarks."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
(defface helm-bookmark-file
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "Deepskyblue2"))
|
||||
"Face used for file bookmarks."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
(defface helm-bookmark-file-not-found
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "Slategray4"))
|
||||
"Face used for file bookmarks."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
(defface helm-bookmark-directory
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:inherit helm-ff-directory))
|
||||
"Face used for file bookmarks."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
(defface helm-bookmark-addressbook
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "tomato"))
|
||||
"Face used for addressbook bookmarks."
|
||||
:group 'helm-bookmark-faces)
|
||||
|
||||
|
||||
(defvar helm-bookmark-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "C-c o") #'helm-bookmark-run-jump-other-window)
|
||||
(define-key map (kbd "C-c C-o") #'helm-bookmark-run-jump-other-frame)
|
||||
(define-key map (kbd "C-c C-t") #'helm-bookmark-run-jump-other-tab)
|
||||
(define-key map (kbd "C-d") #'helm-bookmark-run-delete)
|
||||
(define-key map (kbd "C-]") #'helm-bookmark-toggle-filename)
|
||||
(define-key map (kbd "M-e") #'helm-bookmark-run-edit)
|
||||
map)
|
||||
"Generic Keymap for Emacs bookmark sources.")
|
||||
|
||||
(defclass helm-source-basic-bookmarks (helm-source-in-buffer helm-type-bookmark)
|
||||
((init :initform (lambda ()
|
||||
(bookmark-maybe-load-default-file)
|
||||
(helm-init-candidates-in-buffer
|
||||
'global
|
||||
(if (and (fboundp 'bookmark-maybe-sort-alist)
|
||||
(fboundp 'bookmark-name-from-full-record))
|
||||
(mapcar 'bookmark-name-from-full-record
|
||||
(bookmark-maybe-sort-alist))
|
||||
(bookmark-all-names)))))
|
||||
(filtered-candidate-transformer :initform 'helm-bookmark-transformer)
|
||||
(find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn)))
|
||||
|
||||
(defvar helm-source-bookmarks
|
||||
(helm-make-source "Bookmarks" 'helm-source-basic-bookmarks)
|
||||
"See (info \"(emacs)Bookmarks\").")
|
||||
|
||||
(defun helm-bookmark-transformer (candidates _source)
|
||||
(cl-loop for i in candidates
|
||||
for loc = (bookmark-location i)
|
||||
for len = (string-width i)
|
||||
for trunc = (if (> len bookmark-bmenu-file-column)
|
||||
(helm-substring i bookmark-bmenu-file-column)
|
||||
i)
|
||||
for sep = (make-string (- (+ bookmark-bmenu-file-column 2)
|
||||
(length trunc))
|
||||
? )
|
||||
if helm-bookmark-show-location
|
||||
collect (cons (concat trunc sep (if (listp loc) (car loc) loc)) i)
|
||||
else collect i))
|
||||
|
||||
(defun helm-bookmark-toggle-filename-1 (_candidate)
|
||||
(let* ((real (helm-get-selection helm-buffer))
|
||||
(trunc (if (> (string-width real) bookmark-bmenu-file-column)
|
||||
(helm-substring real bookmark-bmenu-file-column)
|
||||
real)))
|
||||
(setq helm-bookmark-show-location (not helm-bookmark-show-location))
|
||||
(helm-update (if helm-bookmark-show-location
|
||||
(regexp-quote trunc)
|
||||
(regexp-quote real)))))
|
||||
|
||||
(helm-make-persistent-command-from-action helm-bookmark-toggle-filename
|
||||
"Toggle bookmark location visibility."
|
||||
'toggle-filename 'helm-bookmark-toggle-filename-1)
|
||||
|
||||
(defun helm-bookmark-jump-1 (candidate &optional fn)
|
||||
(let (;; FIXME Why is prefarg necessary here?
|
||||
(current-prefix-arg helm-current-prefix-arg)
|
||||
non-essential)
|
||||
(bookmark-jump candidate fn)))
|
||||
|
||||
(defun helm-bookmark-jump (candidate)
|
||||
"Jump to bookmark action."
|
||||
(helm-bookmark-jump-1 candidate))
|
||||
|
||||
(defun helm-bookmark-jump-other-frame (candidate)
|
||||
"Jump to bookmark in other frame action."
|
||||
(helm-bookmark-jump-1 candidate #'switch-to-buffer-other-frame))
|
||||
|
||||
(defun helm-bookmark-jump-other-window (candidate)
|
||||
"Jump to bookmark in other window action."
|
||||
(helm-bookmark-jump-1 candidate #'switch-to-buffer-other-window))
|
||||
|
||||
(defun helm-bookmark-jump-other-tab (candidate)
|
||||
"Jump to bookmark action."
|
||||
(cl-assert (fboundp 'tab-bar-mode) nil "Tab-bar-mode not available")
|
||||
(helm-bookmark-jump-1 candidate #'switch-to-buffer-other-tab))
|
||||
|
||||
;;; bookmark-set
|
||||
;;
|
||||
(defvar helm-source-bookmark-set
|
||||
(helm-build-dummy-source "Set Bookmark"
|
||||
:filtered-candidate-transformer
|
||||
(lambda (_candidates _source)
|
||||
(list (or (and (not (string= helm-pattern ""))
|
||||
helm-pattern)
|
||||
"Enter a bookmark name to record")))
|
||||
:action '(("Set bookmark" . (lambda (candidate)
|
||||
(if (string= helm-pattern "")
|
||||
(message "No bookmark name given for record")
|
||||
(bookmark-set candidate))))))
|
||||
"See (info \"(emacs)Bookmarks\").")
|
||||
|
||||
|
||||
;;; Predicates
|
||||
;;
|
||||
(defconst helm-bookmark--non-file-filename " - no file -"
|
||||
"Name to use for `filename' entry, for non-file bookmarks.")
|
||||
|
||||
(defun helm-bookmark-gnus-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Gnus bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus)
|
||||
(eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)))
|
||||
|
||||
(defun helm-bookmark-mu4e-bookmark-p (bookmark)
|
||||
"Return non nil if BOOKMARK is a mu4e bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(memq (bookmark-get-handler bookmark)
|
||||
'(mu4e-bookmark-jump mu4e--jump-to-bookmark)))
|
||||
|
||||
(defun helm-bookmark-w3m-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a W3m bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m)))
|
||||
|
||||
(defun helm-bookmark-woman-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Woman bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman)
|
||||
(eq (bookmark-get-handler bookmark) 'woman-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman)))
|
||||
|
||||
(defun helm-bookmark-man-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Man bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man)
|
||||
(eq (bookmark-get-handler bookmark) 'Man-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)))
|
||||
|
||||
(defun helm-bookmark-woman-man-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Man or Woman bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (helm-bookmark-man-bookmark-p bookmark)
|
||||
(helm-bookmark-woman-bookmark-p bookmark)))
|
||||
|
||||
(defun helm-bookmark-info-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is an Info bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(eq (bookmark-get-handler bookmark) 'Info-bookmark-jump))
|
||||
|
||||
(defun helm-bookmark-image-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK bookmarks an image file."
|
||||
(if (stringp bookmark)
|
||||
(assq 'image-type (assq bookmark bookmark-alist))
|
||||
(assq 'image-type bookmark)))
|
||||
|
||||
(defun helm-bookmark-file-p (bookmark)
|
||||
"Return non-nil if BOOKMARK bookmarks a file or directory.
|
||||
BOOKMARK is a bookmark name or a bookmark record.
|
||||
This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)."
|
||||
(let* ((filename (bookmark-get-filename bookmark))
|
||||
(isnonfile (equal filename helm-bookmark--non-file-filename)))
|
||||
(and filename (not isnonfile) (not (bookmark-get-handler bookmark)))))
|
||||
|
||||
(defun helm-bookmark-org-file-p (bookmark)
|
||||
(let* ((filename (bookmark-get-filename bookmark)))
|
||||
(or (string-suffix-p ".org" filename t)
|
||||
(string-suffix-p ".org_archive" filename t))))
|
||||
|
||||
(defun helm-bookmark-helm-find-files-p (bookmark)
|
||||
"Return non-nil if BOOKMARK bookmarks a `helm-find-files' session.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(eq (bookmark-get-handler bookmark) 'helm-ff-bookmark-jump))
|
||||
|
||||
(defun helm-bookmark-addressbook-p (bookmark)
|
||||
"Return non--nil if BOOKMARK is a contact recorded with addressbook-bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(if (listp bookmark)
|
||||
(string= (assoc-default 'type bookmark) "addressbook")
|
||||
(string= (assoc-default
|
||||
'type (assoc bookmark bookmark-alist)) "addressbook")))
|
||||
|
||||
(defun helm-bookmark-uncategorized-bookmark-p (bookmark)
|
||||
"Return non--nil if BOOKMARK match no known category."
|
||||
(cl-loop for pred in '(helm-bookmark-org-file-p
|
||||
helm-bookmark-addressbook-p
|
||||
helm-bookmark-gnus-bookmark-p
|
||||
helm-bookmark-mu4e-bookmark-p
|
||||
helm-bookmark-w3m-bookmark-p
|
||||
helm-bookmark-woman-man-bookmark-p
|
||||
helm-bookmark-info-bookmark-p
|
||||
helm-bookmark-image-bookmark-p
|
||||
helm-bookmark-file-p
|
||||
helm-bookmark-helm-find-files-p
|
||||
helm-bookmark-addressbook-p)
|
||||
never (funcall pred bookmark)))
|
||||
|
||||
(defun helm-bookmark-filter-setup-alist (fn)
|
||||
"Return a filtered `bookmark-alist' sorted alphabetically."
|
||||
(cl-loop for b in (if (and (fboundp 'bookmark-maybe-sort-alist)
|
||||
(eq helm-bookmark-default-sort-method 'native))
|
||||
(bookmark-maybe-sort-alist)
|
||||
bookmark-alist)
|
||||
for name = (car b)
|
||||
when (funcall fn b) collect
|
||||
(propertize name 'location (bookmark-location name))))
|
||||
|
||||
;;; Bookmark handlers
|
||||
;;
|
||||
(defvar w3m-async-exec)
|
||||
(defun helm-bookmark-jump-w3m (bookmark)
|
||||
"Jump to W3m bookmark BOOKMARK, setting a new tab.
|
||||
If `browse-url-browser-function' is set to something else than
|
||||
`w3m-browse-url' use it."
|
||||
(require 'helm-net)
|
||||
(let* ((file (or (bookmark-prop-get bookmark 'filename)
|
||||
(bookmark-prop-get bookmark 'url)))
|
||||
(buf (generate-new-buffer-name "*w3m*"))
|
||||
(w3m-async-exec nil)
|
||||
;; If user don't have anymore w3m installed let it browse its
|
||||
;; bookmarks with default browser otherwise assume bookmark
|
||||
;; have been bookmarked from w3m and use w3m.
|
||||
(browse-url-browser-function (or (and (fboundp 'w3m-browse-url)
|
||||
(executable-find "w3m")
|
||||
'w3m-browse-url)
|
||||
browse-url-browser-function))
|
||||
(really-use-w3m (equal browse-url-browser-function 'w3m-browse-url)))
|
||||
(helm-browse-url file really-use-w3m)
|
||||
(when really-use-w3m
|
||||
(bookmark-default-handler
|
||||
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))))
|
||||
|
||||
;; All bookmarks recorded with the handler provided with w3m
|
||||
;; (`bookmark-w3m-bookmark-jump') will use our handler which open
|
||||
;; the bookmark in a new tab or in an external browser depending
|
||||
;; on `browse-url-browser-function'.
|
||||
(defalias 'bookmark-w3m-bookmark-jump #'helm-bookmark-jump-w3m)
|
||||
|
||||
;; Provide compatibility with old handlers provided in external
|
||||
;; packages bookmark-extensions.el and bookmark+.
|
||||
(defalias 'bmkext-jump-woman #'woman-bookmark-jump)
|
||||
(defalias 'bmkext-jump-man #'Man-bookmark-jump)
|
||||
(defalias 'bmkext-jump-w3m #'helm-bookmark-jump-w3m)
|
||||
(defalias 'bmkext-jump-gnus #'gnus-summary-bookmark-jump)
|
||||
(defalias 'bookmarkp-jump-gnus #'gnus-summary-bookmark-jump)
|
||||
(defalias 'bookmarkp-jump-w3m #'helm-bookmark-jump-w3m)
|
||||
(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump)
|
||||
(defalias 'bookmarkp-jump-man #'Man-bookmark-jump)
|
||||
|
||||
|
||||
;;;; Filtered bookmark sources
|
||||
;;
|
||||
;;
|
||||
(defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark)
|
||||
((filtered-candidate-transformer
|
||||
:initform (delq nil
|
||||
`(,(and (eq helm-bookmark-default-sort-method 'adaptive)
|
||||
'helm-adaptive-sort)
|
||||
helm-highlight-bookmark)))
|
||||
(find-file-target :initform #'helm-bookmarks-quit-an-find-file-fn)))
|
||||
|
||||
(defun helm-bookmarks-quit-an-find-file-fn (source)
|
||||
(let* ((sel (helm-get-selection nil nil source))
|
||||
(bmk (assoc (replace-regexp-in-string "\\`\\*" "" sel)
|
||||
bookmark-alist)))
|
||||
(helm-aif (bookmark-get-filename bmk)
|
||||
(if (and helm--url-regexp
|
||||
(string-match helm--url-regexp it))
|
||||
it (expand-file-name it))
|
||||
(expand-file-name default-directory))))
|
||||
|
||||
(defun helm-bookmark-build-source (name buildfn &optional class &rest args)
|
||||
(apply #'helm-make-source name
|
||||
(or class 'helm-source-filtered-bookmarks)
|
||||
:init (lambda ()
|
||||
(bookmark-maybe-load-default-file)
|
||||
(helm-init-candidates-in-buffer
|
||||
'global (funcall buildfn)))
|
||||
args))
|
||||
|
||||
;;; W3m bookmarks.
|
||||
;;
|
||||
(defun helm-bookmark-w3m-setup-alist ()
|
||||
"Specialized filter function for bookmarks w3m."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p))
|
||||
|
||||
(defun helm-source-bookmark-w3m-builder ()
|
||||
(helm-bookmark-build-source "Bookmark W3m" #'helm-bookmark-w3m-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-w3m (helm-source-bookmark-w3m-builder))
|
||||
|
||||
;;; Images
|
||||
;;
|
||||
(defun helm-bookmark-images-setup-alist ()
|
||||
"Specialized filter function for images bookmarks."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p))
|
||||
|
||||
(defun helm-source-bookmark-images-builder ()
|
||||
(helm-bookmark-build-source "Bookmark Images" #'helm-bookmark-images-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-images (helm-source-bookmark-images-builder))
|
||||
|
||||
;;; Woman Man
|
||||
;;
|
||||
(defun helm-bookmark-man-setup-alist ()
|
||||
"Specialized filter function for bookmarks w3m."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p))
|
||||
|
||||
(defun helm-source-bookmark-man-builder ()
|
||||
(helm-bookmark-build-source "Bookmark Woman&Man" #'helm-bookmark-man-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-man (helm-source-bookmark-man-builder))
|
||||
|
||||
;;; Org files
|
||||
;;
|
||||
(defun helm-bookmark-org-setup-alist ()
|
||||
"Specialized filter function for Org file bookmarks."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-org-file-p))
|
||||
|
||||
(defun helm-source-bookmark-org-builder ()
|
||||
(helm-bookmark-build-source "Bookmark Org files" #'helm-bookmark-org-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-org (helm-source-bookmark-org-builder))
|
||||
|
||||
;;; Gnus
|
||||
;;
|
||||
(defun helm-bookmark-gnus-setup-alist ()
|
||||
"Specialized filter function for bookmarks gnus."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p))
|
||||
|
||||
(defun helm-source-bookmark-gnus-builder ()
|
||||
(helm-bookmark-build-source "Bookmark Gnus" #'helm-bookmark-gnus-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-gnus (helm-source-bookmark-gnus-builder))
|
||||
|
||||
;;; Mu4e
|
||||
;;
|
||||
(defun helm-bookmark-mu4e-setup-alist ()
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-mu4e-bookmark-p))
|
||||
|
||||
(defun helm-source-bookmark-mu4e-builder ()
|
||||
(helm-bookmark-build-source "Bookmark Mu4e" #'helm-bookmark-mu4e-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-mu4e (helm-source-bookmark-mu4e-builder))
|
||||
|
||||
;;; Info
|
||||
;;
|
||||
(defun helm-bookmark-info-setup-alist ()
|
||||
"Specialized filter function for bookmarks info."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p))
|
||||
|
||||
(defun helm-source-bookmark-info-builder ()
|
||||
(helm-bookmark-build-source "Bookmark Info" #'helm-bookmark-info-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-info (helm-source-bookmark-info-builder))
|
||||
|
||||
;;; Files and directories
|
||||
;;
|
||||
(defun helm-bookmark-local-files-setup-alist ()
|
||||
"Specialized filter function for bookmarks locals files."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-file-p))
|
||||
|
||||
(defun helm-source-bookmark-files&dirs-builder ()
|
||||
(helm-bookmark-build-source
|
||||
"Bookmark Files&Directories" #'helm-bookmark-local-files-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-files&dirs
|
||||
(helm-source-bookmark-files&dirs-builder))
|
||||
|
||||
;;; Helm find files sessions.
|
||||
;;
|
||||
(defun helm-bookmark-helm-find-files-setup-alist ()
|
||||
"Specialized filter function for `helm-find-files' bookmarks."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-helm-find-files-p))
|
||||
|
||||
(defun helm-bookmark-browse-project (candidate)
|
||||
"Run `helm-browse-project' from action."
|
||||
(with-helm-default-directory
|
||||
(bookmark-get-filename candidate)
|
||||
(helm-browse-project nil)))
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-browse-project
|
||||
"Run `helm-bookmark-browse-project' from keyboard."
|
||||
'helm-bookmark-browse-project)
|
||||
|
||||
(defvar helm-bookmark-find-files-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-bookmark-map)
|
||||
(define-key map (kbd "C-x C-d") #'helm-bookmark-run-browse-project)
|
||||
map))
|
||||
|
||||
;; Same as `helm-source-filtered-bookmarks' but override actions and keymap
|
||||
;; specifically for helm-find-files bookmarks.
|
||||
(defclass helm-bookmark-override-inheritor (helm-source) ())
|
||||
|
||||
(cl-defmethod helm--setup-source ((source helm-bookmark-override-inheritor))
|
||||
;; Ensure `helm-source-in-buffer' method is called.
|
||||
(cl-call-next-method)
|
||||
(setf (slot-value source 'action)
|
||||
(helm-append-at-nth
|
||||
(cl-loop for (name . action) in helm-type-bookmark-actions
|
||||
;; We don't want those actions in helm-find-files bookmarks.
|
||||
unless (memq action '(helm-bookmark-jump-other-frame
|
||||
helm-bookmark-jump-other-window
|
||||
helm-bookmark-jump-other-tab))
|
||||
collect (cons name action))
|
||||
'(("Browse project" . helm-bookmark-browse-project)) 1))
|
||||
(setf (slot-value source 'keymap) helm-bookmark-find-files-map))
|
||||
|
||||
(defclass helm-bookmark-find-files-class (helm-source-filtered-bookmarks
|
||||
helm-bookmark-override-inheritor)
|
||||
())
|
||||
|
||||
(defun helm-source-bookmark-helm-find-files-builder ()
|
||||
(helm-bookmark-build-source
|
||||
"Bookmark helm-find-files sessions"
|
||||
#'helm-bookmark-helm-find-files-setup-alist
|
||||
'helm-bookmark-find-files-class
|
||||
:persistent-action (lambda (_candidate) (ignore))
|
||||
:persistent-help "Do nothing"))
|
||||
|
||||
(defvar helm-source-bookmark-helm-find-files
|
||||
(helm-source-bookmark-helm-find-files-builder))
|
||||
|
||||
;;; Uncategorized bookmarks
|
||||
;;
|
||||
(defun helm-bookmark-uncategorized-setup-alist ()
|
||||
"Specialized filter function for uncategorized bookmarks."
|
||||
(helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p))
|
||||
|
||||
(defun helm-source-bookmark-uncategorized-builder ()
|
||||
(helm-bookmark-build-source
|
||||
"Bookmark uncategorized" #'helm-bookmark-uncategorized-setup-alist))
|
||||
|
||||
(defvar helm-source-bookmark-uncategorized
|
||||
(helm-source-bookmark-uncategorized-builder))
|
||||
|
||||
|
||||
;;; Transformer
|
||||
;;
|
||||
(defun helm-highlight-bookmark (bookmarks _source)
|
||||
"Used as `filtered-candidate-transformer' to colorize bookmarks."
|
||||
(let ((non-essential t))
|
||||
(cl-loop for i in bookmarks
|
||||
for isfile = (bookmark-get-filename i)
|
||||
for hff = (helm-bookmark-helm-find-files-p i)
|
||||
for handlerp = (and (fboundp 'bookmark-get-handler)
|
||||
(bookmark-get-handler i))
|
||||
for isw3m = (and (fboundp 'helm-bookmark-w3m-bookmark-p)
|
||||
(helm-bookmark-w3m-bookmark-p i))
|
||||
for isgnus = (and (fboundp 'helm-bookmark-gnus-bookmark-p)
|
||||
(helm-bookmark-gnus-bookmark-p i))
|
||||
for ismu4e = (and (fboundp 'helm-bookmark-mu4e-bookmark-p)
|
||||
(helm-bookmark-mu4e-bookmark-p i))
|
||||
for isman = (and (fboundp 'helm-bookmark-man-bookmark-p) ; Man
|
||||
(helm-bookmark-man-bookmark-p i))
|
||||
for iswoman = (and (fboundp 'helm-bookmark-woman-bookmark-p) ; Woman
|
||||
(helm-bookmark-woman-bookmark-p i))
|
||||
for isannotation = (bookmark-get-annotation i)
|
||||
for isabook = (string= (bookmark-prop-get i 'type)
|
||||
"addressbook")
|
||||
for isinfo = (eq handlerp 'Info-bookmark-jump)
|
||||
for loc = (bookmark-location i)
|
||||
for len = (string-width i)
|
||||
for trunc = (if (and helm-bookmark-show-location
|
||||
(> len bookmark-bmenu-file-column))
|
||||
(helm-substring
|
||||
i bookmark-bmenu-file-column)
|
||||
i)
|
||||
for icon = (when helm-bookmark-use-icon
|
||||
(cond ((and isfile hff)
|
||||
(all-the-icons-octicon "file-directory"))
|
||||
((and isfile isinfo) (all-the-icons-octicon "info"))
|
||||
(isfile (all-the-icons-icon-for-file isfile))
|
||||
((or iswoman isman)
|
||||
(all-the-icons-fileicon "man-page"))
|
||||
((or isgnus ismu4e)
|
||||
(all-the-icons-octicon "mail-read"))))
|
||||
;; Add a * if bookmark have annotation
|
||||
if (and isannotation (not (string-equal isannotation "")))
|
||||
do (setq trunc (concat "*" (if helm-bookmark-show-location trunc i)))
|
||||
for sep = (and helm-bookmark-show-location
|
||||
(make-string (- (+ bookmark-bmenu-file-column 2)
|
||||
(string-width trunc))
|
||||
? ))
|
||||
for bmk = (cond ( ;; info buffers
|
||||
isinfo
|
||||
(propertize trunc 'face 'helm-bookmark-info
|
||||
'help-echo isfile))
|
||||
( ;; w3m buffers
|
||||
isw3m
|
||||
(propertize trunc 'face 'helm-bookmark-w3m
|
||||
'help-echo isfile))
|
||||
( ;; gnus buffers
|
||||
isgnus
|
||||
(propertize trunc 'face 'helm-bookmark-gnus
|
||||
'help-echo isfile))
|
||||
( ;; Man Woman
|
||||
(or iswoman isman)
|
||||
(propertize trunc 'face 'helm-bookmark-man
|
||||
'help-echo isfile))
|
||||
( ;; Addressbook
|
||||
isabook
|
||||
(propertize trunc 'face 'helm-bookmark-addressbook))
|
||||
(;; Directories (helm-find-files)
|
||||
hff
|
||||
(if (and (file-remote-p isfile)
|
||||
(not (file-remote-p isfile nil t)))
|
||||
(propertize trunc 'face 'helm-bookmark-file-not-found
|
||||
'help-echo isfile)
|
||||
(propertize trunc 'face 'helm-bookmark-directory
|
||||
'help-echo isfile)))
|
||||
( ;; Directories (dired)
|
||||
(and isfile
|
||||
;; This is needed because `non-essential'
|
||||
;; is not working on Emacs-24.2 and the behavior
|
||||
;; of tramp seems to have changed since previous
|
||||
;; versions (Need to reenter password even if a
|
||||
;; first connection have been established,
|
||||
;; probably when host is named differently
|
||||
;; i.e machine/localhost)
|
||||
(and (not (file-remote-p isfile))
|
||||
(file-directory-p isfile)))
|
||||
(propertize trunc 'face 'helm-bookmark-directory
|
||||
'help-echo isfile))
|
||||
( ;; Non existing files.
|
||||
(and isfile
|
||||
;; Be safe and call `file-exists-p'
|
||||
;; only if file is not remote or
|
||||
;; remote but connected.
|
||||
(or (and (file-remote-p isfile)
|
||||
(not (file-remote-p isfile nil t)))
|
||||
(not (file-exists-p isfile))))
|
||||
(propertize trunc 'face 'helm-bookmark-file-not-found
|
||||
'help-echo isfile))
|
||||
( ;; regular files
|
||||
t
|
||||
(propertize trunc 'face 'helm-bookmark-file
|
||||
'help-echo isfile)))
|
||||
collect (if helm-bookmark-show-location
|
||||
(cons (concat (and icon (propertize " " 'display (concat icon " ")))
|
||||
bmk
|
||||
(propertize
|
||||
" " 'display
|
||||
(concat sep (if (listp loc) (car loc) loc))))
|
||||
i)
|
||||
(cons (concat (and icon (propertize " " 'display (concat icon " ")))
|
||||
bmk)
|
||||
i)))))
|
||||
|
||||
|
||||
;;; Edit/rename/save bookmarks.
|
||||
;;
|
||||
;;
|
||||
(defun helm-bookmark-edit-bookmark (bookmark-name)
|
||||
"Edit bookmark's name and file name, and maybe save them.
|
||||
BOOKMARK-NAME is the current (old) name of the bookmark to be
|
||||
renamed."
|
||||
(let ((bmk (helm-bookmark-get-bookmark-from-name bookmark-name))
|
||||
(handler (bookmark-prop-get bookmark-name 'handler)))
|
||||
(if (eq handler 'addressbook-bookmark-jump)
|
||||
(addressbook-bookmark-edit
|
||||
(assoc bmk bookmark-alist))
|
||||
(helm-bookmark-edit-bookmark-1 bookmark-name handler))))
|
||||
|
||||
(defun helm-bookmark-edit-bookmark-1 (bookmark-name handler)
|
||||
(let* ((helm--reading-passwd-or-string t)
|
||||
(bookmark-fname (bookmark-get-filename bookmark-name))
|
||||
(bookmark-loc (bookmark-prop-get bookmark-name 'location))
|
||||
(message-id (bookmark-prop-get bookmark-name 'message-id))
|
||||
(new-name (read-from-minibuffer "Name: " bookmark-name))
|
||||
(new-loc (and (or bookmark-fname bookmark-loc)
|
||||
(read-from-minibuffer "FileName or Location: "
|
||||
(or bookmark-fname
|
||||
(if (consp bookmark-loc)
|
||||
(car bookmark-loc)
|
||||
bookmark-loc)))))
|
||||
(new-message-id (and (memq handler '(mu4e--jump-to-bookmark
|
||||
mu4e-bookmark-jump))
|
||||
(read-string "Message-id: " message-id))))
|
||||
(when (and (not (equal new-name ""))
|
||||
(or (not (equal new-loc ""))
|
||||
(not (equal new-message-id "")))
|
||||
(y-or-n-p "Save changes? "))
|
||||
(if bookmark-fname
|
||||
(progn
|
||||
(helm-bookmark-rename bookmark-name new-name 'batch)
|
||||
(bookmark-set-filename new-name new-loc))
|
||||
(bookmark-prop-set
|
||||
(bookmark-get-bookmark bookmark-name)
|
||||
(cond (new-loc 'location)
|
||||
(new-message-id 'message-id))
|
||||
(or new-loc new-message-id))
|
||||
(helm-bookmark-rename bookmark-name new-name 'batch))
|
||||
(helm-bookmark-maybe-save-bookmark)
|
||||
(list new-name new-loc))))
|
||||
|
||||
(defun helm-bookmark-maybe-save-bookmark ()
|
||||
"Increment save counter and maybe save `bookmark-alist'."
|
||||
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
|
||||
(when (bookmark-time-to-save-p) (bookmark-save)))
|
||||
|
||||
(defun helm-bookmark-rename (old &optional new batch)
|
||||
"Change bookmark's name from OLD to NEW.
|
||||
Interactively:
|
||||
If called from the keyboard, then prompt for OLD.
|
||||
If called from the menubar, select OLD from a menu.
|
||||
If NEW is nil, then prompt for its string value.
|
||||
|
||||
If BATCH is non-nil, then do not rebuild the menu list.
|
||||
|
||||
While the user enters the new name, repeated `C-w' inserts
|
||||
consecutive words from the buffer into the new bookmark name."
|
||||
(interactive (list (bookmark-completing-read "Old bookmark name")))
|
||||
(bookmark-maybe-historicize-string old)
|
||||
(bookmark-maybe-load-default-file)
|
||||
(save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point)))
|
||||
(setq bookmark-current-buffer (current-buffer))
|
||||
(let ((newname (or new (read-from-minibuffer
|
||||
"New name: " nil
|
||||
(let ((now-map (copy-keymap minibuffer-local-map)))
|
||||
(define-key now-map "\C-w" #'bookmark-yank-word)
|
||||
now-map)
|
||||
nil 'bookmark-history))))
|
||||
(bookmark-set-name old newname)
|
||||
(setq bookmark-current-bookmark newname)
|
||||
(unless batch (bookmark-bmenu-surreptitiously-rebuild-list))
|
||||
(helm-bookmark-maybe-save-bookmark) newname))
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-edit
|
||||
"Run `helm-bookmark-edit-bookmark' from keyboard."
|
||||
'helm-bookmark-edit-bookmark)
|
||||
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-jump-other-frame
|
||||
"Jump to bookmark other frame from keyboard."
|
||||
'helm-bookmark-jump-other-frame)
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-jump-other-window
|
||||
"Jump to bookmark other window from keyboard."
|
||||
'helm-bookmark-jump-other-window)
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-jump-other-tab
|
||||
"Jump to bookmark other tab from keyboard."
|
||||
'helm-bookmark-jump-other-tab)
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-delete
|
||||
"Delete bookmark from keyboard."
|
||||
'helm-delete-marked-bookmarks)
|
||||
|
||||
(defun helm-bookmark-get-bookmark-from-name (bmk)
|
||||
"Return bookmark name even if it is a bookmark with annotation.
|
||||
E.g. prepended with *."
|
||||
(let ((bookmark (replace-regexp-in-string "\\`\\*" "" bmk)))
|
||||
(if (assoc bookmark bookmark-alist) bookmark bmk)))
|
||||
|
||||
(defun helm-delete-marked-bookmarks (_ignore)
|
||||
"Delete this bookmark or all marked bookmarks."
|
||||
(dolist (i (helm-marked-candidates))
|
||||
(bookmark-delete (helm-bookmark-get-bookmark-from-name i)
|
||||
'batch)))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-bookmarks ()
|
||||
"Preconfigured `helm' for bookmarks."
|
||||
(interactive)
|
||||
(helm :sources '(helm-source-bookmarks
|
||||
helm-source-bookmark-set)
|
||||
:buffer "*helm bookmarks*"
|
||||
:default (buffer-name helm-current-buffer)))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-filtered-bookmarks ()
|
||||
"Preconfigured `helm' for bookmarks (filtered by category).
|
||||
Optional source `helm-source-bookmark-addressbook' is loaded only
|
||||
if external addressbook-bookmark package is installed."
|
||||
(interactive)
|
||||
(when helm-bookmark-use-icon
|
||||
(require 'all-the-icons))
|
||||
(helm :sources helm-bookmark-default-filtered-sources
|
||||
:prompt "Search Bookmark: "
|
||||
:buffer "*helm filtered bookmarks*"
|
||||
:default (list (thing-at-point 'symbol)
|
||||
(buffer-name helm-current-buffer))))
|
||||
|
||||
(provide 'helm-bookmark)
|
||||
|
||||
;;; helm-bookmark.el ends here
|
1177
code/elpa/helm-20230406.839/helm-buffers.el
Normal file
1177
code/elpa/helm-20230406.839/helm-buffers.el
Normal file
File diff suppressed because it is too large
Load diff
226
code/elpa/helm-20230406.839/helm-comint.el
Normal file
226
code/elpa/helm-20230406.839/helm-comint.el
Normal file
|
@ -0,0 +1,226 @@
|
|||
;;; helm-comint.el --- Comint prompt navigation for helm. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2020 Pierre Neidhardt <mail@ambrevar.xyz>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; You can bind this as follows in .emacs:
|
||||
;;
|
||||
;; (add-hook 'comint-mode-hook
|
||||
;; (lambda ()
|
||||
;; (define-key comint-mode-map (kbd "M-s f") 'helm-comint-prompts-all)))
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-help)
|
||||
(require 'helm-elisp)
|
||||
|
||||
;;; Comint prompts
|
||||
;;
|
||||
(defface helm-comint-prompts-promptidx
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
(:foreground "cyan")))
|
||||
"Face used to highlight comint prompt index."
|
||||
:group 'helm-comint-faces)
|
||||
|
||||
(defface helm-comint-prompts-buffer-name
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
(:foreground "green")))
|
||||
"Face used to highlight comint buffer name."
|
||||
:group 'helm-comint-faces)
|
||||
|
||||
(defcustom helm-comint-prompts-promptidx-p t
|
||||
"Show prompt number."
|
||||
:group 'helm-comint
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-comint-mode-list '(comint-mode slime-repl-mode sly-mrepl-mode sql-interactive-mode)
|
||||
"Supported modes for prompt navigation.
|
||||
Derived modes (e.g., Geiser's REPL) are automatically supported."
|
||||
:group 'helm-comint
|
||||
:type '(repeat (choice symbol)))
|
||||
|
||||
(defcustom helm-comint-next-prompt-function '((sly-mrepl-mode . (lambda ()
|
||||
(sly-mrepl-next-prompt)
|
||||
(point))))
|
||||
"Alist of (MODE . NEXT-PROMPT-FUNCTION) to use.
|
||||
If the current major mode is a key in this list, the associated
|
||||
function will be used to navigate the prompts.
|
||||
The function must return the point after the prompt.
|
||||
Otherwise (comint-next-prompt 1) will be used."
|
||||
:group 'helm-comint
|
||||
:type '(alist :key-type symbol :value-type function))
|
||||
|
||||
(defcustom helm-comint-max-offset 400
|
||||
"Max number of chars displayed per candidate in comint-input-ring browser.
|
||||
When t, don't truncate candidate, show all.
|
||||
By default it is approximatively the number of bits contained in
|
||||
five lines of 80 chars each i.e 80*5.
|
||||
Note that if you set this to nil multiline will be disabled, i.e
|
||||
you will not have anymore separators between candidates."
|
||||
:type '(choice (const :tag "Disabled" t)
|
||||
(integer :tag "Max candidate offset"))
|
||||
:group 'helm-misc)
|
||||
|
||||
(defvar helm-comint-prompts-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "C-c o") #'helm-comint-prompts-other-window)
|
||||
(define-key map (kbd "C-c C-o") #'helm-comint-prompts-other-frame)
|
||||
map)
|
||||
"Keymap for `helm-comint-prompt-all'.")
|
||||
|
||||
(defun helm-comint-prompts-list (mode &optional buffer)
|
||||
"List the prompts in BUFFER in mode MODE.
|
||||
|
||||
Return a list of (\"prompt\" (point) (buffer-name) prompt-index))
|
||||
E.g. (\"ls\" 162 \"*shell*\" 3).
|
||||
If BUFFER is nil, use current buffer."
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(when (derived-mode-p mode)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let (result (count 1))
|
||||
(save-mark-and-excursion
|
||||
(helm-awhile (and (not (eobp))
|
||||
(helm-aif (alist-get major-mode helm-comint-next-prompt-function)
|
||||
(funcall it)
|
||||
(comint-next-prompt 1)))
|
||||
(push (list (buffer-substring-no-properties
|
||||
it (point-at-eol))
|
||||
it (buffer-name) count)
|
||||
result)
|
||||
(setq count (1+ count))))
|
||||
(nreverse result))))))
|
||||
|
||||
(defun helm-comint-prompts-list-all (mode)
|
||||
"List the prompts of all buffers in mode MODE.
|
||||
See `helm-comint-prompts-list'."
|
||||
(cl-loop for b in (buffer-list)
|
||||
append (helm-comint-prompts-list mode b)))
|
||||
|
||||
(defun helm-comint-prompts-transformer (candidates &optional all)
|
||||
;; ("ls" 162 "*shell*" 3) => ("*shell*:3:ls" . ("ls" 162 "*shell*" 3))
|
||||
(cl-loop for (prt pos buf id) in candidates
|
||||
collect `(,(concat
|
||||
(when all
|
||||
(concat (propertize
|
||||
buf
|
||||
'face 'helm-comint-prompts-buffer-name)
|
||||
":"))
|
||||
(when helm-comint-prompts-promptidx-p
|
||||
(concat (propertize
|
||||
(number-to-string id)
|
||||
'face 'helm-comint-prompts-promptidx)
|
||||
":"))
|
||||
prt)
|
||||
. ,(list prt pos buf id))))
|
||||
|
||||
(defun helm-comint-prompts-all-transformer (candidates)
|
||||
(helm-comint-prompts-transformer candidates t))
|
||||
|
||||
(cl-defun helm-comint-prompts-goto (candidate &optional (action 'switch-to-buffer))
|
||||
;; Candidate format: ("ls" 162 "*shell*" 3)
|
||||
(let ((buf (nth 2 candidate)))
|
||||
(unless (and (string= (buffer-name) buf)
|
||||
(eq action 'switch-to-buffer))
|
||||
(funcall action buf))
|
||||
(goto-char (nth 1 candidate))
|
||||
(recenter)))
|
||||
|
||||
(defun helm-comint-prompts-goto-other-window (candidate)
|
||||
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-window))
|
||||
|
||||
(defun helm-comint-prompts-goto-other-frame (candidate)
|
||||
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-frame))
|
||||
|
||||
(helm-make-command-from-action helm-comint-prompts-other-window
|
||||
"Switch to comint prompt in other window."
|
||||
'helm-comint-prompts-goto-other-window)
|
||||
|
||||
(helm-make-command-from-action helm-comint-prompts-other-frame
|
||||
"Switch to comint prompt in other frame."
|
||||
'helm-comint-prompts-goto-other-frame)
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-comint-prompts ()
|
||||
"Pre-configured `helm' to browse the prompts of the current comint buffer."
|
||||
(interactive)
|
||||
(if (apply #'derived-mode-p helm-comint-mode-list)
|
||||
(helm :sources
|
||||
(helm-build-sync-source "Comint prompts"
|
||||
:candidates (helm-comint-prompts-list major-mode)
|
||||
:candidate-transformer #'helm-comint-prompts-transformer
|
||||
:action '(("Go to prompt" . helm-comint-prompts-goto)))
|
||||
:buffer "*helm comint prompts*")
|
||||
(message "Current buffer is not a comint buffer")))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-comint-prompts-all ()
|
||||
"Pre-configured `helm' to browse the prompts of all comint sessions."
|
||||
(interactive)
|
||||
(if (apply #'derived-mode-p helm-comint-mode-list)
|
||||
(helm :sources
|
||||
(helm-build-sync-source "All comint prompts"
|
||||
:candidates (helm-comint-prompts-list-all major-mode)
|
||||
:candidate-transformer #'helm-comint-prompts-all-transformer
|
||||
:action (quote (("Go to prompt" . helm-comint-prompts-goto)
|
||||
("Go to prompt in other window `C-c o`" .
|
||||
helm-comint-prompts-goto-other-window)
|
||||
("Go to prompt in other frame `C-c C-o`" .
|
||||
helm-comint-prompts-goto-other-frame)))
|
||||
:keymap helm-comint-prompts-keymap)
|
||||
:buffer "*helm comint all prompts*")
|
||||
(message "Current buffer is not a comint buffer")))
|
||||
|
||||
;;; Comint history
|
||||
;;
|
||||
;;
|
||||
(defun helm-comint-input-ring-action (candidate)
|
||||
"Default action for comint history."
|
||||
(with-helm-current-buffer
|
||||
(delete-region (comint-line-beginning-position) (point-max))
|
||||
(insert candidate)))
|
||||
|
||||
(defvar helm-source-comint-input-ring
|
||||
(helm-build-sync-source "Comint history"
|
||||
:candidates (lambda ()
|
||||
(with-helm-current-buffer
|
||||
(cl-loop for elm in (ring-elements comint-input-ring)
|
||||
unless (string= elm "")
|
||||
collect elm)))
|
||||
:action 'helm-comint-input-ring-action
|
||||
;; Multiline does not work for `shell' because of an Emacs bug.
|
||||
;; It works in other REPLs like Geiser.
|
||||
:multiline 'helm-comint-max-offset)
|
||||
"Source that provides Helm completion against `comint-input-ring'.")
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-comint-input-ring ()
|
||||
"Preconfigured `helm' that provide completion of `comint' history."
|
||||
(interactive)
|
||||
(when (or (derived-mode-p 'comint-mode)
|
||||
(member major-mode helm-comint-mode-list))
|
||||
(helm :sources 'helm-source-comint-input-ring
|
||||
:input (buffer-substring-no-properties (comint-line-beginning-position)
|
||||
(point-at-eol))
|
||||
:buffer "*helm comint history*")))
|
||||
|
||||
(provide 'helm-comint)
|
||||
|
||||
;;; helm-comint.el ends here
|
|
@ -135,7 +135,8 @@ fuzzy matching is running its own sort function with a different
|
|||
algorithm."
|
||||
(with-helm-current-buffer
|
||||
(cl-loop with max-len = (when helm-M-x-show-short-doc
|
||||
(helm-in-buffer-get-longest-candidate))
|
||||
(buffer-local-value 'helm-candidate-buffer-longest-len
|
||||
(get-buffer (helm-candidate-buffer))))
|
||||
with local-map = (helm-M-x-current-mode-map-alist)
|
||||
for cand in candidates
|
||||
for local-key = (car (rassq cand local-map))
|
||||
|
@ -152,28 +153,25 @@ algorithm."
|
|||
unless (and (null ignore-props) (or (get sym 'helm-only) (get sym 'no-helm-mx)))
|
||||
collect
|
||||
(cons (cond ((and (string-match "^M-x" key) local-key)
|
||||
(propertize (format "%s%s%s %s"
|
||||
(format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize local-key 'face 'helm-M-x-key)))
|
||||
'match-part disp))
|
||||
(propertize local-key 'face 'helm-M-x-key))))
|
||||
((string-match "^M-x" key)
|
||||
(propertize (format "%s%s%s"
|
||||
(format "%s%s%s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
|
||||
'match-part disp))
|
||||
(t (propertize (format "%s%s%s %s"
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")))
|
||||
(t (format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize key 'face 'helm-M-x-key)))
|
||||
'match-part disp)))
|
||||
(propertize key 'face 'helm-M-x-key)))))
|
||||
cand)
|
||||
into ls
|
||||
finally return
|
||||
|
@ -202,7 +200,7 @@ algorithm."
|
|||
(save-excursion
|
||||
(beginning-of-defun)
|
||||
(cadr (split-string (buffer-substring-no-properties
|
||||
(pos-bol) (pos-eol))))))
|
||||
(point-at-bol) (point-at-eol))))))
|
||||
|
||||
(defun helm-cmd--get-preconfigured-commands (&optional dir)
|
||||
(let* ((helm-dir (or dir (helm-basedir (locate-library "helm"))))
|
|
@ -237,7 +237,7 @@ The search starts at (1- BEG) with a regexp starting with
|
|||
regexp matching syntactically any word or symbol.
|
||||
The possible false positives matching SEP-REGEXP at end are
|
||||
finally removed."
|
||||
(let ((eol (pos-eol)))
|
||||
(let ((eol (point-at-eol)))
|
||||
(save-excursion
|
||||
(goto-char (1- beg))
|
||||
(when (re-search-forward
|
|
@ -48,7 +48,8 @@
|
|||
["Gnus Manual index" helm-info-gnus t]
|
||||
["Helm documentation" helm-documentation t])
|
||||
("Elpa"
|
||||
["Elisp packages" helm-packages t])
|
||||
["Elisp packages" helm-list-elisp-packages t]
|
||||
["Elisp packages no fetch" helm-list-elisp-packages-no-fetch t])
|
||||
("Tools"
|
||||
["Occur" helm-occur t]
|
||||
["Grep current directory with AG" helm-do-grep-ag t]
|
483
code/elpa/helm-20230406.839/helm-elisp-package.el
Normal file
483
code/elpa/helm-20230406.839/helm-elisp-package.el
Normal file
|
@ -0,0 +1,483 @@
|
|||
;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-help)
|
||||
(require 'package)
|
||||
|
||||
(defgroup helm-el-package nil
|
||||
"helm elisp packages."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-el-package-initial-filter 'all
|
||||
"Show only installed, upgraded or all packages at startup."
|
||||
:type '(radio :tag "Initial filter for elisp packages"
|
||||
(const :tag "Show all packages" all)
|
||||
(const :tag "Show installed packages" installed)
|
||||
(const :tag "Show not installed packages" uninstalled)
|
||||
(const :tag "Show upgradable packages" upgrade)))
|
||||
|
||||
(defcustom helm-el-truncate-lines t
|
||||
"Truncate lines in `helm-buffer' when non-nil."
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
(defcustom helm-el-package-upgrade-on-start nil
|
||||
"Show package upgrades on startup when non nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-el-package-autoremove-on-start nil
|
||||
"Try to autoremove no more needed packages on startup.
|
||||
See `package-autoremove'."
|
||||
:type 'boolean)
|
||||
|
||||
;; internals vars
|
||||
(defvar helm-el-package--show-only 'all)
|
||||
(defvar helm-el-package--initialized-p nil)
|
||||
(defvar helm-el-package--tabulated-list nil)
|
||||
(defvar helm-el-package--upgrades nil)
|
||||
(defvar helm-el-package--removable-packages nil)
|
||||
|
||||
;; Shutup bytecompiler for emacs-24*
|
||||
(defvar package-menu-async) ; Only available on emacs-25.
|
||||
(defvar helm-marked-buffer-name)
|
||||
(declare-function async-byte-recompile-directory "ext:async-bytecomp.el")
|
||||
(declare-function with-helm-display-marked-candidates "helm-utils.el")
|
||||
|
||||
|
||||
(defun helm-el-package--init ()
|
||||
;; In emacs-27 package-show-package-list returns an empty buffer
|
||||
;; until package-initialize have been called.
|
||||
(unless (or package--initialized
|
||||
(null (boundp 'package-quickstart)))
|
||||
(package-initialize))
|
||||
(let (package-menu-async
|
||||
(inhibit-read-only t))
|
||||
(when (null package-alist)
|
||||
(setq helm-el-package--show-only 'all))
|
||||
(unless (consp package-selected-packages)
|
||||
(helm-aif (package--find-non-dependencies)
|
||||
(setq package-selected-packages it)))
|
||||
(when (and (setq helm-el-package--removable-packages
|
||||
(package--removable-packages))
|
||||
helm-el-package-autoremove-on-start)
|
||||
(package-autoremove))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(save-selected-window
|
||||
(if helm-el-package--initialized-p
|
||||
;; Use this as `list-packages' doesn't work
|
||||
;; properly (empty buffer) when called from lisp
|
||||
;; with 'no-fetch (emacs-25 WA).
|
||||
(package-show-package-list)
|
||||
(when helm--force-updating-p (message "Refreshing packages list..."))
|
||||
(list-packages helm-el-package--initialized-p))
|
||||
(setq helm-el-package--initialized-p t)
|
||||
(message nil))
|
||||
(helm-init-candidates-in-buffer
|
||||
'global
|
||||
(with-current-buffer (get-buffer "*Packages*")
|
||||
(setq helm-el-package--tabulated-list tabulated-list-entries)
|
||||
(remove-text-properties (point-min) (point-max)
|
||||
'(read-only button follow-link category))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^[ \t]+" nil t)
|
||||
(replace-match ""))
|
||||
(buffer-string)))
|
||||
(setq helm-el-package--upgrades (helm-el-package-menu--find-upgrades))
|
||||
(if helm--force-updating-p
|
||||
(if helm-el-package--upgrades
|
||||
(message "Refreshing packages list done, [%d] package(s) to upgrade"
|
||||
(length helm-el-package--upgrades))
|
||||
(message "Refreshing packages list done, no upgrades available"))
|
||||
(setq helm-el-package--show-only (if (and helm-el-package-upgrade-on-start
|
||||
helm-el-package--upgrades)
|
||||
'upgrade
|
||||
helm-el-package-initial-filter))))
|
||||
(kill-buffer "*Packages*"))))
|
||||
|
||||
(defun helm-el-package-describe (candidate)
|
||||
(let ((id (get-text-property 0 'tabulated-list-id candidate)))
|
||||
(describe-package (package-desc-name id))))
|
||||
|
||||
(defun helm-el-package-visit-homepage (candidate)
|
||||
(let* ((id (get-text-property 0 'tabulated-list-id candidate))
|
||||
(pkg (package-desc-name id))
|
||||
(desc (cadr (assoc pkg package-archive-contents)))
|
||||
(extras (package-desc-extras desc))
|
||||
(url (and (listp extras) (cdr-safe (assoc :url extras)))))
|
||||
(if (stringp url)
|
||||
(browse-url url)
|
||||
(message "Package %s has no homepage"
|
||||
(propertize (symbol-name pkg)
|
||||
'face 'font-lock-keyword-face)))))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-visit-homepage
|
||||
"Visit package homepage from helm elisp packages."
|
||||
'helm-el-package-visit-homepage)
|
||||
|
||||
(defun helm-elisp-package--pkg-name (pkg)
|
||||
(if (package-desc-p pkg)
|
||||
(package-desc-name pkg)
|
||||
pkg))
|
||||
|
||||
(defun helm-el-package-install-1 (pkg-list)
|
||||
(cl-loop with mkd = pkg-list
|
||||
for p in mkd
|
||||
for id = (get-text-property 0 'tabulated-list-id p)
|
||||
for name = (helm-elisp-package--pkg-name id)
|
||||
do (package-install id t)
|
||||
when (helm-aand (assq name package-alist)
|
||||
(package-desc-dir (cadr it))
|
||||
(file-exists-p it))
|
||||
collect id into installed-list and
|
||||
do (unless (package--user-selected-p name)
|
||||
(package--save-selected-packages
|
||||
(cons name package-selected-packages)))
|
||||
finally do (message (format "%d packages installed:\n(%s)"
|
||||
(length installed-list)
|
||||
(mapconcat #'package-desc-full-name
|
||||
installed-list ", ")))))
|
||||
|
||||
(defun helm-el-package-install (_candidate)
|
||||
(helm-el-package-install-1 (helm-marked-candidates)))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-install
|
||||
"Install package from helm elisp packages."
|
||||
'helm-el-package-install)
|
||||
|
||||
(defun helm-el-package-uninstall-1 (pkg-list &optional force)
|
||||
(cl-loop with mkd = pkg-list
|
||||
for p in mkd
|
||||
for id = (get-text-property 0 'tabulated-list-id p)
|
||||
do
|
||||
(condition-case-unless-debug err
|
||||
(package-delete id force)
|
||||
(error (message (cadr err))))
|
||||
;; Seems like package-descs are symbols with props instead of
|
||||
;; vectors in emacs-27, use package-desc-name to ensure
|
||||
;; compatibility in all emacs versions.
|
||||
unless (assoc (package-desc-name id) package-alist)
|
||||
collect id into delete-list
|
||||
finally do (if delete-list
|
||||
(message (format "%d packages deleted:\n(%s)"
|
||||
(length delete-list)
|
||||
(mapconcat #'package-desc-full-name
|
||||
delete-list ", ")))
|
||||
"No package deleted")))
|
||||
|
||||
(defun helm-el-package-uninstall (_candidate)
|
||||
(helm-el-package-uninstall-1 (helm-marked-candidates) helm-current-prefix-arg))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-uninstall
|
||||
"Uninstall package from helm elisp packages."
|
||||
'helm-el-package-uninstall)
|
||||
|
||||
(defun helm-el-package-menu--find-upgrades ()
|
||||
(cl-loop for entry in helm-el-package--tabulated-list
|
||||
for pkg-desc = (car entry)
|
||||
for status = (package-desc-status pkg-desc)
|
||||
;; A dependency.
|
||||
when (string= status "dependency")
|
||||
collect pkg-desc into dependencies
|
||||
;; An installed package used as dependency (user have
|
||||
;; installed this package explicitely).
|
||||
when (package--used-elsewhere-p pkg-desc)
|
||||
collect pkg-desc into installed-as-dep
|
||||
;; An installed package.
|
||||
when (member status '("installed" "unsigned"))
|
||||
collect pkg-desc into installed
|
||||
when (member status '("available" "new"))
|
||||
collect (cons (package-desc-name pkg-desc) pkg-desc) into available
|
||||
finally return
|
||||
;; Always try to upgrade dependencies before installed.
|
||||
(cl-loop with all = (append dependencies installed-as-dep installed)
|
||||
for pkg in all
|
||||
for name = (package-desc-name pkg)
|
||||
for avail-pkg = (assq name available)
|
||||
when (and avail-pkg
|
||||
(version-list-<
|
||||
(package-desc-version pkg)
|
||||
(package-desc-version (cdr avail-pkg))))
|
||||
collect avail-pkg)))
|
||||
|
||||
(defun helm-el-package--user-installed-p (package)
|
||||
"Return non-nil if PACKAGE is a user-installed package."
|
||||
(let* ((assoc (assq package package-alist))
|
||||
(pkg-desc (and assoc (cadr assoc)))
|
||||
(dir (and pkg-desc (package-desc-dir pkg-desc))))
|
||||
(when dir
|
||||
(file-in-directory-p dir package-user-dir))))
|
||||
|
||||
(defun helm-el-package-upgrade-1 (pkg-list)
|
||||
(cl-loop for p in pkg-list
|
||||
for pkg-desc = (car p)
|
||||
for pkg-name = (package-desc-name pkg-desc)
|
||||
for upgrade = (cdr (assq pkg-name
|
||||
helm-el-package--upgrades))
|
||||
do
|
||||
(cond (;; Install.
|
||||
(equal pkg-desc upgrade)
|
||||
(message "Installing package `%s'" pkg-name)
|
||||
(package-install pkg-desc t))
|
||||
(;; Do nothing.
|
||||
(or (null upgrade)
|
||||
;; This may happen when a Elpa version of pkg
|
||||
;; is installed and need upgrade and pkg is as
|
||||
;; well a builtin package.
|
||||
(package-built-in-p pkg-name))
|
||||
(ignore))
|
||||
(;; Delete.
|
||||
t
|
||||
(message "Deleting package `%s'" pkg-name)
|
||||
(package-delete pkg-desc t t)))))
|
||||
|
||||
(defun helm-el-package-upgrade (_candidate)
|
||||
(helm-el-package-upgrade-1
|
||||
(cl-loop with pkgs = (helm-marked-candidates)
|
||||
for p in helm-el-package--tabulated-list
|
||||
for pkg = (car p)
|
||||
if (member (symbol-name (package-desc-name pkg)) pkgs)
|
||||
collect p)))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-upgrade
|
||||
"Uninstall package from helm elisp packages."
|
||||
'helm-el-package-upgrade)
|
||||
|
||||
(defun helm-el-package-upgrade-all ()
|
||||
(if helm-el-package--upgrades
|
||||
(with-helm-display-marked-candidates
|
||||
helm-marked-buffer-name (helm-fast-remove-dups
|
||||
(mapcar (lambda (x) (symbol-name (car x)))
|
||||
helm-el-package--upgrades)
|
||||
:test 'equal)
|
||||
(when (y-or-n-p "Upgrade all packages? ")
|
||||
(helm-el-package-upgrade-1 helm-el-package--tabulated-list)))
|
||||
(message "No packages to upgrade actually!")))
|
||||
|
||||
(defun helm-el-package-upgrade-all-action (_candidate)
|
||||
(helm-el-package-upgrade-all))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-upgrade-all
|
||||
"Upgrade all packages from helm elisp packages."
|
||||
'helm-el-package-upgrade-all-action)
|
||||
|
||||
(defun helm-el-package--transformer (candidates _source)
|
||||
(cl-loop for c in candidates
|
||||
for disp = (concat " " c)
|
||||
for id = (get-text-property 0 'tabulated-list-id c)
|
||||
for name = (and id (package-desc-name id))
|
||||
for desc = (package-desc-status id)
|
||||
for built-in-p = (and (package-built-in-p name)
|
||||
(not (member desc '("available" "new"
|
||||
"installed" "dependency"))))
|
||||
for installed-p = (member desc '("installed" "dependency"))
|
||||
for upgrade-p = (assq name helm-el-package--upgrades)
|
||||
for user-installed-p = (memq name package-selected-packages)
|
||||
do (when (and user-installed-p (not upgrade-p))
|
||||
(put-text-property 0 2 'display "S " disp))
|
||||
do (when (or (memq name helm-el-package--removable-packages)
|
||||
(and upgrade-p installed-p))
|
||||
(put-text-property 0 2 'display "U " disp)
|
||||
(put-text-property
|
||||
2 (+ (length (symbol-name name)) 2)
|
||||
'face 'font-lock-variable-name-face disp))
|
||||
do (when (and upgrade-p (not installed-p) (not built-in-p))
|
||||
(put-text-property 0 2 'display "I " disp))
|
||||
for cand = (cons disp (car (split-string disp)))
|
||||
when (or (and built-in-p
|
||||
(eq helm-el-package--show-only 'built-in))
|
||||
(and upgrade-p
|
||||
(eq helm-el-package--show-only 'upgrade))
|
||||
(and installed-p
|
||||
(eq helm-el-package--show-only 'installed))
|
||||
(and (not installed-p)
|
||||
(not built-in-p)
|
||||
(eq helm-el-package--show-only 'uninstalled))
|
||||
(eq helm-el-package--show-only 'all))
|
||||
collect cand))
|
||||
|
||||
(defun helm-el-package-show-built-in ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'built-in)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-built-in 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-upgrade ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'upgrade)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-upgrade 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-installed ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'installed)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-installed 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-all ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'all)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-all 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-uninstalled ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'uninstalled)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-uninstalled 'helm-only t)
|
||||
|
||||
(defvar helm-el-package-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "M-I") #'helm-el-package-show-installed)
|
||||
(define-key map (kbd "M-O") #'helm-el-package-show-uninstalled)
|
||||
(define-key map (kbd "M-U") #'helm-el-package-show-upgrade)
|
||||
(define-key map (kbd "M-B") #'helm-el-package-show-built-in)
|
||||
(define-key map (kbd "M-A") #'helm-el-package-show-all)
|
||||
(define-key map (kbd "C-c i") #'helm-el-run-package-install)
|
||||
(define-key map (kbd "C-c r") #'helm-el-run-package-reinstall)
|
||||
(define-key map (kbd "C-c d") #'helm-el-run-package-uninstall)
|
||||
(define-key map (kbd "C-c u") #'helm-el-run-package-upgrade)
|
||||
(define-key map (kbd "C-c U") #'helm-el-run-package-upgrade-all)
|
||||
(define-key map (kbd "C-c @") #'helm-el-run-visit-homepage)
|
||||
map))
|
||||
|
||||
(defvar helm-source-list-el-package nil)
|
||||
(defclass helm-list-el-package-source (helm-source-in-buffer)
|
||||
((init :initform 'helm-el-package--init)
|
||||
(get-line :initform 'buffer-substring)
|
||||
(filtered-candidate-transformer :initform 'helm-el-package--transformer)
|
||||
(action-transformer :initform 'helm-el-package--action-transformer)
|
||||
(help-message :initform 'helm-el-package-help-message)
|
||||
(keymap :initform 'helm-el-package-map)
|
||||
(update :initform 'helm-el-package--update)
|
||||
(candidate-number-limit :initform 9999)
|
||||
(action :initform '(("Describe package" . helm-el-package-describe)
|
||||
("Visit homepage" . helm-el-package-visit-homepage)))
|
||||
(find-file-target :initform #'helm-el-package-quit-an-find-file-fn)
|
||||
(group :initform 'helm-el-package)))
|
||||
|
||||
(defun helm-el-package-quit-an-find-file-fn (source)
|
||||
(let* ((sel (helm-get-selection nil nil source))
|
||||
(pkg (and (stringp sel)
|
||||
(get-text-property 0 'tabulated-list-id sel))))
|
||||
(when (and pkg (package-installed-p pkg))
|
||||
(expand-file-name (package-desc-dir pkg)))))
|
||||
|
||||
(defun helm-el-package--action-transformer (actions candidate)
|
||||
(let* ((pkg-desc (get-text-property 0 'tabulated-list-id candidate))
|
||||
(status (package-desc-status pkg-desc))
|
||||
(pkg-name (package-desc-name pkg-desc))
|
||||
(built-in (and (package-built-in-p pkg-name)
|
||||
(not (member status '("available" "new"
|
||||
"installed" "dependency")))))
|
||||
(acts (if helm-el-package--upgrades
|
||||
(append actions '(("Upgrade all packages"
|
||||
. helm-el-package-upgrade-all-action)))
|
||||
actions)))
|
||||
(cond (built-in '(("Describe package" . helm-el-package-describe)))
|
||||
((and (package-installed-p pkg-name)
|
||||
(cdr (assq pkg-name helm-el-package--upgrades))
|
||||
(member status '("installed" "dependency")))
|
||||
(append '(("Upgrade package(s)" . helm-el-package-upgrade)
|
||||
("Uninstall package(s)" . helm-el-package-uninstall))
|
||||
acts))
|
||||
((and (package-installed-p pkg-name)
|
||||
(cdr (assq pkg-name helm-el-package--upgrades))
|
||||
(string= status "available"))
|
||||
(append '(("Upgrade package(s)" . helm-el-package-upgrade))
|
||||
acts))
|
||||
((and (package-installed-p pkg-name)
|
||||
(or (null (package-built-in-p pkg-name))
|
||||
(and (package-built-in-p pkg-name)
|
||||
(assq pkg-name package-alist))))
|
||||
(append acts '(("Reinstall package(s)" . helm-el-package-reinstall)
|
||||
("Recompile package(s)" . helm-el-package-recompile)
|
||||
("Uninstall package(s)" . helm-el-package-uninstall))))
|
||||
(t (append acts '(("Install packages(s)" . helm-el-package-install)))))))
|
||||
|
||||
(defun helm-el-package--update ()
|
||||
(setq helm-el-package--initialized-p nil))
|
||||
|
||||
(defun helm-el-package-recompile (_pkg)
|
||||
(cl-loop for p in (helm-marked-candidates)
|
||||
do (helm-el-package-recompile-1 p)))
|
||||
|
||||
(defun helm-el-package-recompile-1 (pkg)
|
||||
(let* ((pkg-desc (get-text-property 0 'tabulated-list-id pkg))
|
||||
(dir (package-desc-dir pkg-desc)))
|
||||
(async-byte-recompile-directory dir)))
|
||||
|
||||
(defun helm-el-package-reinstall (_pkg)
|
||||
(cl-loop for p in (helm-marked-candidates)
|
||||
for pkg-desc = (get-text-property 0 'tabulated-list-id p)
|
||||
do (helm-el-package-reinstall-1 pkg-desc)))
|
||||
|
||||
(defun helm-el-package-reinstall-1 (pkg-desc)
|
||||
(let ((name (package-desc-name pkg-desc)))
|
||||
(package-delete pkg-desc 'force 'nosave)
|
||||
;; pkg-desc contain the description
|
||||
;; of the installed package just removed
|
||||
;; and is BTW no more valid.
|
||||
;; Use the entry in package-archive-content
|
||||
;; which is the non--installed package entry.
|
||||
;; For some reason `package-install'
|
||||
;; need a pkg-desc (package-desc-p) for the build-in
|
||||
;; packages already installed, the name (as symbol)
|
||||
;; fails with such packages.
|
||||
(package-install
|
||||
(cadr (assq name package-archive-contents)) t)))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-reinstall
|
||||
"Reinstall package from helm elisp packages."
|
||||
'helm-el-package-reinstall)
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-list-elisp-packages (arg)
|
||||
"Preconfigured `helm' for listing and handling Emacs packages."
|
||||
(interactive "P")
|
||||
(when arg (setq helm-el-package--initialized-p nil))
|
||||
(unless helm-source-list-el-package
|
||||
(setq helm-source-list-el-package
|
||||
(helm-make-source "list packages" 'helm-list-el-package-source)))
|
||||
(helm :sources 'helm-source-list-el-package
|
||||
:truncate-lines helm-el-truncate-lines
|
||||
:full-frame t
|
||||
:buffer "*helm list packages*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-list-elisp-packages-no-fetch (arg)
|
||||
"Preconfigured Helm for Emacs packages.
|
||||
|
||||
Same as `helm-list-elisp-packages' but don't fetch packages on
|
||||
remote. Called with a prefix ARG always fetch packages on
|
||||
remote."
|
||||
(interactive "P")
|
||||
(let ((helm-el-package--initialized-p (null arg)))
|
||||
(helm-list-elisp-packages nil)))
|
||||
|
||||
(provide 'helm-elisp-package)
|
||||
|
||||
;;; helm-elisp-package.el ends here
|
1051
code/elpa/helm-20230406.839/helm-elisp.el
Normal file
1051
code/elpa/helm-20230406.839/helm-elisp.el
Normal file
File diff suppressed because it is too large
Load diff
|
@ -405,7 +405,7 @@ If BUFFER is nil, use current buffer."
|
|||
(get-text-property (match-beginning 0) 'read-only))
|
||||
(null eshell-highlight-prompt))
|
||||
(push (list (buffer-substring-no-properties
|
||||
it (pos-eol))
|
||||
it (point-at-eol))
|
||||
it (buffer-name) count)
|
||||
result)
|
||||
(setq count (1+ count))))
|
|
@ -21,7 +21,6 @@
|
|||
(require 'helm-types)
|
||||
|
||||
(declare-function ansi-color-apply "ansi-color.el")
|
||||
(declare-function split-string-shell-command "shell.el")
|
||||
|
||||
(defvar helm-fd-executable "fd"
|
||||
"The fd shell command executable.")
|
6679
code/elpa/helm-20230406.839/helm-files.el
Normal file
6679
code/elpa/helm-20230406.839/helm-files.el
Normal file
File diff suppressed because it is too large
Load diff
104
code/elpa/helm-20230406.839/helm-global-bindings.el
Normal file
104
code/elpa/helm-20230406.839/helm-global-bindings.el
Normal file
|
@ -0,0 +1,104 @@
|
|||
;;; helm-global-bindings.el --- Bind global helm commands -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'helm-lib) ; For helm-aif (bug #2520).
|
||||
|
||||
|
||||
;;; Command Keymap
|
||||
;;
|
||||
;;
|
||||
(defgroup helm-global-bindings nil
|
||||
"Global bindings for Helm."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-command-prefix-key
|
||||
(helm-aif (car (where-is-internal 'Control-X-prefix (list global-map)))
|
||||
(concat it [?c]))
|
||||
"The key `helm-command-prefix' is bound to in the global map."
|
||||
:type '(choice (string :tag "Key") (const :tag "no binding"))
|
||||
:group 'helm-global-bindings
|
||||
:set
|
||||
(lambda (var key)
|
||||
(when (and (boundp var) (symbol-value var))
|
||||
(define-key (current-global-map)
|
||||
(read-kbd-macro (symbol-value var)) nil))
|
||||
(when key
|
||||
(define-key (current-global-map)
|
||||
(read-kbd-macro key) 'helm-command-prefix))
|
||||
(set var key)))
|
||||
|
||||
(defvar helm-command-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "a") 'helm-apropos)
|
||||
(define-key map (kbd "e") 'helm-etags-select)
|
||||
(define-key map (kbd "l") 'helm-locate)
|
||||
(define-key map (kbd "s") 'helm-surfraw)
|
||||
(define-key map (kbd "r") 'helm-regexp)
|
||||
(define-key map (kbd "m") 'helm-man-woman)
|
||||
(define-key map (kbd "t") 'helm-top)
|
||||
(define-key map (kbd "/") 'helm-find)
|
||||
(define-key map (kbd "i") 'helm-imenu)
|
||||
(define-key map (kbd "I") 'helm-imenu-in-all-buffers)
|
||||
(define-key map (kbd "<tab>") 'helm-lisp-completion-at-point)
|
||||
(define-key map (kbd "p") 'helm-list-emacs-process)
|
||||
(define-key map (kbd "C-x r b") 'helm-filtered-bookmarks)
|
||||
(define-key map (kbd "M-y") 'helm-show-kill-ring)
|
||||
(define-key map (kbd "C-c <SPC>") 'helm-all-mark-rings)
|
||||
(define-key map (kbd "C-x C-f") 'helm-find-files)
|
||||
(define-key map (kbd "f") 'helm-multi-files)
|
||||
(define-key map (kbd "C-:") 'helm-eval-expression-with-eldoc)
|
||||
(define-key map (kbd "C-,") 'helm-calcul-expression)
|
||||
(define-key map (kbd "M-x") 'helm-M-x)
|
||||
(define-key map (kbd "M-s o") 'helm-occur)
|
||||
(define-key map (kbd "M-g a") 'helm-do-grep-ag)
|
||||
(define-key map (kbd "c") 'helm-colors)
|
||||
(define-key map (kbd "F") 'helm-select-xfont)
|
||||
(define-key map (kbd "8") 'helm-ucs)
|
||||
(define-key map (kbd "C-c f") 'helm-recentf)
|
||||
(define-key map (kbd "C-c g") 'helm-google-suggest)
|
||||
(define-key map (kbd "h i") 'helm-info-at-point)
|
||||
(define-key map (kbd "h r") 'helm-info-emacs)
|
||||
(define-key map (kbd "h g") 'helm-info-gnus)
|
||||
(define-key map (kbd "h h") 'helm-documentation)
|
||||
(define-key map (kbd "C-x C-b") 'helm-buffers-list)
|
||||
(define-key map (kbd "C-x r i") 'helm-register)
|
||||
(define-key map (kbd "C-c C-x") 'helm-run-external-command)
|
||||
(define-key map (kbd "b") 'helm-resume)
|
||||
(define-key map (kbd "M-g i") 'helm-gid)
|
||||
(define-key map (kbd "@") 'helm-list-elisp-packages)
|
||||
map))
|
||||
|
||||
;; Don't override the keymap we just defined with an empty
|
||||
;; keymap. This also protect bindings changed by the user.
|
||||
(defvar helm-command-prefix)
|
||||
(define-prefix-command 'helm-command-prefix)
|
||||
(fset 'helm-command-prefix helm-command-map)
|
||||
(setq helm-command-prefix helm-command-map)
|
||||
|
||||
|
||||
;;; Menu
|
||||
|
||||
(require 'helm-easymenu)
|
||||
|
||||
|
||||
;;; Provide
|
||||
|
||||
(provide 'helm-global-bindings)
|
||||
|
||||
;;; helm-global-bindings.el ends here
|
|
@ -712,7 +712,7 @@ WHERE can be `other-window' or `other-frame'."
|
|||
(if (eq major-mode 'helm-grep-mode)
|
||||
(current-buffer)
|
||||
helm-buffer)
|
||||
(get-text-property (pos-bol)
|
||||
(get-text-property (point-at-bol)
|
||||
'helm-grep-fname))
|
||||
(car split)))
|
||||
(tramp-fname (file-remote-p (or helm-ff-default-directory
|
||||
|
@ -740,8 +740,8 @@ WHERE can be `other-window' or `other-frame'."
|
|||
when (save-excursion
|
||||
(condition-case _err
|
||||
(if helm-migemo-mode
|
||||
(helm-mm-migemo-forward reg (pos-eol) t)
|
||||
(re-search-forward reg (pos-eol) t))
|
||||
(helm-mm-migemo-forward reg (point-at-eol) t)
|
||||
(re-search-forward reg (point-at-eol) t))
|
||||
(invalid-regexp nil)))
|
||||
collect (match-beginning 0) into pos-ls
|
||||
finally (when pos-ls (goto-char (apply #'min pos-ls))))
|
||||
|
@ -779,7 +779,7 @@ If N is positive go forward otherwise go backward."
|
|||
(eq major-mode 'helm-moccur-mode)
|
||||
(eq major-mode 'helm-occur-mode)))
|
||||
(sel (if allow-mode
|
||||
(buffer-substring (pos-bol) (pos-eol))
|
||||
(buffer-substring (point-at-bol) (point-at-eol))
|
||||
(helm-get-selection nil t)))
|
||||
(current-line-list (helm-grep-split-line sel))
|
||||
(current-fname (nth 0 current-line-list))
|
||||
|
@ -793,13 +793,13 @@ If N is positive go forward otherwise go backward."
|
|||
(forward-line n) ; Go forward or backward depending of n value.
|
||||
;; Exit when current-fname is not matched or in `helm-grep-mode'
|
||||
;; the line is not a grep line i.e 'fname:num:tag'.
|
||||
(setq sel (buffer-substring (pos-bol) (pos-eol)))
|
||||
(setq sel (buffer-substring (point-at-bol) (point-at-eol)))
|
||||
(when helm-allow-mouse
|
||||
(helm--mouse-reset-selection-help-echo))
|
||||
(unless (or (string= current-fname
|
||||
(car (helm-grep-split-line sel)))
|
||||
(and (eq major-mode 'helm-grep-mode)
|
||||
(not (get-text-property (pos-bol) 'helm-grep-fname))))
|
||||
(not (get-text-property (point-at-bol) 'helm-grep-fname))))
|
||||
(funcall mark-maybe)
|
||||
(throw 'break nil))))
|
||||
(cond ((and (> n 0) (eobp))
|
||||
|
@ -807,7 +807,7 @@ If N is positive go forward otherwise go backward."
|
|||
(forward-line 0)
|
||||
(funcall mark-maybe))
|
||||
((and (< n 0) (bobp))
|
||||
(helm-aif (next-single-property-change (pos-bol) 'helm-grep-fname)
|
||||
(helm-aif (next-single-property-change (point-at-bol) 'helm-grep-fname)
|
||||
(goto-char it)
|
||||
(forward-line 1))
|
||||
(funcall mark-maybe)))
|
||||
|
@ -898,7 +898,7 @@ If N is positive go forward otherwise go backward."
|
|||
(buffer-substring (point) (point-max)))))
|
||||
(save-excursion
|
||||
(while (not (eobp))
|
||||
(add-text-properties (pos-bol) (pos-eol)
|
||||
(add-text-properties (point-at-bol) (point-at-eol)
|
||||
`(keymap ,map
|
||||
help-echo ,(concat
|
||||
(get-text-property
|
||||
|
@ -1050,7 +1050,7 @@ Special commands:
|
|||
(setq next-error-last-buffer (current-buffer))
|
||||
(setq-local helm-current-error (point-marker))
|
||||
(helm-grep-action
|
||||
(buffer-substring (pos-bol) (pos-eol)))
|
||||
(buffer-substring (point-at-bol) (point-at-eol)))
|
||||
(helm-match-line-cleanup-pulse))
|
||||
|
||||
(defun helm-grep-mode-jump-other-window-1 (arg)
|
||||
|
@ -1060,7 +1060,7 @@ Special commands:
|
|||
(eq last-command 'helm-grep-mode-jump-other-window-backward))
|
||||
(forward-line arg))
|
||||
(save-selected-window
|
||||
(helm-grep-action (buffer-substring (pos-bol) (pos-eol))
|
||||
(helm-grep-action (buffer-substring (point-at-bol) (point-at-eol))
|
||||
'other-window)
|
||||
(helm-match-line-cleanup-pulse)
|
||||
(recenter)))
|
||||
|
@ -1078,7 +1078,7 @@ Special commands:
|
|||
(interactive)
|
||||
(setq next-error-last-buffer (current-buffer))
|
||||
(setq-local helm-current-error (point-marker))
|
||||
(let ((candidate (buffer-substring (pos-bol) (pos-eol))))
|
||||
(let ((candidate (buffer-substring (point-at-bol) (point-at-eol))))
|
||||
(condition-case nil
|
||||
(progn (helm-grep-action candidate 'other-window)
|
||||
(helm-match-line-cleanup-pulse))
|
2571
code/elpa/helm-20230406.839/helm-help.el
Normal file
2571
code/elpa/helm-20230406.839/helm-help.el
Normal file
File diff suppressed because it is too large
Load diff
534
code/elpa/helm-20230406.839/helm-imenu.el
Normal file
534
code/elpa/helm-20230406.839/helm-imenu.el
Normal file
|
@ -0,0 +1,534 @@
|
|||
;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'imenu)
|
||||
(require 'helm-utils)
|
||||
(require 'helm-help)
|
||||
|
||||
(defvar all-the-icons-default-adjust)
|
||||
(defvar all-the-icons-scale-factor)
|
||||
|
||||
(declare-function which-function "which-func")
|
||||
(declare-function all-the-icons-material "ext:all-the-icons.el")
|
||||
(declare-function all-the-icons-octicon "ext:all-the-icons.el")
|
||||
(declare-function all-the-icons-faicon "ext:all-the-icons.el")
|
||||
(declare-function all-the-icons-wicon "ext:all-the-icons.el")
|
||||
|
||||
|
||||
(defgroup helm-imenu nil
|
||||
"Imenu related libraries and applications for Helm."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-imenu-delimiter " / "
|
||||
"Delimit types of candidates and their value in `helm-buffer'."
|
||||
:group 'helm-imenu
|
||||
:type 'string)
|
||||
|
||||
(defcustom helm-imenu-execute-action-at-once-if-one
|
||||
#'helm-imenu--execute-action-at-once-p
|
||||
"Goto the candidate when only one is remaining."
|
||||
:group 'helm-imenu
|
||||
:type 'function)
|
||||
|
||||
(defcustom helm-imenu-all-buffer-assoc nil
|
||||
"Major mode association alist for `helm-imenu-in-all-buffers'.
|
||||
Allow `helm-imenu-in-all-buffers' searching in these associated
|
||||
buffers even if they are not derived from each other. The alist
|
||||
is bidirectional, i.e. no need to add \\='((foo . bar) (bar . foo)),
|
||||
only \\='((foo . bar)) is needed."
|
||||
:type '(alist :key-type symbol :value-type symbol)
|
||||
:group 'helm-imenu)
|
||||
|
||||
(defcustom helm-imenu-in-all-buffers-separate-sources t
|
||||
"Display imenu index of each buffer in its own source when non-nil.
|
||||
|
||||
When nil all candidates are displayed in a single source.
|
||||
|
||||
NOTE: Each source will have as name \"Imenu <buffer-name>\".
|
||||
`helm-source-imenu-all' will not be set, however it will continue
|
||||
to be used as a flag for using default as input. If you do not
|
||||
want this behavior, remove it from
|
||||
`helm-sources-using-default-as-input' even if not using a single
|
||||
source to display imenu in all buffers."
|
||||
:type 'boolean
|
||||
:group 'helm-imenu)
|
||||
|
||||
(defcustom helm-imenu-type-faces
|
||||
'(("^Variables$" . font-lock-variable-name-face)
|
||||
("^\\(Function\\|Functions\\|Defuns\\)$" . font-lock-function-name-face)
|
||||
("^\\(Types\\|Provides\\|Requires\\|Classes\\|Class\\|Includes\\|Imports\\|Misc\\|Code\\)$" . font-lock-type-face))
|
||||
"Faces for showing type in helm-imenu.
|
||||
This is a list of cons cells. The cdr of each cell is a face to
|
||||
be used, and it can also just be like \\='(:foreground
|
||||
\"yellow\"). Each car is a regexp match pattern of the imenu type
|
||||
string."
|
||||
:group 'helm-faces
|
||||
:type '(repeat
|
||||
(cons
|
||||
(regexp :tag "Imenu type regexp pattern")
|
||||
(sexp :tag "Face"))))
|
||||
|
||||
(defcustom helm-imenu-extra-modes nil
|
||||
"Extra modes where `helm-imenu-in-all-buffers' should look into."
|
||||
:group 'helm-imenu
|
||||
:type '(repeat symbol))
|
||||
|
||||
(defcustom helm-imenu-hide-item-type-name nil
|
||||
"Hide display name of imenu item type along with the icon when non nil.
|
||||
|
||||
This value can be toggled with \\<helm-imenu-map>\\[helm-imenu-toggle-type-view]."
|
||||
:group 'helm-imenu
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-imenu-use-icon nil
|
||||
"Display an icon from all-the-icons package when non nil."
|
||||
:group 'helm-imenu
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-imenu-icon-type-alist
|
||||
'(("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||
("Color" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
|
||||
("Colors" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
|
||||
("Constant" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Constants" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Constructor" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Constructors" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Enum Member" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||
("Enum Members" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||
("Enum" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Enums" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Event" . (all-the-icons-wicon "lightning" :face font-lock-builtin-face))
|
||||
("Events" . (all-the-icons-wicon "lightning" :face font-lock-builtin-face))
|
||||
("Field" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||
("Fields" . (all-the-icons-octicon "three-bars" :face font-lock-type-face))
|
||||
("File" . (all-the-icons-faicon "file" :face font-lock-variable-name-face))
|
||||
("Files" . (all-the-icons-faicon "file" :face font-lock-variable-name-face))
|
||||
("Folder" . (all-the-icons-faicon "folder" :face font-lock-variable-name-face))
|
||||
("Folders" . (all-the-icons-faicon "folder" :face font-lock-variable-name-face))
|
||||
("Interface" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||
("Interfaces" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||
("Keyword" . (all-the-icons-octicon "key" :face font-lock-builtin-face))
|
||||
("Keywords" . (all-the-icons-octicon "key" :face font-lock-builtin-face))
|
||||
("Method" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Methods" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Defun" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Defuns" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Fn" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Fns" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Function" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Functions" . (all-the-icons-faicon "cube" :face font-lock-function-name-face))
|
||||
("Misc" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
|
||||
("Miscs" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
|
||||
("Module" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Modules" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Object" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Objects" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Operator" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
|
||||
("Operators" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
|
||||
("Property" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||
("Properties" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||
("Reference" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||
("References" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
|
||||
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
|
||||
("String" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||
("Strings" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||
("Struct" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Structs" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Text" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||
("Texts" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||
("Top level" . (all-the-icons-faicon "globe" :face font-lock-function-name-face))
|
||||
("Trait" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||
("Traits" . (all-the-icons-octicon "package" :face font-lock-builtin-face))
|
||||
("Type" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Types" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Type Parameter" . (all-the-icons-material "code" :face font-lock-type-face))
|
||||
("Type Parameters" . (all-the-icons-material "code" :face font-lock-type-face))
|
||||
("Unit" . (all-the-icons-faicon "bar-chart" :face font-lock-builtin-face))
|
||||
("Units" . (all-the-icons-faicon "bar-chart" :face font-lock-builtin-face))
|
||||
("Value" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Values" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
("Variable" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||
("Variables" . (all-the-icons-octicon "book":face font-lock-variable-name-face)))
|
||||
"An alist of types associated with a sexp returning an icon.
|
||||
The sexp should be an `all-the-icons' function with its args."
|
||||
:type '(alist :key-type string :value-type sexp)
|
||||
:group 'helm-imenu)
|
||||
|
||||
(defcustom helm-imenu-default-type-sexp
|
||||
'(all-the-icons-faicon "globe" :face font-lock-function-name-face)
|
||||
"Default sexp to use when no type for an object is found."
|
||||
:type 'sexp
|
||||
:group 'helm-imenu)
|
||||
|
||||
;;; keymap
|
||||
(defvar helm-imenu-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "M-<down>") 'helm-imenu-next-section)
|
||||
(define-key map (kbd "M-<up>") 'helm-imenu-previous-section)
|
||||
(define-key map (kbd "C-]") 'helm-imenu-toggle-type-view)
|
||||
map))
|
||||
|
||||
(defun helm-imenu-toggle-type-view ()
|
||||
"Toggle candidate type view."
|
||||
(interactive)
|
||||
(with-helm-window
|
||||
(setq helm-imenu-hide-item-type-name (not helm-imenu-hide-item-type-name))
|
||||
(let* ((sel (substring (helm-get-selection nil 'withprop)
|
||||
(if helm-imenu-use-icon 2 0)))
|
||||
(type (get-text-property 1 'type-name sel)))
|
||||
(setq sel (substring-no-properties sel))
|
||||
(helm-force-update (if helm-imenu-hide-item-type-name
|
||||
(format "^[ ]*%s$"
|
||||
(car (last (split-string
|
||||
sel helm-imenu-delimiter t))))
|
||||
(format "^[ ]*%s / %s$"
|
||||
type sel))))))
|
||||
(put 'helm-imenu-toggle-type-view 'no-helm-mx t)
|
||||
|
||||
(defcustom helm-imenu-lynx-style-map nil
|
||||
"Use Arrow keys to jump to occurences."
|
||||
:group 'helm-imenu
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(set var val)
|
||||
(if val
|
||||
(progn
|
||||
(define-key helm-imenu-map (kbd "<right>") 'helm-execute-persistent-action)
|
||||
(define-key helm-imenu-map (kbd "<left>") 'helm-maybe-exit-minibuffer))
|
||||
(define-key helm-imenu-map (kbd "<right>") nil)
|
||||
(define-key helm-imenu-map (kbd "<left>") nil))))
|
||||
|
||||
(defun helm-imenu-next-or-previous-section (n)
|
||||
(with-helm-window
|
||||
(let* ((fn (lambda ()
|
||||
(let ((str (buffer-substring
|
||||
(point-at-bol) (point-at-eol))))
|
||||
(if helm-imenu-hide-item-type-name
|
||||
(get-text-property 1 'type-name str)
|
||||
(car (split-string str helm-imenu-delimiter))))))
|
||||
(curtype (funcall fn))
|
||||
(stop-fn (if (> n 0)
|
||||
#'helm-end-of-source-p
|
||||
#'helm-beginning-of-source-p)))
|
||||
(while (and (not (funcall stop-fn))
|
||||
(string= curtype (funcall fn)))
|
||||
(forward-line n))
|
||||
(helm-mark-current-line)
|
||||
(helm-follow-execute-persistent-action-maybe))))
|
||||
|
||||
(defun helm-imenu-next-section ()
|
||||
(interactive)
|
||||
(helm-imenu-next-or-previous-section 1))
|
||||
|
||||
(defun helm-imenu-previous-section ()
|
||||
(interactive)
|
||||
(helm-imenu-next-or-previous-section -1))
|
||||
|
||||
|
||||
;;; Internals
|
||||
(defvar helm-cached-imenu-alist nil)
|
||||
(make-variable-buffer-local 'helm-cached-imenu-alist)
|
||||
|
||||
(defvar helm-cached-imenu-candidates nil)
|
||||
(make-variable-buffer-local 'helm-cached-imenu-candidates)
|
||||
|
||||
(defvar helm-cached-imenu-tick nil)
|
||||
(make-variable-buffer-local 'helm-cached-imenu-tick)
|
||||
|
||||
(defvar helm-imenu--in-all-buffers-cache nil)
|
||||
|
||||
|
||||
(defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")")
|
||||
(defvar helm-source-imenu-all nil)
|
||||
|
||||
(defclass helm-imenu-source (helm-source-sync)
|
||||
((candidates :initform 'helm-imenu-candidates)
|
||||
(candidate-transformer :initform 'helm-imenu-transformer)
|
||||
(persistent-action :initform 'helm-imenu-persistent-action)
|
||||
(persistent-help :initform "Show this entry")
|
||||
(nomark :initform t)
|
||||
(keymap :initform 'helm-imenu-map)
|
||||
(help-message :initform 'helm-imenu-help-message)
|
||||
(action :initform 'helm-imenu-action)
|
||||
(find-file-target :initform #'helm-imenu-quit-and-find-file-fn)
|
||||
(group :initform 'helm-imenu)))
|
||||
|
||||
(defcustom helm-imenu-fuzzy-match nil
|
||||
"Enable fuzzy matching in `helm-source-imenu'."
|
||||
:group 'helm-imenu
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(set var val)
|
||||
(setq helm-source-imenu
|
||||
(helm-make-source "Imenu" 'helm-imenu-source
|
||||
:fuzzy-match helm-imenu-fuzzy-match))))
|
||||
|
||||
(defun helm-imenu--maybe-switch-to-buffer (candidate)
|
||||
(let ((cand (cdr candidate)))
|
||||
(helm-aif (and (markerp cand) (marker-buffer cand))
|
||||
(switch-to-buffer it))))
|
||||
|
||||
(defun helm-imenu--execute-action-at-once-p ()
|
||||
(let ((cur (helm-get-selection))
|
||||
(mb (with-helm-current-buffer
|
||||
(save-excursion
|
||||
(goto-char (point-at-bol))
|
||||
(point-marker)))))
|
||||
;; Happen when cursor is on the line where a definition is. This
|
||||
;; prevent jumping to the definition where we are already, instead
|
||||
;; display helm with all definitions and preselection to the place
|
||||
;; we already are.
|
||||
(if (equal (cdr cur) mb)
|
||||
(prog1 nil
|
||||
(helm-set-pattern "")
|
||||
(helm-force-update))
|
||||
t)))
|
||||
|
||||
(defun helm-imenu-quit-and-find-file-fn (source)
|
||||
(let ((sel (helm-get-selection nil nil source)))
|
||||
(when (and (consp sel) (markerp (cdr sel)))
|
||||
(buffer-file-name (marker-buffer (cdr sel))))))
|
||||
|
||||
(defun helm-imenu-action (candidate)
|
||||
"Default action for `helm-source-imenu'."
|
||||
(helm-log-run-hook "helm-imenu-action" 'helm-goto-line-before-hook)
|
||||
(helm-imenu--maybe-switch-to-buffer candidate)
|
||||
(imenu candidate)
|
||||
;; If semantic is supported in this buffer
|
||||
;; imenu used `semantic-imenu-goto-function'
|
||||
;; and position have been highlighted,
|
||||
;; no need to highlight again.
|
||||
(unless (eq imenu-default-goto-function
|
||||
'semantic-imenu-goto-function)
|
||||
(helm-highlight-current-line)))
|
||||
|
||||
(defun helm-imenu-persistent-action (candidate)
|
||||
"Default persistent action for `helm-source-imenu'."
|
||||
(helm-imenu--maybe-switch-to-buffer candidate)
|
||||
(imenu candidate)
|
||||
(helm-highlight-current-line))
|
||||
|
||||
(defun helm-imenu-candidates (&optional buffer)
|
||||
(with-current-buffer (or buffer helm-current-buffer)
|
||||
(let ((tick (buffer-modified-tick)))
|
||||
(if (eq helm-cached-imenu-tick tick)
|
||||
helm-cached-imenu-candidates
|
||||
(setq imenu--index-alist nil)
|
||||
(prog1 (setq helm-cached-imenu-candidates
|
||||
(let ((index (imenu--make-index-alist t)))
|
||||
(helm-imenu--candidates-1
|
||||
(delete (assoc "*Rescan*" index) index))))
|
||||
(setq helm-cached-imenu-tick tick))))))
|
||||
|
||||
(defun helm-imenu-candidates-in-all-buffers (&optional build-sources)
|
||||
(let* ((lst (buffer-list))
|
||||
(progress-reporter (make-progress-reporter
|
||||
"Imenu indexing buffers..." 1 (length lst))))
|
||||
(prog1
|
||||
(cl-loop with cur-buf = (if build-sources
|
||||
(current-buffer) helm-current-buffer)
|
||||
for b in lst
|
||||
for count from 1
|
||||
when (with-current-buffer b
|
||||
(and (or (member major-mode helm-imenu-extra-modes)
|
||||
(derived-mode-p 'prog-mode))
|
||||
(helm-same-major-mode-p
|
||||
cur-buf helm-imenu-all-buffer-assoc)))
|
||||
if build-sources
|
||||
collect (helm-make-source
|
||||
(format "Imenu in %s" (buffer-name b))
|
||||
'helm-imenu-source
|
||||
:candidates (with-current-buffer b
|
||||
(helm-imenu-candidates b))
|
||||
:fuzzy-match helm-imenu-fuzzy-match)
|
||||
else
|
||||
append (with-current-buffer b
|
||||
(helm-imenu-candidates b))
|
||||
do (progress-reporter-update progress-reporter count))
|
||||
(progress-reporter-done progress-reporter))))
|
||||
|
||||
(defun helm-imenu--candidates-1 (alist)
|
||||
(cl-loop for elm in alist
|
||||
nconc (cond
|
||||
((imenu--subalist-p elm)
|
||||
(helm-imenu--candidates-1
|
||||
(cl-loop for (e . v) in (cdr elm) collect
|
||||
(cons (propertize
|
||||
e 'helm-imenu-type (car elm))
|
||||
;; If value is an integer, convert it
|
||||
;; to a marker, otherwise it is a cons cell
|
||||
;; and it will be converted on next recursions.
|
||||
;; (Bug#1060) [1].
|
||||
(if (integerp v) (copy-marker v) v)))))
|
||||
((listp (cdr elm))
|
||||
(and elm (list elm)))
|
||||
(t
|
||||
;; bug in imenu, should not be needed.
|
||||
(and (cdr elm)
|
||||
;; Semantic uses overlays whereas imenu uses
|
||||
;; markers (Bug#1706).
|
||||
(setcdr elm (pcase (cdr elm) ; Same as [1].
|
||||
((and ov (pred overlayp))
|
||||
(copy-overlay ov))
|
||||
((and mk (or (pred markerp)
|
||||
(pred integerp)))
|
||||
(copy-marker mk))))
|
||||
(list elm))))))
|
||||
|
||||
(defun helm-imenu--get-prop (item)
|
||||
;; property value of ITEM can have itself
|
||||
;; a property value which have itself a property value
|
||||
;; ...and so on; Return a list of all these
|
||||
;; properties values starting at ITEM.
|
||||
(let* ((prop (get-text-property 0 'helm-imenu-type item))
|
||||
(lst (list prop item)))
|
||||
(when prop
|
||||
(while prop
|
||||
(setq prop (get-text-property 0 'helm-imenu-type prop))
|
||||
(and prop (push prop lst)))
|
||||
lst)))
|
||||
|
||||
(defun helm-imenu-icon-for-type (type)
|
||||
"Return an icon for type TYPE.
|
||||
The icon is found in `helm-imenu-icon-type-alist', if not
|
||||
`helm-imenu-default-type-sexp' is evaled to provide a default icon."
|
||||
(require 'all-the-icons)
|
||||
(let ((all-the-icons-scale-factor 1.0)
|
||||
(all-the-icons-default-adjust 0.0))
|
||||
(or (helm-aand (assoc-default
|
||||
type helm-imenu-icon-type-alist)
|
||||
(apply (car it) (cdr it)))
|
||||
(apply (car helm-imenu-default-type-sexp)
|
||||
(cdr helm-imenu-default-type-sexp)))))
|
||||
|
||||
(defun helm-imenu-transformer (candidates)
|
||||
(cl-loop for (k . v) in candidates
|
||||
;; (k . v) == (symbol-name . marker)
|
||||
for bufname = (buffer-name
|
||||
(pcase v
|
||||
((pred overlayp) (overlay-buffer v))
|
||||
((or (pred markerp) (pred integerp))
|
||||
(marker-buffer v))))
|
||||
for types = (or (helm-imenu--get-prop k)
|
||||
(list (if (with-current-buffer bufname
|
||||
(derived-mode-p 'prog-mode))
|
||||
"Function"
|
||||
"Top level")
|
||||
k))
|
||||
for type-icon = (and helm-imenu-use-icon
|
||||
(helm-imenu-icon-for-type (car types)))
|
||||
for type-name = (propertize
|
||||
(car types) 'face
|
||||
(cl-loop for (p . f) in helm-imenu-type-faces
|
||||
when (string-match p (car types))
|
||||
return f
|
||||
finally return 'default))
|
||||
for disp1 = (mapconcat 'identity
|
||||
(cdr types)
|
||||
(propertize helm-imenu-delimiter
|
||||
'face 'shadow))
|
||||
for disp = (concat (if helm-imenu-use-icon
|
||||
(concat (propertize " " 'display type-icon) " ")
|
||||
"")
|
||||
(if helm-imenu-hide-item-type-name
|
||||
""
|
||||
(concat type-name
|
||||
(propertize helm-imenu-delimiter
|
||||
'face 'shadow)))
|
||||
(propertize disp1 'help-echo bufname 'types types))
|
||||
collect
|
||||
(cons (propertize disp 'type-name type-name) (cons k v))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-imenu ()
|
||||
"Preconfigured `helm' for `imenu'."
|
||||
(interactive)
|
||||
(require 'which-func)
|
||||
(unless helm-source-imenu
|
||||
(setq helm-source-imenu
|
||||
(helm-make-source "Imenu" 'helm-imenu-source
|
||||
:fuzzy-match helm-imenu-fuzzy-match)))
|
||||
(let* ((imenu-auto-rescan t)
|
||||
(helm-highlight-matches-around-point-max-lines 'never)
|
||||
(str (thing-at-point 'symbol))
|
||||
(init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>")))
|
||||
(helm-execute-action-at-once-if-one
|
||||
helm-imenu-execute-action-at-once-if-one))
|
||||
(helm :sources 'helm-source-imenu
|
||||
:default (and str (list init-reg str))
|
||||
:preselect (helm-aif (which-function)
|
||||
(concat "\\_<" (regexp-quote it) "\\_>")
|
||||
init-reg)
|
||||
:buffer "*helm imenu*")))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-imenu-in-all-buffers ()
|
||||
"Fetch Imenu entries in all buffers with similar mode as current.
|
||||
A mode is similar as current if it is the same, it is derived
|
||||
i.e. `derived-mode-p' or it have an association in
|
||||
`helm-imenu-all-buffer-assoc'."
|
||||
(interactive)
|
||||
(require 'which-func)
|
||||
(unless helm-imenu-in-all-buffers-separate-sources
|
||||
(unless helm-source-imenu-all
|
||||
(setq helm-source-imenu-all
|
||||
(helm-make-source "Imenu in all buffers" 'helm-imenu-source
|
||||
:init (lambda ()
|
||||
;; Use a cache to avoid repeatedly sending
|
||||
;; progress-reporter message when updating
|
||||
;; (Bug#1704).
|
||||
(setq helm-imenu--in-all-buffers-cache
|
||||
(helm-imenu-candidates-in-all-buffers)))
|
||||
:candidates 'helm-imenu--in-all-buffers-cache
|
||||
:fuzzy-match helm-imenu-fuzzy-match))))
|
||||
(let* ((imenu-auto-rescan t)
|
||||
(helm-highlight-matches-around-point-max-lines 'never)
|
||||
(str (thing-at-point 'symbol))
|
||||
(init-reg (and str (concat "\\_<" (regexp-quote str) "\\_>")))
|
||||
(helm-execute-action-at-once-if-one
|
||||
helm-imenu-execute-action-at-once-if-one)
|
||||
(helm-maybe-use-default-as-input
|
||||
(not (null (memq 'helm-source-imenu-all
|
||||
helm-sources-using-default-as-input))))
|
||||
(sources (if helm-imenu-in-all-buffers-separate-sources
|
||||
(helm-imenu-candidates-in-all-buffers 'build-sources)
|
||||
'(helm-source-imenu-all))))
|
||||
(helm :sources sources
|
||||
:default (and str (list init-reg str))
|
||||
:preselect (helm-aif (which-function)
|
||||
(concat "\\_<" (regexp-quote it) "\\_>")
|
||||
init-reg)
|
||||
:buffer "*helm imenu all*")))
|
||||
|
||||
(provide 'helm-imenu)
|
||||
|
||||
;;; helm-imenu.el ends here
|
|
@ -18,13 +18,10 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'info)
|
||||
;; helm-utils is requiring helm which is requiring helm-lib, but let's require
|
||||
;; them explicitely anyway to make it clear what we need. helm-core is needed to
|
||||
;; build all the helm-info-* commands and sources.
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-utils) ; for `helm-goto-line'.
|
||||
(require 'helm-utils)
|
||||
(require 'info)
|
||||
|
||||
(declare-function Info-index-nodes "info" (&optional file))
|
||||
(declare-function Info-goto-node "info" (&optional fork))
|
||||
|
@ -67,7 +64,7 @@ found in each node, otherwise scan only the current info buffer."
|
|||
(helm-candidate-buffer))
|
||||
(kill-buffer it))
|
||||
(unless (helm-candidate-buffer)
|
||||
(save-window-excursion
|
||||
(save-selected-window
|
||||
(info file " *helm info temp buffer*")
|
||||
(let ((tobuf (helm-candidate-buffer 'global))
|
||||
Info-history)
|
||||
|
@ -84,16 +81,16 @@ Argument TOBUF is the `helm-candidate-buffer'."
|
|||
(let (start end line)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "\n* " nil t)
|
||||
(unless (search-forward "Menu:\n" (1+ (pos-eol)) t)
|
||||
(setq start (pos-bol)
|
||||
(unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
|
||||
(setq start (point-at-bol)
|
||||
;; Fix Bug#1503 by getting the invisible
|
||||
;; info displayed on next line in long strings.
|
||||
;; e.g "* Foo.\n (line 12)" instead of
|
||||
;; "* Foo.(line 12)"
|
||||
end (or (save-excursion
|
||||
(goto-char (pos-bol))
|
||||
(goto-char (point-at-bol))
|
||||
(re-search-forward "(line +[0-9]+)" nil t))
|
||||
(pos-eol))
|
||||
(point-at-eol))
|
||||
;; Long string have a new line inserted before the
|
||||
;; invisible spec, remove it.
|
||||
line (replace-regexp-in-string
|
||||
|
@ -104,7 +101,6 @@ Argument TOBUF is the `helm-candidate-buffer'."
|
|||
|
||||
(defun helm-info-goto (node-line)
|
||||
"The helm-info action to jump to NODE-LINE."
|
||||
(require 'helm-utils)
|
||||
(let ((alive (buffer-live-p (get-buffer "*info*"))))
|
||||
(Info-goto-node (car node-line))
|
||||
(when alive (revert-buffer nil t))
|
||||
|
@ -161,17 +157,14 @@ Arg SOURCE will be an existing helm source named
|
|||
:candidate-number-limit 1000))
|
||||
doc))
|
||||
|
||||
(defun helm-define-info-index-sources (info-list &optional commands)
|
||||
"Define Helm info sources for all entries in INFO-LIST.
|
||||
|
||||
Sources will be named named helm-source-info-<NAME> where NAME is an element of
|
||||
INFO-LIST.
|
||||
|
||||
Sources are generated for all entries of `helm-default-info-index-list' which is
|
||||
generated by `helm-get-info-files'.
|
||||
|
||||
If COMMANDS arg is non-nil, also build commands named `helm-info-<NAME>'."
|
||||
(cl-loop for str in info-list
|
||||
(defun helm-define-info-index-sources (var-value &optional commands)
|
||||
"Define Helm sources named helm-source-info-<NAME>.
|
||||
Sources are generated for all entries of
|
||||
`helm-default-info-index-list'.
|
||||
If COMMANDS arg is non-nil, also build commands named
|
||||
`helm-info-<NAME>'.
|
||||
Where NAME is an element of `helm-default-info-index-list'."
|
||||
(cl-loop for str in var-value
|
||||
for sym = (intern (concat "helm-source-info-" str))
|
||||
do (set sym (helm-build-info-source str))
|
||||
when commands
|
2276
code/elpa/helm-20230406.839/helm-mode.el
Normal file
2276
code/elpa/helm-20230406.839/helm-mode.el
Normal file
File diff suppressed because it is too large
Load diff
|
@ -179,7 +179,7 @@ This happen only in `helm-source-occur' which is always related to
|
|||
end (point-max))
|
||||
(helm-awhile (helm-get-next-header-pos)
|
||||
(when (string= name (buffer-substring-no-properties
|
||||
(pos-bol) (pos-eol)))
|
||||
(point-at-bol) (point-at-eol)))
|
||||
(forward-line 1)
|
||||
(setq beg (point)
|
||||
end (or (helm-get-next-header-pos) (point-max)))
|
||||
|
@ -455,8 +455,8 @@ METHOD can be one of buffer, buffer-other-window, buffer-other-frame."
|
|||
when (save-excursion
|
||||
(condition-case _err
|
||||
(if helm-migemo-mode
|
||||
(helm-mm-migemo-forward reg (pos-eol) t)
|
||||
(re-search-forward reg (pos-eol) t))
|
||||
(helm-mm-migemo-forward reg (point-at-eol) t)
|
||||
(re-search-forward reg (point-at-eol) t))
|
||||
(invalid-regexp nil)))
|
||||
collect (match-beginning 0) into pos-ls
|
||||
finally (when pos-ls (goto-char (apply #'min pos-ls)))))))
|
||||
|
@ -597,8 +597,8 @@ persistent action."
|
|||
(forward-line -2)
|
||||
(while (not (eobp))
|
||||
(if (helm-pos-header-line-p)
|
||||
(let ((beg (pos-bol))
|
||||
(end (pos-eol)))
|
||||
(let ((beg (point-at-bol))
|
||||
(end (point-at-eol)))
|
||||
(set-text-properties beg (1+ end) nil)
|
||||
(delete-region (1- beg) end))
|
||||
(helm-aif (setq buf-name (assoc-default
|
||||
|
@ -609,10 +609,10 @@ persistent action."
|
|||
'face 'helm-moccur-buffer
|
||||
'helm-realvalue (get-text-property (point) 'helm-realvalue)))
|
||||
(add-text-properties
|
||||
(pos-bol) (pos-eol)
|
||||
(point-at-bol) (point-at-eol)
|
||||
`(buffer-name ,buf-name))
|
||||
(add-text-properties
|
||||
(pos-bol) (pos-eol)
|
||||
(point-at-bol) (point-at-eol)
|
||||
`(keymap ,map
|
||||
help-echo ,(concat
|
||||
(buffer-file-name
|
||||
|
@ -698,7 +698,7 @@ numbered. The property \\='buffer-name is added to the whole string."
|
|||
;; `helm-mm-search' puts point at eol.
|
||||
(forward-line 0)
|
||||
(re-search-forward "^\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)$"
|
||||
(pos-eol) t))
|
||||
(point-at-eol) t))
|
||||
(setq linum (string-to-number (match-string 1))
|
||||
mpart (match-string 2)))
|
||||
;; Match part after line number.
|
11
code/elpa/helm-20230406.839/helm-pkg.el
Normal file
11
code/elpa/helm-20230406.839/helm-pkg.el
Normal file
|
@ -0,0 +1,11 @@
|
|||
(define-package "helm" "20230406.839" "Helm is an Emacs incremental and narrowing framework"
|
||||
'((helm-core "3.9.0")
|
||||
(popup "0.5.3"))
|
||||
:commit "5c9d28da67d3f42fd27c7f7fcf0701b899fbaa8a" :authors
|
||||
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||
:maintainer
|
||||
'("Thierry Volpiatto" . "thievol@posteo.net")
|
||||
:url "https://emacs-helm.github.io/helm/")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
593
code/elpa/helm-20230406.839/helm-ring.el
Normal file
593
code/elpa/helm-20230406.839/helm-ring.el
Normal file
|
@ -0,0 +1,593 @@
|
|||
;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-utils)
|
||||
(require 'helm-help)
|
||||
(require 'helm-elisp)
|
||||
|
||||
(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register))
|
||||
|
||||
|
||||
(defgroup helm-ring nil
|
||||
"Ring related Applications and libraries for Helm."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-kill-ring-threshold 3
|
||||
"Minimum length of a candidate to be listed by `helm-source-kill-ring'."
|
||||
:type 'integer
|
||||
:group 'helm-ring)
|
||||
|
||||
(defcustom helm-kill-ring-max-offset 400
|
||||
"Max number of chars displayed per candidate in kill-ring browser.
|
||||
When `t', don't truncate candidate, show all.
|
||||
By default it is approximatively the number of bits contained in five lines
|
||||
of 80 chars each, i.e. 80*5.
|
||||
Note that if you set this to nil multiline will be disabled, i.e. you
|
||||
will not have separators between candidates any more."
|
||||
:type '(choice (const :tag "Disabled" t)
|
||||
(integer :tag "Max candidate offset"))
|
||||
:group 'helm-ring)
|
||||
|
||||
(defcustom helm-kill-ring-actions
|
||||
'(("Yank marked" . helm-kill-ring-action-yank)
|
||||
("Delete marked" . helm-kill-ring-action-delete)
|
||||
("Search from candidate" . helm-kill-ring-search-from-string))
|
||||
"List of actions for kill ring source."
|
||||
:group 'helm-ring
|
||||
:type '(alist :key-type string :value-type function))
|
||||
|
||||
(defcustom helm-kill-ring-separator "\n"
|
||||
"The separator used to separate marked candidates when yanking."
|
||||
:group 'helm-ring
|
||||
:type 'string)
|
||||
|
||||
(defcustom helm-register-max-offset 160
|
||||
"Max size of string register entries before truncating."
|
||||
:group 'helm-ring
|
||||
:type 'integer)
|
||||
|
||||
;;; Kill ring
|
||||
;;
|
||||
;;
|
||||
(defvar helm-kill-ring-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "M-y") 'helm-next-line)
|
||||
(define-key map (kbd "M-u") 'helm-previous-line)
|
||||
(define-key map (kbd "M-D") 'helm-kill-ring-delete)
|
||||
(define-key map (kbd "C-s") 'helm-kill-ring-run-search-from-string)
|
||||
(define-key map (kbd "C-]") 'helm-kill-ring-toggle-truncated)
|
||||
(define-key map (kbd "C-c C-k") 'helm-kill-ring-kill-selection)
|
||||
(define-key map (kbd "C-c d") 'helm-kill-ring-run-persistent-delete)
|
||||
map)
|
||||
"Keymap for `helm-show-kill-ring'.")
|
||||
|
||||
(defvar helm-source-kill-ring
|
||||
(helm-build-sync-source "Kill Ring"
|
||||
:init (lambda ()
|
||||
(helm-set-attr 'last-command last-command)
|
||||
(helm-set-attr 'multiline helm-kill-ring-max-offset))
|
||||
:candidates #'helm-kill-ring-candidates
|
||||
:filtered-candidate-transformer #'helm-kill-ring-transformer
|
||||
:action 'helm-kill-ring-actions
|
||||
:persistent-action 'ignore
|
||||
:help-message 'helm-kill-ring-help-message
|
||||
:persistent-help "DoNothing"
|
||||
:keymap helm-kill-ring-map
|
||||
:migemo t
|
||||
:multiline 'helm-kill-ring-max-offset
|
||||
:group 'helm-ring)
|
||||
"Source for browse and insert contents of kill-ring.")
|
||||
|
||||
(defun helm-kill-ring-candidates ()
|
||||
(cl-loop with cands = (helm-fast-remove-dups kill-ring :test 'equal)
|
||||
for kill in (if (eq (helm-get-attr 'last-command) 'yank)
|
||||
(cdr cands)
|
||||
cands)
|
||||
unless (or (< (length kill) helm-kill-ring-threshold)
|
||||
(string-match "\\`[\n[:blank:]]+\\'" kill))
|
||||
collect kill))
|
||||
|
||||
(defun helm-kill-ring-transformer (candidates _source)
|
||||
"Ensure CANDIDATES are not read-only."
|
||||
(cl-loop for i in candidates
|
||||
when (get-text-property 0 'read-only i)
|
||||
do (set-text-properties 0 (length i) '(read-only nil) i)
|
||||
collect i))
|
||||
|
||||
(defvar helm-kill-ring--truncated-flag nil)
|
||||
(defun helm-kill-ring-toggle-truncated ()
|
||||
"Toggle truncated view of candidates in helm kill-ring browser."
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-kill-ring--truncated-flag (not helm-kill-ring--truncated-flag))
|
||||
(let* ((cur-cand (helm-get-selection))
|
||||
(presel-fn (lambda ()
|
||||
(helm-kill-ring--preselect-fn cur-cand))))
|
||||
(helm-set-attr 'multiline
|
||||
(if helm-kill-ring--truncated-flag
|
||||
15000000
|
||||
helm-kill-ring-max-offset))
|
||||
(helm-update presel-fn))))
|
||||
(put 'helm-kill-ring-toggle-truncated 'helm-only t)
|
||||
|
||||
(defun helm-kill-ring-kill-selection ()
|
||||
"Store the real value of candidate in kill-ring.
|
||||
Same as `helm-kill-selection-and-quit' called with a prefix arg."
|
||||
(interactive)
|
||||
(helm-kill-selection-and-quit t))
|
||||
(put 'helm-kill-ring-kill-selection 'helm-only t)
|
||||
|
||||
(defun helm-kill-ring--preselect-fn (candidate)
|
||||
"Internal, used to preselect CANDIDATE when toggling truncated view."
|
||||
;; Preselection by regexp may not work if candidate is huge, so walk
|
||||
;; the helm buffer until selection is on CANDIDATE.
|
||||
(helm-awhile (condition-case-unless-debug nil
|
||||
(and (not (helm-pos-header-line-p))
|
||||
(helm-get-selection))
|
||||
(error nil))
|
||||
(if (string= it candidate)
|
||||
(cl-return)
|
||||
(helm-next-line))))
|
||||
|
||||
(defun helm-kill-ring-action-yank (_str)
|
||||
"Insert concatenated marked candidates in current-buffer.
|
||||
|
||||
When two prefix args are given prompt to choose separator, otherwise
|
||||
use `helm-kill-ring-separator' as default."
|
||||
(let ((marked (helm-marked-candidates))
|
||||
(sep (if (equal helm-current-prefix-arg '(16))
|
||||
(read-string "Separator: ")
|
||||
helm-kill-ring-separator)))
|
||||
(helm-kill-ring-action-yank-1
|
||||
(cl-loop for c in (butlast marked)
|
||||
concat (concat c sep) into str
|
||||
finally return (concat str (car (last marked)))))))
|
||||
|
||||
(defun helm-kill-ring-action-yank-1 (str)
|
||||
"Insert STR in `kill-ring' and set STR to the head.
|
||||
|
||||
When called with a prefix arg, point and mark are exchanged
|
||||
without activating region.
|
||||
If this action is executed just after `yank', replace with STR as
|
||||
yanked string."
|
||||
(let ((yank-fn (lambda (&optional before yank-pop)
|
||||
(insert-for-yank str)
|
||||
;; Set the window start back where it was in
|
||||
;; the yank command, if possible.
|
||||
(when yank-pop
|
||||
(set-window-start (selected-window) yank-window-start t))
|
||||
(when (or (equal helm-current-prefix-arg '(4)) before)
|
||||
;; Same as exchange-point-and-mark but without
|
||||
;; activating region.
|
||||
(goto-char (prog1 (mark t)
|
||||
(set-marker (mark-marker)
|
||||
(point)
|
||||
helm-current-buffer)))))))
|
||||
;; Prevent inserting and saving highlighted items.
|
||||
(set-text-properties 0 (length str) nil str)
|
||||
(with-helm-current-buffer
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq kill-ring (delete str kill-ring))
|
||||
;; Adding a `delete-selection' property
|
||||
;; to `helm-kill-ring-action' is not working
|
||||
;; because `this-command' will be `helm-maybe-exit-minibuffer',
|
||||
;; so use this workaround (Bug#1520).
|
||||
(when (and (region-active-p) delete-selection-mode)
|
||||
(delete-region (region-beginning) (region-end)))
|
||||
(if (not (eq (helm-get-attr 'last-command helm-source-kill-ring) 'yank))
|
||||
(progn
|
||||
;; Ensure mark is at beginning of inserted text.
|
||||
(push-mark)
|
||||
;; When yanking in a helm minibuffer we need a small
|
||||
;; delay to detect the mark in previous minibuffer. [1]
|
||||
(run-with-timer 0.01 nil yank-fn))
|
||||
;; from `yank-pop'
|
||||
(let ((inhibit-read-only t)
|
||||
(before (< (point) (mark t))))
|
||||
(if before
|
||||
(funcall (or yank-undo-function 'delete-region) (point) (mark t))
|
||||
(funcall (or yank-undo-function 'delete-region) (mark t) (point)))
|
||||
(setq yank-undo-function nil)
|
||||
(set-marker (mark-marker) (point) helm-current-buffer)
|
||||
;; Same as [1] but use the same mark and point as in
|
||||
;; the initial yank according to BEFORE even if no
|
||||
;; prefix arg is given.
|
||||
(run-with-timer 0.01 nil yank-fn before 'pop))))
|
||||
(kill-new str)))))
|
||||
(define-obsolete-function-alias 'helm-kill-ring-action 'helm-kill-ring-action-yank "2.4.0")
|
||||
|
||||
(defun helm-kill-ring-search-from-string (candidate)
|
||||
(let ((str (car (split-string candidate "\n"))))
|
||||
(helm-multi-occur-1
|
||||
(list (current-buffer))
|
||||
(regexp-quote (substring-no-properties str)))))
|
||||
|
||||
(helm-make-command-from-action helm-kill-ring-run-search-from-string
|
||||
"Run helm-occur from kill ring."
|
||||
'helm-kill-ring-search-from-string)
|
||||
|
||||
(defun helm-kill-ring-action-delete (_candidate)
|
||||
"Delete marked candidates from `kill-ring'."
|
||||
(cl-loop for c in (helm-marked-candidates)
|
||||
do (setq kill-ring
|
||||
(delete c kill-ring))))
|
||||
|
||||
(defun helm-kill-ring-persistent-delete (_candidate)
|
||||
(unwind-protect
|
||||
(cl-loop for c in (helm-marked-candidates)
|
||||
do (progn
|
||||
(helm-preselect (format "^%s" (regexp-quote c)))
|
||||
(setq kill-ring (delete c kill-ring))
|
||||
(helm-delete-current-selection)
|
||||
(helm--remove-marked-and-update-mode-line c)))
|
||||
(with-helm-buffer
|
||||
(setq helm-marked-candidates nil
|
||||
helm-visible-mark-overlays nil))
|
||||
(helm-force-update (helm-aif (helm-get-selection nil t) (regexp-quote it)))))
|
||||
|
||||
(helm-make-persistent-command-from-action helm-kill-ring-run-persistent-delete
|
||||
"Delete current candidate without quitting."
|
||||
'quick-delete 'helm-kill-ring-persistent-delete)
|
||||
|
||||
(helm-make-command-from-action helm-kill-ring-delete
|
||||
"Delete marked candidates from `kill-ring'."
|
||||
'helm-kill-ring-action-delete)
|
||||
|
||||
|
||||
;;;; <Mark ring>
|
||||
;; DO NOT use these sources with other sources use
|
||||
;; the commands `helm-mark-ring', `helm-global-mark-ring' or
|
||||
;; `helm-all-mark-rings' instead.
|
||||
|
||||
(defun helm-mark-ring-line-string-at-pos (pos)
|
||||
"Return line string at position POS."
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(forward-line 0)
|
||||
(let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
|
||||
(remove-text-properties 0 (length line) '(read-only) line)
|
||||
(if (string= "" line)
|
||||
"<EMPTY LINE>"
|
||||
line))))
|
||||
|
||||
(defun helm-mark-ring-get-candidates ()
|
||||
(with-helm-current-buffer
|
||||
(cl-loop with marks = (if (mark t)
|
||||
(cons (mark-marker) mark-ring)
|
||||
mark-ring)
|
||||
for marker in marks
|
||||
with max-line-number = (line-number-at-pos (point-max))
|
||||
with width = (length (number-to-string max-line-number))
|
||||
for m = (format (concat "%" (number-to-string width) "d: %s")
|
||||
(line-number-at-pos marker)
|
||||
(helm-mark-ring-line-string-at-pos marker))
|
||||
unless (and recip (assoc m recip))
|
||||
collect (cons m marker) into recip
|
||||
finally return recip)))
|
||||
|
||||
(defun helm-mark-ring-default-action (candidate)
|
||||
(let ((target (copy-marker candidate)))
|
||||
(helm-aif (marker-buffer candidate)
|
||||
(progn
|
||||
(switch-to-buffer it)
|
||||
(helm-log-run-hook "helm-mark-ring-default-action" 'helm-goto-line-before-hook)
|
||||
(helm-match-line-cleanup)
|
||||
(with-helm-current-buffer
|
||||
(unless helm-yank-point (setq helm-yank-point (point))))
|
||||
(helm-goto-char target)
|
||||
(helm-highlight-current-line))
|
||||
;; marker points to no buffer, no need to dereference it, just
|
||||
;; delete it.
|
||||
(setq mark-ring (delete target mark-ring))
|
||||
(error "Marker points to no buffer"))))
|
||||
|
||||
(defvar helm-source-mark-ring
|
||||
(helm-build-sync-source "mark-ring"
|
||||
:candidates #'helm-mark-ring-get-candidates
|
||||
:action '(("Goto line" . helm-mark-ring-default-action))
|
||||
:persistent-help "Show this line"
|
||||
:group 'helm-ring))
|
||||
|
||||
;;; Global-mark-ring
|
||||
(defvar helm-source-global-mark-ring
|
||||
(helm-build-sync-source "global-mark-ring"
|
||||
:candidates #'helm-global-mark-ring-get-candidates
|
||||
:action '(("Goto line" . helm-mark-ring-default-action))
|
||||
:persistent-help "Show this line"
|
||||
:group 'helm-ring))
|
||||
|
||||
(defun helm-global-mark-ring-format-buffer (marker)
|
||||
(with-current-buffer (marker-buffer marker)
|
||||
(goto-char marker)
|
||||
(forward-line 0)
|
||||
(let ((line (pcase (thing-at-point 'line)
|
||||
((and line (pred stringp)
|
||||
(guard (not (string-match-p "\\`\n?\\'" line))))
|
||||
(car (split-string line "[\n\r]")))
|
||||
(_ "<EMPTY LINE>"))))
|
||||
(remove-text-properties 0 (length line) '(read-only) line)
|
||||
(format "%7d:%s: %s"
|
||||
(line-number-at-pos) (marker-buffer marker) line))))
|
||||
|
||||
(defun helm-global-mark-ring-get-candidates ()
|
||||
(let ((marks global-mark-ring))
|
||||
(when marks
|
||||
(cl-loop for marker in marks
|
||||
for mb = (marker-buffer marker)
|
||||
for gm = (unless (or (string-match "^ " (format "%s" mb))
|
||||
(null mb))
|
||||
(helm-global-mark-ring-format-buffer marker))
|
||||
when (and gm (not (assoc gm recip)))
|
||||
collect (cons gm marker) into recip
|
||||
finally return recip))))
|
||||
|
||||
;;;; <Register>
|
||||
;;; Insert from register
|
||||
(defvar helm-source-register
|
||||
(helm-build-sync-source "Registers"
|
||||
:candidates #'helm-register-candidates
|
||||
:action-transformer #'helm-register-action-transformer
|
||||
:persistent-help ""
|
||||
:multiline t
|
||||
:action '(("Delete Register(s)" .
|
||||
(lambda (_candidate)
|
||||
(cl-loop for candidate in (helm-marked-candidates)
|
||||
for register = (car candidate)
|
||||
do (setq register-alist
|
||||
(delq (assoc register register-alist)
|
||||
register-alist))))))
|
||||
:group 'helm-ring)
|
||||
"See (info \"(emacs)Registers\")")
|
||||
|
||||
(defun helm-register-candidates ()
|
||||
"Collecting register contents and appropriate commands."
|
||||
(cl-loop for (char . rval) in register-alist
|
||||
for key = (single-key-description char)
|
||||
for e27 = (registerv-p rval)
|
||||
for val = (if e27 ; emacs-27
|
||||
(registerv-data rval)
|
||||
rval)
|
||||
for string-actions =
|
||||
(cond
|
||||
((numberp val)
|
||||
(list (int-to-string val)
|
||||
'insert-register
|
||||
'increment-register))
|
||||
((markerp val)
|
||||
(let ((buf (marker-buffer val)))
|
||||
(if (null buf)
|
||||
(list "a marker in no buffer")
|
||||
(list (concat
|
||||
"a buffer position:"
|
||||
(buffer-name buf)
|
||||
", position "
|
||||
(int-to-string (marker-position val)))
|
||||
'jump-to-register
|
||||
'insert-register))))
|
||||
((and (consp val) (window-configuration-p (car val)))
|
||||
(list "window configuration."
|
||||
'jump-to-register))
|
||||
((and (vectorp val)
|
||||
(fboundp 'undo-tree-register-data-p)
|
||||
(undo-tree-register-data-p (if e27 val (elt val 1))))
|
||||
(list
|
||||
"Undo-tree entry."
|
||||
'undo-tree-restore-state-from-register))
|
||||
((or (and (vectorp val) (eq 'registerv (aref val 0)))
|
||||
(and (consp val) (frame-configuration-p (car val))))
|
||||
(list "frame configuration."
|
||||
'jump-to-register))
|
||||
((and (consp val) (eq (car val) 'file))
|
||||
(list (concat "file:"
|
||||
(prin1-to-string (cdr val))
|
||||
".")
|
||||
'jump-to-register))
|
||||
((and (consp val) (eq (car val) 'file-query))
|
||||
(list (concat "file:a file-query reference: file "
|
||||
(car (cdr val))
|
||||
", position "
|
||||
(int-to-string (car (cdr (cdr val))))
|
||||
".")
|
||||
'jump-to-register))
|
||||
((consp val)
|
||||
(let ((lines (format "%4d" (length val))))
|
||||
(list (format "%s: %s\n" lines
|
||||
(truncate-string-to-width
|
||||
(mapconcat 'identity (list (car val))
|
||||
"^J")
|
||||
(- (window-width) 15)))
|
||||
'insert-register)))
|
||||
((stringp val)
|
||||
(list
|
||||
(concat (substring-no-properties
|
||||
val 0 (min (length val) helm-register-max-offset))
|
||||
(if (> (length val) helm-register-max-offset)
|
||||
"[...]" ""))
|
||||
'insert-register
|
||||
'kill-new
|
||||
'append-to-register
|
||||
'prepend-to-register)))
|
||||
unless (null string-actions) ; Fix Bug#1107.
|
||||
collect (cons (format "Register %3s:\n %s" key (car string-actions))
|
||||
(cons char (cdr string-actions)))))
|
||||
|
||||
(defun helm-register-action-transformer (actions register-and-functions)
|
||||
"Decide actions by the contents of register."
|
||||
(cl-loop with func-actions =
|
||||
'((insert-register
|
||||
"Insert Register" .
|
||||
(lambda (c) (insert-register (car c))))
|
||||
(kill-new
|
||||
"Kill Register" .
|
||||
(lambda (c) (with-temp-buffer
|
||||
(insert-register (car c))
|
||||
(kill-new (buffer-string)))))
|
||||
(jump-to-register
|
||||
"Jump to Register" .
|
||||
(lambda (c) (jump-to-register (car c))))
|
||||
(append-to-register
|
||||
"Append Region to Register" .
|
||||
(lambda (c) (append-to-register
|
||||
(car c) (region-beginning) (region-end))))
|
||||
(prepend-to-register
|
||||
"Prepend Region to Register" .
|
||||
(lambda (c) (prepend-to-register
|
||||
(car c) (region-beginning) (region-end))))
|
||||
(increment-register
|
||||
"Increment Prefix Arg to Register" .
|
||||
(lambda (c) (increment-register
|
||||
helm-current-prefix-arg (car c))))
|
||||
(undo-tree-restore-state-from-register
|
||||
"Restore Undo-tree register" .
|
||||
(lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
|
||||
(undo-tree-restore-state-from-register (car c))))))
|
||||
for func in (cdr register-and-functions)
|
||||
when (assq func func-actions)
|
||||
collect (cdr it) into transformer-actions
|
||||
finally return (append transformer-actions actions)))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-mark-ring ()
|
||||
"Preconfigured `helm' for `helm-source-mark-ring'."
|
||||
(interactive)
|
||||
(helm :sources 'helm-source-mark-ring
|
||||
:resume 'noresume
|
||||
:buffer "*helm mark*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-global-mark-ring ()
|
||||
"Preconfigured `helm' for `helm-source-global-mark-ring'."
|
||||
(interactive)
|
||||
(helm :sources 'helm-source-global-mark-ring
|
||||
:resume 'noresume
|
||||
:buffer "*helm global mark*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-all-mark-rings ()
|
||||
"Preconfigured `helm' for mark rings.
|
||||
Source used are `helm-source-global-mark-ring' and
|
||||
`helm-source-mark-ring'."
|
||||
(interactive)
|
||||
(helm :sources '(helm-source-mark-ring
|
||||
helm-source-global-mark-ring)
|
||||
:resume 'noresume
|
||||
:buffer "*helm mark ring*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-register ()
|
||||
"Preconfigured `helm' for Emacs registers."
|
||||
(interactive)
|
||||
(helm :sources 'helm-source-register
|
||||
:resume 'noresume
|
||||
:buffer "*helm register*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-show-kill-ring ()
|
||||
"Preconfigured `helm' for `kill-ring'.
|
||||
It is drop-in replacement of `yank-pop'.
|
||||
|
||||
First call open the kill-ring browser, next calls move to next line."
|
||||
(interactive)
|
||||
(setq helm-kill-ring--truncated-flag nil)
|
||||
(let ((enable-recursive-minibuffers t))
|
||||
(helm :sources helm-source-kill-ring
|
||||
:buffer "*helm kill ring*"
|
||||
:resume 'noresume
|
||||
:allow-nest t)))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-execute-kmacro ()
|
||||
"Preconfigured helm for keyboard macros.
|
||||
Define your macros with `f3' and `f4'.
|
||||
See (info \"(emacs) Keyboard Macros\") for detailed infos.
|
||||
This command is useful when used with persistent action."
|
||||
(interactive)
|
||||
(let ((helm-quit-if-no-candidate
|
||||
(lambda () (message "No kbd macro has been defined"))))
|
||||
(helm :sources
|
||||
(helm-build-sync-source "Kmacro"
|
||||
:candidates (lambda ()
|
||||
(helm-fast-remove-dups
|
||||
(cons (kmacro-ring-head)
|
||||
kmacro-ring)
|
||||
:test 'equal))
|
||||
:multiline t
|
||||
:candidate-transformer
|
||||
(lambda (candidates)
|
||||
(cl-loop for c in candidates collect
|
||||
(propertize (help-key-description (car c) nil)
|
||||
'helm-realvalue c)))
|
||||
:persistent-help "Execute kmacro"
|
||||
:help-message 'helm-kmacro-help-message
|
||||
:action
|
||||
(helm-make-actions
|
||||
"Execute kmacro (`C-u <n>' to execute <n> times)"
|
||||
'helm-kbd-macro-execute
|
||||
"Concat marked macros"
|
||||
'helm-kbd-macro-concat-macros
|
||||
"Delete marked macros"
|
||||
'helm-kbd-macro-delete-macro
|
||||
"Edit marked macro"
|
||||
'helm-kbd-macro-edit-macro)
|
||||
:group 'helm-ring)
|
||||
:buffer "*helm kmacro*")))
|
||||
|
||||
(defun helm-kbd-macro-execute (candidate)
|
||||
;; Move candidate on top of list for next use.
|
||||
(setq kmacro-ring (delete candidate kmacro-ring))
|
||||
(kmacro-push-ring)
|
||||
(kmacro-split-ring-element candidate)
|
||||
(kmacro-exec-ring-item
|
||||
candidate helm-current-prefix-arg))
|
||||
|
||||
(defun helm-kbd-macro-concat-macros (_candidate)
|
||||
(let ((mkd (helm-marked-candidates)))
|
||||
(when (cdr mkd)
|
||||
(kmacro-push-ring)
|
||||
(setq last-kbd-macro
|
||||
(mapconcat 'identity
|
||||
(cl-loop for km in mkd
|
||||
if (vectorp km)
|
||||
append (cl-loop for k across km collect
|
||||
(key-description (vector k)))
|
||||
into result
|
||||
else collect (car km) into result
|
||||
finally return result)
|
||||
"")))))
|
||||
|
||||
(defun helm-kbd-macro-delete-macro (_candidate)
|
||||
(let ((mkd (helm-marked-candidates)))
|
||||
(kmacro-push-ring)
|
||||
(cl-loop for km in mkd
|
||||
do (setq kmacro-ring (delete km kmacro-ring)))
|
||||
(kmacro-pop-ring1)))
|
||||
|
||||
(defun helm-kbd-macro-edit-macro (candidate)
|
||||
(kmacro-push-ring)
|
||||
(setq kmacro-ring (delete candidate kmacro-ring))
|
||||
(kmacro-split-ring-element candidate)
|
||||
(kmacro-edit-macro))
|
||||
|
||||
(provide 'helm-ring)
|
||||
|
||||
;;; helm-ring.el ends here
|
|
@ -124,7 +124,7 @@ you have completion on these functions with `C-M i' in the customize interface."
|
|||
(with-current-buffer helm-buffer
|
||||
(when (looking-at " ")
|
||||
(goto-char (next-single-property-change
|
||||
(pos-bol) 'semantic-tag nil (pos-eol))))
|
||||
(point-at-bol) 'semantic-tag nil (point-at-eol))))
|
||||
(let ((tag (get-text-property (point) 'semantic-tag)))
|
||||
(semantic-go-to-tag tag)
|
||||
(unless persistent
|
38
code/elpa/helm-20230406.839/helm-shell.el
Normal file
38
code/elpa/helm-20230406.839/helm-shell.el
Normal file
|
@ -0,0 +1,38 @@
|
|||
;;; helm-shell.el --- Shell prompt navigation for helm. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2020 Pierre Neidhardt <mail@ambrevar.xyz>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is superseded by helm-comint.el.
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-help)
|
||||
(require 'helm-elisp)
|
||||
(require 'helm-comint)
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'helm-shell-prompts 'helm-comint-prompts)
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'helm-shell-prompts-all 'helm-comint-prompts-all)
|
||||
|
||||
(provide 'helm-shell)
|
||||
|
||||
;;; helm-shell ends here
|
|
@ -41,20 +41,20 @@
|
|||
"Top command used to display output of top.
|
||||
A format string where %s will be replaced with `frame-width'.
|
||||
|
||||
To use top command, a version supporting batch mode (-b option)
|
||||
is needed. On Mac OSX top command doesn't support this, so the
|
||||
ps command is used instead by default.
|
||||
To use 'top' command, a version supporting batch mode (-b option)
|
||||
is needed. On Mac OSX 'top' command doesn't support this, so the
|
||||
'ps' command is used instead by default.
|
||||
|
||||
Normally top command output have 12 columns, but in some
|
||||
Normally 'top' command output have 12 columns, but in some
|
||||
versions you may have less than this, so you can either customize
|
||||
top to use 12 columns with the interactives f and W commands
|
||||
of top, or modify `helm-top-sort-columns-alist' to fit with the
|
||||
number of columns your top command is using.
|
||||
'top' to use 12 columns with the interactives 'f' and 'W' commands
|
||||
of 'top', or modify `helm-top-sort-columns-alist' to fit with the
|
||||
number of columns your 'top' command is using.
|
||||
|
||||
If you modify ps command be sure that pid comes in first and
|
||||
If you modify 'ps' command be sure that 'pid' comes in first and
|
||||
\"env COLUMNS=%s\" is specified at beginning of command. Ensure
|
||||
also that no elements contain spaces (e.g., use start_time and
|
||||
not start). Same as for top: you can customize
|
||||
not start). Same as for 'top': you can customize
|
||||
`helm-top-sort-columns-alist' to make sort commands working
|
||||
properly according to your settings."
|
||||
:group 'helm-sys
|
|
@ -232,7 +232,7 @@
|
|||
(defcustom helm-type-function-actions
|
||||
(helm-make-actions
|
||||
"Describe function" 'helm-describe-function
|
||||
"Find function (C-u for source)" 'helm-find-function
|
||||
"Find function" 'helm-find-function
|
||||
"Info lookup" 'helm-info-lookup-symbol
|
||||
"Debug on entry" 'debug-on-entry
|
||||
"Cancel debug on entry" 'cancel-debug-on-entry
|
1142
code/elpa/helm-20230406.839/helm-utils.el
Normal file
1142
code/elpa/helm-20230406.839/helm-utils.el
Normal file
File diff suppressed because it is too large
Load diff
43
code/elpa/helm-20230406.839/helm.el
Normal file
43
code/elpa/helm-20230406.839/helm.el
Normal file
|
@ -0,0 +1,43 @@
|
|||
;;; helm.el --- Helm is an Emacs incremental and narrowing framework -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2007 Tamas Patrovics
|
||||
;; 2008 ~ 2011 rubikitch <rubikitch@ruby-lang.org>
|
||||
;; 2011 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This is a fork of anything.el wrote by Tamas Patrovics.
|
||||
|
||||
;; Authors of anything.el: Tamas Patrovics
|
||||
;; rubikitch <rubikitch@ruby-lang.org>
|
||||
;; Thierry Volpiatto
|
||||
|
||||
;; Author: Thierry Volpiatto <thievol@posteo.net>
|
||||
;; Version: 3.9.0
|
||||
;; URL: https://emacs-helm.github.io/helm/
|
||||
;; Package-Requires: ((helm-core "3.9.0") (popup "0.5.3"))
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This is just a wrapper for helm-core.el and a place holder we
|
||||
;; currently use only to hold the package's metadata in the header.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'helm-core)
|
||||
(require 'helm-global-bindings)
|
||||
|
||||
(provide 'helm)
|
||||
|
||||
;;; helm.el ends here
|
|
@ -83,6 +83,22 @@ Preconfigured `helm' for color." t nil)
|
|||
|
||||
(register-definition-prefixes "helm-color" '("helm-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-comint" "helm-comint.el" (0 0 0 0))
|
||||
;;; Generated autoloads from helm-comint.el
|
||||
|
||||
(autoload 'helm-comint-prompts "helm-comint" "\
|
||||
Pre-configured `helm' to browse the prompts of the current comint buffer." t nil)
|
||||
|
||||
(autoload 'helm-comint-prompts-all "helm-comint" "\
|
||||
Pre-configured `helm' to browse the prompts of all comint sessions." t nil)
|
||||
|
||||
(autoload 'helm-comint-input-ring "helm-comint" "\
|
||||
Preconfigured `helm' that provide completion of `comint' history." t nil)
|
||||
|
||||
(register-definition-prefixes "helm-comint" '("helm-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-command" "helm-command.el" (0 0 0 0))
|
||||
|
@ -164,6 +180,28 @@ Preconfigured `helm' for complex command history." t nil)
|
|||
|
||||
(register-definition-prefixes "helm-elisp" '("helm-" "with-helm-show-completion"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-elisp-package" "helm-elisp-package.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from helm-elisp-package.el
|
||||
|
||||
(autoload 'helm-list-elisp-packages "helm-elisp-package" "\
|
||||
Preconfigured `helm' for listing and handling Emacs packages.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(autoload 'helm-list-elisp-packages-no-fetch "helm-elisp-package" "\
|
||||
Preconfigured Helm for Emacs packages.
|
||||
|
||||
Same as `helm-list-elisp-packages' but don't fetch packages on
|
||||
remote. Called with a prefix ARG always fetch packages on
|
||||
remote.
|
||||
|
||||
\(fn ARG)" t nil)
|
||||
|
||||
(register-definition-prefixes "helm-elisp-package" '("helm-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-epa" "helm-epa.el" (0 0 0 0))
|
||||
|
@ -939,23 +977,6 @@ To use this bind it to a key in `isearch-mode-map'." t nil)
|
|||
|
||||
(register-definition-prefixes "helm-occur" '("helm-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-packages" "helm-packages.el" (0 0 0 0))
|
||||
;;; Generated autoloads from helm-packages.el
|
||||
|
||||
(autoload 'helm-packages "helm-packages" "\
|
||||
Helm interface to manage packages.
|
||||
|
||||
With a prefix arg ARG refresh package list.
|
||||
|
||||
When installing or upgrading ensure to refresh the package list
|
||||
to avoid errors with outdated packages no more availables.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(register-definition-prefixes "helm-packages" '("helm-packages-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-regexp" "helm-regexp.el" (0 0 0 0))
|
||||
|
@ -1023,6 +1044,15 @@ Fill in the symbol at point by default.
|
|||
|
||||
(register-definition-prefixes "helm-semantic" '("helm-s"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-shell" "helm-shell.el" (0 0 0 0))
|
||||
;;; Generated autoloads from helm-shell.el
|
||||
|
||||
(defalias 'helm-shell-prompts 'helm-comint-prompts)
|
||||
|
||||
(defalias 'helm-shell-prompts-all 'helm-comint-prompts-all)
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "helm-sys" "helm-sys.el" (0 0 0 0))
|
226
code/elpa/helm-20230727.1557/helm-comint.el
Normal file
226
code/elpa/helm-20230727.1557/helm-comint.el
Normal file
|
@ -0,0 +1,226 @@
|
|||
;;; helm-comint.el --- Comint prompt navigation for helm. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2020 Pierre Neidhardt <mail@ambrevar.xyz>
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; You can bind this as follows in .emacs:
|
||||
;;
|
||||
;; (add-hook 'comint-mode-hook
|
||||
;; (lambda ()
|
||||
;; (define-key comint-mode-map (kbd "M-s f") 'helm-comint-prompts-all)))
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-help)
|
||||
(require 'helm-elisp)
|
||||
|
||||
;;; Comint prompts
|
||||
;;
|
||||
(defface helm-comint-prompts-promptidx
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
(:foreground "cyan")))
|
||||
"Face used to highlight comint prompt index."
|
||||
:group 'helm-comint-faces)
|
||||
|
||||
(defface helm-comint-prompts-buffer-name
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
(:foreground "green")))
|
||||
"Face used to highlight comint buffer name."
|
||||
:group 'helm-comint-faces)
|
||||
|
||||
(defcustom helm-comint-prompts-promptidx-p t
|
||||
"Show prompt number."
|
||||
:group 'helm-comint
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-comint-mode-list '(comint-mode slime-repl-mode sly-mrepl-mode sql-interactive-mode)
|
||||
"Supported modes for prompt navigation.
|
||||
Derived modes (e.g., Geiser's REPL) are automatically supported."
|
||||
:group 'helm-comint
|
||||
:type '(repeat (choice symbol)))
|
||||
|
||||
(defcustom helm-comint-next-prompt-function '((sly-mrepl-mode . (lambda ()
|
||||
(sly-mrepl-next-prompt)
|
||||
(point))))
|
||||
"Alist of (MODE . NEXT-PROMPT-FUNCTION) to use.
|
||||
If the current major mode is a key in this list, the associated
|
||||
function will be used to navigate the prompts.
|
||||
The function must return the point after the prompt.
|
||||
Otherwise (comint-next-prompt 1) will be used."
|
||||
:group 'helm-comint
|
||||
:type '(alist :key-type symbol :value-type function))
|
||||
|
||||
(defcustom helm-comint-max-offset 400
|
||||
"Max number of chars displayed per candidate in comint-input-ring browser.
|
||||
When t, don't truncate candidate, show all.
|
||||
By default it is approximatively the number of bits contained in
|
||||
five lines of 80 chars each i.e 80*5.
|
||||
Note that if you set this to nil multiline will be disabled, i.e
|
||||
you will not have anymore separators between candidates."
|
||||
:type '(choice (const :tag "Disabled" t)
|
||||
(integer :tag "Max candidate offset"))
|
||||
:group 'helm-misc)
|
||||
|
||||
(defvar helm-comint-prompts-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "C-c o") #'helm-comint-prompts-other-window)
|
||||
(define-key map (kbd "C-c C-o") #'helm-comint-prompts-other-frame)
|
||||
map)
|
||||
"Keymap for `helm-comint-prompt-all'.")
|
||||
|
||||
(defun helm-comint-prompts-list (mode &optional buffer)
|
||||
"List the prompts in BUFFER in mode MODE.
|
||||
|
||||
Return a list of (\"prompt\" (point) (buffer-name) prompt-index))
|
||||
E.g. (\"ls\" 162 \"*shell*\" 3).
|
||||
If BUFFER is nil, use current buffer."
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(when (derived-mode-p mode)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let (result (count 1))
|
||||
(save-mark-and-excursion
|
||||
(helm-awhile (and (not (eobp))
|
||||
(helm-aif (alist-get major-mode helm-comint-next-prompt-function)
|
||||
(funcall it)
|
||||
(comint-next-prompt 1)))
|
||||
(push (list (buffer-substring-no-properties
|
||||
it (point-at-eol))
|
||||
it (buffer-name) count)
|
||||
result)
|
||||
(setq count (1+ count))))
|
||||
(nreverse result))))))
|
||||
|
||||
(defun helm-comint-prompts-list-all (mode)
|
||||
"List the prompts of all buffers in mode MODE.
|
||||
See `helm-comint-prompts-list'."
|
||||
(cl-loop for b in (buffer-list)
|
||||
append (helm-comint-prompts-list mode b)))
|
||||
|
||||
(defun helm-comint-prompts-transformer (candidates &optional all)
|
||||
;; ("ls" 162 "*shell*" 3) => ("*shell*:3:ls" . ("ls" 162 "*shell*" 3))
|
||||
(cl-loop for (prt pos buf id) in candidates
|
||||
collect `(,(concat
|
||||
(when all
|
||||
(concat (propertize
|
||||
buf
|
||||
'face 'helm-comint-prompts-buffer-name)
|
||||
":"))
|
||||
(when helm-comint-prompts-promptidx-p
|
||||
(concat (propertize
|
||||
(number-to-string id)
|
||||
'face 'helm-comint-prompts-promptidx)
|
||||
":"))
|
||||
prt)
|
||||
. ,(list prt pos buf id))))
|
||||
|
||||
(defun helm-comint-prompts-all-transformer (candidates)
|
||||
(helm-comint-prompts-transformer candidates t))
|
||||
|
||||
(cl-defun helm-comint-prompts-goto (candidate &optional (action 'switch-to-buffer))
|
||||
;; Candidate format: ("ls" 162 "*shell*" 3)
|
||||
(let ((buf (nth 2 candidate)))
|
||||
(unless (and (string= (buffer-name) buf)
|
||||
(eq action 'switch-to-buffer))
|
||||
(funcall action buf))
|
||||
(goto-char (nth 1 candidate))
|
||||
(recenter)))
|
||||
|
||||
(defun helm-comint-prompts-goto-other-window (candidate)
|
||||
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-window))
|
||||
|
||||
(defun helm-comint-prompts-goto-other-frame (candidate)
|
||||
(helm-comint-prompts-goto candidate 'switch-to-buffer-other-frame))
|
||||
|
||||
(helm-make-command-from-action helm-comint-prompts-other-window
|
||||
"Switch to comint prompt in other window."
|
||||
'helm-comint-prompts-goto-other-window)
|
||||
|
||||
(helm-make-command-from-action helm-comint-prompts-other-frame
|
||||
"Switch to comint prompt in other frame."
|
||||
'helm-comint-prompts-goto-other-frame)
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-comint-prompts ()
|
||||
"Pre-configured `helm' to browse the prompts of the current comint buffer."
|
||||
(interactive)
|
||||
(if (apply #'derived-mode-p helm-comint-mode-list)
|
||||
(helm :sources
|
||||
(helm-build-sync-source "Comint prompts"
|
||||
:candidates (helm-comint-prompts-list major-mode)
|
||||
:candidate-transformer #'helm-comint-prompts-transformer
|
||||
:action '(("Go to prompt" . helm-comint-prompts-goto)))
|
||||
:buffer "*helm comint prompts*")
|
||||
(message "Current buffer is not a comint buffer")))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-comint-prompts-all ()
|
||||
"Pre-configured `helm' to browse the prompts of all comint sessions."
|
||||
(interactive)
|
||||
(if (apply #'derived-mode-p helm-comint-mode-list)
|
||||
(helm :sources
|
||||
(helm-build-sync-source "All comint prompts"
|
||||
:candidates (helm-comint-prompts-list-all major-mode)
|
||||
:candidate-transformer #'helm-comint-prompts-all-transformer
|
||||
:action (quote (("Go to prompt" . helm-comint-prompts-goto)
|
||||
("Go to prompt in other window `C-c o`" .
|
||||
helm-comint-prompts-goto-other-window)
|
||||
("Go to prompt in other frame `C-c C-o`" .
|
||||
helm-comint-prompts-goto-other-frame)))
|
||||
:keymap helm-comint-prompts-keymap)
|
||||
:buffer "*helm comint all prompts*")
|
||||
(message "Current buffer is not a comint buffer")))
|
||||
|
||||
;;; Comint history
|
||||
;;
|
||||
;;
|
||||
(defun helm-comint-input-ring-action (candidate)
|
||||
"Default action for comint history."
|
||||
(with-helm-current-buffer
|
||||
(delete-region (comint-line-beginning-position) (point-max))
|
||||
(insert candidate)))
|
||||
|
||||
(defvar helm-source-comint-input-ring
|
||||
(helm-build-sync-source "Comint history"
|
||||
:candidates (lambda ()
|
||||
(with-helm-current-buffer
|
||||
(cl-loop for elm in (ring-elements comint-input-ring)
|
||||
unless (string= elm "")
|
||||
collect elm)))
|
||||
:action 'helm-comint-input-ring-action
|
||||
;; Multiline does not work for `shell' because of an Emacs bug.
|
||||
;; It works in other REPLs like Geiser.
|
||||
:multiline 'helm-comint-max-offset)
|
||||
"Source that provides Helm completion against `comint-input-ring'.")
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-comint-input-ring ()
|
||||
"Preconfigured `helm' that provide completion of `comint' history."
|
||||
(interactive)
|
||||
(when (or (derived-mode-p 'comint-mode)
|
||||
(member major-mode helm-comint-mode-list))
|
||||
(helm :sources 'helm-source-comint-input-ring
|
||||
:input (buffer-substring-no-properties (comint-line-beginning-position)
|
||||
(point-at-eol))
|
||||
:buffer "*helm comint history*")))
|
||||
|
||||
(provide 'helm-comint)
|
||||
|
||||
;;; helm-comint.el ends here
|
413
code/elpa/helm-20230727.1557/helm-command.el
Normal file
413
code/elpa/helm-20230727.1557/helm-command.el
Normal file
|
@ -0,0 +1,413 @@
|
|||
;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-help)
|
||||
(require 'helm-mode)
|
||||
(require 'helm-elisp)
|
||||
|
||||
|
||||
(defvar helm-M-x-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-comp-read-map)
|
||||
(define-key map (kbd "C-u") nil)
|
||||
(define-key map (kbd "C-u") #'helm-M-x-universal-argument)
|
||||
(define-key map (kbd "C-]") #'helm-M-x-toggle-short-doc)
|
||||
map))
|
||||
|
||||
|
||||
(defgroup helm-command nil
|
||||
"Emacs command related Applications and libraries for Helm."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-M-x-always-save-history nil
|
||||
"`helm-M-x' save command in `extended-command-history' even when it fails."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-M-x-reverse-history nil
|
||||
"The history source of `helm-M-x' appear in second position when non-nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-M-x-fuzzy-match t
|
||||
"Helm-M-x fuzzy matching when non nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-M-x-show-short-doc nil
|
||||
"Show short docstring of command when non nil.
|
||||
This value can be toggled with
|
||||
\\<helm-M-x-map>\\[helm-M-x-toggle-short-doc] while in helm-M-x session."
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
;;; Faces
|
||||
;;
|
||||
;;
|
||||
(defgroup helm-command-faces nil
|
||||
"Customize the appearance of helm-command."
|
||||
:prefix "helm-"
|
||||
:group 'helm-command
|
||||
:group 'helm-faces)
|
||||
|
||||
(defface helm-M-x-key
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "orange" :box (:line-width -1)))
|
||||
"Face used in helm-M-x to show keybinding."
|
||||
:group 'helm-command-faces)
|
||||
|
||||
(defface helm-command-active-mode
|
||||
'((t :inherit font-lock-builtin-face))
|
||||
"Face used by `helm-M-x' for activated modes."
|
||||
:group 'helm-command-faces)
|
||||
|
||||
(defface helm-M-x-short-doc
|
||||
'((t :box (:line-width -1) :foreground "DimGray"))
|
||||
"Face used by `helm-M-x' for short docstring."
|
||||
:group 'helm-command-faces)
|
||||
|
||||
(defvar helm-M-x-input-history nil)
|
||||
(defvar helm-M-x-prefix-argument nil
|
||||
"Prefix argument before calling `helm-M-x'.")
|
||||
(defvar helm-M-x--timer nil)
|
||||
(defvar helm-M-x--unwind-forms-done nil)
|
||||
|
||||
(defun helm-M-x-get-major-mode-command-alist (mode-map)
|
||||
"Return alist of MODE-MAP."
|
||||
(when mode-map
|
||||
(cl-loop for key being the key-seqs of mode-map using (key-bindings com)
|
||||
for str-key = (key-description key)
|
||||
for ismenu = (string-match "<menu-bar>" str-key)
|
||||
unless ismenu collect (cons str-key com))))
|
||||
|
||||
(defun helm-get-mode-map-from-mode (mode)
|
||||
"Guess the mode-map name according to MODE.
|
||||
Some modes don't use conventional mode-map name so we need to
|
||||
guess mode-map name. E.g. `python-mode' ==> py-mode-map.
|
||||
Return nil if no mode-map found."
|
||||
(cl-loop ;; Start with a conventional mode-map name.
|
||||
with mode-map = (intern-soft (format "%s-map" mode))
|
||||
with mode-string = (symbol-name mode)
|
||||
with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
|
||||
while (not mode-map)
|
||||
for count downfrom (length mode-name)
|
||||
;; Return when no result after parsing entire string.
|
||||
when (eq count 0) return nil
|
||||
for sub-name = (substring mode-name 0 count)
|
||||
do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
|
||||
finally return mode-map))
|
||||
|
||||
(defun helm-M-x-current-mode-map-alist ()
|
||||
"Return mode-map alist of current `major-mode'."
|
||||
(let ((map-sym (helm-get-mode-map-from-mode major-mode)))
|
||||
(when (and map-sym (boundp map-sym))
|
||||
(helm-M-x-get-major-mode-command-alist (symbol-value map-sym)))))
|
||||
|
||||
(defun helm-M-x-toggle-short-doc ()
|
||||
"Toggle short doc display in helm-M-x."
|
||||
(interactive)
|
||||
(setq helm-M-x-show-short-doc (not helm-M-x-show-short-doc))
|
||||
(helm-force-update (concat "^" (helm-get-selection)) (helm-get-current-source)))
|
||||
(put 'helm-M-x-toggle-short-doc 'no-helm-mx t)
|
||||
|
||||
(defun helm-M-x-transformer-1 (candidates &optional sort ignore-props)
|
||||
"Transformer function to show bindings in emacs commands.
|
||||
Show global bindings and local bindings according to current
|
||||
`major-mode'.
|
||||
If SORT is non nil sort list with `helm-generic-sort-fn'.
|
||||
Note that SORT should not be used when fuzzy matching because
|
||||
fuzzy matching is running its own sort function with a different
|
||||
algorithm."
|
||||
(with-helm-current-buffer
|
||||
(cl-loop with max-len = (when helm-M-x-show-short-doc
|
||||
(buffer-local-value 'helm-candidate-buffer-longest-len
|
||||
(get-buffer (helm-candidate-buffer))))
|
||||
with local-map = (helm-M-x-current-mode-map-alist)
|
||||
for cand in candidates
|
||||
for local-key = (car (rassq cand local-map))
|
||||
for key = (substitute-command-keys (format "\\[%s]" cand))
|
||||
for sym = (intern (if (consp cand) (car cand) cand))
|
||||
for doc = (when max-len
|
||||
(helm-get-first-line-documentation (intern-soft cand)))
|
||||
for disp = (if (or (eq sym major-mode)
|
||||
(and (memq sym minor-mode-list)
|
||||
(boundp sym)
|
||||
(buffer-local-value sym helm-current-buffer)))
|
||||
(propertize cand 'face 'helm-command-active-mode)
|
||||
cand)
|
||||
unless (and (null ignore-props) (or (get sym 'helm-only) (get sym 'no-helm-mx)))
|
||||
collect
|
||||
(cons (cond ((and (string-match "^M-x" key) local-key)
|
||||
(format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize local-key 'face 'helm-M-x-key))))
|
||||
((string-match "^M-x" key)
|
||||
(format "%s%s%s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")))
|
||||
(t (format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize key 'face 'helm-M-x-key)))))
|
||||
cand)
|
||||
into ls
|
||||
finally return
|
||||
(if sort (sort ls #'helm-generic-sort-fn) ls))))
|
||||
|
||||
(defun helm-M-x-transformer (candidates _source)
|
||||
"Transformer function for `helm-M-x' candidates."
|
||||
;; Generic sort function is handling helm-flex.
|
||||
(helm-M-x-transformer-1 candidates (null helm--in-fuzzy)))
|
||||
|
||||
(defun helm-M-x-transformer-no-sort (candidates _source)
|
||||
"Transformer function for `helm-M-x' candidates."
|
||||
(helm-M-x-transformer-1 candidates))
|
||||
|
||||
(defun helm-M-x-transformer-no-sort-no-props (candidates _source)
|
||||
"Transformer function for `helm-M-x' candidates."
|
||||
(helm-M-x-transformer-1 candidates nil t))
|
||||
|
||||
(defun helm-M-x--notify-prefix-arg ()
|
||||
;; Notify a prefix-arg set AFTER calling M-x.
|
||||
(when prefix-arg
|
||||
(with-helm-window
|
||||
(helm-display-mode-line (helm-get-current-source) 'force))))
|
||||
|
||||
(defun helm-cmd--get-current-function-name ()
|
||||
(save-excursion
|
||||
(beginning-of-defun)
|
||||
(cadr (split-string (buffer-substring-no-properties
|
||||
(point-at-bol) (point-at-eol))))))
|
||||
|
||||
(defun helm-cmd--get-preconfigured-commands (&optional dir)
|
||||
(let* ((helm-dir (or dir (helm-basedir (locate-library "helm"))))
|
||||
(helm-autoload-file (expand-file-name "helm-autoloads.el" helm-dir))
|
||||
results)
|
||||
(when (file-exists-p helm-autoload-file)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents helm-autoload-file)
|
||||
(while (re-search-forward "Preconfigured" nil t)
|
||||
(push (substring (helm-cmd--get-current-function-name) 1) results))))
|
||||
results))
|
||||
|
||||
(defun helm-M-x-universal-argument ()
|
||||
"Same as `universal-argument' but for `helm-M-x'."
|
||||
(interactive)
|
||||
(if helm-M-x-prefix-argument
|
||||
(progn (setq helm-M-x-prefix-argument nil)
|
||||
(let ((inhibit-read-only t))
|
||||
(with-selected-window (minibuffer-window)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(delete-char (- (minibuffer-prompt-width) (length "M-x "))))))
|
||||
(message "Initial prefix arg disabled"))
|
||||
(setq prefix-arg (list 4))
|
||||
(universal-argument--mode)))
|
||||
(put 'helm-M-x-universal-argument 'helm-only t)
|
||||
|
||||
(defun helm-M-x-persistent-action (candidate)
|
||||
(helm-elisp--persistent-help
|
||||
candidate 'helm-describe-function))
|
||||
|
||||
(defun helm-M-x--move-selection-after-hook ()
|
||||
(setq current-prefix-arg nil))
|
||||
|
||||
(defun helm-M-x--before-action-hook ()
|
||||
(remove-hook 'helm-move-selection-after-hook
|
||||
#'helm-M-x--move-selection-after-hook))
|
||||
|
||||
(defclass helm-M-x-class (helm-source-in-buffer helm-type-command)
|
||||
((requires-pattern :initform 0)
|
||||
(must-match :initform t)
|
||||
(filtered-candidate-transformer :initform 'helm-M-x-transformer-no-sort)
|
||||
(persistent-help :initform "Describe this command")
|
||||
(help-message :initform 'helm-M-x-help-message)
|
||||
(nomark :initform t)
|
||||
(cleanup :initform #'helm-M-x--unwind-forms)
|
||||
(keymap :initform 'helm-M-x-map)
|
||||
(resume :initform 'helm-M-x-resume-fn)))
|
||||
|
||||
(defun helm-M-x-resume-fn ()
|
||||
(when (and helm-M-x--timer (timerp helm-M-x--timer))
|
||||
(cancel-timer helm-M-x--timer)
|
||||
(setq helm-M-x--timer nil))
|
||||
(setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
|
||||
(setq helm--mode-line-display-prefarg t)
|
||||
;; Prevent displaying a wrong prefix arg when helm-resume is called
|
||||
;; from prefix arg.
|
||||
(setq current-prefix-arg nil))
|
||||
|
||||
(defun helm-M-x-read-extended-command (collection &optional predicate history)
|
||||
"Read or execute action on command name in COLLECTION or HISTORY.
|
||||
|
||||
When `helm-M-x-use-completion-styles' is used, Emacs
|
||||
`completion-styles' mechanism is used, otherwise standard helm
|
||||
completion and helm fuzzy matching are used together.
|
||||
|
||||
Helm completion is not provided when executing or defining kbd
|
||||
macros.
|
||||
|
||||
Arg COLLECTION should be an `obarray' but can be any object
|
||||
suitable for `try-completion'. Arg PREDICATE is a function that
|
||||
default to `commandp' see also `try-completion'. Arg HISTORY
|
||||
default to `extended-command-history'."
|
||||
(setq helm--mode-line-display-prefarg t)
|
||||
(let* ((pred (or predicate #'commandp))
|
||||
(helm-fuzzy-sort-fn (lambda (candidates _source)
|
||||
;; Sort on real candidate otherwise
|
||||
;; "symbol (<binding>)" is used when sorting.
|
||||
(helm-fuzzy-matching-default-sort-fn-1 candidates t)))
|
||||
(sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class
|
||||
:data (lambda ()
|
||||
(helm-comp-read-get-candidates
|
||||
;; History should be quoted to
|
||||
;; force `helm-comp-read-get-candidates'
|
||||
;; to use predicate against
|
||||
;; symbol and not string.
|
||||
(or history 'extended-command-history)
|
||||
;; Ensure using empty string to
|
||||
;; not defeat helm matching fns [1]
|
||||
pred nil nil ""))
|
||||
:fuzzy-match helm-M-x-fuzzy-match)
|
||||
,(helm-make-source "Emacs Commands" 'helm-M-x-class
|
||||
:data (lambda ()
|
||||
(helm-comp-read-get-candidates
|
||||
;; [1] Same comment as above.
|
||||
collection pred nil nil ""))
|
||||
:fuzzy-match helm-M-x-fuzzy-match)))
|
||||
(prompt (concat (cond
|
||||
((eq helm-M-x-prefix-argument '-) "- ")
|
||||
((and (consp helm-M-x-prefix-argument)
|
||||
(eq (car helm-M-x-prefix-argument) 4))
|
||||
"C-u ")
|
||||
((and (consp helm-M-x-prefix-argument)
|
||||
(integerp (car helm-M-x-prefix-argument)))
|
||||
(format "%d " (car helm-M-x-prefix-argument)))
|
||||
((integerp helm-M-x-prefix-argument)
|
||||
(format "%d " helm-M-x-prefix-argument)))
|
||||
"M-x ")))
|
||||
(setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
|
||||
;; Fix Bug#2250, add `helm-move-selection-after-hook' which
|
||||
;; reset prefix arg to nil only for this helm session.
|
||||
(add-hook 'helm-move-selection-after-hook
|
||||
#'helm-M-x--move-selection-after-hook)
|
||||
(add-hook 'helm-before-action-hook
|
||||
#'helm-M-x--before-action-hook)
|
||||
(when (and sources helm-M-x-reverse-history)
|
||||
(setq sources (nreverse sources)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setq current-prefix-arg nil)
|
||||
(helm :sources sources
|
||||
:prompt prompt
|
||||
:buffer "*helm M-x*"
|
||||
:history 'helm-M-x-input-history
|
||||
:truncate-lines t))
|
||||
(helm-M-x--unwind-forms))))
|
||||
|
||||
;; When running a command involving again helm from helm-M-x, the
|
||||
;; unwind-protect UNWINDS forms are executed only once this helm
|
||||
;; command exit leaving the helm-M-x timer running and other variables
|
||||
;; and hooks not unset, so the timer is now in a global var and all
|
||||
;; the forms that should normally run in unwind-protect are running as
|
||||
;; well as soon as helm-M-x-execute-command is called.
|
||||
(defun helm-M-x--unwind-forms (&optional done)
|
||||
;; helm-M-x--unwind-forms-done is non nil when it have been called
|
||||
;; once from helm-M-x-execute-command.
|
||||
(unless helm-M-x--unwind-forms-done
|
||||
(when (timerp helm-M-x--timer)
|
||||
(cancel-timer helm-M-x--timer)
|
||||
(setq helm-M-x--timer nil))
|
||||
(setq helm--mode-line-display-prefarg nil
|
||||
helm-fuzzy-sort-fn (default-toplevel-value 'helm-fuzzy-sort-fn))
|
||||
;; Be sure to remove it here as well in case of quit.
|
||||
(remove-hook 'helm-move-selection-after-hook
|
||||
#'helm-M-x--move-selection-after-hook)
|
||||
(remove-hook 'helm-before-action-hook
|
||||
#'helm-M-x--before-action-hook))
|
||||
;; Reset helm-M-x--unwind-forms-done to nil when DONE is
|
||||
;; unspecified.
|
||||
(setq helm-M-x--unwind-forms-done done))
|
||||
|
||||
(defun helm-M-x-execute-command (command)
|
||||
"Execute COMMAND as an editor command.
|
||||
COMMAND must be a symbol that satisfies the `commandp' predicate.
|
||||
Save COMMAND to `extended-command-history'."
|
||||
(helm-M-x--unwind-forms t)
|
||||
(when command
|
||||
;; Avoid having `this-command' set to *exit-minibuffer.
|
||||
(setq this-command command
|
||||
;; Handle C-x z (repeat) Bug#322
|
||||
real-this-command command)
|
||||
;; If helm-M-x is called with regular emacs completion (kmacro)
|
||||
;; use the value of arg otherwise use helm-current-prefix-arg.
|
||||
(let ((prefix-arg (or helm-current-prefix-arg helm-M-x-prefix-argument))
|
||||
(command-name (symbol-name command)))
|
||||
(condition-case-unless-debug err
|
||||
(progn
|
||||
(command-execute command 'record)
|
||||
(add-to-history 'extended-command-history command-name))
|
||||
(error
|
||||
(when helm-M-x-always-save-history
|
||||
(add-to-history 'extended-command-history command-name))
|
||||
(signal (car err) (cdr err)))))))
|
||||
|
||||
(defun helm-M-x--vanilla-M-x ()
|
||||
(helm-M-x-execute-command
|
||||
(intern-soft
|
||||
(if helm-mode
|
||||
(unwind-protect
|
||||
(progn
|
||||
(helm-mode -1)
|
||||
(read-extended-command))
|
||||
(helm-mode 1))
|
||||
(read-extended-command)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-M-x (_arg)
|
||||
"Preconfigured `helm' for Emacs commands.
|
||||
It is `helm' replacement of regular `M-x'
|
||||
`execute-extended-command'.
|
||||
|
||||
Unlike regular `M-x' Emacs vanilla `execute-extended-command'
|
||||
command, the prefix args if needed, can be passed AFTER starting
|
||||
`helm-M-x'. When a prefix arg is passed BEFORE starting
|
||||
`helm-M-x', the first `C-u' while in `helm-M-x' session will
|
||||
disable it.
|
||||
|
||||
You can get help on each command by persistent action."
|
||||
(interactive
|
||||
(progn
|
||||
(setq helm-M-x-prefix-argument current-prefix-arg)
|
||||
(list current-prefix-arg)))
|
||||
(if (or defining-kbd-macro executing-kbd-macro)
|
||||
(helm-M-x--vanilla-M-x)
|
||||
(helm-M-x-read-extended-command obarray)))
|
||||
(put 'helm-M-x 'interactive-only 'command-execute)
|
||||
|
||||
(provide 'helm-command)
|
||||
|
||||
;;; helm-command.el ends here
|
388
code/elpa/helm-20230727.1557/helm-dabbrev.el
Normal file
388
code/elpa/helm-20230727.1557/helm-dabbrev.el
Normal file
|
@ -0,0 +1,388 @@
|
|||
;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-help)
|
||||
(require 'helm-elisp) ; For show-completion.
|
||||
|
||||
(defgroup helm-dabbrev nil
|
||||
"Dabbrev related Applications and libraries for Helm."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-dabbrev-always-search-all t
|
||||
"Always search in all buffers when non--nil.
|
||||
Note that even if nil, a search in all buffers will occur if the
|
||||
length of candidates is <= than
|
||||
`helm-dabbrev-max-length-result'."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-dabbrev-candidates-number-limit 1000
|
||||
"Maximum number of candidates to collect.
|
||||
|
||||
The higher this number is, the slower the computation of
|
||||
candidates will be. You can use safely a higher value with
|
||||
emacs-26+.
|
||||
Note that this have nothing to do with
|
||||
`helm-candidate-number-limit', this means that computation of
|
||||
candidates stop when this value is reached but only
|
||||
`helm-candidate-number-limit' candidates are displayed in the
|
||||
Helm buffer."
|
||||
:type 'integer)
|
||||
|
||||
(defcustom helm-dabbrev-ignored-buffers-regexps
|
||||
'("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List")
|
||||
"List of regexps matching names of buffers that `helm-dabbrev' should not check."
|
||||
:type '(repeat regexp))
|
||||
|
||||
(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
|
||||
"A function that decide if a buffer to search in its related to `current-buffer'.
|
||||
|
||||
This is actually determined by comparing `major-mode' of the
|
||||
buffer to search and the `current-buffer'.
|
||||
|
||||
The function take one arg, the buffer which is current, look at
|
||||
`helm-dabbrev--same-major-mode-p' for an example.
|
||||
|
||||
When nil all buffers are considered related to `current-buffer'."
|
||||
:type 'function)
|
||||
|
||||
(defcustom helm-dabbrev-major-mode-assoc nil
|
||||
"Major mode association alist.
|
||||
|
||||
This allow helm-dabbrev searching in buffers with the associated
|
||||
`major-mode'.
|
||||
E.g. (emacs-lisp-mode . lisp-interaction-mode)
|
||||
|
||||
will allow searching in the lisp-interaction-mode buffer when
|
||||
`current-buffer' is an `emacs-lisp-mode' buffer and vice versa
|
||||
i.e. no need to provide (lisp-interaction-mode .
|
||||
emacs-lisp-mode) association.
|
||||
|
||||
When nil check is the searched buffer has same `major-mode' than
|
||||
the `current-buffer'.
|
||||
|
||||
This has no effect when `helm-dabbrev-related-buffer-fn' is nil
|
||||
or of course bound to a function that doesn't handle this var."
|
||||
:type '(alist :key-type symbol :value-type symbol))
|
||||
|
||||
(defcustom helm-dabbrev-lineno-around 30
|
||||
"Search first in this number of lines before and after point."
|
||||
:type 'integer)
|
||||
|
||||
(defcustom helm-dabbrev-cycle-threshold 5
|
||||
"Number of time helm-dabbrev cycle before displaying helm completion.
|
||||
When nil or 0 disable cycling."
|
||||
:type '(choice (const :tag "Cycling disabled" nil) integer))
|
||||
|
||||
(defcustom helm-dabbrev-case-fold-search 'smart
|
||||
"Set `case-fold-search' in `helm-dabbrev'.
|
||||
Same as `helm-case-fold-search' but for `helm-dabbrev'.
|
||||
Note that this is not affecting searching in Helm buffer, but the
|
||||
initial search for all candidates in buffer(s)."
|
||||
:type '(choice (const :tag "Ignore case" t)
|
||||
(const :tag "Respect case" nil)
|
||||
(other :tag "Smart" smart)))
|
||||
|
||||
(defvaralias 'helm-dabbrev--regexp 'helm-dabbrev-separator-regexp)
|
||||
(make-obsolete-variable 'helm-dabbrev--regexp
|
||||
'helm-dabbrev-separator-regexp "2.8.3")
|
||||
;; Check for beginning of line should happen last (^\n\\|^).
|
||||
(defvar helm-dabbrev-separator-regexp
|
||||
"\\s-\\|\t\\|[(\\[\\{\"'`=<>$;,@.#+]\\|\\s\\\\|^\n\\|^"
|
||||
"Regexp matching the start of a dabbrev candidate.")
|
||||
|
||||
|
||||
(defvar helm-dabbrev-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "M-/") #'helm-next-line)
|
||||
(define-key map (kbd "M-:") #'helm-previous-line)
|
||||
map))
|
||||
|
||||
;; Internal
|
||||
(defvar helm-dabbrev--cache nil)
|
||||
(defvar helm-dabbrev--data nil)
|
||||
(cl-defstruct helm-dabbrev-info dabbrev limits iterator)
|
||||
(defvar helm-dabbrev--already-tried nil)
|
||||
(defvar helm-dabbrev--computing-cache nil
|
||||
"[INTERNAL] Flag to notify helm-dabbrev is blocked.
|
||||
Do nothing when non nil.")
|
||||
|
||||
(defun helm-dabbrev--buffer-list ()
|
||||
(cl-loop for buf in (buffer-list)
|
||||
unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps
|
||||
thereis (string-match r (buffer-name buf)))
|
||||
collect buf))
|
||||
|
||||
(defun helm-dabbrev--same-major-mode-p (start-buffer)
|
||||
"Decide if current-buffer is related to START-BUFFER."
|
||||
(helm-same-major-mode-p start-buffer helm-dabbrev-major-mode-assoc))
|
||||
|
||||
(defun helm-dabbrev--collect (str limit ignore-case all)
|
||||
(let* ((case-fold-search ignore-case)
|
||||
(buffer1 (current-buffer)) ; start buffer.
|
||||
(minibuf (minibufferp buffer1))
|
||||
results pos-before pos-after)
|
||||
(catch 'break
|
||||
(dolist (buf (if all (helm-dabbrev--buffer-list)
|
||||
(list (current-buffer))))
|
||||
(with-current-buffer buf
|
||||
(when (or minibuf ; check against all buffers when in minibuffer.
|
||||
(if helm-dabbrev-related-buffer-fn
|
||||
(funcall helm-dabbrev-related-buffer-fn buffer1)
|
||||
t))
|
||||
(save-excursion
|
||||
;; Start searching before thing before point.
|
||||
(goto-char (- (point) (length str)))
|
||||
;; Search the last 30 lines BEFORE point and set POS-BEFORE.
|
||||
(cl-multiple-value-bind (res _pa pb)
|
||||
(helm-dabbrev--search-and-store str -2 limit results)
|
||||
(setq results res
|
||||
;; No need to set POS-AFTER here.
|
||||
pos-before pb)))
|
||||
(save-excursion
|
||||
;; Search the next 30 lines AFTER point and set POS-AFTER.
|
||||
(cl-multiple-value-bind (res pa _pb)
|
||||
(helm-dabbrev--search-and-store str 2 limit results)
|
||||
(setq results res
|
||||
;; No need to set POS-BEFORE, we keep the last
|
||||
;; value found.
|
||||
pos-after pa)))
|
||||
(save-excursion
|
||||
;; Search all BEFORE point maybe starting from
|
||||
;; POS-BEFORE to not search again what previously found.
|
||||
;; If limit is reached in previous call of
|
||||
;; `helm-dabbrev--search-and-store' POS-BEFORE is nil and
|
||||
;; goto-char will fail, so check it.
|
||||
(when pos-before (goto-char pos-before))
|
||||
(cl-multiple-value-bind (res _pa _pb)
|
||||
(helm-dabbrev--search-and-store str -1 limit results)
|
||||
;; No need to set POS-BEFORE and POS-AFTER here.
|
||||
(setq results res)))
|
||||
(save-excursion
|
||||
;; Search all AFTER point maybe starting from POS-AFTER.
|
||||
;; Same comment as above for POS-AFTER.
|
||||
(when pos-after (goto-char pos-after))
|
||||
(cl-multiple-value-bind (res _pa _pb)
|
||||
(helm-dabbrev--search-and-store str 1 limit results)
|
||||
;; No need to set POS-BEFORE and POS-AFTER here.
|
||||
(setq results res)))))
|
||||
(when (>= (length results) limit) (throw 'break nil))))
|
||||
(nreverse results)))
|
||||
|
||||
(defun helm-dabbrev--search-and-store (pattern direction limit results)
|
||||
"Search words or symbols matching PATTERN in DIRECTION up to LIMIT.
|
||||
Finally returns all matched candidates appended to RESULTS.
|
||||
Argument DIRECTION can be:
|
||||
- (1): Search forward from point.
|
||||
- (-1): Search backward from point.
|
||||
- (2): Search forward from the
|
||||
`helm-dabbrev-lineno-around'
|
||||
lines after point.
|
||||
- (-2): Search backward from the
|
||||
`helm-dabbrev-lineno-around'
|
||||
lines before point."
|
||||
(let ((res results)
|
||||
after before)
|
||||
(while (and (<= (length res) limit)
|
||||
(cl-case direction
|
||||
(1 (search-forward pattern nil t))
|
||||
(-1 (search-backward pattern nil t))
|
||||
(2 (let ((pos
|
||||
(save-excursion
|
||||
(forward-line
|
||||
helm-dabbrev-lineno-around)
|
||||
(point))))
|
||||
(setq after pos)
|
||||
(search-forward pattern pos t)))
|
||||
(-2 (let ((pos
|
||||
(save-excursion
|
||||
(forward-line
|
||||
(- helm-dabbrev-lineno-around))
|
||||
(point))))
|
||||
(setq before pos)
|
||||
(search-backward pattern pos t)))))
|
||||
(let* ((mb (match-beginning 0))
|
||||
(replace-regexp (concat "\\(" helm-dabbrev-separator-regexp
|
||||
"\\)\\'"))
|
||||
(match-word (helm-dabbrev--search
|
||||
pattern mb replace-regexp)))
|
||||
(when (and match-word (not (member match-word res)))
|
||||
(push match-word res))))
|
||||
(list res after before)))
|
||||
|
||||
(defun helm-dabbrev--search (pattern beg sep-regexp)
|
||||
"Search word or symbol at point matching PATTERN.
|
||||
Argument BEG is corresponding to the previous `match-beginning'
|
||||
search.
|
||||
The search starts at (1- BEG) with a regexp starting with
|
||||
`helm-dabbrev-separator-regexp' followed by PATTERN followed by a
|
||||
regexp matching syntactically any word or symbol.
|
||||
The possible false positives matching SEP-REGEXP at end are
|
||||
finally removed."
|
||||
(let ((eol (point-at-eol)))
|
||||
(save-excursion
|
||||
(goto-char (1- beg))
|
||||
(when (re-search-forward
|
||||
(concat "\\("
|
||||
helm-dabbrev-separator-regexp
|
||||
"\\)"
|
||||
"\\(?99:\\("
|
||||
(regexp-quote pattern)
|
||||
"\\(\\sw\\|\\s_\\)+\\)\\)")
|
||||
eol t)
|
||||
(replace-regexp-in-string
|
||||
sep-regexp ""
|
||||
(match-string-no-properties 99))))))
|
||||
|
||||
(defun helm-dabbrev--get-candidates (dabbrev &optional limit)
|
||||
(cl-assert dabbrev nil "[No Match]")
|
||||
(helm-dabbrev--collect
|
||||
dabbrev (or limit helm-dabbrev-candidates-number-limit)
|
||||
(cl-case helm-dabbrev-case-fold-search
|
||||
(smart (helm-set-case-fold-search-1 dabbrev))
|
||||
(t helm-dabbrev-case-fold-search))
|
||||
helm-dabbrev-always-search-all))
|
||||
|
||||
(defun helm-dabbrev-default-action (candidate)
|
||||
(with-helm-current-buffer
|
||||
(let* ((limits (helm-bounds-of-thing-before-point
|
||||
helm-dabbrev-separator-regexp))
|
||||
(beg (car limits))
|
||||
(end (point)))
|
||||
(run-with-timer
|
||||
0.01 nil
|
||||
#'helm-insert-completion-at-point
|
||||
beg end candidate))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun helm-dabbrev ()
|
||||
"Preconfigured helm for dynamic abbreviations."
|
||||
(interactive)
|
||||
(unless helm-dabbrev--computing-cache
|
||||
(let ((dabbrev (helm-thing-before-point
|
||||
nil helm-dabbrev-separator-regexp))
|
||||
(limits (helm-bounds-of-thing-before-point
|
||||
helm-dabbrev-separator-regexp))
|
||||
(enable-recursive-minibuffers t)
|
||||
(cycling-disabled-p (or (null helm-dabbrev-cycle-threshold)
|
||||
(zerop helm-dabbrev-cycle-threshold)))
|
||||
(helm-execute-action-at-once-if-one t)
|
||||
(helm-quit-if-no-candidate
|
||||
(lambda ()
|
||||
(message "[Helm-dabbrev: No expansion found]"))))
|
||||
(cl-assert (and (stringp dabbrev) (not (string= dabbrev "")))
|
||||
nil "[Helm-dabbrev: Nothing found before point]")
|
||||
(when (and
|
||||
;; have been called at least once.
|
||||
(helm-dabbrev-info-p helm-dabbrev--data)
|
||||
;; But user have moved with some other command
|
||||
;; in the meaning time.
|
||||
(not (eq last-command 'helm-dabbrev)))
|
||||
(setq helm-dabbrev--data nil))
|
||||
;; When candidates are requested in helm directly without cycling,
|
||||
;; we need them right now before running helm.
|
||||
(when cycling-disabled-p
|
||||
(message "Waiting for helm-dabbrev candidates...")
|
||||
(setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)))
|
||||
(unless (or cycling-disabled-p
|
||||
(helm-dabbrev-info-p helm-dabbrev--data))
|
||||
(setq helm-dabbrev--data
|
||||
(make-helm-dabbrev-info
|
||||
:dabbrev dabbrev
|
||||
:limits limits
|
||||
:iterator
|
||||
(helm-iter-list
|
||||
(cl-loop for i in (helm-dabbrev--get-candidates
|
||||
dabbrev helm-dabbrev-cycle-threshold)
|
||||
when (string-match-p
|
||||
(concat "^" (regexp-quote dabbrev)) i)
|
||||
collect i)))))
|
||||
(let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data)
|
||||
(helm-dabbrev-info-iterator helm-dabbrev--data)))
|
||||
deactivate-mark)
|
||||
;; Cycle until iterator is consumed.
|
||||
(helm-aif (and iter (helm-iter-next iter))
|
||||
(progn
|
||||
(helm-insert-completion-at-point
|
||||
(car (helm-dabbrev-info-limits helm-dabbrev--data))
|
||||
;; END is the end of the previous inserted string, not
|
||||
;; the end (apart for first insertion) of the initial string.
|
||||
(cdr limits) it)
|
||||
;; Move already tried candidates to end of list.
|
||||
(push it helm-dabbrev--already-tried))
|
||||
;; Iterator is now empty, or cycling was disabled, maybe
|
||||
;; reset dabbrev to initial value and start helm completion.
|
||||
(let* ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data)
|
||||
(helm-dabbrev-info-dabbrev helm-dabbrev--data)
|
||||
dabbrev))
|
||||
(only-one (eq (length helm-dabbrev--already-tried) 1)))
|
||||
(unless helm-dabbrev--cache ; Already computed when
|
||||
; cycling is disabled.
|
||||
(message "Waiting for helm-dabbrev candidates...")
|
||||
(setq helm-dabbrev--computing-cache t)
|
||||
(setq helm-dabbrev--cache
|
||||
(helm-dabbrev--get-candidates old-dabbrev))
|
||||
;; If user continues typing M-/ while display is blocked by
|
||||
;; helm-dabbrev--get-candidates delete these events.
|
||||
(setq unread-command-events nil))
|
||||
;; If the length of candidates is only one when computed
|
||||
;; that's mean the unique matched item have already been
|
||||
;; inserted by the iterator, so no need to reinsert the old dabbrev,
|
||||
;; just let helm exiting with "No expansion found".
|
||||
(unless (or only-one cycling-disabled-p)
|
||||
(setq dabbrev old-dabbrev
|
||||
limits (helm-dabbrev-info-limits helm-dabbrev--data))
|
||||
(setq helm-dabbrev--data nil)
|
||||
(delete-region (car limits) (point))
|
||||
(insert dabbrev))
|
||||
(when (and (null cycling-disabled-p) only-one)
|
||||
(setq helm-dabbrev--cache nil
|
||||
helm-dabbrev--already-tried nil
|
||||
helm-dabbrev--computing-cache nil)
|
||||
(cl-return-from helm-dabbrev
|
||||
(message "[Helm-dabbrev: No expansion found]")))
|
||||
(with-helm-show-completion (car limits) (cdr limits)
|
||||
(unwind-protect
|
||||
(helm :sources
|
||||
(helm-build-in-buffer-source "Dabbrev Expand"
|
||||
:data
|
||||
(append
|
||||
(cl-loop with lst = helm-dabbrev--cache
|
||||
for cand in helm-dabbrev--already-tried
|
||||
do (setq lst (delete cand lst))
|
||||
finally return lst)
|
||||
helm-dabbrev--already-tried)
|
||||
:persistent-action 'ignore
|
||||
:persistent-help "DoNothing"
|
||||
:keymap helm-dabbrev-map
|
||||
:action 'helm-dabbrev-default-action
|
||||
:group 'helm-dabbrev)
|
||||
:buffer "*helm dabbrev*"
|
||||
:input (concat "^" dabbrev " ")
|
||||
:resume 'noresume
|
||||
:allow-nest t)
|
||||
(setq helm-dabbrev--computing-cache nil
|
||||
helm-dabbrev--already-tried nil
|
||||
helm-dabbrev--cache nil)))))))))
|
||||
|
||||
(provide 'helm-dabbrev)
|
||||
|
||||
;;; helm-dabbrev.el ends here
|
|
@ -48,7 +48,8 @@
|
|||
["Gnus Manual index" helm-info-gnus t]
|
||||
["Helm documentation" helm-documentation t])
|
||||
("Elpa"
|
||||
["Elisp packages" helm-packages t])
|
||||
["Elisp packages" helm-list-elisp-packages t]
|
||||
["Elisp packages no fetch" helm-list-elisp-packages-no-fetch t])
|
||||
("Tools"
|
||||
["Occur" helm-occur t]
|
||||
["Grep current directory with AG" helm-do-grep-ag t]
|
483
code/elpa/helm-20230727.1557/helm-elisp-package.el
Normal file
483
code/elpa/helm-20230727.1557/helm-elisp-package.el
Normal file
|
@ -0,0 +1,483 @@
|
|||
;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-help)
|
||||
(require 'package)
|
||||
|
||||
(defgroup helm-el-package nil
|
||||
"helm elisp packages."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-el-package-initial-filter 'all
|
||||
"Show only installed, upgraded or all packages at startup."
|
||||
:type '(radio :tag "Initial filter for elisp packages"
|
||||
(const :tag "Show all packages" all)
|
||||
(const :tag "Show installed packages" installed)
|
||||
(const :tag "Show not installed packages" uninstalled)
|
||||
(const :tag "Show upgradable packages" upgrade)))
|
||||
|
||||
(defcustom helm-el-truncate-lines t
|
||||
"Truncate lines in `helm-buffer' when non-nil."
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
(defcustom helm-el-package-upgrade-on-start nil
|
||||
"Show package upgrades on startup when non nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-el-package-autoremove-on-start nil
|
||||
"Try to autoremove no more needed packages on startup.
|
||||
See `package-autoremove'."
|
||||
:type 'boolean)
|
||||
|
||||
;; internals vars
|
||||
(defvar helm-el-package--show-only 'all)
|
||||
(defvar helm-el-package--initialized-p nil)
|
||||
(defvar helm-el-package--tabulated-list nil)
|
||||
(defvar helm-el-package--upgrades nil)
|
||||
(defvar helm-el-package--removable-packages nil)
|
||||
|
||||
;; Shutup bytecompiler for emacs-24*
|
||||
(defvar package-menu-async) ; Only available on emacs-25.
|
||||
(defvar helm-marked-buffer-name)
|
||||
(declare-function async-byte-recompile-directory "ext:async-bytecomp.el")
|
||||
(declare-function with-helm-display-marked-candidates "helm-utils.el")
|
||||
|
||||
|
||||
(defun helm-el-package--init ()
|
||||
;; In emacs-27 package-show-package-list returns an empty buffer
|
||||
;; until package-initialize have been called.
|
||||
(unless (or package--initialized
|
||||
(null (boundp 'package-quickstart)))
|
||||
(package-initialize))
|
||||
(let (package-menu-async
|
||||
(inhibit-read-only t))
|
||||
(when (null package-alist)
|
||||
(setq helm-el-package--show-only 'all))
|
||||
(unless (consp package-selected-packages)
|
||||
(helm-aif (package--find-non-dependencies)
|
||||
(setq package-selected-packages it)))
|
||||
(when (and (setq helm-el-package--removable-packages
|
||||
(package--removable-packages))
|
||||
helm-el-package-autoremove-on-start)
|
||||
(package-autoremove))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(save-selected-window
|
||||
(if helm-el-package--initialized-p
|
||||
;; Use this as `list-packages' doesn't work
|
||||
;; properly (empty buffer) when called from lisp
|
||||
;; with 'no-fetch (emacs-25 WA).
|
||||
(package-show-package-list)
|
||||
(when helm--force-updating-p (message "Refreshing packages list..."))
|
||||
(list-packages helm-el-package--initialized-p))
|
||||
(setq helm-el-package--initialized-p t)
|
||||
(message nil))
|
||||
(helm-init-candidates-in-buffer
|
||||
'global
|
||||
(with-current-buffer (get-buffer "*Packages*")
|
||||
(setq helm-el-package--tabulated-list tabulated-list-entries)
|
||||
(remove-text-properties (point-min) (point-max)
|
||||
'(read-only button follow-link category))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^[ \t]+" nil t)
|
||||
(replace-match ""))
|
||||
(buffer-string)))
|
||||
(setq helm-el-package--upgrades (helm-el-package-menu--find-upgrades))
|
||||
(if helm--force-updating-p
|
||||
(if helm-el-package--upgrades
|
||||
(message "Refreshing packages list done, [%d] package(s) to upgrade"
|
||||
(length helm-el-package--upgrades))
|
||||
(message "Refreshing packages list done, no upgrades available"))
|
||||
(setq helm-el-package--show-only (if (and helm-el-package-upgrade-on-start
|
||||
helm-el-package--upgrades)
|
||||
'upgrade
|
||||
helm-el-package-initial-filter))))
|
||||
(kill-buffer "*Packages*"))))
|
||||
|
||||
(defun helm-el-package-describe (candidate)
|
||||
(let ((id (get-text-property 0 'tabulated-list-id candidate)))
|
||||
(describe-package (package-desc-name id))))
|
||||
|
||||
(defun helm-el-package-visit-homepage (candidate)
|
||||
(let* ((id (get-text-property 0 'tabulated-list-id candidate))
|
||||
(pkg (package-desc-name id))
|
||||
(desc (cadr (assoc pkg package-archive-contents)))
|
||||
(extras (package-desc-extras desc))
|
||||
(url (and (listp extras) (cdr-safe (assoc :url extras)))))
|
||||
(if (stringp url)
|
||||
(browse-url url)
|
||||
(message "Package %s has no homepage"
|
||||
(propertize (symbol-name pkg)
|
||||
'face 'font-lock-keyword-face)))))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-visit-homepage
|
||||
"Visit package homepage from helm elisp packages."
|
||||
'helm-el-package-visit-homepage)
|
||||
|
||||
(defun helm-elisp-package--pkg-name (pkg)
|
||||
(if (package-desc-p pkg)
|
||||
(package-desc-name pkg)
|
||||
pkg))
|
||||
|
||||
(defun helm-el-package-install-1 (pkg-list)
|
||||
(cl-loop with mkd = pkg-list
|
||||
for p in mkd
|
||||
for id = (get-text-property 0 'tabulated-list-id p)
|
||||
for name = (helm-elisp-package--pkg-name id)
|
||||
do (package-install id t)
|
||||
when (helm-aand (assq name package-alist)
|
||||
(package-desc-dir (cadr it))
|
||||
(file-exists-p it))
|
||||
collect id into installed-list and
|
||||
do (unless (package--user-selected-p name)
|
||||
(package--save-selected-packages
|
||||
(cons name package-selected-packages)))
|
||||
finally do (message (format "%d packages installed:\n(%s)"
|
||||
(length installed-list)
|
||||
(mapconcat #'package-desc-full-name
|
||||
installed-list ", ")))))
|
||||
|
||||
(defun helm-el-package-install (_candidate)
|
||||
(helm-el-package-install-1 (helm-marked-candidates)))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-install
|
||||
"Install package from helm elisp packages."
|
||||
'helm-el-package-install)
|
||||
|
||||
(defun helm-el-package-uninstall-1 (pkg-list &optional force)
|
||||
(cl-loop with mkd = pkg-list
|
||||
for p in mkd
|
||||
for id = (get-text-property 0 'tabulated-list-id p)
|
||||
do
|
||||
(condition-case-unless-debug err
|
||||
(package-delete id force)
|
||||
(error (message (cadr err))))
|
||||
;; Seems like package-descs are symbols with props instead of
|
||||
;; vectors in emacs-27, use package-desc-name to ensure
|
||||
;; compatibility in all emacs versions.
|
||||
unless (assoc (package-desc-name id) package-alist)
|
||||
collect id into delete-list
|
||||
finally do (if delete-list
|
||||
(message (format "%d packages deleted:\n(%s)"
|
||||
(length delete-list)
|
||||
(mapconcat #'package-desc-full-name
|
||||
delete-list ", ")))
|
||||
"No package deleted")))
|
||||
|
||||
(defun helm-el-package-uninstall (_candidate)
|
||||
(helm-el-package-uninstall-1 (helm-marked-candidates) helm-current-prefix-arg))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-uninstall
|
||||
"Uninstall package from helm elisp packages."
|
||||
'helm-el-package-uninstall)
|
||||
|
||||
(defun helm-el-package-menu--find-upgrades ()
|
||||
(cl-loop for entry in helm-el-package--tabulated-list
|
||||
for pkg-desc = (car entry)
|
||||
for status = (package-desc-status pkg-desc)
|
||||
;; A dependency.
|
||||
when (string= status "dependency")
|
||||
collect pkg-desc into dependencies
|
||||
;; An installed package used as dependency (user have
|
||||
;; installed this package explicitely).
|
||||
when (package--used-elsewhere-p pkg-desc)
|
||||
collect pkg-desc into installed-as-dep
|
||||
;; An installed package.
|
||||
when (member status '("installed" "unsigned"))
|
||||
collect pkg-desc into installed
|
||||
when (member status '("available" "new"))
|
||||
collect (cons (package-desc-name pkg-desc) pkg-desc) into available
|
||||
finally return
|
||||
;; Always try to upgrade dependencies before installed.
|
||||
(cl-loop with all = (append dependencies installed-as-dep installed)
|
||||
for pkg in all
|
||||
for name = (package-desc-name pkg)
|
||||
for avail-pkg = (assq name available)
|
||||
when (and avail-pkg
|
||||
(version-list-<
|
||||
(package-desc-version pkg)
|
||||
(package-desc-version (cdr avail-pkg))))
|
||||
collect avail-pkg)))
|
||||
|
||||
(defun helm-el-package--user-installed-p (package)
|
||||
"Return non-nil if PACKAGE is a user-installed package."
|
||||
(let* ((assoc (assq package package-alist))
|
||||
(pkg-desc (and assoc (cadr assoc)))
|
||||
(dir (and pkg-desc (package-desc-dir pkg-desc))))
|
||||
(when dir
|
||||
(file-in-directory-p dir package-user-dir))))
|
||||
|
||||
(defun helm-el-package-upgrade-1 (pkg-list)
|
||||
(cl-loop for p in pkg-list
|
||||
for pkg-desc = (car p)
|
||||
for pkg-name = (package-desc-name pkg-desc)
|
||||
for upgrade = (cdr (assq pkg-name
|
||||
helm-el-package--upgrades))
|
||||
do
|
||||
(cond (;; Install.
|
||||
(equal pkg-desc upgrade)
|
||||
(message "Installing package `%s'" pkg-name)
|
||||
(package-install pkg-desc t))
|
||||
(;; Do nothing.
|
||||
(or (null upgrade)
|
||||
;; This may happen when a Elpa version of pkg
|
||||
;; is installed and need upgrade and pkg is as
|
||||
;; well a builtin package.
|
||||
(package-built-in-p pkg-name))
|
||||
(ignore))
|
||||
(;; Delete.
|
||||
t
|
||||
(message "Deleting package `%s'" pkg-name)
|
||||
(package-delete pkg-desc t t)))))
|
||||
|
||||
(defun helm-el-package-upgrade (_candidate)
|
||||
(helm-el-package-upgrade-1
|
||||
(cl-loop with pkgs = (helm-marked-candidates)
|
||||
for p in helm-el-package--tabulated-list
|
||||
for pkg = (car p)
|
||||
if (member (symbol-name (package-desc-name pkg)) pkgs)
|
||||
collect p)))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-upgrade
|
||||
"Uninstall package from helm elisp packages."
|
||||
'helm-el-package-upgrade)
|
||||
|
||||
(defun helm-el-package-upgrade-all ()
|
||||
(if helm-el-package--upgrades
|
||||
(with-helm-display-marked-candidates
|
||||
helm-marked-buffer-name (helm-fast-remove-dups
|
||||
(mapcar (lambda (x) (symbol-name (car x)))
|
||||
helm-el-package--upgrades)
|
||||
:test 'equal)
|
||||
(when (y-or-n-p "Upgrade all packages? ")
|
||||
(helm-el-package-upgrade-1 helm-el-package--tabulated-list)))
|
||||
(message "No packages to upgrade actually!")))
|
||||
|
||||
(defun helm-el-package-upgrade-all-action (_candidate)
|
||||
(helm-el-package-upgrade-all))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-upgrade-all
|
||||
"Upgrade all packages from helm elisp packages."
|
||||
'helm-el-package-upgrade-all-action)
|
||||
|
||||
(defun helm-el-package--transformer (candidates _source)
|
||||
(cl-loop for c in candidates
|
||||
for disp = (concat " " c)
|
||||
for id = (get-text-property 0 'tabulated-list-id c)
|
||||
for name = (and id (package-desc-name id))
|
||||
for desc = (package-desc-status id)
|
||||
for built-in-p = (and (package-built-in-p name)
|
||||
(not (member desc '("available" "new"
|
||||
"installed" "dependency"))))
|
||||
for installed-p = (member desc '("installed" "dependency"))
|
||||
for upgrade-p = (assq name helm-el-package--upgrades)
|
||||
for user-installed-p = (memq name package-selected-packages)
|
||||
do (when (and user-installed-p (not upgrade-p))
|
||||
(put-text-property 0 2 'display "S " disp))
|
||||
do (when (or (memq name helm-el-package--removable-packages)
|
||||
(and upgrade-p installed-p))
|
||||
(put-text-property 0 2 'display "U " disp)
|
||||
(put-text-property
|
||||
2 (+ (length (symbol-name name)) 2)
|
||||
'face 'font-lock-variable-name-face disp))
|
||||
do (when (and upgrade-p (not installed-p) (not built-in-p))
|
||||
(put-text-property 0 2 'display "I " disp))
|
||||
for cand = (cons disp (car (split-string disp)))
|
||||
when (or (and built-in-p
|
||||
(eq helm-el-package--show-only 'built-in))
|
||||
(and upgrade-p
|
||||
(eq helm-el-package--show-only 'upgrade))
|
||||
(and installed-p
|
||||
(eq helm-el-package--show-only 'installed))
|
||||
(and (not installed-p)
|
||||
(not built-in-p)
|
||||
(eq helm-el-package--show-only 'uninstalled))
|
||||
(eq helm-el-package--show-only 'all))
|
||||
collect cand))
|
||||
|
||||
(defun helm-el-package-show-built-in ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'built-in)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-built-in 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-upgrade ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'upgrade)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-upgrade 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-installed ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'installed)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-installed 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-all ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'all)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-all 'helm-only t)
|
||||
|
||||
(defun helm-el-package-show-uninstalled ()
|
||||
(interactive)
|
||||
(with-helm-alive-p
|
||||
(setq helm-el-package--show-only 'uninstalled)
|
||||
(helm-update)))
|
||||
(put 'helm-el-package-show-uninstalled 'helm-only t)
|
||||
|
||||
(defvar helm-el-package-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "M-I") #'helm-el-package-show-installed)
|
||||
(define-key map (kbd "M-O") #'helm-el-package-show-uninstalled)
|
||||
(define-key map (kbd "M-U") #'helm-el-package-show-upgrade)
|
||||
(define-key map (kbd "M-B") #'helm-el-package-show-built-in)
|
||||
(define-key map (kbd "M-A") #'helm-el-package-show-all)
|
||||
(define-key map (kbd "C-c i") #'helm-el-run-package-install)
|
||||
(define-key map (kbd "C-c r") #'helm-el-run-package-reinstall)
|
||||
(define-key map (kbd "C-c d") #'helm-el-run-package-uninstall)
|
||||
(define-key map (kbd "C-c u") #'helm-el-run-package-upgrade)
|
||||
(define-key map (kbd "C-c U") #'helm-el-run-package-upgrade-all)
|
||||
(define-key map (kbd "C-c @") #'helm-el-run-visit-homepage)
|
||||
map))
|
||||
|
||||
(defvar helm-source-list-el-package nil)
|
||||
(defclass helm-list-el-package-source (helm-source-in-buffer)
|
||||
((init :initform 'helm-el-package--init)
|
||||
(get-line :initform 'buffer-substring)
|
||||
(filtered-candidate-transformer :initform 'helm-el-package--transformer)
|
||||
(action-transformer :initform 'helm-el-package--action-transformer)
|
||||
(help-message :initform 'helm-el-package-help-message)
|
||||
(keymap :initform 'helm-el-package-map)
|
||||
(update :initform 'helm-el-package--update)
|
||||
(candidate-number-limit :initform 9999)
|
||||
(action :initform '(("Describe package" . helm-el-package-describe)
|
||||
("Visit homepage" . helm-el-package-visit-homepage)))
|
||||
(find-file-target :initform #'helm-el-package-quit-an-find-file-fn)
|
||||
(group :initform 'helm-el-package)))
|
||||
|
||||
(defun helm-el-package-quit-an-find-file-fn (source)
|
||||
(let* ((sel (helm-get-selection nil nil source))
|
||||
(pkg (and (stringp sel)
|
||||
(get-text-property 0 'tabulated-list-id sel))))
|
||||
(when (and pkg (package-installed-p pkg))
|
||||
(expand-file-name (package-desc-dir pkg)))))
|
||||
|
||||
(defun helm-el-package--action-transformer (actions candidate)
|
||||
(let* ((pkg-desc (get-text-property 0 'tabulated-list-id candidate))
|
||||
(status (package-desc-status pkg-desc))
|
||||
(pkg-name (package-desc-name pkg-desc))
|
||||
(built-in (and (package-built-in-p pkg-name)
|
||||
(not (member status '("available" "new"
|
||||
"installed" "dependency")))))
|
||||
(acts (if helm-el-package--upgrades
|
||||
(append actions '(("Upgrade all packages"
|
||||
. helm-el-package-upgrade-all-action)))
|
||||
actions)))
|
||||
(cond (built-in '(("Describe package" . helm-el-package-describe)))
|
||||
((and (package-installed-p pkg-name)
|
||||
(cdr (assq pkg-name helm-el-package--upgrades))
|
||||
(member status '("installed" "dependency")))
|
||||
(append '(("Upgrade package(s)" . helm-el-package-upgrade)
|
||||
("Uninstall package(s)" . helm-el-package-uninstall))
|
||||
acts))
|
||||
((and (package-installed-p pkg-name)
|
||||
(cdr (assq pkg-name helm-el-package--upgrades))
|
||||
(string= status "available"))
|
||||
(append '(("Upgrade package(s)" . helm-el-package-upgrade))
|
||||
acts))
|
||||
((and (package-installed-p pkg-name)
|
||||
(or (null (package-built-in-p pkg-name))
|
||||
(and (package-built-in-p pkg-name)
|
||||
(assq pkg-name package-alist))))
|
||||
(append acts '(("Reinstall package(s)" . helm-el-package-reinstall)
|
||||
("Recompile package(s)" . helm-el-package-recompile)
|
||||
("Uninstall package(s)" . helm-el-package-uninstall))))
|
||||
(t (append acts '(("Install packages(s)" . helm-el-package-install)))))))
|
||||
|
||||
(defun helm-el-package--update ()
|
||||
(setq helm-el-package--initialized-p nil))
|
||||
|
||||
(defun helm-el-package-recompile (_pkg)
|
||||
(cl-loop for p in (helm-marked-candidates)
|
||||
do (helm-el-package-recompile-1 p)))
|
||||
|
||||
(defun helm-el-package-recompile-1 (pkg)
|
||||
(let* ((pkg-desc (get-text-property 0 'tabulated-list-id pkg))
|
||||
(dir (package-desc-dir pkg-desc)))
|
||||
(async-byte-recompile-directory dir)))
|
||||
|
||||
(defun helm-el-package-reinstall (_pkg)
|
||||
(cl-loop for p in (helm-marked-candidates)
|
||||
for pkg-desc = (get-text-property 0 'tabulated-list-id p)
|
||||
do (helm-el-package-reinstall-1 pkg-desc)))
|
||||
|
||||
(defun helm-el-package-reinstall-1 (pkg-desc)
|
||||
(let ((name (package-desc-name pkg-desc)))
|
||||
(package-delete pkg-desc 'force 'nosave)
|
||||
;; pkg-desc contain the description
|
||||
;; of the installed package just removed
|
||||
;; and is BTW no more valid.
|
||||
;; Use the entry in package-archive-content
|
||||
;; which is the non--installed package entry.
|
||||
;; For some reason `package-install'
|
||||
;; need a pkg-desc (package-desc-p) for the build-in
|
||||
;; packages already installed, the name (as symbol)
|
||||
;; fails with such packages.
|
||||
(package-install
|
||||
(cadr (assq name package-archive-contents)) t)))
|
||||
|
||||
(helm-make-command-from-action helm-el-run-package-reinstall
|
||||
"Reinstall package from helm elisp packages."
|
||||
'helm-el-package-reinstall)
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-list-elisp-packages (arg)
|
||||
"Preconfigured `helm' for listing and handling Emacs packages."
|
||||
(interactive "P")
|
||||
(when arg (setq helm-el-package--initialized-p nil))
|
||||
(unless helm-source-list-el-package
|
||||
(setq helm-source-list-el-package
|
||||
(helm-make-source "list packages" 'helm-list-el-package-source)))
|
||||
(helm :sources 'helm-source-list-el-package
|
||||
:truncate-lines helm-el-truncate-lines
|
||||
:full-frame t
|
||||
:buffer "*helm list packages*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-list-elisp-packages-no-fetch (arg)
|
||||
"Preconfigured Helm for Emacs packages.
|
||||
|
||||
Same as `helm-list-elisp-packages' but don't fetch packages on
|
||||
remote. Called with a prefix ARG always fetch packages on
|
||||
remote."
|
||||
(interactive "P")
|
||||
(let ((helm-el-package--initialized-p (null arg)))
|
||||
(helm-list-elisp-packages nil)))
|
||||
|
||||
(provide 'helm-elisp-package)
|
||||
|
||||
;;; helm-elisp-package.el ends here
|
|
@ -223,7 +223,7 @@ If `helm-turn-on-show-completion' is nil do nothing."
|
|||
(or
|
||||
(and (eq (char-before) ?\ )
|
||||
(save-excursion
|
||||
(skip-syntax-backward " " (pos-bol))
|
||||
(skip-syntax-backward " " (point-at-bol))
|
||||
(memq (symbol-at-point)
|
||||
helm-lisp-unquoted-function-list)))
|
||||
(and (eq (char-before) ?\')
|
||||
|
@ -241,7 +241,7 @@ If `helm-turn-on-show-completion' is nil do nothing."
|
|||
(and (eq (char-before) ?\')
|
||||
(save-excursion
|
||||
(forward-char (if (funcall fn-sym-p) -2 -1))
|
||||
(skip-syntax-backward " " (pos-bol))
|
||||
(skip-syntax-backward " " (point-at-bol))
|
||||
(memq (symbol-at-point)
|
||||
helm-lisp-quoted-function-list)))
|
||||
(eq (char-before) ?\())) ; no paren before str.
|
||||
|
@ -263,7 +263,7 @@ of symbol before point."
|
|||
(save-excursion
|
||||
(let (beg
|
||||
(end (point))
|
||||
(boundary (field-beginning nil nil (pos-bol))))
|
||||
(boundary (field-beginning nil nil (point-at-bol))))
|
||||
(if (re-search-backward (or regexp "\\_<") boundary t)
|
||||
(setq beg (match-end 0))
|
||||
(setq beg boundary))
|
||||
|
@ -416,7 +416,6 @@ Argument NAME allows specifiying what function to use to display
|
|||
documentation when SYM name is the same for function and variable."
|
||||
(let ((doc (condition-case _err
|
||||
(pcase sym
|
||||
((pred class-p) (cl--class-docstring (cl--find-class sym)))
|
||||
((and (pred fboundp) (pred boundp))
|
||||
(pcase name
|
||||
("describe-function"
|
||||
|
@ -424,10 +423,6 @@ documentation when SYM name is the same for function and variable."
|
|||
("describe-variable"
|
||||
(documentation-property sym 'variable-documentation t))
|
||||
(_ (documentation sym t))))
|
||||
((pred custom-theme-p)
|
||||
(documentation-property sym 'theme-documentation t))
|
||||
((pred helm-group-p) (documentation-property
|
||||
sym 'group-documentation t))
|
||||
((pred fboundp) (documentation sym t))
|
||||
((pred boundp) (documentation-property
|
||||
sym 'variable-documentation t))
|
||||
|
@ -441,12 +436,7 @@ documentation when SYM name is the same for function and variable."
|
|||
(truncate-string-to-width
|
||||
(substitute-command-keys (car (split-string doc "\n")))
|
||||
end-column nil nil t)
|
||||
(if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym))
|
||||
"Not documented"
|
||||
;; Symbol exist but has no definition yet e.g.
|
||||
;; (advice-add 'foo-test :override (lambda () (message "invalid
|
||||
;; function"))) and foo-test is not already defined.
|
||||
"Not already defined or loaded"))))
|
||||
"Not documented")))
|
||||
|
||||
;;; File completion.
|
||||
;;
|
||||
|
@ -463,7 +453,7 @@ documentation when SYM name is the same for function and variable."
|
|||
(or force
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(search-backward tap (pos-bol) t)
|
||||
(search-backward tap (point-at-bol) t)
|
||||
(setq beg (point))
|
||||
(looking-back "[^'`( ]" (1- (point)))))
|
||||
(expand-file-name
|
||||
|
@ -499,7 +489,7 @@ double quote."
|
|||
(let* ((tap (thing-at-point 'filename)))
|
||||
(if (and tap (save-excursion
|
||||
(end-of-line)
|
||||
(search-backward tap (pos-bol) t)
|
||||
(search-backward tap (point-at-bol) t)
|
||||
(looking-back "[^'`( ]" (1- (point)))))
|
||||
(helm-complete-file-name-at-point)
|
||||
(helm-lisp-completion-at-point))))
|
||||
|
@ -543,7 +533,8 @@ is only used to test DEFAULT."
|
|||
|
||||
(defun helm-apropos-short-doc-transformer (candidates _source)
|
||||
(if helm-apropos-show-short-doc
|
||||
(cl-loop with max-len = (helm-in-buffer-get-longest-candidate)
|
||||
(cl-loop with max-len = (buffer-local-value 'helm-candidate-buffer-longest-len
|
||||
(get-buffer (helm-candidate-buffer)))
|
||||
for cand in candidates
|
||||
for doc = (helm-get-first-line-documentation (intern-soft cand))
|
||||
collect (cons (format "%s%s%s"
|
||||
|
@ -624,9 +615,7 @@ is only used to test DEFAULT."
|
|||
(helm-build-in-buffer-source "Variables"
|
||||
:init (lambda ()
|
||||
(helm-apropos-init
|
||||
(lambda (x)
|
||||
(and (boundp x) (not (keywordp x)) (not (class-p x))))
|
||||
default))
|
||||
(lambda (x) (and (boundp x) (not (keywordp x)))) default))
|
||||
:fuzzy-match helm-apropos-fuzzy-match
|
||||
:filtered-candidate-transformer
|
||||
(delq nil (list (and (null helm-apropos-fuzzy-match)
|
||||
|
@ -732,7 +721,7 @@ is only used to test DEFAULT."
|
|||
:persistent-help "Toggle describe class"
|
||||
:keymap helm-apropos-map
|
||||
:action '(("Describe Class" . helm-describe-class)
|
||||
("Find Class (C-u for source)" . helm-find-function)
|
||||
("Find Class" . helm-find-function)
|
||||
("Info lookup" . helm-info-lookup-symbol))))
|
||||
|
||||
(defun helm-def-source--eieio-generic (&optional default)
|
||||
|
@ -754,7 +743,7 @@ is only used to test DEFAULT."
|
|||
:persistent-help "Toggle describe generic function"
|
||||
:keymap helm-apropos-map
|
||||
:action '(("Describe function" . helm-describe-function)
|
||||
("Find function (C-u for source)" . helm-find-function)
|
||||
("Find function" . helm-find-function)
|
||||
("Info lookup" . helm-info-lookup-symbol))))
|
||||
|
||||
(defun helm-info-lookup-fallback-source (candidate)
|
494
code/elpa/helm-20230727.1557/helm-eshell.el
Normal file
494
code/elpa/helm-20230727.1557/helm-eshell.el
Normal file
|
@ -0,0 +1,494 @@
|
|||
;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; Enable like this in .emacs:
|
||||
;; (add-hook 'eshell-mode-hook
|
||||
;; (lambda ()
|
||||
;; (eshell-cmpl-initialize)
|
||||
;; (define-key eshell-mode-map [remap eshell-pcomplete] 'helm-esh-pcomplete)
|
||||
;; (define-key eshell-mode-map (kbd "M-s f") 'helm-eshell-prompts-all)))
|
||||
;; (define-key eshell-mode-map (kbd "M-r") 'helm-eshell-history)))
|
||||
|
||||
|
||||
;;; Code:
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-help)
|
||||
(require 'helm-elisp)
|
||||
|
||||
(declare-function eshell-read-aliases-list "em-alias")
|
||||
(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
|
||||
(declare-function eshell-bol "esh-mode")
|
||||
(declare-function eshell-parse-arguments "esh-arg" (beg end))
|
||||
(declare-function eshell-backward-argument "esh-mode" (&optional arg))
|
||||
(declare-function helm-quote-whitespace "helm-lib")
|
||||
(declare-function eshell-skip-prompt "em-prompt")
|
||||
(defvar eshell-special-chars-outside-quoting)
|
||||
|
||||
|
||||
(defgroup helm-eshell nil
|
||||
"Helm completion and history for Eshell."
|
||||
:group 'helm)
|
||||
|
||||
|
||||
(defcustom helm-eshell-fuzzy-match nil
|
||||
"Enable fuzzy matching in `helm-esh-pcomplete' when non-nil."
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
(defvar helm-eshell-history-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "M-p") #'helm-next-line)
|
||||
map)
|
||||
"Keymap for `helm-eshell-history'.")
|
||||
|
||||
(defvar helm-esh-completion-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "TAB") #'helm-next-line)
|
||||
map)
|
||||
"Keymap for `helm-esh-pcomplete'.")
|
||||
|
||||
(defvar helm-eshell--quit-flag nil)
|
||||
|
||||
|
||||
;; Internal.
|
||||
(defvar helm-ec-target "")
|
||||
(defun helm-ec-insert (_candidate)
|
||||
"Replace text at point with CANDIDATE.
|
||||
The function that call this should set `helm-ec-target' to thing
|
||||
at point."
|
||||
(set (make-local-variable 'comint-file-name-quote-list)
|
||||
eshell-special-chars-outside-quoting)
|
||||
(let ((pt (point)))
|
||||
(when (and helm-ec-target
|
||||
(search-backward helm-ec-target nil t)
|
||||
(string= (buffer-substring (point) pt) helm-ec-target))
|
||||
(delete-region (point) pt)))
|
||||
(when (string-match "\\`\\*" helm-ec-target) (insert "*"))
|
||||
(let ((marked (helm-marked-candidates)))
|
||||
(prog1 t ;; Makes helm returns t on action.
|
||||
(insert
|
||||
(mapconcat
|
||||
(lambda (x)
|
||||
(cond ((string-match "\\`~/" helm-ec-target)
|
||||
;; Strip out the first escape char added by
|
||||
;; `comint-quote-filename' before "~" (Bug#1803).
|
||||
(substring (comint-quote-filename (abbreviate-file-name x)) 1))
|
||||
((string-match "\\`/" helm-ec-target)
|
||||
(comint-quote-filename x))
|
||||
(t
|
||||
(concat (and (string-match "\\`[.]/" helm-ec-target) "./")
|
||||
(comint-quote-filename
|
||||
(file-relative-name x))))))
|
||||
marked " ")
|
||||
(or (helm-aand (car (last marked))
|
||||
(string-match-p "/\\'" it)
|
||||
"")
|
||||
" ")))))
|
||||
|
||||
(defun helm-esh-transformer (candidates _sources)
|
||||
(cl-loop
|
||||
for i in candidates
|
||||
collect
|
||||
(cond ((string-match "\\`~/?" helm-ec-target)
|
||||
(abbreviate-file-name i))
|
||||
((string-match "\\`/" helm-ec-target) i)
|
||||
(t
|
||||
(file-relative-name i)))
|
||||
into lst
|
||||
finally return (sort lst #'helm-generic-sort-fn)))
|
||||
|
||||
(defclass helm-esh-source (helm-source-sync)
|
||||
((init :initform (lambda ()
|
||||
(setq pcomplete-current-completions nil
|
||||
pcomplete-last-completion-raw nil)
|
||||
;; Eshell-command add this hook in all minibuffers
|
||||
;; Remove it for the helm one. (Fixed in Emacs24)
|
||||
(remove-hook 'minibuffer-setup-hook 'eshell-mode)))
|
||||
(candidates :initform 'helm-esh-get-candidates)
|
||||
;(nomark :initform t)
|
||||
(persistent-action :initform 'ignore)
|
||||
(nohighlight :initform t)
|
||||
(filtered-candidate-transformer :initform #'helm-esh-transformer)
|
||||
(action :initform 'helm-ec-insert))
|
||||
"Helm class to define source for Eshell completion.")
|
||||
|
||||
(defun helm-esh-get-candidates ()
|
||||
"Get candidates for Eshell completion using `pcomplete'."
|
||||
(catch 'pcompleted
|
||||
(with-helm-current-buffer
|
||||
(let* ((pcomplete-stub)
|
||||
pcomplete-seen pcomplete-norm-func
|
||||
pcomplete-args pcomplete-last pcomplete-index
|
||||
(pcomplete-autolist pcomplete-autolist)
|
||||
(pcomplete-suffix-list pcomplete-suffix-list)
|
||||
(table (pcomplete-completions))
|
||||
(entry (or (try-completion helm-pattern
|
||||
(pcomplete-entries))
|
||||
helm-pattern)))
|
||||
(cl-loop ;; expand entry too to be able to compare it with file-cand.
|
||||
with exp-entry = (and (stringp entry)
|
||||
(not (string= entry ""))
|
||||
(file-name-as-directory
|
||||
(expand-file-name entry default-directory)))
|
||||
with comps = (all-completions pcomplete-stub table)
|
||||
unless comps return (prog1 nil
|
||||
;; Don't add final space when
|
||||
;; there is no completion (Bug#1990).
|
||||
(setq helm-eshell--quit-flag t)
|
||||
(message "No completions of %s" pcomplete-stub))
|
||||
for i in comps
|
||||
;; Transform the relative names to abs names.
|
||||
for file-cand = (and exp-entry
|
||||
(if (file-remote-p i) i
|
||||
(expand-file-name
|
||||
i (file-name-directory
|
||||
(if (directory-name-p pcomplete-stub)
|
||||
entry
|
||||
(directory-file-name entry))))))
|
||||
;; Compare them to avoid dups.
|
||||
for file-entry-p = (and (stringp exp-entry)
|
||||
(stringp file-cand)
|
||||
;; Fix :/tmp/foo/ $ cd foo
|
||||
(not (file-directory-p file-cand))
|
||||
(file-equal-p exp-entry file-cand))
|
||||
if (and file-cand (or (file-remote-p file-cand)
|
||||
(file-exists-p file-cand))
|
||||
(not file-entry-p))
|
||||
collect file-cand into ls
|
||||
else
|
||||
;; Avoid adding entry here.
|
||||
unless file-entry-p collect i into ls
|
||||
finally return
|
||||
(if (and exp-entry
|
||||
(file-directory-p exp-entry)
|
||||
;; If the car of completion list is
|
||||
;; an executable, probably we are in
|
||||
;; command completion, so don't add a
|
||||
;; possible file related entry here.
|
||||
(and ls (not (executable-find (car ls))))
|
||||
;; Don't add entry if already in prompt.
|
||||
(not (file-equal-p exp-entry pcomplete-stub)))
|
||||
(append (list exp-entry)
|
||||
;; Entry should not be here now but double check.
|
||||
(remove entry ls))
|
||||
ls))))))
|
||||
|
||||
;;; Eshell history.
|
||||
;;
|
||||
;;
|
||||
(defclass helm-eshell-history-source (helm-source-sync)
|
||||
((init :initform
|
||||
(lambda ()
|
||||
;; Same comment as in `helm-source-esh'.
|
||||
(remove-hook 'minibuffer-setup-hook 'eshell-mode)))
|
||||
(candidates
|
||||
:initform
|
||||
(lambda ()
|
||||
(with-helm-current-buffer
|
||||
(cl-loop for c from 0 to (ring-length eshell-history-ring)
|
||||
for elm = (eshell-get-history c)
|
||||
unless (and (member elm lst)
|
||||
eshell-hist-ignoredups)
|
||||
collect elm into lst
|
||||
finally return lst))))
|
||||
(nomark :initform t)
|
||||
(multiline :initform t)
|
||||
(keymap :initform 'helm-eshell-history-map)
|
||||
(candidate-number-limit :initform 9999)
|
||||
(action :initform (lambda (candidate)
|
||||
(eshell-kill-input)
|
||||
(insert candidate))))
|
||||
"Helm class to define source for Eshell history.")
|
||||
|
||||
|
||||
(defun helm-esh-pcomplete-input (target users-comp last)
|
||||
(if (and (stringp last)
|
||||
(not (string= last ""))
|
||||
(not users-comp)
|
||||
;; Fix completion on "../" see Bug#1832.
|
||||
(or (file-exists-p last)
|
||||
(helm-aand
|
||||
(file-name-directory last)
|
||||
(file-directory-p it))))
|
||||
(if (and (file-directory-p last)
|
||||
(string-match "\\`[~.]*.*/[.]\\'" target))
|
||||
;; Fix completion on "~/.", "~/[...]/.", and "../."
|
||||
(expand-file-name
|
||||
(concat (helm-basedir (file-name-as-directory last))
|
||||
(regexp-quote (helm-basename target))))
|
||||
(expand-file-name last))
|
||||
;; Don't add "~" to input to provide completion on all users instead of only
|
||||
;; on current $HOME (#1832).
|
||||
(unless users-comp last)))
|
||||
|
||||
(defun helm-esh-pcomplete-default-source ()
|
||||
"Make and return the default source for Eshell completion."
|
||||
(helm-make-source "Eshell completions" 'helm-esh-source
|
||||
:fuzzy-match helm-eshell-fuzzy-match
|
||||
:keymap helm-esh-completion-map))
|
||||
|
||||
(defvar helm-esh-pcomplete-build-source-fn #'helm-esh-pcomplete-default-source
|
||||
"Function that builds a source or a list of sources.")
|
||||
|
||||
(defun helm-esh-pcomplete--make-helm (&optional input)
|
||||
(helm :sources (funcall helm-esh-pcomplete-build-source-fn)
|
||||
:buffer "*helm pcomplete*"
|
||||
:resume 'noresume
|
||||
:input input))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-esh-pcomplete ()
|
||||
"Preconfigured `helm' to provide Helm completion in Eshell."
|
||||
(interactive)
|
||||
(let* ((helm-quit-if-no-candidate t)
|
||||
(helm-execute-action-at-once-if-one t)
|
||||
(end (point-marker))
|
||||
(beg (save-excursion (eshell-bol) (point)))
|
||||
(args (catch 'eshell-incomplete
|
||||
(eshell-parse-arguments beg end)))
|
||||
(target
|
||||
(or (and (looking-back " " (1- (point))) " ")
|
||||
(buffer-substring-no-properties
|
||||
(save-excursion
|
||||
(eshell-backward-argument 1) (point))
|
||||
end)))
|
||||
(users-comp (string= target "~"))
|
||||
(first (car args)) ; Maybe lisp delimiter "(".
|
||||
last ; Will be the last but parsed by pcomplete.
|
||||
del-space
|
||||
del-dot)
|
||||
(setq helm-ec-target (or target " ")
|
||||
end (point)
|
||||
;; Reset beg for `with-helm-show-completion'.
|
||||
beg (or (and target (not (string= target " "))
|
||||
(- end (length target)))
|
||||
;; Nothing at point.
|
||||
(progn (insert " ") (setq del-space t) (point))))
|
||||
(when (string-match "\\`[~.]*.*/[.]\\'" target)
|
||||
;; Fix completion on
|
||||
;; "~/.", "~/[...]/.", and "../."
|
||||
(delete-char -1) (setq del-dot t)
|
||||
(setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target)))))
|
||||
(cond ((eq first ?\()
|
||||
(helm-lisp-completion-or-file-name-at-point))
|
||||
;; In eshell `pcomplete-parse-arguments' is called
|
||||
;; with `pcomplete-parse-arguments-function'
|
||||
;; locally bound to `eshell-complete-parse-arguments'
|
||||
;; which is calling `lisp-complete-symbol',
|
||||
;; calling it before would popup the
|
||||
;; *completions* buffer.
|
||||
(t (setq last (replace-regexp-in-string
|
||||
"\\`\\*" ""
|
||||
(car (last (ignore-errors
|
||||
(pcomplete-parse-arguments))))))
|
||||
;; Set helm-eshell--quit-flag to non-nil only on
|
||||
;; quit, this tells to not add final suffix when quitting
|
||||
;; helm.
|
||||
(add-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn)
|
||||
(with-helm-show-completion beg end
|
||||
(unwind-protect
|
||||
(or (helm-esh-pcomplete--make-helm
|
||||
(helm-esh-pcomplete-input target users-comp last))
|
||||
;; Delete removed dot on quit
|
||||
(and del-dot (prog1 t (insert ".")))
|
||||
;; A space is needed to have completion, remove
|
||||
;; it when nothing found.
|
||||
(and del-space (looking-back "\\s-" (1- (point)))
|
||||
(delete-char -1))
|
||||
(if (and (null helm-eshell--quit-flag)
|
||||
(and (stringp last) (file-directory-p last))
|
||||
(looking-back "\\([.]\\{1,2\\}\\|[^/]\\)\\'"
|
||||
(1- (point))))
|
||||
(prog1 t (insert "/"))
|
||||
;; We need another flag for space here, but
|
||||
;; global to pass it to `helm-quit-hook', this
|
||||
;; space is added when point is just after
|
||||
;; previous completion and there is no
|
||||
;; more completion, see Bug#1832.
|
||||
(unless (or helm-eshell--quit-flag
|
||||
(looking-back "/\\'" (1- (point))))
|
||||
(prog1 t (insert " ")))
|
||||
(when (and helm-eshell--quit-flag
|
||||
(string-match-p "[.]\\{2\\}\\'" last))
|
||||
(insert "/"))))
|
||||
(remove-hook 'helm-quit-hook #'helm-eshell--quit-hook-fn)
|
||||
(setq helm-eshell--quit-flag nil)))))))
|
||||
|
||||
(defun helm-eshell--quit-hook-fn ()
|
||||
(setq helm-eshell--quit-flag t))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-eshell-history ()
|
||||
"Preconfigured Helm for Eshell history."
|
||||
(interactive)
|
||||
(let* ((end (point))
|
||||
(beg (save-excursion (eshell-bol) (point)))
|
||||
(input (buffer-substring beg end))
|
||||
flag-empty)
|
||||
(when (eq beg end)
|
||||
(insert " ")
|
||||
(setq flag-empty t)
|
||||
(setq end (point)))
|
||||
(unwind-protect
|
||||
(with-helm-show-completion beg end
|
||||
(helm :sources (helm-make-source "Eshell history"
|
||||
'helm-eshell-history-source
|
||||
:fuzzy-match helm-eshell-fuzzy-match)
|
||||
:buffer "*helm eshell history*"
|
||||
:resume 'noresume
|
||||
:input input))
|
||||
(when (and flag-empty
|
||||
(looking-back " " (1- (point))))
|
||||
(delete-char -1)))))
|
||||
|
||||
|
||||
;;; Eshell prompts
|
||||
;;
|
||||
(defface helm-eshell-prompts-promptidx
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "cyan"))
|
||||
"Face used to highlight Eshell prompt index.")
|
||||
|
||||
(defface helm-eshell-prompts-buffer-name
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "green"))
|
||||
"Face used to highlight Eshell buffer name.")
|
||||
|
||||
(defcustom helm-eshell-prompts-promptidx-p t
|
||||
"Show prompt number."
|
||||
:type 'boolean)
|
||||
|
||||
(defvar helm-eshell-prompts-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "C-c o") #'helm-eshell-prompts-other-window)
|
||||
(define-key map (kbd "C-c C-o") #'helm-eshell-prompts-other-frame)
|
||||
map)
|
||||
"Keymap for `helm-eshell-prompt-all'.")
|
||||
|
||||
(defvar eshell-prompt-regexp)
|
||||
(defvar eshell-highlight-prompt)
|
||||
|
||||
(defun helm-eshell-prompts-list (&optional buffer)
|
||||
"List the prompts in Eshell BUFFER.
|
||||
|
||||
Return a list of (\"prompt\" (point) (buffer-name) prompt-index))
|
||||
E.g. (\"ls\" 162 \"*eshell*\" 3).
|
||||
If BUFFER is nil, use current buffer."
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(when (eq major-mode 'eshell-mode)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let (result (count 1))
|
||||
(helm-awhile (re-search-forward eshell-prompt-regexp nil t)
|
||||
(when (or (and eshell-highlight-prompt
|
||||
(get-text-property (match-beginning 0) 'read-only))
|
||||
(null eshell-highlight-prompt))
|
||||
(push (list (buffer-substring-no-properties
|
||||
it (point-at-eol))
|
||||
it (buffer-name) count)
|
||||
result)
|
||||
(setq count (1+ count))))
|
||||
(nreverse result))))))
|
||||
|
||||
(defun helm-eshell-prompts-list-all ()
|
||||
"List the prompts of all Eshell buffers.
|
||||
See `helm-eshell-prompts-list'."
|
||||
(cl-loop for b in (buffer-list)
|
||||
append (helm-eshell-prompts-list b)))
|
||||
|
||||
(defun helm-eshell-prompts-transformer (candidates &optional all)
|
||||
;; ("ls" 162 "*eshell*" 3) => ("*eshell*:3:ls" . ("ls" 162 "*eshell*" 3))
|
||||
(cl-loop for (prt pos buf id) in candidates
|
||||
collect `(,(concat
|
||||
(when all
|
||||
(concat (propertize
|
||||
buf
|
||||
'face 'helm-eshell-prompts-buffer-name)
|
||||
":"))
|
||||
(when helm-eshell-prompts-promptidx-p
|
||||
(concat (propertize
|
||||
(number-to-string id)
|
||||
'face 'helm-eshell-prompts-promptidx)
|
||||
":"))
|
||||
prt)
|
||||
. ,(list prt pos buf id))))
|
||||
|
||||
(defun helm-eshell-prompts-all-transformer (candidates)
|
||||
(helm-eshell-prompts-transformer candidates t))
|
||||
|
||||
(cl-defun helm-eshell-prompts-goto (candidate &optional (action 'switch-to-buffer))
|
||||
;; Candidate format: ("ls" 162 "*eshell*" 3)
|
||||
(let ((buf (nth 2 candidate)))
|
||||
(unless (and (string= (buffer-name) buf)
|
||||
(eq action 'switch-to-buffer))
|
||||
(funcall action buf))
|
||||
(goto-char (nth 1 candidate))
|
||||
(recenter)))
|
||||
|
||||
(defun helm-eshell-prompts-goto-other-window (candidate)
|
||||
(helm-eshell-prompts-goto candidate 'switch-to-buffer-other-window))
|
||||
|
||||
(defun helm-eshell-prompts-goto-other-frame (candidate)
|
||||
(helm-eshell-prompts-goto candidate 'switch-to-buffer-other-frame))
|
||||
|
||||
(helm-make-command-from-action helm-eshell-prompts-other-window
|
||||
"Switch to eshell prompt in other window."
|
||||
'helm-eshell-prompts-goto-other-window)
|
||||
|
||||
(helm-make-command-from-action helm-eshell-prompts-other-frame
|
||||
"Switch to eshell prompt in other frame."
|
||||
'helm-eshell-prompts-goto-other-frame)
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-eshell-prompts ()
|
||||
"Pre-configured `helm' to browse the prompts of the current Eshell."
|
||||
(interactive)
|
||||
(if (eq major-mode 'eshell-mode)
|
||||
(helm :sources
|
||||
(helm-build-sync-source "Eshell prompts"
|
||||
:candidates (helm-eshell-prompts-list)
|
||||
:candidate-transformer 'helm-eshell-prompts-transformer
|
||||
:action '(("Go to prompt" . helm-eshell-prompts-goto)))
|
||||
:buffer "*helm Eshell prompts*")
|
||||
(message "Current buffer is not an Eshell buffer")))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-eshell-prompts-all ()
|
||||
"Pre-configured `helm' to browse the prompts of all Eshell sessions."
|
||||
(interactive)
|
||||
(helm :sources
|
||||
(helm-build-sync-source "All Eshell prompts"
|
||||
:candidates (helm-eshell-prompts-list-all)
|
||||
:candidate-transformer 'helm-eshell-prompts-all-transformer
|
||||
:action '(("Go to prompt" . helm-eshell-prompts-goto)
|
||||
("Go to prompt in other window `C-c o`" .
|
||||
helm-eshell-prompts-goto-other-window)
|
||||
("Go to prompt in other frame `C-c C-o`" .
|
||||
helm-eshell-prompts-goto-other-frame))
|
||||
:keymap helm-eshell-prompts-keymap)
|
||||
:buffer "*helm Eshell all prompts*"))
|
||||
|
||||
(provide 'helm-eshell)
|
||||
|
||||
;;; helm-eshell ends here
|
|
@ -21,7 +21,6 @@
|
|||
(require 'helm-types)
|
||||
|
||||
(declare-function ansi-color-apply "ansi-color.el")
|
||||
(declare-function split-string-shell-command "shell.el")
|
||||
|
||||
(defvar helm-fd-executable "fd"
|
||||
"The fd shell command executable.")
|
|
@ -137,6 +137,7 @@ Don't set it directly, use instead `helm-ff-auto-update-initial-value'.")
|
|||
;; watch out!
|
||||
(defvar helm-tramp-file-name-regexp "\\`/\\([^/:|]+\\):")
|
||||
(defvar helm-ff-tramp-method-regexp "[/|]:\\([^:]*\\)")
|
||||
(defvar helm-marked-buffer-name "*helm marked*")
|
||||
(defvar helm-ff--auto-update-state nil)
|
||||
(defvar helm-ff--deleting-char-backward nil)
|
||||
(defvar helm-multi-files--toggle-locate nil)
|
||||
|
@ -165,10 +166,7 @@ than `helm-candidate-number-limit'.")
|
|||
This is used only as a let binding.")
|
||||
(defvar helm-ff--show-thumbnails nil)
|
||||
(defvar helm-ff--thumbnailed-directories nil)
|
||||
(defvar helm-source-find-files nil
|
||||
"The main source to browse files.
|
||||
Should not be used among other sources.")
|
||||
(defvar helm-ff-icon-mode nil)
|
||||
|
||||
|
||||
;;; Helm-find-files - The helm file browser.
|
||||
;;
|
||||
|
@ -659,8 +657,8 @@ currently transfered in an help-echo in mode-line, if you use
|
|||
Value can be either bar or text.
|
||||
Progress bar is inaccurate on non graphic displays, use text instead."
|
||||
:type '(choice
|
||||
(const :tag "Progress bar as a bar" bar)
|
||||
(const :tag "Progress bar with text" text)))
|
||||
(const :tag "Progress bar as a bar" 'bar)
|
||||
(const :tag "Progress bar with text" 'text)))
|
||||
|
||||
(defcustom helm-ff-rsync-progress-bar-info '(percent)
|
||||
"Infos shown at end of Rsync progress bar.
|
||||
|
@ -878,11 +876,10 @@ present in this list."
|
|||
(defcustom helm-ff-edit-marked-files-fn #'helm-ff-wfnames
|
||||
"A function to edit filenames in a special buffer.
|
||||
|
||||
By default `wfnames' package is used to avoid wdired which
|
||||
doesn't always work with all emacs versions and also is quite
|
||||
clumsy about default-directory among other things. If you still
|
||||
want to use it, helm is still providing
|
||||
`helm-marked-files-in-dired'."
|
||||
By default `wfnames' package is used to avoid wdired which doesn't
|
||||
always work with all emacs versions and also is quite clumsy about
|
||||
default-directory among other things.
|
||||
If you still want to use it, helm is still providing `helm-marked-files-in-dired'."
|
||||
:type '(choice (function :tag "Use Wfnames package to edit filenames."
|
||||
helm-ff-wfnames)
|
||||
(function :tag "Use Wdired package to edit filenames."
|
||||
|
@ -1050,6 +1047,10 @@ want to use it, helm is still providing
|
|||
;;; Helm-find-files
|
||||
;;
|
||||
;;
|
||||
(defvar helm-source-find-files nil
|
||||
"The main source to browse files.
|
||||
Should not be used among other sources.")
|
||||
|
||||
(defclass helm-source-ffiles (helm-source-sync)
|
||||
((header-name
|
||||
:initform (lambda (name)
|
||||
|
@ -1248,16 +1249,13 @@ ACTION can be `rsync' or any action supported by `helm-dired-action'."
|
|||
:initial-input (helm-dwim-target-directory)
|
||||
:history (helm-find-files-history nil :comp-read nil))))))
|
||||
(dest-dir-p (file-directory-p dest))
|
||||
(dest-dir (if dest-dir-p dest (helm-basedir dest))))
|
||||
(dest-dir (helm-basedir dest)))
|
||||
;; We still need to handle directory creation for Emacs version < 27.1 that
|
||||
;; doesn't have `dired-create-destination-dirs' and for rsync as well.
|
||||
(unless (or (and (boundp 'dired-create-destination-dirs)
|
||||
(null (eq action 'rsync)))
|
||||
;; doesn't have `dired-create-destination-dirs'.
|
||||
(unless (or (boundp 'dired-create-destination-dirs)
|
||||
dest-dir-p
|
||||
(file-directory-p dest-dir))
|
||||
(when (y-or-n-p (format "Create directory `%s'? " dest-dir))
|
||||
;; When saying No here with rsync, `helm-rsync-copy-files' will raise an
|
||||
;; error about dest not existing.
|
||||
(make-directory dest-dir t)))
|
||||
(if (eq action 'rsync)
|
||||
(helm-rsync-copy-files ifiles dest rsync-switches)
|
||||
|
@ -1442,7 +1440,7 @@ DEST must be a directory. SWITCHES when unspecified default to
|
|||
(when (re-search-backward "^[^[:cntrl:]]" nil t)
|
||||
(setq fname (helm-basename
|
||||
(buffer-substring-no-properties
|
||||
(point) (pos-eol))))))
|
||||
(point) (point-at-eol))))))
|
||||
;; Now format the string for the mode-line.
|
||||
(let ((ml-str (helm-ff--rsync-progress-bar progbar proc)))
|
||||
(setq ml-str (propertize ml-str 'help-echo
|
||||
|
@ -2920,7 +2918,6 @@ Ensure disabling `helm-ff-auto-update-flag' before undoing."
|
|||
(helm-check-minibuffer-input))
|
||||
(setq helm-ff-auto-update-flag old--flag)
|
||||
(setq helm-ff--auto-update-state helm-ff-auto-update-flag))))
|
||||
(put 'helm-ff-undo 'helm-only t)
|
||||
|
||||
;;; Auto-update - helm-find-files auto expansion of directories.
|
||||
;;
|
||||
|
@ -3134,7 +3131,7 @@ and should be used carefully elsewhere, or not at all, using
|
|||
(string-match-p "/[[:alpha:]]:/" match))
|
||||
(1+ (match-beginning 0))
|
||||
(match-beginning 0)))
|
||||
(buffer-substring-no-properties (point) (pos-eol)))
|
||||
(buffer-substring-no-properties (point) (point-at-eol)))
|
||||
fname)))))
|
||||
|
||||
(defun helm-point-file-in-dired (file)
|
||||
|
@ -3212,7 +3209,7 @@ editing absolute fnames in previous Emacs versions."
|
|||
"\\):")
|
||||
nil t)
|
||||
(list
|
||||
(buffer-substring-no-properties (pos-bol) (match-beginning 2))
|
||||
(buffer-substring-no-properties (point-at-bol) (match-beginning 2))
|
||||
(buffer-substring-no-properties (match-beginning 2) (match-end 2)))))))
|
||||
|
||||
(defun helm-ff--get-host-from-tramp-invalid-fname (fname)
|
||||
|
@ -3297,7 +3294,7 @@ debugging purpose."
|
|||
(or (looking-back "[/|]" (1- (point)))
|
||||
(looking-back
|
||||
(mapconcat (lambda (m) (format "[/|]%s" m)) methods "\\|")
|
||||
(pos-bol))))
|
||||
(point-at-bol))))
|
||||
(setq result nil)
|
||||
(setq result it)))))
|
||||
result))
|
||||
|
@ -3651,13 +3648,13 @@ later in the transformer."
|
|||
(helm-acase (match-string 0)
|
||||
("*" (replace-match "")
|
||||
(put-text-property
|
||||
(pos-bol) (pos-eol) 'helm-ff-exe t))
|
||||
(point-at-bol) (point-at-eol) 'helm-ff-exe t))
|
||||
("@" (replace-match "")
|
||||
(put-text-property
|
||||
(pos-bol) (pos-eol) 'helm-ff-sym t))
|
||||
(point-at-bol) (point-at-eol) 'helm-ff-sym t))
|
||||
("/" (replace-match "")
|
||||
(put-text-property
|
||||
(pos-bol) (pos-eol) 'helm-ff-dir t))
|
||||
(point-at-bol) (point-at-eol) 'helm-ff-dir t))
|
||||
(("=" "|" ">") (replace-match "")))))
|
||||
(while (re-search-forward "[\"]" nil t)
|
||||
(replace-match ""))
|
||||
|
@ -4379,7 +4376,7 @@ Arg FILE is the real part of candidate, a filename with no props."
|
|||
"Action transformer for `helm-source-find-files'."
|
||||
(let ((str-at-point (with-helm-current-buffer
|
||||
(buffer-substring-no-properties
|
||||
(pos-bol) (pos-eol)))))
|
||||
(point-at-bol) (point-at-eol)))))
|
||||
(when (file-regular-p candidate)
|
||||
(setq actions (helm-append-at-nth
|
||||
actions '(("Checksum File" . helm-ff-checksum)) 4)))
|
||||
|
@ -4578,7 +4575,7 @@ specifying the trash directory with TRASH-DIR arg."
|
|||
(when (re-search-forward "^path=" nil t)
|
||||
(let ((path (helm-url-unhex-string
|
||||
(buffer-substring-no-properties
|
||||
(point) (pos-eol)))))
|
||||
(point) (point-at-eol)))))
|
||||
(if (string-match "\\`/" path)
|
||||
;; path is absolute
|
||||
path
|
||||
|
@ -4594,7 +4591,7 @@ Line number should be added at end of fname preceded with \":\".
|
|||
E.g. \"foo:12\"."
|
||||
(let ((linum (with-helm-current-buffer
|
||||
(let ((str (buffer-substring-no-properties
|
||||
(pos-bol) (pos-eol))))
|
||||
(point-at-bol) (point-at-eol))))
|
||||
(when (string-match ":\\([0-9]+:?\\)" str)
|
||||
(match-string 1 str))))))
|
||||
(find-file candidate)
|
||||
|
@ -5291,7 +5288,7 @@ arg."
|
|||
(save-excursion
|
||||
(when (re-search-backward
|
||||
(regexp-quote guess)
|
||||
(pos-bol) t)
|
||||
(point-at-bol) t)
|
||||
(point))))
|
||||
it (point)))
|
||||
(full-path-p (and (stringp guess)
|
||||
|
@ -5454,7 +5451,8 @@ Use it for non-interactive calls of `helm-find-files'."
|
|||
(expand-file-name tap))))
|
||||
;; Ensure not being prompted for password each time we
|
||||
;; navigate to a directory.
|
||||
(password-cache t))
|
||||
(password-cache t)
|
||||
(minibuffer-completing-file-name t))
|
||||
(helm-set-local-variable 'helm-follow-mode-persistent nil
|
||||
'helm-drag-mouse-1-fn 'helm-ff-drag-mouse-1-fn)
|
||||
(unless helm-source-find-files
|
||||
|
@ -5665,7 +5663,7 @@ source is `helm-source-find-files'."
|
|||
"Try to find library path at point.
|
||||
Find inside `require' and `declare-function' sexp."
|
||||
(require 'find-func)
|
||||
(let* ((beg-sexp (save-excursion (search-backward "(" (pos-bol) t)))
|
||||
(let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
|
||||
(end-sexp (save-excursion (ignore-errors (end-of-defun)) (point)))
|
||||
(sexp (and beg-sexp end-sexp
|
||||
(buffer-substring-no-properties
|
|
@ -83,7 +83,7 @@ Using `setq' to modify this variable will have no effect."
|
|||
(define-key map (kbd "C-c C-x") 'helm-run-external-command)
|
||||
(define-key map (kbd "b") 'helm-resume)
|
||||
(define-key map (kbd "M-g i") 'helm-gid)
|
||||
(define-key map (kbd "@") 'helm-packages)
|
||||
(define-key map (kbd "@") 'helm-list-elisp-packages)
|
||||
map)
|
||||
"Default keymap for \\[helm-command-prefix] commands.
|
||||
The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.")
|
1800
code/elpa/helm-20230727.1557/helm-grep.el
Normal file
1800
code/elpa/helm-20230727.1557/helm-grep.el
Normal file
File diff suppressed because it is too large
Load diff
|
@ -44,6 +44,7 @@
|
|||
helm-buffers-ido-virtual-help-message
|
||||
helm-moccur-help-message
|
||||
helm-top-help-message
|
||||
helm-el-package-help-message
|
||||
helm-M-x-help-message
|
||||
helm-imenu-help-message
|
||||
helm-colors-help-message
|
||||
|
@ -2260,6 +2261,66 @@ See [[Moving in `helm-buffer'][Moving in `helm-buffer']].
|
|||
|\\[helm-top-run-sort-by-user]|Sort alphabetically by user.
|
||||
|\\[helm-top-run-sort-by-mem]|Sort by memory.")
|
||||
|
||||
;;; Helm Elisp package
|
||||
;;
|
||||
;;
|
||||
(defvar helm-el-package-help-message
|
||||
"* Helm Elisp package
|
||||
|
||||
** Tips
|
||||
|
||||
*** Compile all your packages asynchronously
|
||||
|
||||
If you use async (if you have installed Helm from MELPA you do), only \"helm\",
|
||||
\"helm-core\", and \"magit\" are compiled asynchronously. If you want all your
|
||||
packages compiled asynchronously, add this to your init file:
|
||||
|
||||
(setq async-bytecomp-allowed-packages '(all))
|
||||
|
||||
*** Upgrade Elisp packages
|
||||
|
||||
On initialization (when Emacs is fetching packages on remote), if Helm finds
|
||||
packages to upgrade, it will start in the upgradable packages view showing the packages
|
||||
available for upgrade.
|
||||
|
||||
On subsequent runs, you will have to refresh the list with `C-c \\[universal-argument]'. If Helm
|
||||
finds upgrades you can switch to upgrade view (see below) to see what packages
|
||||
are available for upgrade or simply hit `C-c U' to upgrade them all.
|
||||
|
||||
To see upgradable packages hit `M-U'.
|
||||
|
||||
Then you can install all upgradable packages with the \"upgrade all\" action
|
||||
\(`C-c \\[universal-argument]'), or upgrade only specific packages by marking them and running the
|
||||
\"upgrade\" action (visible only when there are upgradable packages). Of course
|
||||
you can upgrade a single package by just running the \"upgrade\" action without
|
||||
marking it (`C-c u' or `RET') .
|
||||
|
||||
\*Warning:* You are strongly advised to \*restart* Emacs after \*upgrading* packages.
|
||||
|
||||
*** Meaning of flags prefixing packages
|
||||
|
||||
\(Emacs ≥25)
|
||||
|
||||
- The flag \"S\" that prefixes package names means that the packages belong to `package-selected-packages'.
|
||||
|
||||
- The flag \"U\" that prefix package names mean that this package is no more needed.
|
||||
|
||||
** Commands
|
||||
\\<helm-el-package-map>
|
||||
|Keys|Description
|
||||
|-----------+----------|
|
||||
|\\[helm-el-package-show-all]|Show all packages.
|
||||
|\\[helm-el-package-show-installed]|Show installed packages only.
|
||||
|\\[helm-el-package-show-uninstalled]|Show non-installed packages only.
|
||||
|\\[helm-el-package-show-upgrade]|Show upgradable packages only.
|
||||
|\\[helm-el-package-show-built-in]|Show built-in packages only.
|
||||
|\\[helm-el-run-package-install]|Install package(s).
|
||||
|\\[helm-el-run-package-reinstall]|Reinstall package(s).
|
||||
|\\[helm-el-run-package-uninstall]|Uninstall package(s).
|
||||
|\\[helm-el-run-package-upgrade]|Upgrade package(s).
|
||||
|\\[helm-el-run-package-upgrade-all]|Upgrade all packages.
|
||||
|\\[helm-el-run-visit-homepage]|Visit package homepage.")
|
||||
|
||||
;;; Helm M-x
|
||||
;;
|
||||
;;
|
|
@ -241,7 +241,7 @@ The sexp should be an `all-the-icons' function with its args."
|
|||
(with-helm-window
|
||||
(let* ((fn (lambda ()
|
||||
(let ((str (buffer-substring
|
||||
(pos-bol) (pos-eol))))
|
||||
(point-at-bol) (point-at-eol))))
|
||||
(if helm-imenu-hide-item-type-name
|
||||
(get-text-property 1 'type-name str)
|
||||
(car (split-string str helm-imenu-delimiter))))))
|
||||
|
@ -311,7 +311,7 @@ The sexp should be an `all-the-icons' function with its args."
|
|||
(let ((cur (helm-get-selection))
|
||||
(mb (with-helm-current-buffer
|
||||
(save-excursion
|
||||
(goto-char (pos-bol))
|
||||
(goto-char (point-at-bol))
|
||||
(point-marker)))))
|
||||
;; Happen when cursor is on the line where a definition is. This
|
||||
;; prevent jumping to the definition where we are already, instead
|
308
code/elpa/helm-20230727.1557/helm-info.el
Normal file
308
code/elpa/helm-20230727.1557/helm-info.el
Normal file
|
@ -0,0 +1,308 @@
|
|||
;;; helm-info.el --- Browse info index with helm -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-lib)
|
||||
(require 'helm-utils)
|
||||
(require 'info)
|
||||
|
||||
(declare-function Info-index-nodes "info" (&optional file))
|
||||
(declare-function Info-goto-node "info" (&optional fork))
|
||||
(declare-function Info-find-node "info" (filename nodename &optional no-going-back))
|
||||
(declare-function ring-insert "ring")
|
||||
(declare-function ring-empty-p "ring")
|
||||
(declare-function ring-ref "ring")
|
||||
(defvar Info-history)
|
||||
(defvar Info-directory-list)
|
||||
;; `Info-minibuf-history' is not declared in Emacs, see emacs bug/58786.
|
||||
(when (and (> emacs-major-version 28)
|
||||
(not (boundp 'Info-minibuf-history)))
|
||||
(defvar Info-minibuf-history nil))
|
||||
|
||||
|
||||
;;; Customize
|
||||
|
||||
(defgroup helm-info nil
|
||||
"Info-related applications and libraries for Helm."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-info-default-sources
|
||||
'(helm-source-info-elisp
|
||||
helm-source-info-cl
|
||||
helm-source-info-eieio
|
||||
helm-source-info-pages)
|
||||
"Default sources to use for looking up symbols at point in Info
|
||||
files with `helm-info-at-point'."
|
||||
:group 'helm-info
|
||||
:type '(repeat (choice symbol)))
|
||||
|
||||
;;; Build info-index sources with `helm-info-source' class.
|
||||
|
||||
(cl-defun helm-info-init (&optional (file (helm-get-attr 'info-file)))
|
||||
"Initialize candidates for info FILE.
|
||||
If FILE have nodes, loop through all nodes and accumulate candidates
|
||||
found in each node, otherwise scan only the current info buffer."
|
||||
;; Allow reinit candidate buffer when using edebug.
|
||||
(helm-aif (and debug-on-error
|
||||
(helm-candidate-buffer))
|
||||
(kill-buffer it))
|
||||
(unless (helm-candidate-buffer)
|
||||
(save-selected-window
|
||||
(info file " *helm info temp buffer*")
|
||||
(let ((tobuf (helm-candidate-buffer 'global))
|
||||
Info-history)
|
||||
(helm-aif (Info-index-nodes)
|
||||
(dolist (node it)
|
||||
(Info-goto-node node)
|
||||
(helm-info-scan-current-buffer tobuf))
|
||||
(helm-info-scan-current-buffer tobuf))
|
||||
(bury-buffer)))))
|
||||
|
||||
(defun helm-info-scan-current-buffer (tobuf)
|
||||
"Scan current info buffer and print lines to TOBUF.
|
||||
Argument TOBUF is the `helm-candidate-buffer'."
|
||||
(let (start end line)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "\n* " nil t)
|
||||
(unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
|
||||
(setq start (point-at-bol)
|
||||
;; Fix Bug#1503 by getting the invisible
|
||||
;; info displayed on next line in long strings.
|
||||
;; e.g "* Foo.\n (line 12)" instead of
|
||||
;; "* Foo.(line 12)"
|
||||
end (or (save-excursion
|
||||
(goto-char (point-at-bol))
|
||||
(re-search-forward "(line +[0-9]+)" nil t))
|
||||
(point-at-eol))
|
||||
;; Long string have a new line inserted before the
|
||||
;; invisible spec, remove it.
|
||||
line (replace-regexp-in-string
|
||||
"\n" "" (buffer-substring start end)))
|
||||
(with-current-buffer tobuf
|
||||
(insert line)
|
||||
(insert "\n"))))))
|
||||
|
||||
(defun helm-info-goto (node-line)
|
||||
"The helm-info action to jump to NODE-LINE."
|
||||
(let ((alive (buffer-live-p (get-buffer "*info*"))))
|
||||
(Info-goto-node (car node-line))
|
||||
(when alive (revert-buffer nil t))
|
||||
(helm-goto-line (cdr node-line))))
|
||||
|
||||
(defvar helm-info--node-regexp
|
||||
"^\\* +\\(.+\\):[[:space:]]+\\(.*\\)\\(?:[[:space:]]*\\)(line +\\([0-9]+\\))"
|
||||
"A regexp that should match file name, node name and line number in
|
||||
a line like this:
|
||||
|
||||
\* bind: Bash Builtins. (line 21).")
|
||||
|
||||
(defun helm-info-display-to-real (line)
|
||||
"Transform LINE to an acceptable argument for `info'.
|
||||
If line have a node use the node, otherwise use directly first name found."
|
||||
(let ((info-file (helm-get-attr 'info-file))
|
||||
nodename linum)
|
||||
(when (string-match helm-info--node-regexp line)
|
||||
(setq nodename (match-string 2 line)
|
||||
linum (match-string 3 line)))
|
||||
(if nodename
|
||||
(cons (format "(%s)%s"
|
||||
info-file
|
||||
(replace-regexp-in-string ":\\'" "" nodename))
|
||||
(string-to-number (or linum "1")))
|
||||
(cons (format "(%s)%s"
|
||||
info-file
|
||||
(helm-aand (replace-regexp-in-string "^* " "" line)
|
||||
(replace-regexp-in-string "::?.*\\'" "" it)))
|
||||
1))))
|
||||
|
||||
(defclass helm-info-source (helm-source-in-buffer)
|
||||
((info-file :initarg :info-file
|
||||
:initform nil
|
||||
:custom 'string)
|
||||
(init :initform #'helm-info-init)
|
||||
(display-to-real :initform #'helm-info-display-to-real)
|
||||
(get-line :initform #'buffer-substring)
|
||||
(action :initform '(("Goto node" . helm-info-goto)))))
|
||||
|
||||
(defmacro helm-build-info-source (fname &rest args)
|
||||
`(helm-make-source (concat "Info Index: " ,fname) 'helm-info-source
|
||||
:info-file ,fname ,@args))
|
||||
|
||||
(defun helm-build-info-index-command (name doc source buffer)
|
||||
"Define a Helm command NAME with documentation DOC.
|
||||
Arg SOURCE will be an existing helm source named
|
||||
`helm-source-info-<NAME>' and BUFFER a string buffer name."
|
||||
(defalias (intern (concat "helm-info-" name))
|
||||
(lambda ()
|
||||
(interactive)
|
||||
(helm :sources source
|
||||
:buffer buffer
|
||||
:candidate-number-limit 1000))
|
||||
doc))
|
||||
|
||||
(defun helm-define-info-index-sources (var-value &optional commands)
|
||||
"Define Helm sources named helm-source-info-<NAME>.
|
||||
Sources are generated for all entries of
|
||||
`helm-default-info-index-list'.
|
||||
If COMMANDS arg is non-nil, also build commands named
|
||||
`helm-info-<NAME>'.
|
||||
Where NAME is an element of `helm-default-info-index-list'."
|
||||
(cl-loop for str in var-value
|
||||
for sym = (intern (concat "helm-source-info-" str))
|
||||
do (set sym (helm-build-info-source str))
|
||||
when commands
|
||||
do (helm-build-info-index-command
|
||||
str (format "Predefined helm for %s info." str)
|
||||
sym (format "*helm info %s*" str))))
|
||||
|
||||
(defun helm-info-index-set (var value)
|
||||
(set var value)
|
||||
(helm-define-info-index-sources value t))
|
||||
|
||||
;;; Search Info files
|
||||
|
||||
;; `helm-info' is the main entry point here. It prompts the user for an Info
|
||||
;; file, then a term in the file's index to jump to.
|
||||
|
||||
(defvar helm-info-searched (make-ring 32)
|
||||
"Ring of previously searched Info files.")
|
||||
|
||||
(defun helm-get-info-files ()
|
||||
"Return list of Info files to use for `helm-info'.
|
||||
|
||||
Elements of the list are strings of Info file names without
|
||||
extensions (e.g., \"emacs\" for file \"emacs.info.gz\"). Info
|
||||
files are found by searching directories in
|
||||
`Info-directory-list'."
|
||||
(info-initialize) ; Build Info-directory-list from INFOPATH (Bug#2118)
|
||||
(let ((files (cl-loop for d in (or Info-directory-list
|
||||
Info-default-directory-list)
|
||||
when (file-directory-p d)
|
||||
append (directory-files d nil "\\.info"))))
|
||||
(helm-fast-remove-dups
|
||||
(cl-loop for f in files collect
|
||||
(helm-file-name-sans-extension f))
|
||||
:test 'equal)))
|
||||
|
||||
(defcustom helm-default-info-index-list
|
||||
(helm-get-info-files)
|
||||
"Info files to search in with `helm-info'."
|
||||
:group 'helm-info
|
||||
:type '(repeat (choice string))
|
||||
:set 'helm-info-index-set)
|
||||
|
||||
(defun helm-info-search-index (candidate)
|
||||
"Search the index of CANDIDATE's Info file using the function
|
||||
helm-info-<CANDIDATE>."
|
||||
(let ((helm-info-function
|
||||
(intern-soft (concat "helm-info-" candidate))))
|
||||
(when (fboundp helm-info-function)
|
||||
(funcall helm-info-function)
|
||||
(ring-insert helm-info-searched candidate))))
|
||||
|
||||
(defun helm-def-source--info-files ()
|
||||
"Return a Helm source for Info files."
|
||||
(helm-build-sync-source "Helm Info"
|
||||
:candidates
|
||||
(lambda () (copy-sequence helm-default-info-index-list))
|
||||
:candidate-number-limit 999
|
||||
:candidate-transformer
|
||||
(lambda (candidates)
|
||||
(sort candidates #'string-lessp))
|
||||
:nomark t
|
||||
:action '(("Search index" . helm-info-search-index))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-info (&optional refresh)
|
||||
"Preconfigured `helm' for searching Info files' indices.
|
||||
|
||||
With a prefix argument \\[universal-argument], set REFRESH to
|
||||
non-nil.
|
||||
|
||||
Optional parameter REFRESH, when non-nil, re-evaluates
|
||||
`helm-default-info-index-list'. If the variable has been
|
||||
customized, set it to its saved value. If not, set it to its
|
||||
standard value. See `custom-reevaluate-setting' for more.
|
||||
|
||||
REFRESH is useful when new Info files are installed. If
|
||||
`helm-default-info-index-list' has not been customized, the new
|
||||
Info files are made available."
|
||||
(interactive "P")
|
||||
(let ((default (unless (ring-empty-p helm-info-searched)
|
||||
(ring-ref helm-info-searched 0))))
|
||||
(when refresh
|
||||
(custom-reevaluate-setting 'helm-default-info-index-list))
|
||||
(helm :sources (helm-def-source--info-files)
|
||||
:buffer "*helm Info*"
|
||||
:preselect (and default
|
||||
(concat "\\_<" (regexp-quote default) "\\_>")))))
|
||||
|
||||
;;;; Info at point
|
||||
|
||||
;; `helm-info-at-point' is the main entry point here. It searches for the
|
||||
;; symbol at point through the Info sources defined in
|
||||
;; `helm-info-default-sources' and jumps to it.
|
||||
|
||||
(defvar helm-info--pages-cache nil
|
||||
"Cache for all Info pages on the system.")
|
||||
|
||||
(defvar helm-source-info-pages
|
||||
(helm-build-sync-source "Info Pages"
|
||||
:init #'helm-info-pages-init
|
||||
:candidates (lambda () helm-info--pages-cache)
|
||||
:action '(("Show with Info" .
|
||||
(lambda (node-str)
|
||||
(info (replace-regexp-in-string
|
||||
"^[^:]+: " "" node-str)))))
|
||||
:requires-pattern 2)
|
||||
"Helm source for Info pages.")
|
||||
|
||||
(defun helm-info-pages-init ()
|
||||
"Collect candidates for initial Info node Top."
|
||||
(or helm-info--pages-cache
|
||||
(let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\."))
|
||||
(save-selected-window
|
||||
(info "dir" " *helm info temp buffer*")
|
||||
(Info-find-node "dir" "top")
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward info-topic-regexp nil t)
|
||||
(push (match-string-no-properties 1)
|
||||
helm-info--pages-cache))
|
||||
(kill-buffer)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-info-at-point ()
|
||||
"Preconfigured `helm' for searching info at point."
|
||||
(interactive)
|
||||
;; Symbol at point is used as default as long as one of the sources
|
||||
;; in `helm-info-default-sources' is member of
|
||||
;; `helm-sources-using-default-as-input'.
|
||||
(cl-loop for src in helm-info-default-sources
|
||||
for name = (if (symbolp src)
|
||||
(assoc 'name (symbol-value src))
|
||||
(assoc 'name src))
|
||||
unless name
|
||||
do (warn "Couldn't build source `%S' without its info file" src))
|
||||
(helm :sources helm-info-default-sources
|
||||
:buffer "*helm info*"))
|
||||
|
||||
(provide 'helm-info)
|
||||
|
||||
;;; helm-info.el ends here
|
|
@ -29,7 +29,6 @@
|
|||
(defvar helm-completion--sorting-done)
|
||||
(defvar helm-mode)
|
||||
(defvar password-cache)
|
||||
(defvar package--builtins)
|
||||
|
||||
;; No warnings in Emacs built --without-x
|
||||
(declare-function x-file-dialog "xfns.c")
|
||||
|
@ -40,12 +39,6 @@
|
|||
(declare-function helm-lisp-completion-persistent-help "helm-elisp")
|
||||
(declare-function help--symbol-class "help-fns.el")
|
||||
(declare-function helm-get-first-line-documentation "helm-elisp")
|
||||
(declare-function package-desc-summary "package")
|
||||
(declare-function package-built-in-p "package")
|
||||
(declare-function package-desc-status "package")
|
||||
(declare-function package-get-descriptor "package")
|
||||
(declare-function print-coding-system-briefly "mul-diag.el")
|
||||
(declare-function color-rgb-to-hex "color.el")
|
||||
|
||||
(defgroup helm-mode nil
|
||||
"Enable helm completion."
|
||||
|
@ -53,6 +46,8 @@
|
|||
|
||||
(defcustom helm-completing-read-handlers-alist
|
||||
'((find-tag . helm-completing-read-default-find-tag)
|
||||
(xref-find-definitions . helm-completing-read-default-find-tag)
|
||||
(xref-find-references . helm-completing-read-default-find-tag)
|
||||
(ggtags-find-tag-dwim . helm-completing-read-default-find-tag)
|
||||
(tmm-menubar . nil)
|
||||
(find-file . nil)
|
||||
|
@ -156,16 +151,7 @@ same as
|
|||
Note that you don't need to enable `ido-mode' for this to work, see
|
||||
`helm-mode' documentation."
|
||||
:group 'helm-mode
|
||||
:type '(alist
|
||||
:key-type symbol
|
||||
:value-type (choice
|
||||
function
|
||||
(list :tag "Specify the completing-read and read-file-name handlers"
|
||||
(choice
|
||||
(const :tag "Use default helm completing-read handler" default)
|
||||
(function :tag "Use this helm completing-read function"))
|
||||
(function :tag "Use this helm read file name function"))
|
||||
(other :tag "Disabled" nil))))
|
||||
:type '(alist :key-type symbol :value-type symbol))
|
||||
|
||||
(defcustom helm-comp-read-case-fold-search helm-case-fold-search
|
||||
"Default Local setting of `helm-case-fold-search' for `helm-comp-read'.
|
||||
|
@ -239,30 +225,11 @@ A list of symbols. `helm-mode' is rejecting all lambda's, byte-code fns
|
|||
and all functions belonging in this list from `minibuffer-setup-hook'.
|
||||
This is mainly needed to prevent \"*Completions*\" buffers to popup.")
|
||||
|
||||
(defvar helm-comp-read-require-match-overrides '((describe-function . t)
|
||||
(describe-command . t)
|
||||
(describe-minor-mode . t)
|
||||
(load-theme . t)
|
||||
(describe-theme . t))
|
||||
"Allow overriding REQUIRE-MATCH completing-read arg for a specific function.")
|
||||
|
||||
(defcustom helm-completions-detailed (and (boundp 'completions-detailed)
|
||||
completions-detailed)
|
||||
"Allow providing `completions-detailed' for Emacs < 28.
|
||||
Not guaranteed to work with Emacs < 27."
|
||||
:type 'boolean
|
||||
:group 'helm-mode)
|
||||
|
||||
(defface helm-mode-prefix
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
(:background "red" :foreground "black")))
|
||||
"Face used for prefix completion."
|
||||
:group 'helm-mode)
|
||||
|
||||
(defface helm-completion-invalid
|
||||
'((t :inherit font-lock-property-name-face))
|
||||
"Face used to highlight invalid functions."
|
||||
:group 'helm-mode)
|
||||
|
||||
(defvar helm-comp-read-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
@ -370,17 +337,15 @@ NOT `setq'."
|
|||
"Allow configuring `helm-completion-style' per mode or command.
|
||||
|
||||
NOTE: Use a mode for a completion that will be used in a buffer
|
||||
i.e. completion-in-region, whereas you have to specify instead a
|
||||
command to affect the completing-read trigerred by this
|
||||
command. Commands specified in `helm-completing-read-handlers-alist' take
|
||||
precedence on commands you put here.
|
||||
i.e. completion-in-region, whereas you have to specify instead a command to
|
||||
affect the completing-read trigerred by this command.
|
||||
|
||||
Each entry is a cons cell like (mode . style) where style must be
|
||||
a suitable value for `helm-completion-style'. When specifying
|
||||
emacs as style for a mode or a command, `completion-styles' can
|
||||
be specified by using a cons cell specifying completion-styles to
|
||||
use with helm emacs style, e.g. (foo-mode . (emacs helm flex))
|
||||
will set `completion-styles' to \\='(helm flex) for foo-mode."
|
||||
Each entry is a cons cell like (mode . style) where style must be a
|
||||
suitable value for `helm-completion-style'.
|
||||
When specifying emacs as style for a mode or a command, `completion-styles' can be
|
||||
specified by using a cons cell specifying completion-styles to use
|
||||
with helm emacs style, e.g. (foo-mode . (emacs helm flex)) will set
|
||||
`completion-styles' to \\='(helm flex) for foo-mode."
|
||||
:group 'helm-mode
|
||||
:type
|
||||
`(alist :key-type (symbol :tag "Major Mode")
|
||||
|
@ -560,16 +525,19 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
|
|||
(eq must-match t)
|
||||
(helm-cr--pattern-in-candidates-p lst pat))
|
||||
lst
|
||||
(append (list (cons (helm-aand (propertize "[?]" 'face 'helm-ff-prefix)
|
||||
(propertize " " 'display it 'unknown t)
|
||||
(concat it pat))
|
||||
(append (list (cons (concat (propertize
|
||||
" " 'display
|
||||
(propertize "[?]"
|
||||
'face 'helm-ff-prefix
|
||||
'unknown t))
|
||||
pat)
|
||||
pat))
|
||||
lst))))))
|
||||
|
||||
(defun helm-comp-read--move-to-first-real-candidate ()
|
||||
(helm-aif (helm-get-selection nil 'withprop)
|
||||
;; Avoid error with candidates with an image as display (Bug#2296).
|
||||
(when (helm-candidate-prefixed-p it)
|
||||
(when (get-text-property 0 'helm-new-file it)
|
||||
(helm-next-line))))
|
||||
|
||||
(defun helm-cr-default (default cands)
|
||||
|
@ -584,10 +552,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
|
|||
do (setq cands (delete d cands))
|
||||
when str collect str)
|
||||
cands))
|
||||
;; Some functions like debug-on-entry use (symbol-name sym)
|
||||
;; without checking if sym is non nil, so the return value become
|
||||
;; "nil".
|
||||
((and (not (member default '("" "nil")))
|
||||
((and (not (equal default ""))
|
||||
(string= helm-pattern ""))
|
||||
(cons default (delete (helm-stringify default)
|
||||
cands)))
|
||||
|
@ -877,10 +842,8 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
|||
:multiline multiline
|
||||
:header-name header-name
|
||||
:filtered-candidate-transformer
|
||||
(let ((transformers (helm-mklist fc-transformer)))
|
||||
(append transformers
|
||||
(unless (member 'helm-cr-default-transformer transformers)
|
||||
'(helm-cr-default-transformer))))
|
||||
(append (helm-mklist fc-transformer)
|
||||
'(helm-cr-default-transformer))
|
||||
:requires-pattern requires-pattern
|
||||
:persistent-action persistent-action
|
||||
:fuzzy-match fuzzy
|
||||
|
@ -980,285 +943,7 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
|||
:default (or default ""))
|
||||
(helm-mode--keyboard-quit)))
|
||||
|
||||
|
||||
;;; Extra metadata for completions-detailed
|
||||
;;
|
||||
;;
|
||||
(defvar helm-completing-read-extra-metadata
|
||||
'((buffer . (metadata
|
||||
(affixation-function . helm-completing-read-buffer-affixation)
|
||||
(category . buffer)
|
||||
(flags . (helm-completing-read--buffer-lgst-mode))))
|
||||
(symbol-help . (metadata
|
||||
(affixation-function . helm-symbol-completion-table-affixation)
|
||||
(category . symbol-help)))
|
||||
(package . (metadata
|
||||
(affixation-function . helm-completion-package-affixation)
|
||||
(category . package)))
|
||||
(theme . (metadata
|
||||
(affixation-function . helm-completion-theme-affixation)
|
||||
(category . theme)))
|
||||
(coding-system . (metadata
|
||||
(affixation-function . helm-completion-coding-system-affixation)
|
||||
(category . coding-system)))
|
||||
(color . (metadata
|
||||
(affixation-function . helm-completion-color-affixation)
|
||||
(category . color))))
|
||||
"Extra metadata for completing-read.
|
||||
|
||||
Alist composed of (CATEGORY . METADATA).
|
||||
CATEGORY is extracted from original metadata and METADATA is a list composed
|
||||
like this:
|
||||
(metadata (affixation-function . fun)
|
||||
(annotation-function . fun)
|
||||
(category . category)
|
||||
(flags . flags))
|
||||
|
||||
FLAGS is a list of variables to renitialize to nil when exiting or quitting.
|
||||
|
||||
It is used to add `affixation-function' or `annotation-function' if original
|
||||
metadata doesn't have some and `completions-detailed' is non nil.
|
||||
When using emacs as `helm-completion-style', this has no effect, keeping same
|
||||
behavior as emacs vanilla.")
|
||||
|
||||
(defvar helm-completing-read-command-categories
|
||||
'(("customize-variable" . symbol-help)
|
||||
("customize-set-variable" . symbol-help)
|
||||
("customize-set-value" . symbol-help)
|
||||
("customize-save-variable" . symbol-help)
|
||||
("describe-function" . symbol-help); For Emacs-27.
|
||||
("describe-variable" . symbol-help); For Emacs-27.
|
||||
("describe-symbol" . symbol-help) ; For Emacs-27.
|
||||
("describe-command" . symbol-help) ; For Emacs-27.
|
||||
("set-variable" . symbol-help)
|
||||
("customize-group" . symbol-help)
|
||||
("find-function" . symbol-help)
|
||||
("find-variable" . symbol-help)
|
||||
("trace-function" . symbol-help)
|
||||
("trace-function-foreground" . symbol-help)
|
||||
("trace-function-background" . symbol-help)
|
||||
("describe-minor-mode" . symbol-help)
|
||||
("find-library" . library)
|
||||
("kill-buffer" . buffer)
|
||||
("package-install" . package)
|
||||
("package-vc-install" . package)
|
||||
("package-vc-checkout" . package)
|
||||
("describe-package" . package)
|
||||
("load-theme" . theme)
|
||||
("describe-theme" . theme)
|
||||
("describe-coding-system" . coding-system)
|
||||
("read-color" . color))
|
||||
"An alist to specify metadata category by command.
|
||||
|
||||
Some commands provide a completion-table with no category
|
||||
specified in metadata, we allow here specifying the category of
|
||||
the completion provided by a specific command. The command
|
||||
should be specified as a string and the category as a symbol.")
|
||||
|
||||
(defvar helm-completing-read--buffer-lgst-mode nil)
|
||||
(defun helm-completing-read-buffer-affixation (completions)
|
||||
(let ((len-mode (or helm-completing-read--buffer-lgst-mode
|
||||
(cl-loop for bn in completions
|
||||
maximize (with-current-buffer bn
|
||||
(length (symbol-name major-mode)))))))
|
||||
(lambda (comp)
|
||||
(let* ((buf (get-buffer comp))
|
||||
(fname (buffer-file-name buf))
|
||||
(modified (and fname (buffer-modified-p buf)))
|
||||
(prefix (cond (modified
|
||||
(propertize
|
||||
"fm " 'face 'font-lock-comment-face))
|
||||
(fname
|
||||
(propertize
|
||||
" f " 'face 'font-lock-property-name-face))
|
||||
(t (propertize "nf " 'face 'font-lock-doc-face))))
|
||||
(mode (with-current-buffer comp
|
||||
(propertize
|
||||
(symbol-name major-mode) 'face 'font-lock-warning-face)))
|
||||
(size (helm-buffer-size buf))
|
||||
(max-len helm-buffer-max-length)
|
||||
(bname (truncate-string-to-width
|
||||
comp helm-buffer-max-length nil nil
|
||||
helm-buffers-end-truncated-string))
|
||||
(suffix (format "%s%s%s%s%s(in %s)"
|
||||
(make-string (1+ (- max-len (length bname))) ? )
|
||||
(propertize size
|
||||
'face 'helm-buffer-size)
|
||||
(make-string (- 7 (length size)) ? )
|
||||
mode
|
||||
(make-string (1+ (- len-mode (length mode))) ? )
|
||||
(helm-aif fname
|
||||
(propertize
|
||||
(abbreviate-file-name (file-name-directory it))
|
||||
'face 'font-lock-type-face)
|
||||
(propertize
|
||||
(with-current-buffer comp
|
||||
(abbreviate-file-name default-directory))
|
||||
'face 'font-lock-doc-face)))))
|
||||
(list (propertize
|
||||
bname 'face (if fname
|
||||
'font-lock-builtin-face
|
||||
'font-lock-doc-face))
|
||||
(propertize " " 'display prefix)
|
||||
(propertize " " 'display suffix))))))
|
||||
|
||||
(defun helm-symbol-completion-table-affixation (_completions)
|
||||
"Override `help--symbol-completion-table-affixation'.
|
||||
|
||||
Normally affixation functions use COMPLETIONS as arg, and return a list of
|
||||
modified COMPLETIONS. Now we allow affixations functions to return a
|
||||
function instead, just like annotation functions. The function should return a
|
||||
list of three elements like (comp prefix suffix). This increase significantly
|
||||
the speed avoiding one useless loop on complete list of candidates.
|
||||
|
||||
Returns a function and not a list of completions.
|
||||
|
||||
It affects actually describe-variable/function/command/symbol functions.
|
||||
It uses `helm-get-first-line-documentation' which allow providing documentation
|
||||
for `describe-variable' symbols and align properly documentation when helm style
|
||||
is used."
|
||||
(lambda (comp)
|
||||
(require 'help-fns)
|
||||
(let* ((sym (intern comp))
|
||||
;; When using in-buffer implementation we should have the
|
||||
;; longest len to align documentation for free.
|
||||
;; Check for style as well in case user switches to emacs
|
||||
;; style and a candidate buffer remains (with its local vars
|
||||
;; still available).
|
||||
(max-len (and (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(helm-in-buffer-get-longest-candidate)))
|
||||
(sep (if (or (null max-len) (zerop max-len))
|
||||
" --" ; Default separator.
|
||||
(make-string (- max-len (length comp)) ? )))
|
||||
(doc (ignore-errors
|
||||
(helm-get-first-line-documentation sym)))
|
||||
(symbol-class (help--symbol-class sym))
|
||||
(group (helm-group-p sym)))
|
||||
(list
|
||||
;; Symbol (comp).
|
||||
(if (or (symbol-function sym) (boundp sym)
|
||||
(facep sym) group)
|
||||
comp
|
||||
;; Not already defined function. To test add an advice on a non
|
||||
;; existing function.
|
||||
(propertize comp 'face 'helm-completion-invalid))
|
||||
;; Prefix.
|
||||
(helm-aand (propertize
|
||||
(cond ((and symbol-class group)
|
||||
(concat "g" symbol-class))
|
||||
((and (not (string= symbol-class ""))
|
||||
symbol-class))
|
||||
(group "g")
|
||||
(t "i"))
|
||||
'face 'completions-annotations)
|
||||
(propertize " " 'display (format "%-4s" it)))
|
||||
;; Suffix.
|
||||
(if doc
|
||||
(helm-aand (propertize doc 'face 'completions-annotations)
|
||||
(propertize " " 'display (concat sep it)))
|
||||
"")))))
|
||||
|
||||
(defun helm-completion-package-affixation (_completions)
|
||||
(lambda (comp)
|
||||
(let* ((sym (intern-soft comp))
|
||||
(id (package-get-descriptor sym))
|
||||
(built-in (package-built-in-p sym))
|
||||
(status (and id (package-desc-status id)))
|
||||
(desc (if built-in
|
||||
(aref (assoc-default sym package--builtins) 2)
|
||||
(and id (package-desc-summary id))))
|
||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? )))
|
||||
(list comp
|
||||
(propertize
|
||||
(if status
|
||||
(format "%s " (substring status 0 1))
|
||||
"b ")
|
||||
'face 'font-lock-property-name-face)
|
||||
(or (helm-aand desc
|
||||
(propertize it 'face 'font-lock-warning-face)
|
||||
(propertize " " 'display (concat sep it)))
|
||||
"")))))
|
||||
|
||||
(defun helm-completion-theme-affixation (_completions)
|
||||
(lambda (comp)
|
||||
(let* ((sym (intern-soft comp))
|
||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? ))
|
||||
(doc (if (custom-theme-p sym)
|
||||
(helm-get-first-line-documentation sym)
|
||||
(helm--get-theme-doc-1 sym))))
|
||||
(list comp
|
||||
""
|
||||
(helm-aand (propertize doc 'face 'font-lock-warning-face)
|
||||
(propertize " " 'display (concat sep it)))))))
|
||||
|
||||
(defun helm--get-theme-doc-1 (sym)
|
||||
(let ((fn (locate-file (concat (symbol-name sym) "-theme.el")
|
||||
(custom-theme--load-path)
|
||||
'("" "c")))
|
||||
doc)
|
||||
;; Avoid loading theme as much as possible.
|
||||
(when fn
|
||||
(with-temp-buffer
|
||||
(insert-file-contents fn)
|
||||
(helm-awhile (let ((read-circle nil))
|
||||
(condition-case nil
|
||||
(read (current-buffer))
|
||||
(end-of-file nil)))
|
||||
(when (eq (car-safe it) 'deftheme)
|
||||
(cl-return (setq doc (car (split-string (nth 2 it) "\n"))))))
|
||||
(unless doc
|
||||
(setq doc (helm--get-theme-doc-from-header)))))
|
||||
doc))
|
||||
|
||||
(defun helm--get-theme-doc-from-header ()
|
||||
"Extract doc in first line of theme file."
|
||||
(goto-char (point-min))
|
||||
(let (beg end)
|
||||
(when (re-search-forward "--- " (pos-eol) t)
|
||||
(setq beg (point)))
|
||||
(if (re-search-forward " -\\*-" (pos-eol) t)
|
||||
(setq end (match-beginning 0))
|
||||
(setq end (pos-eol)))
|
||||
(when (and beg end)
|
||||
(buffer-substring beg end))))
|
||||
|
||||
(defun helm-completion-coding-system-affixation (_comps)
|
||||
(lambda (comp)
|
||||
(let ((doc (with-output-to-string
|
||||
(with-current-buffer standard-output
|
||||
(print-coding-system-briefly (intern comp) 'tightly))))
|
||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? )))
|
||||
(list comp "" (helm-aand (replace-regexp-in-string "^ *" "" doc)
|
||||
(replace-regexp-in-string "[\n]" "" it)
|
||||
(propertize it 'face 'font-lock-warning-face)
|
||||
(propertize " " 'display (concat sep it)))))))
|
||||
|
||||
(defun helm-completion-color-affixation (_comps)
|
||||
(lambda (comp)
|
||||
(let ((sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? ))
|
||||
(rgb (condition-case nil
|
||||
(helm-acase comp
|
||||
("foreground at point" (with-helm-current-buffer
|
||||
(foreground-color-at-point)))
|
||||
("background at point" (with-helm-current-buffer
|
||||
(background-color-at-point)))
|
||||
(t
|
||||
(apply #'color-rgb-to-hex (color-name-to-rgb comp))))
|
||||
(error "SAMPLE"))))
|
||||
(list comp
|
||||
""
|
||||
(helm-aand (propertize rgb 'face `(:background ,rgb
|
||||
:distant-foreground "black"))
|
||||
(propertize " " 'display (concat sep it)))))))
|
||||
|
||||
;;; Generic completing read
|
||||
;;
|
||||
;;
|
||||
|
@ -1266,10 +951,7 @@ is used."
|
|||
(prompt collection test require-match
|
||||
init hist default _inherit-input-method
|
||||
name buffer &optional cands-in-buffer exec-when-only-one alistp get-line)
|
||||
"Helm `completing-read' handler not rebuilding its candidates dynamically.
|
||||
|
||||
It is used usually with helm or helm-fuzzy `helm-completion-style'.
|
||||
Call `helm-comp-read' with same args as `completing-read'.
|
||||
"Call `helm-comp-read' with same args as `completing-read'.
|
||||
|
||||
Extra optional arg CANDS-IN-BUFFER means use `candidates-in-buffer'
|
||||
method which is faster.
|
||||
|
@ -1282,7 +964,7 @@ When using CANDS-IN-BUFFER, GET-LINE can be specified to exit with candidate
|
|||
handling properties, see `helm-comp-read'.
|
||||
|
||||
This handler should be used when candidate list doesn't need to be rebuilt
|
||||
dynamically otherwise use `helm-completing-read-default-2'."
|
||||
dynamically otherwise see `helm-completing-read-default-2'."
|
||||
(let* ((history (or (car-safe hist) hist))
|
||||
(initial-input (helm-aif (pcase init
|
||||
((pred (stringp)) init)
|
||||
|
@ -1296,27 +978,14 @@ dynamically otherwise use `helm-completing-read-default-2'."
|
|||
(completion-metadata-get metadata 'annotation-function)))
|
||||
(afix (or (plist-get completion-extra-properties :affixation-function)
|
||||
(completion-metadata-get metadata 'affixation-function)))
|
||||
(category (completion-metadata-get metadata 'category))
|
||||
(sort-fn (unless (eq helm-completion-style 'helm-fuzzy)
|
||||
(or
|
||||
(file-comp-p (eq (completion-metadata-get metadata 'category) 'file))
|
||||
(sort-fn (or
|
||||
;; Emacs-27+
|
||||
(completion-metadata-get
|
||||
metadata 'display-sort-function)
|
||||
;; Emacs-26
|
||||
(lambda (candidates)
|
||||
(sort candidates #'helm-generic-sort-fn)))))
|
||||
flags)
|
||||
(helm-aif (and (null category)
|
||||
(assoc-default name helm-completing-read-command-categories))
|
||||
(setq metadata `(metadata (category . ,it))
|
||||
category it))
|
||||
(helm-aif (and (or (and (boundp 'completions-detailed) completions-detailed)
|
||||
helm-completions-detailed)
|
||||
(assoc-default category helm-completing-read-extra-metadata))
|
||||
(progn
|
||||
(setq metadata it)
|
||||
(setq afun (completion-metadata-get metadata 'annotation-function)
|
||||
afix (completion-metadata-get metadata 'affixation-function)
|
||||
flags (completion-metadata-get metadata 'flags))))
|
||||
(unwind-protect
|
||||
(helm-comp-read
|
||||
prompt collection
|
||||
:test test
|
||||
|
@ -1330,16 +999,21 @@ dynamically otherwise use `helm-completing-read-default-2'."
|
|||
:name name
|
||||
:requires-pattern (if (and (stringp default)
|
||||
(string= default "")
|
||||
(memq require-match
|
||||
'(confirm confirm-after-completion)))
|
||||
(or (eq require-match 'confirm)
|
||||
(eq require-match
|
||||
'confirm-after-completion)))
|
||||
1 0)
|
||||
:fc-transformer (append (and (or afix afun (memq category '(file library)) sort-fn)
|
||||
(list (lambda (candidates _source)
|
||||
(helm-completion--initial-filter
|
||||
(if (and sort-fn (> (length helm-pattern) 0))
|
||||
(funcall sort-fn candidates)
|
||||
candidates)
|
||||
afun afix category))))
|
||||
:fc-transformer (append (list (lambda (candidates _source)
|
||||
(helm-completion-in-region--initial-filter
|
||||
(let* ((all (copy-sequence candidates))
|
||||
(lst (if (and sort-fn (> (length helm-pattern) 0))
|
||||
(funcall sort-fn all)
|
||||
all)))
|
||||
(if (and default (string= helm-pattern ""))
|
||||
(append (list default)
|
||||
(delete default lst))
|
||||
lst))
|
||||
afun afix file-comp-p)))
|
||||
'(helm-cr-default-transformer))
|
||||
:quit-when-no-cand (eq require-match t)
|
||||
:nomark (null helm-comp-read-use-marked)
|
||||
|
@ -1355,17 +1029,14 @@ dynamically otherwise use `helm-completing-read-default-2'."
|
|||
;; if regexp-quote is not used.
|
||||
;; when init is added to history, it will be unquoted by
|
||||
;; helm-comp-read.
|
||||
:initial-input initial-input)
|
||||
(dolist (f flags) (set f nil)))))
|
||||
:initial-input initial-input)))
|
||||
|
||||
(defun helm-completing-read-default-2
|
||||
(prompt collection predicate require-match
|
||||
init hist default _inherit-input-method
|
||||
name buffer &optional _cands-in-buffer exec-when-only-one)
|
||||
"Helm `completing-read' handler with dynamic matching.
|
||||
"Call `helm-comp-read' with same args as `completing-read'.
|
||||
|
||||
Call `helm-comp-read' with same args as `completing-read'.
|
||||
For the meaning of optional args see `helm-completing-read-default-1'.
|
||||
This handler uses dynamic matching which allows honouring `completion-styles'."
|
||||
(let* ((history (or (car-safe hist) hist))
|
||||
(input (pcase init
|
||||
|
@ -1382,7 +1053,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(completion-metadata-get metadata 'annotation-function)))
|
||||
(afix (or (plist-get completion-extra-properties :affixation-function)
|
||||
(completion-metadata-get metadata 'affixation-function)))
|
||||
(category (completion-metadata-get metadata 'category))
|
||||
(file-comp-p (eq (completion-metadata-get metadata 'category) 'file))
|
||||
(compfn (lambda (str _predicate _action)
|
||||
(let* ((completion-ignore-case (helm-set-case-fold-search))
|
||||
(comps
|
||||
|
@ -1424,7 +1095,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(append (and default
|
||||
(memq helm-completion-style '(helm helm-fuzzy))
|
||||
(list default))
|
||||
(helm-completion--initial-filter
|
||||
(helm-completion-in-region--initial-filter
|
||||
(let ((lst (if (and sort-fn (> (length str) 0))
|
||||
(funcall sort-fn all)
|
||||
all)))
|
||||
|
@ -1433,7 +1104,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(delete default lst))
|
||||
(setq default nil))
|
||||
lst))
|
||||
afun afix category)))))
|
||||
afun afix file-comp-p)))))
|
||||
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(funcall compfn (or input "") nil nil)
|
||||
compfn))
|
||||
|
@ -1473,7 +1144,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(defun helm-mode-all-the-icons-handler (prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
name buffer)
|
||||
"Helm `completing-read' handler for `all-the-icons-insert'."
|
||||
"A special `completing-read' handler for `all-the-icons-insert'."
|
||||
(let* ((max-len 0)
|
||||
sname
|
||||
(cands (cl-loop for (desc . str) in collection
|
||||
|
@ -1515,7 +1186,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
name buffer)
|
||||
"Helm `completing-read' handler for `find-tag'."
|
||||
"Specialized `helm-mode' handler for `find-tag'."
|
||||
;; Some commands like find-tag may use `read-file-name' from inside
|
||||
;; the calculation of collection. in this case it clash with
|
||||
;; candidates-in-buffer that reuse precedent data (files) which is wrong.
|
||||
|
@ -1530,7 +1201,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
name buffer)
|
||||
"Helm `completing-read' handler using sync source as backend."
|
||||
"`helm-mode' handler using sync source as backend."
|
||||
(helm-completing-read-default-1 prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
name buffer))
|
||||
|
@ -1539,7 +1210,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
name buffer)
|
||||
"Helm `completing-read' handler using inbuffer source as backend."
|
||||
"`helm-mode' handler using inbuffer source as backend."
|
||||
(helm-completing-read-default-1 prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
name buffer t))
|
||||
|
@ -1548,10 +1219,7 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
name buffer)
|
||||
"Default Helm `completing-read' handler.
|
||||
|
||||
Use either `helm-completing-read-default-1' or `helm-completing-read-default-2'
|
||||
according to `helm-completion-style'."
|
||||
"Default `helm-mode' handler for all `completing-read'."
|
||||
(let* (;; Standard will be used as CANDS-IN-BUFFER arg.
|
||||
(standard (and (memq helm-completion-style '(helm helm-fuzzy)) t))
|
||||
(fn (if standard
|
||||
|
@ -1643,10 +1311,7 @@ See documentation of `completing-read' and `all-completions' for details."
|
|||
helm-completing-read-handlers-alist))
|
||||
(def-com (helm-mode--get-default-handler-for 'comp entry))
|
||||
(str-defcom (and def-com (helm-symbol-name def-com)))
|
||||
(def-args (list prompt collection predicate
|
||||
(helm-aif (assq current-command
|
||||
helm-comp-read-require-match-overrides)
|
||||
(cdr it) require-match)
|
||||
(def-args (list prompt collection predicate require-match
|
||||
initial-input hist def inherit-input-method))
|
||||
;; Append the two extra args needed to set the buffer and source name
|
||||
;; in helm specialized functions.
|
||||
|
@ -1893,9 +1558,9 @@ Keys description:
|
|||
(remhash helm-ff-default-directory
|
||||
helm-ff--list-directory-cache))
|
||||
:match-on-real t
|
||||
:filtered-candidate-transformer '(helm-ff-fct
|
||||
:filtered-candidate-transformer (delq nil `(helm-ff-fct
|
||||
helm-ff-maybe-show-thumbnails
|
||||
helm-ff-sort-candidates)
|
||||
helm-ff-sort-candidates))
|
||||
:persistent-action-if persistent-action-if
|
||||
:persistent-help persistent-help
|
||||
:volatile t
|
||||
|
@ -2150,48 +1815,42 @@ The `helm-find-files' history `helm-ff-history' is used here."
|
|||
(propertize str 'read-only t 'face 'helm-mode-prefix 'rear-nonsticky t)
|
||||
str))
|
||||
|
||||
(defun helm-completion--initial-filter (comps afun afix category)
|
||||
"Compute COMPS with function AFIX or AFUN.
|
||||
(defun helm--symbol-completion-table-affixation (completions)
|
||||
"Same as `help--symbol-completion-table-affixation' but for helm.
|
||||
|
||||
When CATEGORY is file or library remove dot files from COMPS.
|
||||
Return a list of cons cells of the form (disp . real)."
|
||||
(mapcar (lambda (c)
|
||||
(let* ((s (intern c))
|
||||
(doc (ignore-errors
|
||||
(helm-get-first-line-documentation s))))
|
||||
(cons (concat (propertize
|
||||
(format "%-4s" (help--symbol-class s))
|
||||
'face 'completions-annotations)
|
||||
c
|
||||
(if doc
|
||||
(propertize (format " -- %s" doc)
|
||||
'face 'completions-annotations)
|
||||
""))
|
||||
c)))
|
||||
completions))
|
||||
|
||||
If both AFUN and AFIX are provided, AFIX takes precedence.
|
||||
(defun helm-completion-in-region--initial-filter (comps afun afix file-comp-p)
|
||||
"Compute COMPS with function AFUN or AFIX unless FILE-COMP-P non nil.
|
||||
|
||||
When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
|
||||
;; Normally COMPS should be a list of
|
||||
;; string but in some cases it is given as a list of strings containing a list
|
||||
;; of string e.g. ("a" "b" "c" ("d" "e" "f")) ; This happen in rgrep
|
||||
;; (bug#2607) and highlight-* fns (bug #2610), so ensure the list is flattened to
|
||||
;; avoid e.g. wrong-type argument: stringp '("d" "e" "f")
|
||||
;; FIXME: If this create a new bug with completion-in-region, flatten COMPS
|
||||
;; directly in the caller i.e. helm-completing-read-default-1.
|
||||
(when (or afix afun (memq category '(file library)))
|
||||
(setq comps (helm-fast-remove-dups
|
||||
If both AFUN and AFIX are provided only AFIX is used.
|
||||
When FILE-COMP-P is provided only filter out dot files."
|
||||
(if file-comp-p
|
||||
;; Filter out dot files in file completion. Normally COMPS should be a
|
||||
;; list of string but in some cases it is given as a list of strings
|
||||
;; containing a list of string e.g. ("a" "b" "c" ("d" "e" "f")) ; This
|
||||
;; happen in rgrep (bug #2607), so ensure the list is flattened to avoid
|
||||
;; e.g. wrong-type argument '("d" "e" "f")
|
||||
(cl-loop for f in (helm-fast-remove-dups
|
||||
(helm-flatten-list comps)
|
||||
:test 'equal)))
|
||||
;; Filter out dot files in file completion.
|
||||
;; We were previously exiting directly without handling afix and afun, but
|
||||
;; maybe some file completion tables have an afix or afun in their metadata so
|
||||
;; let them a chance to run these functions if some.
|
||||
(when (memq category '(file library))
|
||||
(setq comps
|
||||
(cl-loop for f in comps
|
||||
:test 'equal)
|
||||
unless (string-match "\\`\\.\\{1,2\\}/\\'" f)
|
||||
collect f)))
|
||||
(cond (afix (let ((affixations (funcall afix comps)))
|
||||
(if (functionp affixations)
|
||||
(cl-loop for comp in comps
|
||||
for cand = (funcall affixations comp)
|
||||
collect (cons (propertize (concat (nth 1 cand) ;prefix
|
||||
(nth 0 cand) ;comp
|
||||
(nth 2 cand)) ;suffix
|
||||
'match-part (nth 0 cand))
|
||||
comp))
|
||||
(cl-loop for (comp prefix suffix) in affixations
|
||||
collect (cons (propertize
|
||||
(concat prefix comp suffix)
|
||||
'match-part comp)
|
||||
comp)))))
|
||||
collect f)
|
||||
(cond (afix (helm--symbol-completion-table-affixation comps))
|
||||
(afun
|
||||
;; Add annotation at end of
|
||||
;; candidate if needed, e.g. foo<f>, this happen when
|
||||
|
@ -2210,7 +1869,7 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
|
|||
s)
|
||||
s)))
|
||||
comps))
|
||||
(t comps)))
|
||||
(t comps))))
|
||||
|
||||
;; Helm multi matching style
|
||||
|
||||
|
@ -2450,10 +2109,11 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
(string-suffix-p " " input)
|
||||
(string= input ""))
|
||||
" "))
|
||||
(category (or (eq (completion-metadata-get metadata 'category) 'file)
|
||||
(eq (plist-get completion-extra-properties :category) 'file)))
|
||||
(file-comp-p (or (eq category 'file)
|
||||
(helm-guess-filename-at-point)))
|
||||
(file-comp-p (or (eq (completion-metadata-get metadata 'category) 'file)
|
||||
(helm-guess-filename-at-point)
|
||||
;; Assume that when `afun' and `predicate' are null
|
||||
;; we are in filename completion.
|
||||
(and (null afun) (null predicate))))
|
||||
;; `completion-all-completions' store the base-size in the last `cdr',
|
||||
;; so data looks like this: '(a b c d . 0) and (last data) == (d . 0).
|
||||
base-size
|
||||
|
@ -2503,11 +2163,11 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
(unless base-size (setq base-size bs))
|
||||
(setq helm-completion--sorting-done (and sort-fn t))
|
||||
(setq all (copy-sequence comps))
|
||||
(helm-completion--initial-filter
|
||||
(helm-completion-in-region--initial-filter
|
||||
(if (and sort-fn (> (length str) 0))
|
||||
(funcall sort-fn all)
|
||||
all)
|
||||
afun afix category))))
|
||||
afun afix file-comp-p))))
|
||||
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(funcall compfn input nil nil)
|
||||
compfn))
|
885
code/elpa/helm-20230727.1557/helm-occur.el
Normal file
885
code/elpa/helm-20230727.1557/helm-occur.el
Normal file
|
@ -0,0 +1,885 @@
|
|||
;;; helm-occur.el --- Incremental Occur for Helm. -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'helm)
|
||||
(require 'helm-help)
|
||||
(require 'helm-utils)
|
||||
|
||||
(declare-function helm-buffers-get-visible-buffers "helm-buffers")
|
||||
(declare-function helm-buffer-list "helm-buffers")
|
||||
(declare-function helm-grep-split-line "helm-grep")
|
||||
(declare-function helm-grep-highlight-match "helm-grep")
|
||||
(declare-function helm-comp-read "helm-mode")
|
||||
|
||||
(defvar helm-current-error)
|
||||
|
||||
;;; Internals
|
||||
;;
|
||||
(defvar helm-source-occur nil
|
||||
"This will be the name of the source related to `current-buffer'.
|
||||
Don't use it as it value changes always.")
|
||||
(defvar helm-source-moccur nil
|
||||
"This is just a flag to add to `helm-sources-using-default-as-input'.
|
||||
Don't set it to any value, it will have no effect.")
|
||||
(defvar helm-occur--buffer-list nil)
|
||||
(defvar helm-occur--buffer-tick nil)
|
||||
(defvar helm-occur-history nil)
|
||||
(defvar helm-occur--search-buffer-regexp "\\`\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)\\'"
|
||||
"The regexp matching candidates in helm-occur candidate buffer.")
|
||||
(defvar helm-occur-mode--last-pattern nil)
|
||||
(defvar helm-occur--initial-pos 0)
|
||||
|
||||
(defvar helm-occur-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-map)
|
||||
(define-key map (kbd "C-c o") 'helm-occur-run-goto-line-ow)
|
||||
(define-key map (kbd "C-c C-o") 'helm-occur-run-goto-line-of)
|
||||
(define-key map (kbd "C-x C-s") 'helm-occur-run-save-buffer)
|
||||
map)
|
||||
"Keymap used in occur source.")
|
||||
|
||||
(defgroup helm-occur nil
|
||||
"Regexp related Applications and libraries for Helm."
|
||||
:group 'helm)
|
||||
|
||||
(defcustom helm-occur-actions
|
||||
'(("Go to Line" . helm-occur-goto-line)
|
||||
("Goto line other window (C-u vertically)" . helm-occur-goto-line-ow)
|
||||
("Goto line new frame" . helm-occur-goto-line-of)
|
||||
("Save buffer" . helm-occur-save-results)
|
||||
)
|
||||
"Actions for helm-occur."
|
||||
:type '(alist :key-type string :value-type function))
|
||||
|
||||
(defcustom helm-occur-use-ioccur-style-keys nil
|
||||
"Similar to `helm-grep-use-ioccur-style-keys' but for multi occur.
|
||||
|
||||
Note that if you define this variable with `setq' your change will
|
||||
have no effect, use customize instead."
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(set var val)
|
||||
(if val
|
||||
(progn
|
||||
(define-key helm-occur-map (kbd "<right>") 'helm-occur-right)
|
||||
(define-key helm-occur-map (kbd "<left>") 'helm-occur-run-default-action))
|
||||
(define-key helm-occur-map (kbd "<right>") nil)
|
||||
(define-key helm-occur-map (kbd "<left>") nil))))
|
||||
|
||||
(defcustom helm-occur-always-search-in-current nil
|
||||
"Helm multi occur always search in current buffer when non--nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-occur-truncate-lines t
|
||||
"Truncate lines in occur buffer when non nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-occur-auto-update-on-resume nil
|
||||
"Allow auto updating helm-occur buffer when outdated.
|
||||
noask => Always update without asking
|
||||
nil => Don't update but signal buffer needs update
|
||||
never => Never update and do not signal buffer needs update
|
||||
Any other non--nil value update after confirmation."
|
||||
:type '(radio :tag "Allow auto updating helm-occur buffer when outdated."
|
||||
(const :tag "Always update without asking" noask)
|
||||
(const :tag "Never update and do not signal buffer needs update" never)
|
||||
(const :tag "Don't update but signal buffer needs update" nil)
|
||||
(const :tag "Update after confirmation" t)))
|
||||
|
||||
(defcustom helm-occur-candidate-number-limit 99999
|
||||
"Value of `helm-candidate-number-limit' for helm-occur."
|
||||
:type 'integer)
|
||||
|
||||
(defcustom helm-occur-buffer-substring-fn-for-modes
|
||||
'((mu4e-headers-mode . buffer-substring))
|
||||
"Function used to display buffer contents per major-mode.
|
||||
|
||||
Use this to display lines with their text properties in helm-occur
|
||||
buffer. Can be one of `buffer-substring' or `buffer-substring-no-properties'.
|
||||
See `helm-occur-buffer-substring-default-mode' to setup this globally.
|
||||
|
||||
Note that when using `buffer-substring' initialization will be slower."
|
||||
:type '(alist :key-type (symbol :tag "Mode")
|
||||
:value-type (radio (const :tag "With text properties"
|
||||
buffer-substring)
|
||||
(const :tag "Without text properties"
|
||||
buffer-substring-no-properties))))
|
||||
|
||||
(defcustom helm-occur-buffer-substring-default-mode
|
||||
'buffer-substring-no-properties
|
||||
"Function used to display buffer contents in helm-occur buffer.
|
||||
|
||||
Default mode for major modes not defined in
|
||||
`helm-occur-buffer-substring-fn-for-modes'.
|
||||
Can be one of `buffer-substring' or `buffer-substring-no-properties'.
|
||||
|
||||
Note that when using `buffer-substring' initialization will be
|
||||
slower. If buffer-substring, all buffers with the modes not
|
||||
defined in helm-occur-buffer-substring-fn-for-modes will be
|
||||
displayed with colors and properties in the helm-occur buffer"
|
||||
:type '(radio
|
||||
(const :tag "With text properties" buffer-substring)
|
||||
(const :tag "Without text properties" buffer-substring-no-properties)))
|
||||
|
||||
(defcustom helm-occur-keep-closest-position t
|
||||
"When non nil select closest candidate from point after update.
|
||||
This happen only in `helm-source-occur' which is always related to
|
||||
`current-buffer'."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-occur-ignore-diacritics nil
|
||||
"When non nil helm-occur will ignore diacritics in patterns."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-occur-match-shorthands nil
|
||||
"Transform pattern according to `read-symbol-shorthands' when non nil."
|
||||
:type 'boolean)
|
||||
|
||||
(defface helm-moccur-buffer
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:foreground "DarkTurquoise" :underline t))
|
||||
"Face used to highlight occur buffer names.")
|
||||
|
||||
(defface helm-resume-need-update
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
:background "red"))
|
||||
"Face used to flash occur buffer when it needs update.")
|
||||
|
||||
|
||||
(defun helm-occur--select-closest-candidate ()
|
||||
;; Prevent error with `with-helm-window' when switching to help.
|
||||
(unless (or (not (get-buffer-window helm-buffer 'visible))
|
||||
(string-equal helm-pattern ""))
|
||||
(with-helm-window
|
||||
(let ((lst '())
|
||||
(name (helm-get-attr 'name helm-source-occur))
|
||||
closest beg end)
|
||||
(while-no-input
|
||||
(goto-char (point-min))
|
||||
(if (string= name "Helm occur")
|
||||
(setq beg (point)
|
||||
end (point-max))
|
||||
(helm-awhile (helm-get-next-header-pos)
|
||||
(when (string= name (buffer-substring-no-properties
|
||||
(point-at-bol) (point-at-eol)))
|
||||
(forward-line 1)
|
||||
(setq beg (point)
|
||||
end (or (helm-get-next-header-pos) (point-max)))
|
||||
(cl-return))))
|
||||
(save-excursion
|
||||
(when (and beg end)
|
||||
(goto-char beg)
|
||||
(while (re-search-forward "^[0-9]+" end t)
|
||||
(push (string-to-number (match-string 0)) lst))
|
||||
(setq closest (helm-closest-number-in-list
|
||||
helm-occur--initial-pos lst))))
|
||||
(when (and closest (re-search-forward (format "^%s" closest) end t))
|
||||
(helm-mark-current-line)
|
||||
(goto-char (overlay-start
|
||||
helm-selection-overlay))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-occur ()
|
||||
"Preconfigured helm for searching lines matching pattern in `current-buffer'.
|
||||
|
||||
When `helm-source-occur' is member of
|
||||
`helm-sources-using-default-as-input' which is the default,
|
||||
symbol at point is searched at startup.
|
||||
|
||||
When a region is marked search only in this region by narrowing.
|
||||
|
||||
To search in multiples buffers start from one of the commands listing
|
||||
buffers (i.e. a helm command using `helm-source-buffers-list' like
|
||||
`helm-mini') and use the multi occur buffers action.
|
||||
|
||||
This is the helm implementation that collect lines matching pattern
|
||||
like vanilla Emacs `occur' but have nothing to do with it, the search
|
||||
engine beeing completely different and also much faster."
|
||||
(interactive)
|
||||
(setq helm-source-occur
|
||||
(car (helm-occur-build-sources (list (current-buffer)) "Helm occur")))
|
||||
(helm-set-local-variable 'helm-occur--buffer-list (list (current-buffer))
|
||||
'helm-occur--buffer-tick
|
||||
(list (buffer-chars-modified-tick (current-buffer))))
|
||||
(helm-set-attr 'header-name (lambda (_name)
|
||||
(format "HO [%s]"
|
||||
(buffer-name helm-current-buffer)))
|
||||
helm-source-occur)
|
||||
(when helm-occur-keep-closest-position
|
||||
(setq helm-occur--initial-pos (line-number-at-pos))
|
||||
(add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))
|
||||
(save-restriction
|
||||
(let ((helm-sources-using-default-as-input
|
||||
(unless (> (buffer-size) 2000000)
|
||||
helm-sources-using-default-as-input))
|
||||
def pos)
|
||||
(when (use-region-p)
|
||||
;; When user mark defun with `mark-defun' with intention of
|
||||
;; using helm-occur on this region, it is relevant to use the
|
||||
;; thing-at-point located at previous position which have been
|
||||
;; pushed to `mark-ring', if it's within the active region.
|
||||
(let ((beg (region-beginning))
|
||||
(end (region-end))
|
||||
(prev-pos (car mark-ring)))
|
||||
(when (and prev-pos (>= prev-pos beg) (< prev-pos end))
|
||||
(setq def (save-excursion
|
||||
(goto-char (setq pos prev-pos))
|
||||
(helm-aif (thing-at-point 'symbol) (regexp-quote it)))))
|
||||
(narrow-to-region beg end)))
|
||||
(unwind-protect
|
||||
(helm :sources 'helm-source-occur
|
||||
:buffer "*helm occur*"
|
||||
:history 'helm-occur-history
|
||||
:default (or def (helm-aif (thing-at-point 'symbol)
|
||||
(regexp-quote it)))
|
||||
:preselect (and (memq 'helm-source-occur
|
||||
helm-sources-using-default-as-input)
|
||||
(format "^%d:" (line-number-at-pos
|
||||
(or pos (point)))))
|
||||
:truncate-lines helm-occur-truncate-lines)
|
||||
(deactivate-mark t)
|
||||
(remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-occur-visible-buffers ()
|
||||
"Run helm-occur on all visible buffers in frame."
|
||||
(interactive)
|
||||
(require 'helm-buffers)
|
||||
(if (or (one-window-p) (region-active-p))
|
||||
(call-interactively #'helm-occur)
|
||||
(let ((buffers (helm-buffers-get-visible-buffers)))
|
||||
(helm-multi-occur-1 (mapcar 'get-buffer buffers)))))
|
||||
|
||||
(defun helm-occur-transformer (candidates source)
|
||||
"Return CANDIDATES prefixed with line number."
|
||||
(cl-loop with buf = (helm-get-attr 'buffer-name source)
|
||||
for c in candidates
|
||||
for disp-linum = (when (string-match helm-occur--search-buffer-regexp c)
|
||||
(let ((linum (match-string 1 c))
|
||||
(disp (match-string 2 c)))
|
||||
(list
|
||||
linum
|
||||
(format "%s:%s"
|
||||
(propertize
|
||||
linum 'face 'helm-grep-lineno
|
||||
'help-echo (buffer-file-name
|
||||
(get-buffer buf)))
|
||||
disp))))
|
||||
for linum = (car disp-linum)
|
||||
for disp = (cadr disp-linum)
|
||||
when (and disp (not (string= disp "")))
|
||||
collect (cons disp (string-to-number linum))))
|
||||
|
||||
(defvar helm-occur--gshorthands nil)
|
||||
(defun helm-occur-symbol-shorthands-pattern-transformer (pattern buffer gshorthands)
|
||||
"Maybe transform PATTERN to its `read-symbol-shorthands' counterpart in BUFFER.
|
||||
|
||||
GSHORTHANDS is the concatenation of all `read-symbol-shorthands' value found in
|
||||
all buffers i.e. `buffer-list'.
|
||||
When GSHORTHANDS is nil use PATTERN unmodified."
|
||||
(if gshorthands
|
||||
(let* ((lshorthands (buffer-local-value 'read-symbol-shorthands buffer))
|
||||
(prefix (cl-loop for (k . v) in gshorthands
|
||||
if (string-match (concat "\\`" k) pattern)
|
||||
return k
|
||||
else
|
||||
if (string-match (concat "\\`" v) pattern)
|
||||
return v))
|
||||
(lgstr (cdr (or (assoc prefix gshorthands)
|
||||
(rassoc prefix gshorthands)))))
|
||||
(if (and lgstr lshorthands)
|
||||
(concat (car (rassoc lgstr lshorthands))
|
||||
(replace-regexp-in-string prefix "" pattern))
|
||||
pattern))
|
||||
pattern))
|
||||
|
||||
(defclass helm-moccur-class (helm-source-in-buffer)
|
||||
((buffer-name :initarg :buffer-name
|
||||
:initform nil)
|
||||
(moccur-buffers :initarg :moccur-buffers
|
||||
:initform nil)
|
||||
(find-file-target :initform #'helm-occur-quit-an-find-file-fn)))
|
||||
|
||||
(defun helm-occur-build-sources (buffers &optional source-name)
|
||||
"Build sources for `helm-occur' for each buffer in BUFFERS list."
|
||||
(setq helm-occur--gshorthands nil)
|
||||
(and helm-occur-match-shorthands
|
||||
(setq helm-occur--gshorthands
|
||||
(cl-loop for b in (buffer-list)
|
||||
for rss = (buffer-local-value
|
||||
'read-symbol-shorthands
|
||||
b)
|
||||
when rss append rss)))
|
||||
(let (sources)
|
||||
(dolist (buf buffers)
|
||||
(let ((bname (buffer-name buf)))
|
||||
(push (helm-make-source (or source-name bname)
|
||||
'helm-moccur-class
|
||||
:header-name (lambda (name)
|
||||
(format "HO [%s]" (if (string= name "Helm occur")
|
||||
bname name)))
|
||||
:buffer-name bname
|
||||
:match-part
|
||||
(lambda (candidate)
|
||||
;; The regexp should match what is in candidate buffer,
|
||||
;; not what is displayed in helm-buffer e.g. "12 foo"
|
||||
;; and not "12:foo".
|
||||
(when (string-match helm-occur--search-buffer-regexp
|
||||
candidate)
|
||||
(match-string 2 candidate)))
|
||||
:diacritics helm-occur-ignore-diacritics
|
||||
:search (lambda (pattern)
|
||||
(when (string-match "\\`\\^\\([^ ]*\\)" pattern)
|
||||
(setq pattern (concat "^[0-9]* \\{1\\}" (match-string 1 pattern))))
|
||||
(condition-case _err
|
||||
(re-search-forward pattern nil t)
|
||||
(invalid-regexp nil)))
|
||||
:pattern-transformer (lambda (pattern)
|
||||
(helm-occur-symbol-shorthands-pattern-transformer
|
||||
pattern buf helm-occur--gshorthands))
|
||||
:init (lambda ()
|
||||
(with-current-buffer buf
|
||||
(let* ((bsfn (or (cdr (assq
|
||||
major-mode
|
||||
helm-occur-buffer-substring-fn-for-modes))
|
||||
helm-occur-buffer-substring-default-mode))
|
||||
(contents (funcall bsfn (point-min) (point-max))))
|
||||
(helm-set-attr 'get-line bsfn)
|
||||
(with-current-buffer (helm-candidate-buffer 'global)
|
||||
(insert contents)
|
||||
(goto-char (point-min))
|
||||
(let ((linum 1))
|
||||
(insert (format "%s " linum))
|
||||
(while (re-search-forward "\n" nil t)
|
||||
(cl-incf linum)
|
||||
(insert (format "%s " linum))))))))
|
||||
:filtered-candidate-transformer 'helm-occur-transformer
|
||||
:help-message 'helm-moccur-help-message
|
||||
:nomark t
|
||||
:migemo t
|
||||
;; Needed for resume.
|
||||
:history 'helm-occur-history
|
||||
:candidate-number-limit helm-occur-candidate-number-limit
|
||||
:action 'helm-occur-actions
|
||||
:requires-pattern 2
|
||||
:follow 1
|
||||
:group 'helm-occur
|
||||
:keymap helm-occur-map
|
||||
:resume 'helm-occur-resume-fn
|
||||
:moccur-buffers buffers)
|
||||
sources)))
|
||||
(nreverse sources)))
|
||||
|
||||
(defun helm-multi-occur-1 (buffers &optional input)
|
||||
"Run `helm-occur' on a list of buffers.
|
||||
Each buffer's result is displayed in a separated source."
|
||||
(let* ((curbuf (current-buffer))
|
||||
(bufs (if helm-occur-always-search-in-current
|
||||
(cons curbuf (remove curbuf buffers))
|
||||
buffers))
|
||||
(helm-sources-using-default-as-input
|
||||
(unless (cl-loop with total_size = 0
|
||||
for b in bufs
|
||||
do (setq total_size (buffer-size b))
|
||||
finally return (> total_size 2000000))
|
||||
helm-sources-using-default-as-input))
|
||||
(sources (helm-occur-build-sources bufs (and (eql curbuf (car bufs))
|
||||
(not (cdr bufs))
|
||||
"Helm occur")))
|
||||
(helm-maybe-use-default-as-input
|
||||
(not (null (memq 'helm-source-moccur
|
||||
helm-sources-using-default-as-input)))))
|
||||
(helm-set-local-variable 'helm-occur--buffer-list bufs
|
||||
'helm-occur--buffer-tick
|
||||
(cl-loop for b in bufs collect
|
||||
(buffer-chars-modified-tick
|
||||
(get-buffer b))))
|
||||
(when (and helm-occur-always-search-in-current
|
||||
helm-occur-keep-closest-position)
|
||||
(setq helm-source-occur
|
||||
(cl-loop for s in sources
|
||||
when (eql helm-current-buffer
|
||||
(get-buffer (helm-get-attr 'buffer-name s)))
|
||||
return s))
|
||||
(setq helm-occur--initial-pos (line-number-at-pos))
|
||||
(add-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))
|
||||
(unwind-protect
|
||||
(helm :sources sources
|
||||
:buffer "*helm moccur*"
|
||||
:history 'helm-occur-history
|
||||
:default (helm-aif (thing-at-point 'symbol)
|
||||
(regexp-quote it))
|
||||
:input input
|
||||
:truncate-lines helm-occur-truncate-lines)
|
||||
(remove-hook 'helm-after-update-hook 'helm-occur--select-closest-candidate))))
|
||||
|
||||
;;; Actions
|
||||
;;
|
||||
(cl-defun helm-occur-action (lineno
|
||||
&optional (method (quote buffer)))
|
||||
"Jump to line number LINENO with METHOD.
|
||||
METHOD can be one of buffer, buffer-other-window, buffer-other-frame."
|
||||
(require 'helm-grep)
|
||||
(let ((buf (if (eq major-mode 'helm-occur-mode)
|
||||
(get-text-property (point) 'buffer-name)
|
||||
(helm-get-attr 'buffer-name)))
|
||||
(split-pat (helm-mm-split-pattern helm-input)))
|
||||
(cl-case method
|
||||
(buffer (switch-to-buffer buf))
|
||||
(buffer-other-window (helm-window-show-buffers (list buf) t))
|
||||
(buffer-other-frame (switch-to-buffer-other-frame buf)))
|
||||
(with-current-buffer buf
|
||||
(helm-goto-line lineno)
|
||||
;; Move point to the nearest matching regexp from bol.
|
||||
(cl-loop for str in split-pat
|
||||
for reg = (helm-occur-symbol-shorthands-pattern-transformer
|
||||
str (get-buffer buf) helm-occur--gshorthands)
|
||||
when (save-excursion
|
||||
(condition-case _err
|
||||
(if helm-migemo-mode
|
||||
(helm-mm-migemo-forward reg (point-at-eol) t)
|
||||
(re-search-forward reg (point-at-eol) t))
|
||||
(invalid-regexp nil)))
|
||||
collect (match-beginning 0) into pos-ls
|
||||
finally (when pos-ls (goto-char (apply #'min pos-ls)))))))
|
||||
|
||||
(defun helm-occur-goto-line (candidate)
|
||||
"From multi occur, switch to buffer and CANDIDATE line."
|
||||
(helm-occur-action
|
||||
candidate 'buffer))
|
||||
|
||||
(defun helm-occur-goto-line-ow (candidate)
|
||||
"Go to CANDIDATE line in other window.
|
||||
Same as `helm-occur-goto-line' but go in other window."
|
||||
(helm-occur-action
|
||||
candidate 'buffer-other-window))
|
||||
|
||||
(defun helm-occur-goto-line-of (candidate)
|
||||
"Go to CANDIDATE line in new frame.
|
||||
Same as `helm-occur-goto-line' but go in new frame."
|
||||
(helm-occur-action
|
||||
candidate 'buffer-other-frame))
|
||||
|
||||
(helm-make-command-from-action helm-occur-run-goto-line-ow
|
||||
"Run goto line other window action from `helm-occur'."
|
||||
'helm-occur-goto-line-ow)
|
||||
|
||||
(helm-make-command-from-action helm-occur-run-goto-line-of
|
||||
"Run goto line new frame action from `helm-occur'."
|
||||
'helm-occur-goto-line-of)
|
||||
|
||||
(helm-make-command-from-action helm-occur-run-default-action
|
||||
"Goto matching line from helm-occur buffer."
|
||||
'helm-occur-goto-line)
|
||||
|
||||
(helm-make-command-from-action helm-occur-run-save-buffer
|
||||
"Run moccur save results action from `helm-moccur'."
|
||||
'helm-occur-save-results)
|
||||
|
||||
(defun helm-occur-right ()
|
||||
"`helm-occur' action for right arrow.
|
||||
This is used when `helm-occur-use-ioccur-style-keys' is enabled.
|
||||
If follow is enabled (default) go to next source, otherwise execute
|
||||
persistent action."
|
||||
(interactive)
|
||||
(if (helm-aand (helm-get-attr 'follow) (> it 0))
|
||||
(helm-next-source)
|
||||
(helm-execute-persistent-action)))
|
||||
(put 'helm-occur-right 'helm-only t)
|
||||
|
||||
(defun helm-occur-quit-an-find-file-fn (source)
|
||||
(let* ((sel (helm-get-selection nil nil source))
|
||||
(occur-fname (helm-aand (numberp sel)
|
||||
(helm-get-attr 'buffer-name)
|
||||
(buffer-file-name (get-buffer it)))))
|
||||
(when (and occur-fname (file-exists-p occur-fname))
|
||||
(expand-file-name occur-fname))))
|
||||
|
||||
;;; helm-occur-mode
|
||||
;;
|
||||
;;
|
||||
(defvar helm-occur-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "RET") 'helm-occur-mode-goto-line)
|
||||
(define-key map (kbd "C-o") 'helm-occur-mode-goto-line-ow)
|
||||
(define-key map (kbd "<C-down>") 'helm-occur-mode-goto-line-ow-forward)
|
||||
(define-key map (kbd "<C-up>") 'helm-occur-mode-goto-line-ow-backward)
|
||||
(define-key map (kbd "<M-down>") 'helm-gm-next-file)
|
||||
(define-key map (kbd "<M-up>") 'helm-gm-precedent-file)
|
||||
(define-key map (kbd "M-n") 'helm-occur-mode-goto-line-ow-forward)
|
||||
(define-key map (kbd "M-p") 'helm-occur-mode-goto-line-ow-backward)
|
||||
(define-key map (kbd "M-N") 'helm-gm-next-file)
|
||||
(define-key map (kbd "M-P") 'helm-gm-precedent-file)
|
||||
(define-key map (kbd "C-c b") 'helm-occur-mode-resume-session)
|
||||
map))
|
||||
|
||||
(defun helm-occur-mode-goto-line ()
|
||||
(interactive)
|
||||
(setq next-error-last-buffer (current-buffer))
|
||||
(setq-local helm-current-error (point-marker))
|
||||
(helm-aif (get-text-property (point) 'helm-realvalue)
|
||||
(progn (helm-occur-goto-line it) (helm-match-line-cleanup-pulse))))
|
||||
|
||||
(defun helm-occur-mode-goto-line-ow ()
|
||||
(interactive)
|
||||
(setq next-error-last-buffer (current-buffer))
|
||||
(setq-local helm-current-error (point-marker))
|
||||
(helm-aif (get-text-property (point) 'helm-realvalue)
|
||||
(progn (helm-occur-goto-line-ow it) (helm-match-line-cleanup-pulse))))
|
||||
|
||||
(defun helm-occur-mode-goto-line-ow-forward-1 (arg)
|
||||
(condition-case nil
|
||||
(progn
|
||||
(when (or (eq last-command 'helm-occur-mode-goto-line-ow-forward)
|
||||
(eq last-command 'helm-occur-mode-goto-line-ow-backward))
|
||||
(forward-line arg))
|
||||
(save-selected-window
|
||||
(helm-occur-mode-goto-line-ow)
|
||||
(recenter)))
|
||||
(error nil)))
|
||||
|
||||
(defun helm-occur-mode-goto-line-ow-forward (arg)
|
||||
(interactive "p")
|
||||
(helm-occur-mode-goto-line-ow-forward-1 arg))
|
||||
|
||||
(defun helm-occur-mode-goto-line-ow-backward (arg)
|
||||
(interactive "p")
|
||||
(helm-occur-mode-goto-line-ow-forward-1 (- arg)))
|
||||
|
||||
(defun helm-occur-save-results (_candidate)
|
||||
"Save helm moccur results in a `helm-moccur-mode' buffer."
|
||||
(let ((buf "*hmoccur*")
|
||||
new-buf)
|
||||
(when (get-buffer buf)
|
||||
(setq new-buf (helm-read-string "OccurBufferName: " buf))
|
||||
(cl-loop for b in (helm-buffer-list)
|
||||
when (and (string= new-buf b)
|
||||
(not (y-or-n-p
|
||||
(format "Buffer `%s' already exists overwrite? "
|
||||
new-buf))))
|
||||
do (setq new-buf (helm-read-string
|
||||
"OccurBufferName: " "*hmoccur ")))
|
||||
(setq buf new-buf))
|
||||
(with-current-buffer (get-buffer-create buf)
|
||||
(kill-all-local-variables)
|
||||
(setq buffer-read-only t)
|
||||
(buffer-disable-undo)
|
||||
(let ((inhibit-read-only t)
|
||||
(map (make-sparse-keymap))
|
||||
buf-name)
|
||||
(erase-buffer)
|
||||
(insert "-*- mode: helm-occur -*-\n\n"
|
||||
(format "Occur Results for `%s':\n\n" helm-input))
|
||||
(save-excursion
|
||||
(insert (with-current-buffer helm-buffer
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(buffer-substring (point) (point-max)))))
|
||||
(save-excursion
|
||||
(forward-line -2)
|
||||
(while (not (eobp))
|
||||
(if (helm-pos-header-line-p)
|
||||
(let ((beg (point-at-bol))
|
||||
(end (point-at-eol)))
|
||||
(set-text-properties beg (1+ end) nil)
|
||||
(delete-region (1- beg) end))
|
||||
(helm-aif (setq buf-name (assoc-default
|
||||
'buffer-name
|
||||
(get-text-property (point) 'helm-cur-source)))
|
||||
(progn
|
||||
(insert (propertize (concat it ":")
|
||||
'face 'helm-moccur-buffer
|
||||
'helm-realvalue (get-text-property (point) 'helm-realvalue)))
|
||||
(add-text-properties
|
||||
(point-at-bol) (point-at-eol)
|
||||
`(buffer-name ,buf-name))
|
||||
(add-text-properties
|
||||
(point-at-bol) (point-at-eol)
|
||||
`(keymap ,map
|
||||
help-echo ,(concat
|
||||
(buffer-file-name
|
||||
(get-buffer buf-name))
|
||||
"\nmouse-1: set point\nmouse-2: jump to selection")
|
||||
mouse-face highlight
|
||||
invisible nil))
|
||||
(define-key map [mouse-1] 'mouse-set-point)
|
||||
(define-key map [mouse-2] 'helm-occur-mode-mouse-goto-line)
|
||||
(define-key map [mouse-3] 'ignore))))
|
||||
(forward-line 1))))
|
||||
(buffer-enable-undo)
|
||||
(helm-occur-mode))
|
||||
(pop-to-buffer buf)
|
||||
(setq next-error-last-buffer (get-buffer buf))
|
||||
(message "Helm occur Results saved in `%s' buffer" buf)))
|
||||
|
||||
(defun helm-occur-mode-mouse-goto-line (event)
|
||||
(interactive "e")
|
||||
(let* ((window (posn-window (event-end event)))
|
||||
(pos (posn-point (event-end event))))
|
||||
(with-selected-window window
|
||||
(when (eq major-mode 'helm-occur-mode)
|
||||
(goto-char pos)
|
||||
(helm-occur-mode-goto-line)))))
|
||||
(put 'helm-moccur-mode-mouse-goto-line 'helm-only t)
|
||||
|
||||
(defun helm-occur-mode-resume-session ()
|
||||
(interactive)
|
||||
(cl-assert (eq major-mode 'helm-occur-mode) nil "Helm command called in wrong context")
|
||||
(helm-multi-occur-1 helm-occur--buffer-list helm-occur-mode--last-pattern))
|
||||
|
||||
(defun helm-occur-buffer-substring-with-linums ()
|
||||
"Return current-buffer contents as a string with all lines
|
||||
numbered. The property \\='buffer-name is added to the whole string."
|
||||
(let ((bufstr (buffer-substring-no-properties (point-min) (point-max)))
|
||||
(bufname (buffer-name)))
|
||||
(with-temp-buffer
|
||||
(save-excursion
|
||||
(insert bufstr))
|
||||
(let ((linum 1))
|
||||
(insert (format "%s " linum))
|
||||
(while (re-search-forward "\n" nil t)
|
||||
(cl-incf linum)
|
||||
(insert (format "%s " linum)))
|
||||
(add-text-properties (point-min) (point-max) `(buffer-name ,bufname)))
|
||||
(buffer-string))))
|
||||
|
||||
(defun helm-occur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm)
|
||||
"The `revert-buffer-function' for `helm-occur-mode'."
|
||||
(goto-char (point-min))
|
||||
(let (pattern)
|
||||
(when (re-search-forward "^Occur Results for `\\(.*\\)'" nil t)
|
||||
(setq pattern (match-string 1))
|
||||
(forward-line 0)
|
||||
(when (re-search-forward "^$" nil t)
|
||||
(forward-line 1))
|
||||
(let ((inhibit-read-only t)
|
||||
(buffer (current-buffer))
|
||||
(buflst helm-occur--buffer-list))
|
||||
(delete-region (point) (point-max))
|
||||
(message "Reverting buffer...")
|
||||
(save-excursion
|
||||
(with-temp-buffer
|
||||
(insert
|
||||
"\n"
|
||||
(cl-loop for buf in buflst
|
||||
for bufstr = (or (and (buffer-live-p (get-buffer buf))
|
||||
(with-current-buffer buf
|
||||
(helm-occur-buffer-substring-with-linums)))
|
||||
"")
|
||||
concat bufstr)
|
||||
"\n")
|
||||
(goto-char (point-min))
|
||||
(cl-loop with linum
|
||||
with mpart
|
||||
;; Bind helm-pattern used by `helm-grep-split-line'.
|
||||
with helm-pattern = pattern
|
||||
while (helm-mm-search pattern) ; point is at eol.
|
||||
;; Calculate line number (linum) and extract real
|
||||
;; part of line (mpart).
|
||||
do (when (save-excursion
|
||||
;; `helm-mm-search' puts point at eol.
|
||||
(forward-line 0)
|
||||
(re-search-forward "^\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)$"
|
||||
(point-at-eol) t))
|
||||
(setq linum (string-to-number (match-string 1))
|
||||
mpart (match-string 2)))
|
||||
;; Match part after line number.
|
||||
when (and mpart (helm-mm-match mpart pattern))
|
||||
for line = (format "%s:%d:%s"
|
||||
(get-text-property (point) 'buffer-name)
|
||||
linum
|
||||
mpart)
|
||||
when line
|
||||
do (with-current-buffer buffer
|
||||
(insert
|
||||
(propertize
|
||||
(car (helm-occur-filter-one-by-one line))
|
||||
'helm-realvalue linum)
|
||||
"\n"))))
|
||||
(when (fboundp 'wgrep-cleanup-overlays)
|
||||
(wgrep-cleanup-overlays (point-min) (point-max)))
|
||||
(message "Reverting buffer done")
|
||||
(when executing-kbd-macro (sit-for 1)))))))
|
||||
|
||||
(defun helm-occur-filter-one-by-one (candidate)
|
||||
"`filter-one-by-one' function for `helm-source-moccur'."
|
||||
(require 'helm-grep)
|
||||
(let* ((split (helm-grep-split-line candidate))
|
||||
(buf (car split))
|
||||
(lineno (nth 1 split))
|
||||
(str (nth 2 split)))
|
||||
(cons (concat (propertize
|
||||
buf
|
||||
'face 'helm-moccur-buffer
|
||||
'help-echo (buffer-file-name
|
||||
(get-buffer buf))
|
||||
'buffer-name buf)
|
||||
":"
|
||||
(propertize lineno 'face 'helm-grep-lineno)
|
||||
":"
|
||||
(helm-grep-highlight-match str))
|
||||
candidate)))
|
||||
|
||||
(define-derived-mode helm-occur-mode
|
||||
special-mode "helm-moccur"
|
||||
"Major mode to provide actions in helm moccur saved buffer.
|
||||
|
||||
Special commands:
|
||||
\\{helm-occur-mode-map}"
|
||||
(set (make-local-variable 'helm-occur--buffer-list)
|
||||
(with-helm-buffer helm-occur--buffer-list))
|
||||
(set (make-local-variable 'revert-buffer-function)
|
||||
#'helm-occur-mode--revert-buffer-function)
|
||||
(set (make-local-variable 'helm-occur-mode--last-pattern)
|
||||
helm-input)
|
||||
(set (make-local-variable 'next-error-function)
|
||||
#'helm-occur-next-error)
|
||||
(set (make-local-variable 'helm-current-error) nil))
|
||||
(put 'helm-moccur-mode 'helm-only t)
|
||||
|
||||
(defun helm-occur-next-error (&optional argp reset)
|
||||
"Goto ARGP position from a `helm-occur-mode' buffer.
|
||||
RESET non-nil means rewind to the first match.
|
||||
This is the `next-error-function' for `helm-occur-mode'."
|
||||
(interactive "p")
|
||||
(goto-char (cond (reset (point-min))
|
||||
((and (< argp 0) helm-current-error)
|
||||
(line-beginning-position))
|
||||
((and (> argp 0) helm-current-error)
|
||||
(line-end-position))
|
||||
((point))))
|
||||
(let ((fun (if (> argp 0)
|
||||
#'next-single-property-change
|
||||
#'previous-single-property-change)))
|
||||
(helm-aif (funcall fun (point) 'buffer-name)
|
||||
(progn
|
||||
(goto-char it)
|
||||
(forward-line 0)
|
||||
;; `helm-current-error' is set in
|
||||
;; `helm-occur-mode-goto-line'.
|
||||
(helm-occur-mode-goto-line))
|
||||
(user-error "No more matches"))))
|
||||
|
||||
;;; Resume
|
||||
;;
|
||||
(defun helm-occur-resume-fn ()
|
||||
(with-helm-buffer
|
||||
(let (new-tick-ls buffer-is-modified)
|
||||
(set (make-local-variable 'helm-occur--buffer-list)
|
||||
(cl-loop for b in helm-occur--buffer-list
|
||||
when (buffer-live-p (get-buffer b))
|
||||
collect b))
|
||||
(setq buffer-is-modified (/= (length helm-occur--buffer-list)
|
||||
(length (helm-get-attr 'moccur-buffers))))
|
||||
(helm-set-attr 'moccur-buffers helm-occur--buffer-list)
|
||||
(setq new-tick-ls (cl-loop for b in helm-occur--buffer-list
|
||||
collect (buffer-chars-modified-tick
|
||||
(get-buffer b))))
|
||||
(when buffer-is-modified
|
||||
(setq helm-occur--buffer-tick new-tick-ls))
|
||||
(cl-assert (> (length helm-occur--buffer-list) 0) nil
|
||||
"helm-resume error: helm-(m)occur buffer list is empty")
|
||||
(unless (eq helm-occur-auto-update-on-resume 'never)
|
||||
(when (or buffer-is-modified
|
||||
(cl-loop for b in helm-occur--buffer-list
|
||||
for new-tick = (buffer-chars-modified-tick
|
||||
(get-buffer b))
|
||||
for tick in helm-occur--buffer-tick
|
||||
thereis (/= tick new-tick)))
|
||||
(helm-aif helm-occur-auto-update-on-resume
|
||||
(when (or (eq it 'noask)
|
||||
(y-or-n-p "Helm (m)occur Buffer outdated, update? "))
|
||||
(run-with-idle-timer
|
||||
0.1 nil (lambda ()
|
||||
(with-helm-buffer
|
||||
(helm-force-update)
|
||||
(message "Helm (m)occur Buffer have been udated")
|
||||
(sit-for 1) (message nil))))
|
||||
(unless buffer-is-modified (setq helm-occur--buffer-tick
|
||||
new-tick-ls)))
|
||||
(run-with-idle-timer
|
||||
0.1 nil
|
||||
(lambda ()
|
||||
(with-helm-buffer
|
||||
(let ((ov (make-overlay (save-excursion
|
||||
(goto-char (point-min))
|
||||
(forward-line 1)
|
||||
(point))
|
||||
(point-max))))
|
||||
(overlay-put ov 'face 'helm-resume-need-update)
|
||||
(sit-for 0)
|
||||
(delete-overlay ov)
|
||||
(message "[Helm occur Buffer outdated (C-c C-u to update)]")))))
|
||||
(unless buffer-is-modified
|
||||
(with-helm-after-update-hook
|
||||
(setq helm-occur--buffer-tick new-tick-ls)
|
||||
(message "Helm (m)occur Buffer have been udated")))))))))
|
||||
|
||||
;;; Helm occur from isearch
|
||||
;;
|
||||
;;;###autoload
|
||||
(defun helm-occur-from-isearch ()
|
||||
"Invoke `helm-occur' from isearch.
|
||||
|
||||
To use this bind it to a key in `isearch-mode-map'."
|
||||
(interactive)
|
||||
(let ((input (if isearch-regexp
|
||||
isearch-string
|
||||
(regexp-quote isearch-string)))
|
||||
(bufs (list (current-buffer)))
|
||||
;; Use `helm-occur-always-search-in-current' as a flag for
|
||||
;; `helm-occur--select-closest-candidate'.
|
||||
(helm-occur-always-search-in-current t))
|
||||
(isearch-exit)
|
||||
(helm-multi-occur-1 bufs input)))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-multi-occur-from-isearch ()
|
||||
"Invoke `helm-multi-occur' from isearch.
|
||||
|
||||
With a prefix arg, reverse the behavior of
|
||||
`helm-moccur-always-search-in-current'.
|
||||
The prefix arg can be set before calling
|
||||
`helm-multi-occur-from-isearch' or during the buffer selection.
|
||||
|
||||
To use this bind it to a key in `isearch-mode-map'."
|
||||
(interactive)
|
||||
(let (buf-list
|
||||
helm-moccur-always-search-in-current
|
||||
(input (if isearch-regexp
|
||||
isearch-string
|
||||
(regexp-quote isearch-string))))
|
||||
(isearch-exit)
|
||||
(setq buf-list (mapcar 'get-buffer
|
||||
(helm-comp-read "Buffers: "
|
||||
(helm-buffer-list)
|
||||
:name "Occur in buffer(s)"
|
||||
:marked-candidates t)))
|
||||
(setq helm-moccur-always-search-in-current
|
||||
(if (or current-prefix-arg
|
||||
helm-current-prefix-arg)
|
||||
(not helm-moccur-always-search-in-current)
|
||||
helm-moccur-always-search-in-current))
|
||||
(helm-multi-occur-1 buf-list input)))
|
||||
|
||||
(provide 'helm-occur)
|
||||
|
||||
;;; helm-occur.el ends here
|
|
@ -1,8 +1,8 @@
|
|||
(define-package "helm" "20230830.514" "Helm is an Emacs incremental and narrowing framework"
|
||||
'((helm-core "3.9.4")
|
||||
(define-package "helm" "20230727.1557" "Helm is an Emacs incremental and narrowing framework"
|
||||
'((helm-core "3.9.1")
|
||||
(wfnames "1.1")
|
||||
(popup "0.5.3"))
|
||||
:commit "587bed0f735c7955ab385a5fbc2660a61713eb29" :authors
|
||||
:commit "c11845ea65500255ec294eb8026aef7ad3489269" :authors
|
||||
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||
:maintainers
|
||||
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
Some files were not shown because too many files have changed in this diff Show more
Reference in a new issue