mirror of https://github.com/Chizi123/.emacs.d.git

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