Klimi's new dotfiles with stow.
選択できるのは25トピックまでです。 トピックは、先頭が英数字で、英数字とダッシュ('-')を使用した35文字以内のものにしてください。

737 行
30 KiB

  1. ;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2012 ~ 2019 Thierry Volpiatto <thierry.volpiatto@gmail.com>
  3. ;; This program is free software; you can redistribute it and/or modify
  4. ;; it under the terms of the GNU General Public License as published by
  5. ;; the Free Software Foundation, either version 3 of the License, or
  6. ;; (at your option) any later version.
  7. ;; This program is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  10. ;; GNU General Public License for more details.
  11. ;; You should have received a copy of the GNU General Public License
  12. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  13. ;;; Code:
  14. (require 'cl-lib)
  15. (require 'bookmark)
  16. (require 'helm)
  17. (require 'helm-lib)
  18. (require 'helm-help)
  19. (require 'helm-types)
  20. (require 'helm-utils)
  21. (require 'helm-info)
  22. (require 'helm-adaptive)
  23. (require 'helm-net)
  24. (declare-function helm-browse-project "helm-files" (arg))
  25. (declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark))
  26. (defgroup helm-bookmark nil
  27. "Predefined configurations for `helm.el'."
  28. :group 'helm)
  29. (defcustom helm-bookmark-show-location nil
  30. "Show location of bookmark on display."
  31. :group 'helm-bookmark
  32. :type 'boolean)
  33. (defcustom helm-bookmark-default-filtered-sources
  34. (append '(helm-source-bookmark-org
  35. helm-source-bookmark-files&dirs
  36. helm-source-bookmark-helm-find-files
  37. helm-source-bookmark-info
  38. helm-source-bookmark-gnus
  39. helm-source-bookmark-man
  40. helm-source-bookmark-images
  41. helm-source-bookmark-w3m)
  42. (list 'helm-source-bookmark-uncategorized
  43. 'helm-source-bookmark-set))
  44. "List of sources to use in `helm-filtered-bookmarks'."
  45. :group 'helm-bookmark
  46. :type '(repeat (choice symbol)))
  47. (defface helm-bookmark-info
  48. '((t (:foreground "green")))
  49. "Face used for W3m Emacs bookmarks (not w3m bookmarks)."
  50. :group 'helm-bookmark)
  51. (defface helm-bookmark-w3m
  52. '((t (:foreground "yellow")))
  53. "Face used for W3m Emacs bookmarks (not w3m bookmarks)."
  54. :group 'helm-bookmark)
  55. (defface helm-bookmark-gnus
  56. '((t (:foreground "magenta")))
  57. "Face used for Gnus bookmarks."
  58. :group 'helm-bookmark)
  59. (defface helm-bookmark-man
  60. '((t (:foreground "Orange4")))
  61. "Face used for Woman/man bookmarks."
  62. :group 'helm-bookmark)
  63. (defface helm-bookmark-file
  64. '((t (:foreground "Deepskyblue2")))
  65. "Face used for file bookmarks."
  66. :group 'helm-bookmark)
  67. (defface helm-bookmark-file-not-found
  68. '((t (:foreground "Slategray4")))
  69. "Face used for file bookmarks."
  70. :group 'helm-bookmark)
  71. (defface helm-bookmark-directory
  72. '((t (:inherit helm-ff-directory)))
  73. "Face used for file bookmarks."
  74. :group 'helm-bookmark)
  75. (defface helm-bookmark-addressbook
  76. '((t (:foreground "tomato")))
  77. "Face used for addressbook bookmarks."
  78. :group 'helm-bookmark)
  79. (defvar helm-bookmark-map
  80. (let ((map (make-sparse-keymap)))
  81. (set-keymap-parent map helm-map)
  82. (define-key map (kbd "C-c o") 'helm-bookmark-run-jump-other-window)
  83. (define-key map (kbd "C-c C-o") 'helm-bookmark-run-jump-other-frame)
  84. (define-key map (kbd "C-d") 'helm-bookmark-run-delete)
  85. (define-key map (kbd "C-]") 'helm-bookmark-toggle-filename)
  86. (define-key map (kbd "M-e") 'helm-bookmark-run-edit)
  87. map)
  88. "Generic Keymap for emacs bookmark sources.")
  89. (defclass helm-source-basic-bookmarks (helm-source-in-buffer helm-type-bookmark)
  90. ((init :initform (lambda ()
  91. (bookmark-maybe-load-default-file)
  92. (helm-init-candidates-in-buffer
  93. 'global
  94. (bookmark-all-names))))
  95. (filtered-candidate-transformer :initform 'helm-bookmark-transformer)))
  96. (defvar helm-source-bookmarks
  97. (helm-make-source "Bookmarks" 'helm-source-basic-bookmarks)
  98. "See (info \"(emacs)Bookmarks\").")
  99. (defun helm-bookmark-transformer (candidates _source)
  100. (cl-loop for i in candidates
  101. for loc = (bookmark-location i)
  102. for len = (string-width i)
  103. for trunc = (if (> len bookmark-bmenu-file-column)
  104. (helm-substring i bookmark-bmenu-file-column)
  105. i)
  106. for sep = (make-string (- (+ bookmark-bmenu-file-column 2)
  107. (length trunc))
  108. ? )
  109. if helm-bookmark-show-location
  110. collect (cons (concat trunc sep (if (listp loc) (car loc) loc)) i)
  111. else collect i))
  112. (defun helm-bookmark-toggle-filename-1 (_candidate)
  113. (let* ((real (helm-get-selection helm-buffer))
  114. (trunc (if (> (string-width real) bookmark-bmenu-file-column)
  115. (helm-substring real bookmark-bmenu-file-column)
  116. real))
  117. (loc (bookmark-location real)))
  118. (setq helm-bookmark-show-location (not helm-bookmark-show-location))
  119. (helm-update (if helm-bookmark-show-location
  120. (concat (regexp-quote trunc)
  121. " +"
  122. (regexp-quote
  123. (if (listp loc) (car loc) loc)))
  124. (regexp-quote real)))))
  125. (defun helm-bookmark-toggle-filename ()
  126. "Toggle bookmark location visibility."
  127. (interactive)
  128. (with-helm-alive-p
  129. (helm-attrset 'toggle-filename
  130. '(helm-bookmark-toggle-filename-1 . never-split))
  131. (helm-execute-persistent-action 'toggle-filename)))
  132. (put 'helm-bookmark-toggle-filename 'helm-only t)
  133. (defun helm-bookmark-jump (candidate)
  134. "Jump to bookmark action."
  135. (let ((current-prefix-arg helm-current-prefix-arg)
  136. non-essential)
  137. (bookmark-jump candidate)))
  138. (defun helm-bookmark-jump-other-frame (candidate)
  139. "Jump to bookmark in other frame action."
  140. (let ((current-prefix-arg helm-current-prefix-arg)
  141. non-essential)
  142. (bookmark-jump candidate 'switch-to-buffer-other-frame)))
  143. (defun helm-bookmark-jump-other-window (candidate)
  144. "Jump to bookmark in other window action."
  145. (let (non-essential)
  146. (bookmark-jump-other-window candidate)))
  147. ;;; bookmark-set
  148. ;;
  149. (defvar helm-source-bookmark-set
  150. (helm-build-dummy-source "Set Bookmark"
  151. :filtered-candidate-transformer
  152. (lambda (_candidates _source)
  153. (list (or (and (not (string= helm-pattern ""))
  154. helm-pattern)
  155. "Enter a bookmark name to record")))
  156. :action '(("Set bookmark" . (lambda (candidate)
  157. (if (string= helm-pattern "")
  158. (message "No bookmark name given for record")
  159. (bookmark-set candidate))))))
  160. "See (info \"(emacs)Bookmarks\").")
  161. ;;; Predicates
  162. ;;
  163. (defconst helm-bookmark--non-file-filename " - no file -"
  164. "Name to use for `filename' entry, for non-file bookmarks.")
  165. (defun helm-bookmark-gnus-bookmark-p (bookmark)
  166. "Return non-nil if BOOKMARK is a Gnus bookmark.
  167. BOOKMARK is a bookmark name or a bookmark record."
  168. (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus)
  169. (eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump)
  170. (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)))
  171. (defun helm-bookmark-w3m-bookmark-p (bookmark)
  172. "Return non-nil if BOOKMARK is a W3m bookmark.
  173. BOOKMARK is a bookmark name or a bookmark record."
  174. (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m)
  175. (eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump)
  176. (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m)))
  177. (defun helm-bookmark-woman-bookmark-p (bookmark)
  178. "Return non-nil if BOOKMARK is a Woman bookmark.
  179. BOOKMARK is a bookmark name or a bookmark record."
  180. (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman)
  181. (eq (bookmark-get-handler bookmark) 'woman-bookmark-jump)
  182. (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman)))
  183. (defun helm-bookmark-man-bookmark-p (bookmark)
  184. "Return non-nil if BOOKMARK is a Man bookmark.
  185. BOOKMARK is a bookmark name or a bookmark record."
  186. (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man)
  187. (eq (bookmark-get-handler bookmark) 'Man-bookmark-jump)
  188. (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)))
  189. (defun helm-bookmark-woman-man-bookmark-p (bookmark)
  190. "Return non-nil if BOOKMARK is a Man or Woman bookmark.
  191. BOOKMARK is a bookmark name or a bookmark record."
  192. (or (helm-bookmark-man-bookmark-p bookmark)
  193. (helm-bookmark-woman-bookmark-p bookmark)))
  194. (defun helm-bookmark-info-bookmark-p (bookmark)
  195. "Return non-nil if BOOKMARK is an Info bookmark.
  196. BOOKMARK is a bookmark name or a bookmark record."
  197. (eq (bookmark-get-handler bookmark) 'Info-bookmark-jump))
  198. (defun helm-bookmark-image-bookmark-p (bookmark)
  199. "Return non-nil if BOOKMARK bookmarks an image file."
  200. (if (stringp bookmark)
  201. (assq 'image-type (assq bookmark bookmark-alist))
  202. (assq 'image-type bookmark)))
  203. (defun helm-bookmark-file-p (bookmark)
  204. "Return non-nil if BOOKMARK bookmarks a file or directory.
  205. BOOKMARK is a bookmark name or a bookmark record.
  206. This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)."
  207. (let* ((filename (bookmark-get-filename bookmark))
  208. (isnonfile (equal filename helm-bookmark--non-file-filename)))
  209. (and filename (not isnonfile) (not (bookmark-get-handler bookmark)))))
  210. (defun helm-bookmark-org-file-p (bookmark)
  211. (let* ((filename (bookmark-get-filename bookmark)))
  212. (or (string-suffix-p ".org" filename t)
  213. (string-suffix-p ".org_archive" filename t))))
  214. (defun helm-bookmark-helm-find-files-p (bookmark)
  215. "Return non-nil if BOOKMARK bookmarks a `helm-find-files' session.
  216. BOOKMARK is a bookmark name or a bookmark record."
  217. (eq (bookmark-get-handler bookmark) 'helm-ff-bookmark-jump))
  218. (defun helm-bookmark-addressbook-p (bookmark)
  219. "Return non--nil if BOOKMARK is a contact recorded with addressbook-bookmark.
  220. BOOKMARK is a bookmark name or a bookmark record."
  221. (if (listp bookmark)
  222. (string= (assoc-default 'type bookmark) "addressbook")
  223. (string= (assoc-default
  224. 'type (assoc bookmark bookmark-alist)) "addressbook")))
  225. (defun helm-bookmark-uncategorized-bookmark-p (bookmark)
  226. "Return non--nil if BOOKMARK match no known category."
  227. (cl-loop for pred in '(helm-bookmark-org-file-p
  228. helm-bookmark-addressbook-p
  229. helm-bookmark-gnus-bookmark-p
  230. helm-bookmark-w3m-bookmark-p
  231. helm-bookmark-woman-man-bookmark-p
  232. helm-bookmark-info-bookmark-p
  233. helm-bookmark-image-bookmark-p
  234. helm-bookmark-file-p
  235. helm-bookmark-helm-find-files-p
  236. helm-bookmark-addressbook-p)
  237. never (funcall pred bookmark)))
  238. (defun helm-bookmark-filter-setup-alist (fn)
  239. "Return a filtered `bookmark-alist' sorted alphabetically."
  240. (cl-loop for b in bookmark-alist
  241. for name = (car b)
  242. when (funcall fn b) collect
  243. (propertize name 'location (bookmark-location name))))
  244. ;;; Bookmark handlers
  245. ;;
  246. (defvar w3m-async-exec)
  247. (defun helm-bookmark-jump-w3m (bookmark)
  248. "Jump to W3m bookmark BOOKMARK, setting a new tab.
  249. If `browse-url-browser-function' is set to something else
  250. than `w3m-browse-url' use it."
  251. (require 'helm-net)
  252. (let* ((file (or (bookmark-prop-get bookmark 'filename)
  253. (bookmark-prop-get bookmark 'url)))
  254. (buf (generate-new-buffer-name "*w3m*"))
  255. (w3m-async-exec nil)
  256. ;; If user don't have anymore w3m installed let it browse its
  257. ;; bookmarks with default browser otherwise assume bookmark
  258. ;; have been bookmarked from w3m and use w3m.
  259. (browse-url-browser-function (or (and (fboundp 'w3m-browse-url)
  260. (executable-find "w3m")
  261. 'w3m-browse-url)
  262. browse-url-browser-function))
  263. (really-use-w3m (equal browse-url-browser-function 'w3m-browse-url)))
  264. (helm-browse-url file really-use-w3m)
  265. (when really-use-w3m
  266. (bookmark-default-handler
  267. `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))))
  268. ;; All bookmarks recorded with the handler provided with w3m
  269. ;; (`bookmark-w3m-bookmark-jump') will use our handler which open
  270. ;; the bookmark in a new tab or in an external browser depending
  271. ;; on `browse-url-browser-function'.
  272. (defalias 'bookmark-w3m-bookmark-jump 'helm-bookmark-jump-w3m)
  273. ;; Provide compatibility with old handlers provided in external
  274. ;; packages bookmark-extensions.el and bookmark+.
  275. (defalias 'bmkext-jump-woman 'woman-bookmark-jump)
  276. (defalias 'bmkext-jump-man 'Man-bookmark-jump)
  277. (defalias 'bmkext-jump-w3m 'helm-bookmark-jump-w3m)
  278. (defalias 'bmkext-jump-gnus 'gnus-summary-bookmark-jump)
  279. (defalias 'bookmarkp-jump-gnus 'gnus-summary-bookmark-jump)
  280. (defalias 'bookmarkp-jump-w3m 'helm-bookmark-jump-w3m)
  281. (defalias 'bookmarkp-jump-woman 'woman-bookmark-jump)
  282. (defalias 'bookmarkp-jump-man 'Man-bookmark-jump)
  283. ;;;; Filtered bookmark sources
  284. ;;
  285. ;;
  286. (defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark)
  287. ((filtered-candidate-transformer
  288. :initform '(helm-adaptive-sort
  289. helm-highlight-bookmark))))
  290. ;;; W3m bookmarks.
  291. ;;
  292. (defun helm-bookmark-w3m-setup-alist ()
  293. "Specialized filter function for bookmarks w3m."
  294. (helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p))
  295. (defvar helm-source-bookmark-w3m
  296. (helm-make-source "Bookmark W3m" 'helm-source-filtered-bookmarks
  297. :init (lambda ()
  298. (bookmark-maybe-load-default-file)
  299. (helm-init-candidates-in-buffer
  300. 'global (helm-bookmark-w3m-setup-alist)))))
  301. ;;; Images
  302. ;;
  303. (defun helm-bookmark-images-setup-alist ()
  304. "Specialized filter function for images bookmarks."
  305. (helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p))
  306. (defvar helm-source-bookmark-images
  307. (helm-make-source "Bookmark Images" 'helm-source-filtered-bookmarks
  308. :init (lambda ()
  309. (bookmark-maybe-load-default-file)
  310. (helm-init-candidates-in-buffer
  311. 'global (helm-bookmark-images-setup-alist)))))
  312. ;;; Woman Man
  313. ;;
  314. (defun helm-bookmark-man-setup-alist ()
  315. "Specialized filter function for bookmarks w3m."
  316. (helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p))
  317. (defvar helm-source-bookmark-man
  318. (helm-make-source "Bookmark Woman&Man" 'helm-source-filtered-bookmarks
  319. :init (lambda ()
  320. (bookmark-maybe-load-default-file)
  321. (helm-init-candidates-in-buffer
  322. 'global (helm-bookmark-man-setup-alist)))))
  323. ;;; Org files
  324. ;;
  325. (defun helm-bookmark-org-setup-alist ()
  326. "Specialized filter function for Org file bookmarks."
  327. (helm-bookmark-filter-setup-alist 'helm-bookmark-org-file-p))
  328. (defvar helm-source-bookmark-org
  329. (helm-make-source " Bookmarked Org files" 'helm-source-filtered-bookmarks
  330. :init (lambda ()
  331. (bookmark-maybe-load-default-file)
  332. (helm-init-candidates-in-buffer
  333. 'global (helm-bookmark-org-setup-alist)))))
  334. ;;; Gnus
  335. ;;
  336. (defun helm-bookmark-gnus-setup-alist ()
  337. "Specialized filter function for bookmarks gnus."
  338. (helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p))
  339. (defvar helm-source-bookmark-gnus
  340. (helm-make-source "Bookmark Gnus" 'helm-source-filtered-bookmarks
  341. :init (lambda ()
  342. (bookmark-maybe-load-default-file)
  343. (helm-init-candidates-in-buffer
  344. 'global (helm-bookmark-gnus-setup-alist)))))
  345. ;;; Info
  346. ;;
  347. (defun helm-bookmark-info-setup-alist ()
  348. "Specialized filter function for bookmarks info."
  349. (helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p))
  350. (defvar helm-source-bookmark-info
  351. (helm-make-source "Bookmark Info" 'helm-source-filtered-bookmarks
  352. :init (lambda ()
  353. (bookmark-maybe-load-default-file)
  354. (helm-init-candidates-in-buffer
  355. 'global (helm-bookmark-info-setup-alist)))))
  356. ;;; Files and directories
  357. ;;
  358. (defun helm-bookmark-local-files-setup-alist ()
  359. "Specialized filter function for bookmarks locals files."
  360. (helm-bookmark-filter-setup-alist 'helm-bookmark-file-p))
  361. (defvar helm-source-bookmark-files&dirs
  362. (helm-make-source "Bookmark Files&Directories" 'helm-source-filtered-bookmarks
  363. :init (lambda ()
  364. (bookmark-maybe-load-default-file)
  365. (helm-init-candidates-in-buffer
  366. 'global (helm-bookmark-local-files-setup-alist)))))
  367. ;;; Helm find files sessions.
  368. ;;
  369. (defun helm-bookmark-helm-find-files-setup-alist ()
  370. "Specialized filter function for `helm-find-files' bookmarks."
  371. (helm-bookmark-filter-setup-alist 'helm-bookmark-helm-find-files-p))
  372. (defun helm-bookmark-browse-project (candidate)
  373. "Run `helm-browse-project' from action."
  374. (with-helm-default-directory
  375. (bookmark-get-filename candidate)
  376. (helm-browse-project nil)))
  377. (defun helm-bookmark-run-browse-project ()
  378. "Run `helm-bookmark-browse-project' from keyboard."
  379. (interactive)
  380. (with-helm-alive-p
  381. (helm-exit-and-execute-action 'helm-bookmark-browse-project)))
  382. (put 'helm-bookmark-run-browse-project 'helm-only t)
  383. (defvar helm-bookmark-find-files-map
  384. (let ((map (make-sparse-keymap)))
  385. (set-keymap-parent map helm-bookmark-map)
  386. (define-key map (kbd "C-x C-d") 'helm-bookmark-run-browse-project)
  387. map))
  388. (defclass helm-bookmark-override-inheritor (helm-source) ())
  389. (defmethod helm--setup-source ((source helm-bookmark-override-inheritor))
  390. ;; Ensure `helm-source-in-buffer' method is called.
  391. (call-next-method)
  392. (setf (slot-value source 'action)
  393. (helm-append-at-nth
  394. (cl-loop for (name . action) in helm-type-bookmark-actions
  395. unless (memq action '(helm-bookmark-jump-other-frame
  396. helm-bookmark-jump-other-window))
  397. collect (cons name action))
  398. '(("Browse project" . helm-bookmark-browse-project)) 1))
  399. (setf (slot-value source 'keymap) helm-bookmark-find-files-map))
  400. (defclass helm-bookmark-find-files-class (helm-source-filtered-bookmarks
  401. helm-bookmark-override-inheritor)
  402. ())
  403. (defvar helm-source-bookmark-helm-find-files
  404. (helm-make-source "Bookmark helm-find-files sessions" 'helm-bookmark-find-files-class
  405. :init (lambda ()
  406. (bookmark-maybe-load-default-file)
  407. (helm-init-candidates-in-buffer
  408. 'global (helm-bookmark-helm-find-files-setup-alist)))
  409. :persistent-action (lambda (_candidate) (ignore))
  410. :persistent-help "Do nothing"))
  411. ;;; Uncategorized bookmarks
  412. ;;
  413. (defun helm-bookmark-uncategorized-setup-alist ()
  414. "Specialized filter function for uncategorized bookmarks."
  415. (helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p))
  416. (defvar helm-source-bookmark-uncategorized
  417. (helm-make-source "Bookmark uncategorized" 'helm-source-filtered-bookmarks
  418. :init (lambda ()
  419. (bookmark-maybe-load-default-file)
  420. (helm-init-candidates-in-buffer
  421. 'global (helm-bookmark-uncategorized-setup-alist)))))
  422. ;;; Transformer
  423. ;;
  424. (defun helm-highlight-bookmark (bookmarks _source)
  425. "Used as `filtered-candidate-transformer' to colorize bookmarks."
  426. (let ((non-essential t))
  427. (cl-loop for i in bookmarks
  428. for isfile = (bookmark-get-filename i)
  429. for hff = (helm-bookmark-helm-find-files-p i)
  430. for handlerp = (and (fboundp 'bookmark-get-handler)
  431. (bookmark-get-handler i))
  432. for isw3m = (and (fboundp 'helm-bookmark-w3m-bookmark-p)
  433. (helm-bookmark-w3m-bookmark-p i))
  434. for isgnus = (and (fboundp 'helm-bookmark-gnus-bookmark-p)
  435. (helm-bookmark-gnus-bookmark-p i))
  436. for isman = (and (fboundp 'helm-bookmark-man-bookmark-p) ; Man
  437. (helm-bookmark-man-bookmark-p i))
  438. for iswoman = (and (fboundp 'helm-bookmark-woman-bookmark-p) ; Woman
  439. (helm-bookmark-woman-bookmark-p i))
  440. for isannotation = (bookmark-get-annotation i)
  441. for isabook = (string= (bookmark-prop-get i 'type)
  442. "addressbook")
  443. for isinfo = (eq handlerp 'Info-bookmark-jump)
  444. for loc = (bookmark-location i)
  445. for len = (string-width i)
  446. for trunc = (if (and helm-bookmark-show-location
  447. (> len bookmark-bmenu-file-column))
  448. (helm-substring
  449. i bookmark-bmenu-file-column)
  450. i)
  451. ;; Add a * if bookmark have annotation
  452. if (and isannotation (not (string-equal isannotation "")))
  453. do (setq trunc (concat "*" (if helm-bookmark-show-location trunc i)))
  454. for sep = (and helm-bookmark-show-location
  455. (make-string (- (+ bookmark-bmenu-file-column 2)
  456. (string-width trunc))
  457. ? ))
  458. for bmk = (cond ( ;; info buffers
  459. isinfo
  460. (propertize trunc 'face 'helm-bookmark-info
  461. 'help-echo isfile))
  462. ( ;; w3m buffers
  463. isw3m
  464. (propertize trunc 'face 'helm-bookmark-w3m
  465. 'help-echo isfile))
  466. ( ;; gnus buffers
  467. isgnus
  468. (propertize trunc 'face 'helm-bookmark-gnus
  469. 'help-echo isfile))
  470. ( ;; Man Woman
  471. (or iswoman isman)
  472. (propertize trunc 'face 'helm-bookmark-man
  473. 'help-echo isfile))
  474. ( ;; Addressbook
  475. isabook
  476. (propertize trunc 'face 'helm-bookmark-addressbook))
  477. (;; Directories (helm-find-files)
  478. hff
  479. (if (and (file-remote-p isfile)
  480. (not (file-remote-p isfile nil t)))
  481. (propertize trunc 'face 'helm-bookmark-file-not-found
  482. 'help-echo isfile)
  483. (propertize trunc 'face 'helm-bookmark-directory
  484. 'help-echo isfile)))
  485. ( ;; Directories (dired)
  486. (and isfile
  487. ;; This is needed because `non-essential'
  488. ;; is not working on Emacs-24.2 and the behavior
  489. ;; of tramp seems to have changed since previous
  490. ;; versions (Need to reenter password even if a
  491. ;; first connection have been established,
  492. ;; probably when host is named differently
  493. ;; i.e machine/localhost)
  494. (and (not (file-remote-p isfile))
  495. (file-directory-p isfile)))
  496. (propertize trunc 'face 'helm-bookmark-directory
  497. 'help-echo isfile))
  498. ( ;; Non existing files.
  499. (and isfile
  500. ;; Be safe and call `file-exists-p'
  501. ;; only if file is not remote or
  502. ;; remote but connected.
  503. (or (and (file-remote-p isfile)
  504. (not (file-remote-p isfile nil t)))
  505. (not (file-exists-p isfile))))
  506. (propertize trunc 'face 'helm-bookmark-file-not-found
  507. 'help-echo isfile))
  508. ( ;; regular files
  509. t
  510. (propertize trunc 'face 'helm-bookmark-file
  511. 'help-echo isfile)))
  512. collect (if helm-bookmark-show-location
  513. (cons (concat bmk sep (if (listp loc) (car loc) loc))
  514. i)
  515. (cons bmk i)))))
  516. ;;; Edit/rename/save bookmarks.
  517. ;;
  518. ;;
  519. (defun helm-bookmark-edit-bookmark (bookmark-name)
  520. "Edit bookmark's name and file name, and maybe save them.
  521. BOOKMARK-NAME is the current (old) name of the bookmark to be renamed."
  522. (let ((bmk (helm-bookmark-get-bookmark-from-name bookmark-name))
  523. (handler (bookmark-prop-get bookmark-name 'handler)))
  524. (if (eq handler 'addressbook-bookmark-jump)
  525. (addressbook-bookmark-edit
  526. (assoc bmk bookmark-alist))
  527. (helm-bookmark-edit-bookmark-1 bookmark-name handler))))
  528. (defun helm-bookmark-edit-bookmark-1 (bookmark-name handler)
  529. (let* ((helm--reading-passwd-or-string t)
  530. (bookmark-fname (bookmark-get-filename bookmark-name))
  531. (bookmark-loc (bookmark-prop-get bookmark-name 'location))
  532. (new-name (read-from-minibuffer "Name: " bookmark-name))
  533. (new-loc (read-from-minibuffer "FileName or Location: "
  534. (or bookmark-fname
  535. (if (consp bookmark-loc)
  536. (car bookmark-loc)
  537. bookmark-loc))))
  538. (docid (and (eq handler 'mu4e-bookmark-jump)
  539. (read-number "Docid: " (cdr bookmark-loc)))))
  540. (when docid
  541. (setq new-loc (cons new-loc docid)))
  542. (when (and (not (equal new-name "")) (not (equal new-loc ""))
  543. (y-or-n-p "Save changes? "))
  544. (if bookmark-fname
  545. (progn
  546. (helm-bookmark-rename bookmark-name new-name 'batch)
  547. (bookmark-set-filename new-name new-loc))
  548. (bookmark-prop-set
  549. (bookmark-get-bookmark bookmark-name) 'location new-loc)
  550. (helm-bookmark-rename bookmark-name new-name 'batch))
  551. (helm-bookmark-maybe-save-bookmark)
  552. (list new-name new-loc))))
  553. (defun helm-bookmark-maybe-save-bookmark ()
  554. "Increment save counter and maybe save `bookmark-alist'."
  555. (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
  556. (when (bookmark-time-to-save-p) (bookmark-save)))
  557. (defun helm-bookmark-rename (old &optional new batch)
  558. "Change bookmark's name from OLD to NEW.
  559. Interactively:
  560. If called from the keyboard, then prompt for OLD.
  561. If called from the menubar, select OLD from a menu.
  562. If NEW is nil, then prompt for its string value.
  563. If BATCH is non-nil, then do not rebuild the menu list.
  564. While the user enters the new name, repeated `C-w' inserts consecutive
  565. words from the buffer into the new bookmark name."
  566. (interactive (list (bookmark-completing-read "Old bookmark name")))
  567. (bookmark-maybe-historicize-string old)
  568. (bookmark-maybe-load-default-file)
  569. (save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point)))
  570. (setq bookmark-current-buffer (current-buffer))
  571. (let ((newname (or new (read-from-minibuffer
  572. "New name: " nil
  573. (let ((now-map (copy-keymap minibuffer-local-map)))
  574. (define-key now-map "\C-w" 'bookmark-yank-word)
  575. now-map)
  576. nil 'bookmark-history))))
  577. (bookmark-set-name old newname)
  578. (setq bookmark-current-bookmark newname)
  579. (unless batch (bookmark-bmenu-surreptitiously-rebuild-list))
  580. (helm-bookmark-maybe-save-bookmark) newname))
  581. (defun helm-bookmark-run-edit ()
  582. "Run `helm-bookmark-edit-bookmark' from keyboard."
  583. (interactive)
  584. (with-helm-alive-p
  585. (helm-exit-and-execute-action 'helm-bookmark-edit-bookmark)))
  586. (put 'helm-bookmark-run-edit 'helm-only t)
  587. (defun helm-bookmark-run-jump-other-frame ()
  588. "Jump to bookmark other frame from keyboard."
  589. (interactive)
  590. (with-helm-alive-p
  591. (helm-exit-and-execute-action 'helm-bookmark-jump-other-frame)))
  592. (put 'helm-bookmark-run-jump-other-frame 'helm-only t)
  593. (defun helm-bookmark-run-jump-other-window ()
  594. "Jump to bookmark from keyboard."
  595. (interactive)
  596. (with-helm-alive-p
  597. (helm-exit-and-execute-action 'helm-bookmark-jump-other-window)))
  598. (put 'helm-bookmark-run-jump-other-window 'helm-only t)
  599. (defun helm-bookmark-run-delete ()
  600. "Delete bookmark from keyboard."
  601. (interactive)
  602. (with-helm-alive-p
  603. (when (y-or-n-p "Delete bookmark(s)?")
  604. (helm-exit-and-execute-action 'helm-delete-marked-bookmarks))))
  605. (put 'helm-bookmark-run-delete 'helm-only t)
  606. (defun helm-bookmark-get-bookmark-from-name (bmk)
  607. "Return bookmark name even if it is a bookmark with annotation.
  608. e.g prepended with *."
  609. (let ((bookmark (replace-regexp-in-string "\\`\\*" "" bmk)))
  610. (if (assoc bookmark bookmark-alist) bookmark bmk)))
  611. (defun helm-delete-marked-bookmarks (_ignore)
  612. "Delete this bookmark or all marked bookmarks."
  613. (cl-dolist (i (helm-marked-candidates))
  614. (bookmark-delete (helm-bookmark-get-bookmark-from-name i)
  615. 'batch)))
  616. ;;;###autoload
  617. (defun helm-bookmarks ()
  618. "Preconfigured `helm' for bookmarks."
  619. (interactive)
  620. (helm :sources '(helm-source-bookmarks
  621. helm-source-bookmark-set)
  622. :buffer "*helm bookmarks*"
  623. :default (buffer-name helm-current-buffer)))
  624. ;;;###autoload
  625. (defun helm-filtered-bookmarks ()
  626. "Preconfigured helm for bookmarks (filtered by category).
  627. Optional source `helm-source-bookmark-addressbook' is loaded
  628. only if external addressbook-bookmark package is installed."
  629. (interactive)
  630. (helm :sources helm-bookmark-default-filtered-sources
  631. :prompt "Search Bookmark: "
  632. :buffer "*helm filtered bookmarks*"
  633. :default (list (thing-at-point 'symbol)
  634. (buffer-name helm-current-buffer))))
  635. (provide 'helm-bookmark)
  636. ;; Local Variables:
  637. ;; byte-compile-warnings: (not obsolete)
  638. ;; coding: utf-8
  639. ;; indent-tabs-mode: nil
  640. ;; End:
  641. ;;; helm-bookmark.el ends here