Mercurial > emacs

comparison lisp/bookmark.el @ 105787:d5f02d259103

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(bookmark-insert-location, bookmark-bmenu-list) (bookmark-bmenu-show-filenames, bookmark-bmenu-hide-filenames): Don't consider whether the display supports colors. (bookmark-import-new-list): Use dolist. (bookmark-bmenu-mode-map): Move initialization into declaration. (bookmark-bmenu-list): Use dolist, simplify. (bookmark-show-all-annotations): Use save-selected-window and dolist. (menu-bar-final-items): Use push.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 28 Oct 2009 03:09:11 +0000
parents 2a4b89270020
children 0a019b48e945
comparison
equal deleted inserted replaced
105786:b88f8aaabdf2 105787:d5f02d259103
460 (bookmark-maybe-load-default-file) ; paranoia 460 (bookmark-maybe-load-default-file) ; paranoia
461 (if (listp last-nonmenu-event) 461 (if (listp last-nonmenu-event)
462 (bookmark-menu-popup-paned-menu t prompt (bookmark-all-names)) 462 (bookmark-menu-popup-paned-menu t prompt (bookmark-all-names))
463 (let* ((completion-ignore-case bookmark-completion-ignore-case) 463 (let* ((completion-ignore-case bookmark-completion-ignore-case)
464 (default default) 464 (default default)
465 (prompt (if default 465 (prompt (concat prompt (if default
466 (concat prompt (format " (%s): " default)) 466 (format " (%s): " default)
467 (concat prompt ": "))) 467 ": ")))
468 (str 468 (str
469 (completing-read prompt 469 (completing-read prompt
470 bookmark-alist 470 bookmark-alist
471 nil 471 nil
472 0 472 0
1188 (interactive (list (bookmark-completing-read "Insert bookmark location"))) 1188 (interactive (list (bookmark-completing-read "Insert bookmark location")))
1189 (or no-history (bookmark-maybe-historicize-string bookmark)) 1189 (or no-history (bookmark-maybe-historicize-string bookmark))
1190 (let ((start (point))) 1190 (let ((start (point)))
1191 (prog1 1191 (prog1
1192 (insert (bookmark-location bookmark)) ; *Return this line* 1192 (insert (bookmark-location bookmark)) ; *Return this line*
1193 (if (and (display-color-p) (display-mouse-p)) 1193 (if (display-mouse-p)
1194 (add-text-properties 1194 (add-text-properties
1195 start 1195 start
1196 (save-excursion (re-search-backward 1196 (save-excursion (re-search-backward
1197 "[^ \t]") 1197 "[^ \t]")
1198 (1+ (point))) 1198 (1+ (point)))
1199 '(mouse-face highlight 1199 '(mouse-face highlight
1200 follow-link t 1200 follow-link t
1201 help-echo "mouse-2: go to this bookmark in other window")))))) 1201 help-echo "mouse-2: go to this bookmark in other window"))))))
1202 1202
1203 ;;;###autoload 1203 ;;;###autoload
1396 1396
1397 (defun bookmark-import-new-list (new-list) 1397 (defun bookmark-import-new-list (new-list)
1398 "Add NEW-LIST of bookmarks to `bookmark-alist'. 1398 "Add NEW-LIST of bookmarks to `bookmark-alist'.
1399 Rename new bookmarks as needed using suffix \"<N>\" (N=1,2,3...), when 1399 Rename new bookmarks as needed using suffix \"<N>\" (N=1,2,3...), when
1400 they conflict with existing bookmark names." 1400 they conflict with existing bookmark names."
1401 (let ((lst new-list) 1401 (let ((names (bookmark-all-names)))
1402 (names (bookmark-all-names))) 1402 (dolist (full-record new-list)
1403 (while lst 1403 (bookmark-maybe-rename full-record names)
1404 (let* ((full-record (car lst))) 1404 (setq bookmark-alist (nconc bookmark-alist (list full-record)))
1405 (bookmark-maybe-rename full-record names) 1405 (push (bookmark-name-from-full-record full-record) names))))
1406 (setq bookmark-alist (nconc bookmark-alist (list full-record)))
1407 (setq names (cons (bookmark-name-from-full-record full-record) names))
1408 (setq lst (cdr lst))))))
1409 1406
1410 1407
1411 (defun bookmark-maybe-rename (full-record names) 1408 (defun bookmark-maybe-rename (full-record names)
1412 "Rename bookmark FULL-RECORD if its current name is already used. 1409 "Rename bookmark FULL-RECORD if its current name is already used.
1413 This is a helper for `bookmark-import-new-list'." 1410 This is a helper for `bookmark-import-new-list'."
1489 1486
1490 1487
1491 (defvar bookmark-bmenu-hidden-bookmarks ()) 1488 (defvar bookmark-bmenu-hidden-bookmarks ())
1492 1489
1493 1490
1494 (defvar bookmark-bmenu-mode-map nil) 1491 (defvar bookmark-bmenu-mode-map
1495 1492 (let ((map (make-keymap)))
1496 1493 (suppress-keymap map t)
1497 (if bookmark-bmenu-mode-map 1494 (define-key map "q" 'quit-window)
1498 nil 1495 (define-key map "v" 'bookmark-bmenu-select)
1499 (setq bookmark-bmenu-mode-map (make-keymap)) 1496 (define-key map "w" 'bookmark-bmenu-locate)
1500 (suppress-keymap bookmark-bmenu-mode-map t) 1497 (define-key map "2" 'bookmark-bmenu-2-window)
1501 (define-key bookmark-bmenu-mode-map "q" 'quit-window) 1498 (define-key map "1" 'bookmark-bmenu-1-window)
1502 (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select) 1499 (define-key map "j" 'bookmark-bmenu-this-window)
1503 (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate) 1500 (define-key map "\C-c\C-c" 'bookmark-bmenu-this-window)
1504 (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window) 1501 (define-key map "f" 'bookmark-bmenu-this-window)
1505 (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window) 1502 (define-key map "\C-m" 'bookmark-bmenu-this-window)
1506 (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window) 1503 (define-key map "o" 'bookmark-bmenu-other-window)
1507 (define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window) 1504 (define-key map "\C-o" 'bookmark-bmenu-switch-other-window)
1508 (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window) 1505 (define-key map "s" 'bookmark-bmenu-save)
1509 (define-key bookmark-bmenu-mode-map "\C-m" 'bookmark-bmenu-this-window) 1506 (define-key map "k" 'bookmark-bmenu-delete)
1510 (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window) 1507 (define-key map "\C-d" 'bookmark-bmenu-delete-backwards)
1511 (define-key bookmark-bmenu-mode-map "\C-o" 1508 (define-key map "x" 'bookmark-bmenu-execute-deletions)
1512 'bookmark-bmenu-switch-other-window) 1509 (define-key map "d" 'bookmark-bmenu-delete)
1513 (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save) 1510 (define-key map " " 'next-line)
1514 (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete) 1511 (define-key map "n" 'next-line)
1515 (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards) 1512 (define-key map "p" 'previous-line)
1516 (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions) 1513 (define-key map "\177" 'bookmark-bmenu-backup-unmark)
1517 (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete) 1514 (define-key map "?" 'describe-mode)
1518 (define-key bookmark-bmenu-mode-map " " 'next-line) 1515 (define-key map "u" 'bookmark-bmenu-unmark)
1519 (define-key bookmark-bmenu-mode-map "n" 'next-line) 1516 (define-key map "m" 'bookmark-bmenu-mark)
1520 (define-key bookmark-bmenu-mode-map "p" 'previous-line) 1517 (define-key map "l" 'bookmark-bmenu-load)
1521 (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark) 1518 (define-key map "r" 'bookmark-bmenu-rename)
1522 (define-key bookmark-bmenu-mode-map "?" 'describe-mode) 1519 (define-key map "R" 'bookmark-bmenu-relocate)
1523 (define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark) 1520 (define-key map "t" 'bookmark-bmenu-toggle-filenames)
1524 (define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark) 1521 (define-key map "a" 'bookmark-bmenu-show-annotation)
1525 (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load) 1522 (define-key map "A" 'bookmark-bmenu-show-all-annotations)
1526 (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename) 1523 (define-key map "e" 'bookmark-bmenu-edit-annotation)
1527 (define-key bookmark-bmenu-mode-map "R" 'bookmark-bmenu-relocate) 1524 (define-key map [mouse-2] 'bookmark-bmenu-other-window-with-mouse)
1528 (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames) 1525 map))
1529 (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
1530 (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations)
1531 (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)
1532 (define-key bookmark-bmenu-mode-map [mouse-2]
1533 'bookmark-bmenu-other-window-with-mouse))
1534
1535
1536 1526
1537 ;; Bookmark Buffer Menu mode is suitable only for specially formatted 1527 ;; Bookmark Buffer Menu mode is suitable only for specially formatted
1538 ;; data. 1528 ;; data.
1539 (put 'bookmark-bmenu-mode 'mode-class 'special) 1529 (put 'bookmark-bmenu-mode 'mode-class 'special)
1540 1530
1572 (let ((inhibit-read-only t)) 1562 (let ((inhibit-read-only t))
1573 (erase-buffer) 1563 (erase-buffer)
1574 (insert "% Bookmark\n- --------\n") 1564 (insert "% Bookmark\n- --------\n")
1575 (add-text-properties (point-min) (point) 1565 (add-text-properties (point-min) (point)
1576 '(font-lock-face bookmark-menu-heading)) 1566 '(font-lock-face bookmark-menu-heading))
1577 (mapc 1567 (dolist (full-record (bookmark-maybe-sort-alist))
1578 (lambda (full-record) 1568 ;; if a bookmark has an annotation, prepend a "*"
1579 ;; if a bookmark has an annotation, prepend a "*" 1569 ;; in the list of bookmarks.
1580 ;; in the list of bookmarks. 1570 (let ((annotation (bookmark-get-annotation full-record)))
1581 (let ((annotation (bookmark-get-annotation 1571 (insert (if (and annotation (not (string-equal annotation "")))
1582 (bookmark-name-from-full-record full-record)))) 1572 " *" " "))
1583 (if (and annotation (not (string-equal annotation ""))) 1573 (let ((start (point)))
1584 (insert " *") 1574 (insert (bookmark-name-from-full-record full-record))
1585 (insert " ")) 1575 (if (display-mouse-p)
1586 (let ((start (point))) 1576 (add-text-properties
1587 (insert (bookmark-name-from-full-record full-record)) 1577 start
1588 (if (and (display-color-p) (display-mouse-p)) 1578 (save-excursion (re-search-backward
1589 (add-text-properties 1579 "[^ \t]")
1590 start 1580 (1+ (point)))
1591 (save-excursion (re-search-backward 1581 '(mouse-face highlight
1592 "[^ \t]") 1582 follow-link t
1593 (1+ (point))) 1583 help-echo "mouse-2: go to this bookmark in other window")))
1594 '(mouse-face highlight 1584 (insert "\n")))))
1595 follow-link t 1585
1596 help-echo "mouse-2: go to this bookmark in other window")))
1597 (insert "\n")
1598 )))
1599 (bookmark-maybe-sort-alist)))
1600 (goto-char (point-min)) 1586 (goto-char (point-min))
1601 (forward-line 2) 1587 (forward-line 2)
1602 (bookmark-bmenu-mode) 1588 (bookmark-bmenu-mode)
1603 (if bookmark-bmenu-toggle-filenames 1589 (if bookmark-bmenu-toggle-filenames
1604 (bookmark-bmenu-toggle-filenames t))) 1590 (bookmark-bmenu-toggle-filenames t)))
1686 (setq bookmark-bmenu-hidden-bookmarks 1672 (setq bookmark-bmenu-hidden-bookmarks
1687 (cons bmrk bookmark-bmenu-hidden-bookmarks)) 1673 (cons bmrk bookmark-bmenu-hidden-bookmarks))
1688 (let ((start (save-excursion (end-of-line) (point)))) 1674 (let ((start (save-excursion (end-of-line) (point))))
1689 (move-to-column bookmark-bmenu-file-column t) 1675 (move-to-column bookmark-bmenu-file-column t)
1690 ;; Strip off `mouse-face' from the white spaces region. 1676 ;; Strip off `mouse-face' from the white spaces region.
1691 (if (and (display-color-p) (display-mouse-p)) 1677 (if (display-mouse-p)
1692 (remove-text-properties start (point) 1678 (remove-text-properties start (point)
1693 '(mouse-face nil help-echo nil)))) 1679 '(mouse-face nil help-echo nil))))
1694 (delete-region (point) (progn (end-of-line) (point))) 1680 (delete-region (point) (progn (end-of-line) (point)))
1695 (insert " ") 1681 (insert " ")
1696 ;; Pass the NO-HISTORY arg: 1682 ;; Pass the NO-HISTORY arg:
1720 (while bookmark-bmenu-hidden-bookmarks 1706 (while bookmark-bmenu-hidden-bookmarks
1721 (move-to-column bookmark-bmenu-bookmark-column t) 1707 (move-to-column bookmark-bmenu-bookmark-column t)
1722 (bookmark-kill-line) 1708 (bookmark-kill-line)
1723 (let ((start (point))) 1709 (let ((start (point)))
1724 (insert (car bookmark-bmenu-hidden-bookmarks)) 1710 (insert (car bookmark-bmenu-hidden-bookmarks))
1725 (if (and (display-color-p) (display-mouse-p)) 1711 (if (display-mouse-p)
1726 (add-text-properties 1712 (add-text-properties
1727 start 1713 start
1728 (save-excursion (re-search-backward 1714 (save-excursion (re-search-backward
1729 "[^ \t]") 1715 "[^ \t]")
1730 (1+ (point))) 1716 (1+ (point)))
1799 (pop-to-buffer old-buf)))))) 1785 (pop-to-buffer old-buf))))))
1800 1786
1801 1787
1802 (defun bookmark-show-all-annotations () 1788 (defun bookmark-show-all-annotations ()
1803 "Display the annotations for all bookmarks in a buffer." 1789 "Display the annotations for all bookmarks in a buffer."
1804 (let ((old-buf (current-buffer))) 1790 (save-selected-window
1805 (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t) 1791 (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
1806 (delete-region (point-min) (point-max)) 1792 (delete-region (point-min) (point-max))
1807 (mapc 1793 (dolist (full-record bookmark-alist)
1808 (lambda (full-record) 1794 (let* ((name (bookmark-name-from-full-record full-record))
1809 (let* ((name (bookmark-name-from-full-record full-record)) 1795 (ann (bookmark-get-annotation full-record)))
1810 (ann (bookmark-get-annotation name))) 1796 (insert (concat name ":\n"))
1811 (insert (concat name ":\n")) 1797 (if (and ann (not (string-equal ann "")))
1812 (if (and ann (not (string-equal ann ""))) 1798 ;; insert the annotation, indented by 4 spaces.
1813 ;; insert the annotation, indented by 4 spaces. 1799 (progn
1814 (progn 1800 (save-excursion (insert ann) (unless (bolp)
1815 (save-excursion (insert ann) (unless (bolp) 1801 (insert "\n")))
1816 (insert "\n"))) 1802 (while (< (point) (point-max))
1817 (while (< (point) (point-max)) 1803 (beginning-of-line) ; paranoia
1818 (beginning-of-line) ; paranoia 1804 (insert " ")
1819 (insert " ") 1805 (forward-line)
1820 (forward-line) 1806 (end-of-line))))))
1821 (end-of-line)))))) 1807 (goto-char (point-min))))
1822 bookmark-alist)
1823 (goto-char (point-min))
1824 (pop-to-buffer old-buf)))
1825 1808
1826 1809
1827 (defun bookmark-bmenu-mark () 1810 (defun bookmark-bmenu-mark ()
1828 "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]." 1811 "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
1829 (interactive) 1812 (interactive)
2169 (defalias 'menu-bar-bookmark-map menu-bar-bookmark-map) 2152 (defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
2170 2153
2171 ;; make bookmarks appear toward the right side of the menu. 2154 ;; make bookmarks appear toward the right side of the menu.
2172 (if (boundp 'menu-bar-final-items) 2155 (if (boundp 'menu-bar-final-items)
2173 (if menu-bar-final-items 2156 (if menu-bar-final-items
2174 (setq menu-bar-final-items 2157 (push 'bookmark menu-bar-final-items))
2175 (cons 'bookmark menu-bar-final-items)))
2176 (setq menu-bar-final-items '(bookmark))) 2158 (setq menu-bar-final-items '(bookmark)))
2177 2159
2178 ;;;; end bookmark menu stuff ;;;; 2160 ;;;; end bookmark menu stuff ;;;;
2179 2161
2180 2162