1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292
|
;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001 Free Software Foundation
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
;; Created: July, 1993
;; Keywords: bookmarks, placeholders, annotations
;; This file is part of GNU Emacs.
;; GNU Emacs 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 2, or (at your option)
;; any later version.
;; GNU Emacs 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; This package is for setting "bookmarks" in files. A bookmark
;; associates a string with a location in a certain file. Thus, you
;; can navigate your way to that location by providing the string.
;; See the "User Variables" section for customizations.
;; Thanks to David Bremner <bremner@cs.sfu.ca> for thinking of and
;; then implementing the bookmark-current-bookmark idea. He even
;; sent *patches*, bless his soul...
;; Thanks to Gregory M. Saunders <saunders@cis.ohio-state.edu> for
;; fixing and improving bookmark-time-to-save-p.
;; Thanks go to Andrew V. Klein <avk@cig.mot.com> for the code that
;; sorts the alist before presenting it to the user (in bookmark-bmenu-list
;; and the menu-bar).
;; And much thanks to David Hughes <djh@harston.cv.com> for many small
;; suggestions and the code to implement them (like
;; bookmark-bmenu-check-position, and some of the Lucid compatibility
;; stuff).
;; Kudos (whatever they are) go to Jim Blandy <jimb@red-bean.com>
;; for his eminently sensible suggestion to separate bookmark-jump
;; into bookmark-jump and bookmark-jump-noselect, which made many
;; other things cleaner as well.
;; Thanks to Roland McGrath for encouragement and help with defining
;; autoloads on the menu-bar.
;; Jonathan Stigelman <stig@hackvan.com> gave patches for default
;; values in bookmark-jump and bookmark-set. Everybody please keep
;; all the keystrokes they save thereby and send them to him at the
;; end of each year :-) (No, seriously, thanks Jonathan!)
;; Buckets of gratitude to John Grabowski <johng@media.mit.edu> for
;; thinking up the annotations feature and implementing it so well.
;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad
;; <olstad@msc.edu>.
;; Thanks to Mikio Nakajima <PBC01764@niftyserve.or.jp> for many bugs
;; reported and fixed.
;; Thank you, Michael Kifer, for contributing the XEmacs support.
;; Enough with the credits already, get on to the good stuff:
;; FAVORITE CHINESE RESTAURANT:
;; Boy, that's a tough one. Probably Hong Min, or maybe Emperor's
;; Choice (both in Chicago's Chinatown). Well, both. How about you?
;;; Code:
(require 'pp)
;;; Misc comments:
;;
;; If variable bookmark-use-annotations is non-nil, an annotation is
;; queried for when setting a bookmark.
;;
;; The bookmark list is sorted lexically by default, but you can turn
;; this off by setting bookmark-sort-flag to nil. If it is nil, then
;; the list will be presented in the order it is recorded
;; (chronologically), which is actually fairly useful as well.
;;; User Variables
(defgroup bookmark nil
"Setting, annotation and jumping to bookmarks."
:group 'matching)
(defcustom bookmark-use-annotations nil
"*If non-nil, saving a bookmark queries for an annotation in a buffer."
:type 'boolean
:group 'bookmark)
(defcustom bookmark-save-flag t
"*Controls when Emacs saves bookmarks to a file.
--> nil means never save bookmarks, except when `bookmark-save' is
explicitly called \(\\[bookmark-save]\).
--> t means save bookmarks when Emacs is killed.
--> Otherwise, it should be a number that is the frequency with which
the bookmark list is saved \(i.e.: the number of times which
Emacs' bookmark list may be modified before it is automatically
saved.\). If it is a number, Emacs will also automatically save
bookmarks when it is killed.
Therefore, the way to get it to save every time you make or delete a
bookmark is to set this variable to 1 \(or 0, which produces the same
behavior.\)
To specify the file in which to save them, modify the variable
`bookmark-default-file', which is `~/.emacs.bmk' by default."
:type '(choice (const nil) integer (other t))
:group 'bookmark)
(defconst bookmark-old-default-file "~/.emacs-bkmrks"
"*The `.emacs.bmk' file used to be called this name.")
;; defvarred to avoid a compilation warning:
(defvar bookmark-file nil
"Old name for `bookmark-default-file'.")
(defcustom bookmark-default-file
(if bookmark-file
;; In case user set `bookmark-file' in her .emacs:
bookmark-file
(convert-standard-filename "~/.emacs.bmk"))
"*File in which to save bookmarks by default."
:type 'file
:group 'bookmark)
(defcustom bookmark-version-control 'nospecial
"*Whether or not to make numbered backups of the bookmark file.
It can have four values: t, nil, `never', and `nospecial'.
The first three have the same meaning that they do for the
variable `version-control', and the final value `nospecial' means just
use the value of `version-control'."
:type '(choice (const nil) (const never) (const nospecial)
(other t))
:group 'bookmark)
(defcustom bookmark-completion-ignore-case t
"*Non-nil means bookmark functions ignore case in completion."
:type 'boolean
:group 'bookmark)
(defcustom bookmark-sort-flag t
"*Non-nil means that bookmarks will be displayed sorted by bookmark name.
Otherwise they will be displayed in LIFO order (that is, most
recently set ones come first, oldest ones come last)."
:type 'boolean
:group 'bookmark)
(defcustom bookmark-automatically-show-annotations t
"*Nil means don't show annotations when jumping to a bookmark."
:type 'boolean
:group 'bookmark)
(defcustom bookmark-bmenu-file-column 30
"*Column at which to display filenames in a buffer listing bookmarks.
You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
:type 'integer
:group 'bookmark)
(defcustom bookmark-bmenu-toggle-filenames t
"*Non-nil means show filenames when listing bookmarks.
This may result in truncated bookmark names. To disable this, put the
following in your `.emacs' file:
\(setq bookmark-bmenu-toggle-filenames nil\)"
:type 'boolean
:group 'bookmark)
(defcustom bookmark-menu-length 70
"*Maximum length of a bookmark name displayed on a popup menu."
:type 'integer
:group 'boolean)
;;; No user-serviceable parts beyond this point.
;; Is it XEmacs?
(defconst bookmark-xemacsp
(string-match "\\(Lucid\\|Xemacs\\)" emacs-version))
;; Added for lucid emacs compatibility, db
(or (fboundp 'defalias) (fset 'defalias 'fset))
;; suggested for lucid compatibility by david hughes:
(or (fboundp 'frame-height) (defalias 'frame-height 'screen-height))
;; This variable is probably obsolete now...
(or (boundp 'baud-rate)
;; some random value higher than 9600
(setq baud-rate 19200))
;;; Keymap stuff:
;; Set up these bindings dumping time *only*;
;; if the user alters them, don't override the user when loading bookmark.el.
;;;###autoload (define-key ctl-x-map "rb" 'bookmark-jump)
;;;###autoload (define-key ctl-x-map "rm" 'bookmark-set)
;;;###autoload (define-key ctl-x-map "rl" 'bookmark-bmenu-list)
;;;###autoload
(defvar bookmark-map nil
"Keymap containing bindings to bookmark functions.
It is not bound to any key by default: to bind it
so that you have a bookmark prefix, just use `global-set-key' and bind a
key of your choice to `bookmark-map'. All interactive bookmark
functions have a binding in this keymap.")
;;;###autoload
(define-prefix-command 'bookmark-map)
;; Read the help on all of these functions for details...
;;;###autoload
(define-key bookmark-map "x" 'bookmark-set)
;;;###autoload
(define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark"
;;;###autoload
(define-key bookmark-map "j" 'bookmark-jump)
;;;###autoload
(define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go"
;;;###autoload
(define-key bookmark-map "i" 'bookmark-insert)
;;;###autoload
(define-key bookmark-map "e" 'edit-bookmarks)
;;;###autoload
(define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find"
;;;###autoload
(define-key bookmark-map "r" 'bookmark-rename)
;;;###autoload
(define-key bookmark-map "d" 'bookmark-delete)
;;;###autoload
(define-key bookmark-map "l" 'bookmark-load)
;;;###autoload
(define-key bookmark-map "w" 'bookmark-write)
;;;###autoload
(define-key bookmark-map "s" 'bookmark-save)
;;; The annotation maps.
(defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map)
"Keymap for composing an annotation for a bookmark.")
(define-key bookmark-read-annotation-mode-map "\C-c\C-c"
'bookmark-send-annotation)
;;; Core variables and data structures:
(defvar bookmark-alist ()
"Association list of bookmarks and their records.
You probably don't want to change the value of this alist yourself;
instead, let the various bookmark functions do it for you.
The format of the alist is
\(BOOKMARK1 BOOKMARK2 ...\)
where each BOOKMARK is of the form
\(NAME
\(filename . FILE\)
\(front-context-string . FRONT-STR\)
\(rear-context-string . REAR-STR\)
\(position . POS\)
\(info-node . POS\)
\(annotation . ANNOTATION\)\)
So the cdr of each bookmark is an alist too.
`info-node' is optional, by the way.")
(defvar bookmarks-already-loaded nil)
;; more stuff added by db.
(defvar bookmark-current-bookmark nil
"Name of bookmark most recently used in the current file.
It is buffer local, used to make moving a bookmark forward
through a file easier.")
(make-variable-buffer-local 'bookmark-current-bookmark)
(defvar bookmark-alist-modification-count 0
"Number of modifications to bookmark list since it was last saved.")
(defvar bookmark-search-size 16
"Length of the context strings recorded on either side of a bookmark.")
(defvar bookmark-current-point 0)
(defvar bookmark-yank-point 0)
(defvar bookmark-current-buffer nil)
;; Helper functions.
;; Only functions on this page and the next one (file formats) need to
;; know anything about the format of bookmark-alist entries.
;; Everyone else should go through them.
(defun bookmark-name-from-full-record (full-record)
"Return name of FULL-RECORD \(an alist element instead of a string\)."
(car full-record))
(defun bookmark-all-names ()
"Return a list of all current bookmark names."
(bookmark-maybe-load-default-file)
(mapcar
(lambda (full-record)
(bookmark-name-from-full-record full-record))
bookmark-alist))
(defun bookmark-get-bookmark (bookmark)
"Return the full entry for BOOKMARK in bookmark-alist.
If BOOKMARK is not a string, return nil."
(when (stringp bookmark)
(apply (if bookmark-completion-ignore-case
#'assoc-ignore-case
#'assoc)
(list bookmark bookmark-alist))))
(defun bookmark-get-bookmark-record (bookmark)
"Return the guts of the entry for BOOKMARK in bookmark-alist.
That is, all information but the name."
(car (cdr (bookmark-get-bookmark bookmark))))
(defun bookmark-set-name (bookmark newname)
"Set BOOKMARK's name to NEWNAME."
(setcar
(if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark)
newname))
(defun bookmark-get-annotation (bookmark)
"Return the annotation of BOOKMARK, or nil if none."
(cdr (assq 'annotation (bookmark-get-bookmark-record bookmark))))
(defun bookmark-set-annotation (bookmark ann)
"Set the annotation of BOOKMARK to ANN."
(let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark))))
(if cell
(setcdr cell ann)
(nconc (bookmark-get-bookmark-record bookmark)
(list (cons 'annotation ann))))))
(defun bookmark-get-filename (bookmark)
"Return the full filename of BOOKMARK."
(cdr (assq 'filename (bookmark-get-bookmark-record bookmark))))
(defun bookmark-set-filename (bookmark filename)
"Set the full filename of BOOKMARK to FILENAME."
(let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark))))
(if cell
(setcdr cell filename)
(nconc (bookmark-get-bookmark-record bookmark)
(list (cons 'filename filename))))))
(defun bookmark-get-position (bookmark)
"Return the position \(i.e.: point\) of BOOKMARK."
(cdr (assq 'position (bookmark-get-bookmark-record bookmark))))
(defun bookmark-set-position (bookmark position)
"Set the position \(i.e.: point\) of BOOKMARK to POSITION."
(let ((cell (assq 'position (bookmark-get-bookmark-record bookmark))))
(if cell
(setcdr cell position)
(nconc (bookmark-get-bookmark-record bookmark)
(list (cons 'position position))))))
(defun bookmark-get-front-context-string (bookmark)
"Return the front-context-string of BOOKMARK."
(cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark))))
(defun bookmark-set-front-context-string (bookmark string)
"Set the front-context-string of BOOKMARK to STRING."
(let ((cell (assq 'front-context-string
(bookmark-get-bookmark-record bookmark))))
(if cell
(setcdr cell string)
(nconc (bookmark-get-bookmark-record bookmark)
(list (cons 'front-context-string string))))))
(defun bookmark-get-rear-context-string (bookmark)
"Return the rear-context-string of BOOKMARK."
(cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark))))
(defun bookmark-set-rear-context-string (bookmark string)
"Set the rear-context-string of BOOKMARK to STRING."
(let ((cell (assq 'rear-context-string
(bookmark-get-bookmark-record bookmark))))
(if cell
(setcdr cell string)
(nconc (bookmark-get-bookmark-record bookmark)
(list (cons 'rear-context-string string))))))
(defun bookmark-get-info-node (bookmark)
"Get the info node associated with BOOKMARK."
(cdr (assq 'info-node (bookmark-get-bookmark-record bookmark))))
(defun bookmark-set-info-node (bookmark node)
"Set the Info node of BOOKMARK to NODE."
(let ((cell (assq 'info-node
(bookmark-get-bookmark-record bookmark))))
(if cell
(setcdr cell node)
(nconc (bookmark-get-bookmark-record bookmark)
(list (cons 'info-node node)))))
(message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
(sit-for 4)
)
(defvar bookmark-history nil
"The history list for bookmark functions.")
(defun bookmark-completing-read (prompt &optional default)
"Prompting with PROMPT, read a bookmark name in completion.
PROMPT will get a \": \" stuck on the end no matter what, so you
probably don't want to include one yourself.
Optional second arg DEFAULT is a string to return if the user enters
the empty string."
(bookmark-maybe-load-default-file) ; paranoia
(let* ((completion-ignore-case bookmark-completion-ignore-case)
(default default)
(prompt (if default
(concat prompt (format " (%s): " default))
(concat prompt ": ")))
(str
(completing-read prompt
bookmark-alist
nil
0
nil
'bookmark-history)))
(if (string-equal "" str)
(list default)
(list str))))
(defmacro bookmark-maybe-historicize-string (string)
"Put STRING into the bookmark prompt history, if caller non-interactive.
We need this because sometimes bookmark functions are invoked from
menus, so `completing-read' never gets a chance to set `bookmark-history'."
`(or
(interactive-p)
(setq bookmark-history (cons ,string bookmark-history))))
(defun bookmark-make (name &optional annotation overwrite info-node)
"Make a bookmark named NAME.
Optional second arg ANNOTATION gives it an annotation.
Optional third arg OVERWRITE means replace any existing bookmarks with
this name.
Optional fourth arg INFO-NODE means this bookmark is at info node
INFO-NODE, so record this fact in the bookmark's entry."
(bookmark-maybe-load-default-file)
(let ((stripped-name (copy-sequence name)))
(or bookmark-xemacsp
;; XEmacs's `set-text-properties' doesn't work on
;; free-standing strings, apparently.
(set-text-properties 0 (length stripped-name) nil stripped-name))
(if (and (bookmark-get-bookmark stripped-name) (not overwrite))
;; already existing bookmark under that name and
;; no prefix arg means just overwrite old bookmark
(setcdr (bookmark-get-bookmark stripped-name)
(list (bookmark-make-cell annotation info-node)))
;; otherwise just cons it onto the front (either the bookmark
;; doesn't exist already, or there is no prefix arg. In either
;; case, we want the new bookmark consed onto the alist...)
(setq bookmark-alist
(cons
(list stripped-name
(bookmark-make-cell annotation info-node))
bookmark-alist)))
;; Added by db
(setq bookmark-current-bookmark stripped-name)
(setq bookmark-alist-modification-count
(1+ bookmark-alist-modification-count))
(if (bookmark-time-to-save-p)
(bookmark-save))))
(defun bookmark-make-cell (annotation &optional info-node)
"Return the record part of a new bookmark, given ANNOTATION.
Must be at the correct position in the buffer in which the bookmark is
being set. This might change someday.
Optional second arg INFO-NODE means this bookmark is at info node
INFO-NODE, so record this fact in the bookmark's entry."
(let ((the-record
(` ((filename . (, (bookmark-buffer-file-name)))
(front-context-string
. (, (if (>= (- (point-max) (point)) bookmark-search-size)
(buffer-substring-no-properties
(point)
(+ (point) bookmark-search-size))
nil)))
(rear-context-string
. (, (if (>= (- (point) (point-min)) bookmark-search-size)
(buffer-substring-no-properties
(point)
(- (point) bookmark-search-size))
nil)))
(position . (, (point)))
))))
;; Now fill in the optional parts:
;; Take no chances with text properties
(set-text-properties 0 (length annotation) nil annotation)
(set-text-properties 0 (length info-node) nil info-node)
(if annotation
(nconc the-record (list (cons 'annotation annotation))))
(if info-node
(nconc the-record (list (cons 'info-node info-node))))
;; Finally, return the completed record.
the-record))
;;; File format stuff
;; The OLD format of the bookmark-alist was:
;;
;; ((bookmark-name (filename
;; string-in-front
;; string-behind
;; point))
;; ...)
;;
;; The NEW format of the bookmark-alist is:
;;
;; ((bookmark-name ((filename . FILENAME)
;; (front-context-string . string-in-front)
;; (rear-context-string . string-behind)
;; (position . POINT)
;; (annotation . annotation)
;; (whatever . VALUE)
;; ...
;; ))
;; ...)
;;
;;
;; I switched to using an internal as well as external alist because I
;; felt that would be a more flexible framework in which to add
;; features. It means that the order in which values appear doesn't
;; matter, and it means that arbitrary values can be added without
;; risk of interfering with existing ones.
;;
;; BOOKMARK-NAME is the string the user gives the bookmark and
;; accesses it by from then on.
;;
;; FILENAME is the location of the file in which the bookmark is set.
;;
;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of
;; context in front of the point at which the bookmark is set.
;;
;; STRING-BEHIND is the same thing, but after the point.
;;
;; The context strings exist so that modifications to a file don't
;; necessarily cause a bookmark's position to be invalidated.
;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
;; case the file has changed since the bookmark was set. It will
;; attempt to place the user before the changes, if there were any.
;; ANNOTATION is the annotation for the bookmark; it may not exist
;; (for backward compatibility), be nil (no annotation), or be a
;; string.
(defconst bookmark-file-format-version 1
"The current version of the format used by bookmark files.
You should never need to change this.")
(defconst bookmark-end-of-version-stamp-marker
"-*- End Of Bookmark File Format Version Stamp -*-\n"
"This string marks the end of the version stamp in a bookmark file.")
(defun bookmark-alist-from-buffer ()
"Return a bookmark-alist (in any format) from the current buffer.
The buffer must of course contain bookmark format information.
Does not care from where in the buffer it is called, and does not
affect point."
(save-excursion
(goto-char (point-min))
(if (search-forward bookmark-end-of-version-stamp-marker nil t)
(read (current-buffer))
;; Else we're dealing with format version 0
(if (search-forward "(" nil t)
(progn
(forward-char -1)
(read (current-buffer)))
;; Else no hope of getting information here.
(error "Not bookmark format")))))
(defun bookmark-upgrade-version-0-alist (old-list)
"Upgrade a version 0 alist OLD-LIST to the current version."
(mapcar
(lambda (bookmark)
(let* ((name (car bookmark))
(record (car (cdr bookmark)))
(filename (nth 0 record))
(front-str (nth 1 record))
(rear-str (nth 2 record))
(position (nth 3 record))
(ann (nth 4 record)))
(list
name
(` ((filename . (, filename))
(front-context-string . (, (or front-str "")))
(rear-context-string . (, (or rear-str "")))
(position . (, position))
(annotation . (, ann)))))))
old-list))
(defun bookmark-upgrade-file-format-from-0 ()
"Upgrade a bookmark file of format 0 (the original format) to format 1.
This expects to be called from point-min in a bookmark file."
(message "Upgrading bookmark format from 0 to %d..."
bookmark-file-format-version)
(let* ((old-list (bookmark-alist-from-buffer))
(new-list (bookmark-upgrade-version-0-alist old-list)))
(delete-region (point-min) (point-max))
(bookmark-insert-file-format-version-stamp)
(pp new-list (current-buffer))
(save-buffer))
(goto-char (point-min))
(message "Upgrading bookmark format from 0 to %d...done"
bookmark-file-format-version)
)
(defun bookmark-grok-file-format-version ()
"Return an integer which is the file-format version of this bookmark file.
This expects to be called from point-min in a bookmark file."
(if (looking-at "^;;;;")
(save-excursion
(save-match-data
(re-search-forward "[0-9]")
(forward-char -1)
(read (current-buffer))))
;; Else this is format version 0, the original one, which didn't
;; even have version stamps.
0))
(defun bookmark-maybe-upgrade-file-format ()
"Check the file-format version of this bookmark file.
If the version is not up-to-date, upgrade it automatically.
This expects to be called from point-min in a bookmark file."
(let ((version (bookmark-grok-file-format-version)))
(cond
((= version bookmark-file-format-version)
) ; home free -- version is current
((= version 0)
(bookmark-upgrade-file-format-from-0))
(t
(error "Bookmark file format version strangeness")))))
(defun bookmark-insert-file-format-version-stamp ()
"Insert text indicating current version of bookmark file format."
(insert
(format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
bookmark-file-format-version))
(insert ";;; This format is meant to be slightly human-readable;\n"
";;; nevertheless, you probably don't want to edit it.\n"
";;; "
bookmark-end-of-version-stamp-marker))
;;; end file-format stuff
;;; Core code:
;;;###autoload
(defun bookmark-set (&optional name parg)
"Set a bookmark named NAME inside a file.
If name is nil, then the user will be prompted.
With prefix arg, will not overwrite a bookmark that has the same name
as NAME if such a bookmark already exists, but instead will \"push\"
the new bookmark onto the bookmark alist. Thus the most recently set
bookmark with name NAME would be the one in effect at any given time,
but the others are still there, should you decide to delete the most
recent one.
To yank words from the text of the buffer and use them as part of the
bookmark name, type C-w while setting a bookmark. Successive C-w's
yank successive words.
Typing C-u inserts the name of the last bookmark used in the buffer
\(as an aid in using a single bookmark name to track your progress
through a large file\). If no bookmark was used, then C-u inserts the
name of the file being visited.
Use \\[bookmark-delete] to remove bookmarks \(you give it a name,
and it removes only the first instance of a bookmark with that name from
the list of bookmarks.\)"
(interactive (list nil current-prefix-arg))
(or
(bookmark-buffer-file-name)
(error "Buffer not visiting a file or directory"))
(bookmark-maybe-load-default-file)
(setq bookmark-current-point (point))
(setq bookmark-yank-point (point))
(setq bookmark-current-buffer (current-buffer))
(let* ((default (or bookmark-current-bookmark
(bookmark-buffer-name)))
(str
(or name
(read-from-minibuffer
(format "Set bookmark (%s): " default)
nil
(let ((now-map (copy-keymap minibuffer-local-map)))
(define-key now-map "\C-w" 'bookmark-yank-word)
(define-key now-map "\C-u" 'bookmark-insert-current-bookmark)
now-map))))
(annotation nil))
(and (string-equal str "") (setq str default))
;; Ask for an annotation buffer for this bookmark
(if bookmark-use-annotations
(bookmark-read-annotation parg str)
(bookmark-make str annotation parg (bookmark-info-current-node))
(setq bookmark-current-bookmark str)
(bookmark-bmenu-surreptitiously-rebuild-list)
(goto-char bookmark-current-point))))
(defun bookmark-info-current-node ()
"If in Info-mode, return current node name (a string), else nil."
(if (eq major-mode 'Info-mode)
Info-current-node))
(defun bookmark-kill-line (&optional newline-too)
"Kill from point to end of line.
If optional arg NEWLINE-TOO is non-nil, delete the newline too.
Does not affect the kill-ring."
(let ((eol (save-excursion (end-of-line) (point))))
(delete-region (point) eol)
(if (and newline-too (looking-at "\n"))
(delete-char 1))))
;; Defvars to avoid compilation warnings:
(defvar bookmark-annotation-paragraph nil)
(defvar bookmark-annotation-name nil)
(defvar bookmark-annotation-buffer nil)
(defvar bookmark-annotation-file nil)
(defvar bookmark-annotation-point nil)
(defun bookmark-send-annotation ()
"Use buffer contents as the annotation for a bookmark.
Exclude lines that begin with `#'.
Store the annotation text in the bookmark list with
the bookmark (and file, and point) specified in buffer local variables."
(interactive)
(if (not (eq major-mode 'bookmark-read-annotation-mode))
(error "Not in bookmark-read-annotation-mode"))
(goto-char (point-min))
(while (< (point) (point-max))
(if (looking-at "^#")
(bookmark-kill-line t)
(forward-line 1)))
(let ((annotation (buffer-string))
(parg bookmark-annotation-paragraph)
(bookmark bookmark-annotation-name)
(pt bookmark-annotation-point)
(buf bookmark-annotation-buffer))
;; for bookmark-make-cell to work, we need to be
;; in the relevant buffer, at the relevant point.
;; Actually, bookmark-make-cell should probably be re-written,
;; to avoid this need. Should I handle the error if a buffer is
;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer?
(save-excursion
(pop-to-buffer buf)
(goto-char pt)
(bookmark-make bookmark annotation parg (bookmark-info-current-node))
(setq bookmark-current-bookmark bookmark))
(bookmark-bmenu-surreptitiously-rebuild-list)
(goto-char bookmark-current-point))
(kill-buffer (current-buffer)))
(defun bookmark-default-annotation-text (bookmark)
(concat "# Type the annotation for bookmark '" bookmark "' here.\n"
"# All lines which start with a '#' will be deleted.\n"
"# Type C-c C-c when done.\n#\n"
"# Author: " (user-full-name) " <" (user-login-name) "@"
(system-name) ">\n"
"# Date: " (current-time-string) "\n"))
(defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text
"Function to return default text to use for a bookmark annotation.
It takes the name of the bookmark, as a string, as an arg.")
(defun bookmark-read-annotation-mode (buf point parg bookmark)
"Mode for composing annotations for a bookmark.
Wants BUF POINT PARG and BOOKMARK.
When you have finished composing, type \\[bookmark-send-annotation] to send
the annotation.
\\{bookmark-read-annotation-mode-map}
"
(interactive)
(kill-all-local-variables)
(make-local-variable 'bookmark-annotation-paragraph)
(make-local-variable 'bookmark-annotation-name)
(make-local-variable 'bookmark-annotation-buffer)
(make-local-variable 'bookmark-annotation-file)
(make-local-variable 'bookmark-annotation-point)
(setq bookmark-annotation-paragraph parg)
(setq bookmark-annotation-name bookmark)
(setq bookmark-annotation-buffer buf)
(setq bookmark-annotation-file (buffer-file-name buf))
(setq bookmark-annotation-point point)
(use-local-map bookmark-read-annotation-mode-map)
(setq major-mode 'bookmark-read-annotation-mode)
(insert (funcall bookmark-read-annotation-text-func bookmark))
(run-hooks 'text-mode-hook))
(defun bookmark-read-annotation (parg bookmark)
"Pop up a buffer for entering a bookmark annotation.
Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK."
(let ((buf (current-buffer))
(point (point)))
(pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
(bookmark-read-annotation-mode buf point parg bookmark)))
(defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map)
"Keymap for editing an annotation of a bookmark.")
(define-key bookmark-edit-annotation-mode-map "\C-c\C-c"
'bookmark-send-edited-annotation)
(defun bookmark-edit-annotation-mode (bookmark)
"Mode for editing the annotation of bookmark BOOKMARK.
When you have finished composing, type \\[bookmark-send-annotation].
\\{bookmark-edit-annotation-mode-map}
"
(interactive)
(kill-all-local-variables)
(make-local-variable 'bookmark-annotation-name)
(setq bookmark-annotation-name bookmark)
(use-local-map bookmark-edit-annotation-mode-map)
(setq major-mode 'bookmark-edit-annotation-mode)
(insert (funcall bookmark-read-annotation-text-func bookmark))
(let ((annotation (bookmark-get-annotation bookmark)))
(if (and annotation (not (string-equal annotation "")))
(insert annotation)))
(run-hooks 'text-mode-hook))
(defun bookmark-send-edited-annotation ()
"Use buffer contents (minus beginning with `#' as annotation for a bookmark."
(interactive)
(if (not (eq major-mode 'bookmark-edit-annotation-mode))
(error "Not in bookmark-edit-annotation-mode"))
(goto-char (point-min))
(while (< (point) (point-max))
(if (looking-at "^#")
(bookmark-kill-line t)
(forward-line 1)))
(let ((annotation (buffer-string))
(bookmark bookmark-annotation-name))
(bookmark-set-annotation bookmark annotation)
(bookmark-bmenu-surreptitiously-rebuild-list)
(goto-char bookmark-current-point))
(kill-buffer (current-buffer)))
(defun bookmark-edit-annotation (bookmark)
"Pop up a buffer for editing bookmark BOOKMARK's annotation."
(let ((buf (current-buffer))
(point (point)))
(pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
(bookmark-edit-annotation-mode bookmark)))
(defun bookmark-insert-current-bookmark ()
"Insert this buffer's value of bookmark-current-bookmark.
Default to file name if it's nil."
(interactive)
(let ((str
(save-excursion
(set-buffer bookmark-current-buffer)
bookmark-current-bookmark)))
(if str (insert str) (bookmark-insert-buffer-name))))
(defun bookmark-insert-buffer-name ()
"Insert the current file name into the bookmark name being set.
The directory part of the file name is not used."
(interactive)
(let ((str
(save-excursion
(set-buffer bookmark-current-buffer)
(bookmark-buffer-name))))
(insert str)))
(defun bookmark-buffer-name ()
"Return the name of the current buffer's file, non-directory.
In Info, return the current node."
(cond
;; Are we in Info?
((string-equal mode-name "Info") Info-current-node)
;; Or are we a file?
(buffer-file-name (file-name-nondirectory buffer-file-name))
;; Or are we a directory?
((and (boundp 'dired-directory) dired-directory)
(let* ((dirname (if (stringp dired-directory)
dired-directory
(car dired-directory)))
(idx (1- (length dirname))))
;; Strip the trailing slash.
(if (= ?/ (aref dirname idx))
(file-name-nondirectory (substring dirname 0 idx))
;; Else return the current-buffer
(buffer-name (current-buffer)))))
;; If all else fails, use the buffer's name.
(t
(buffer-name (current-buffer)))))
(defun bookmark-yank-word ()
(interactive)
;; get the next word from the buffer and append it to the name of
;; the bookmark currently being set.
(let ((string (save-excursion
(set-buffer bookmark-current-buffer)
(goto-char bookmark-yank-point)
(buffer-substring-no-properties
(point)
(progn
(forward-word 1)
(setq bookmark-yank-point (point)))))))
(insert string)))
(defun bookmark-buffer-file-name ()
"Return the current buffer's file in a way useful for bookmarks.
For example, if this is a Info buffer, return the Info file's name."
(if (eq major-mode 'Info-mode)
Info-current-file
(or
buffer-file-name
(if (and (boundp 'dired-directory) dired-directory)
(if (stringp dired-directory)
dired-directory
(car dired-directory))))))
(defun bookmark-maybe-load-default-file ()
(and (not bookmarks-already-loaded)
(null bookmark-alist)
(prog2
(and
;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
;; to be renamed.
(file-exists-p (expand-file-name bookmark-old-default-file))
(not (file-exists-p (expand-file-name bookmark-default-file)))
(rename-file (expand-file-name bookmark-old-default-file)
(expand-file-name bookmark-default-file)))
;; return t so the `and' will continue...
t)
(file-readable-p (expand-file-name bookmark-default-file))
(bookmark-load bookmark-default-file t t)
(setq bookmarks-already-loaded t)))
(defun bookmark-maybe-sort-alist ()
;;Return the bookmark-alist for display. If the bookmark-sort-flag
;;is non-nil, then return a sorted copy of the alist.
(if bookmark-sort-flag
(setq bookmark-alist
(sort (copy-alist bookmark-alist)
(function
(lambda (x y) (string-lessp (car x) (car y))))))))
;;;###autoload
(defun bookmark-jump (bookmark)
"Jump to bookmark BOOKMARK (a point in some file).
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
this.
If the file pointed to by BOOKMARK no longer exists, you will be asked
if you wish to give the bookmark a new location, and bookmark-jump
will then jump to the new location, as well as recording it in place
of the old one in the permanent bookmark record."
(interactive
(bookmark-completing-read "Jump to bookmark" bookmark-current-bookmark))
(bookmark-maybe-historicize-string bookmark)
(let ((cell (bookmark-jump-noselect bookmark)))
(and cell
(switch-to-buffer (car cell))
(goto-char (cdr cell))
(if bookmark-automatically-show-annotations
;; if there is an annotation for this bookmark,
;; show it in a buffer.
(bookmark-show-annotation bookmark)))))
(defun bookmark-file-or-variation-thereof (file)
"Return FILE (a string) if it exists in any reasonable variation, else nil.
Reasonable variations are FILE.gz, FILE.Z, FILE.info, FILE.info.gz, etc."
(cond
((file-exists-p file) file)
((file-exists-p (concat file ".Z")) (concat file ".Z"))
((file-exists-p (concat file ".gz")) (concat file ".gz"))
((file-exists-p (concat file ".z")) (concat file ".z"))
((file-exists-p (concat file ".info")) (concat file ".info"))
((file-exists-p (concat file ".info.gz")) (concat file ".info.gz"))
((file-exists-p (concat file ".info.Z")) (concat file ".info.Z"))
((file-exists-p (concat file ".info.z")) (concat file ".info.z"))
((vc-backend file) file) ; maybe VC has it?
(t nil)))
(defun bookmark-jump-noselect (str)
;; a leetle helper for bookmark-jump :-)
;; returns (BUFFER . POINT)
(bookmark-maybe-load-default-file)
(let* ((file (expand-file-name (bookmark-get-filename str)))
(forward-str (bookmark-get-front-context-string str))
(behind-str (bookmark-get-rear-context-string str))
(place (bookmark-get-position str))
(info-node (bookmark-get-info-node str))
(orig-file file)
)
(if (setq file (bookmark-file-or-variation-thereof file))
(save-excursion
(save-window-excursion
(if info-node
;; Info nodes must be visited with care.
(progn
(require 'info)
(Info-find-node file info-node))
;; Else no Info. Can do an ordinary find-file:
(set-buffer (find-file-noselect file))
(goto-char place))
;; Go searching forward first. Then, if forward-str exists and
;; was found in the file, we can search backward for behind-str.
;; Rationale is that if text was inserted between the two in the
;; file, it's better to be put before it so you can read it,
;; rather than after and remain perhaps unaware of the changes.
(if forward-str
(if (search-forward forward-str (point-max) t)
(goto-char (match-beginning 0))))
(if behind-str
(if (search-backward behind-str (point-min) t)
(goto-char (match-end 0))))
;; added by db
(setq bookmark-current-bookmark str)
(cons (current-buffer) (point))))
;; Else unable to find the marked file, so ask if user wants to
;; relocate the bookmark, else remind them to consider deletion.
(ding)
(if (y-or-n-p (concat (file-name-nondirectory orig-file)
" nonexistent. Relocate \""
str
"\"? "))
(progn
(bookmark-relocate str)
;; gasp! It's a recursive function call in Emacs Lisp!
(bookmark-jump-noselect str))
(message
"Bookmark not relocated; consider removing it \(%s\)." str)
nil))))
;;;###autoload
(defun bookmark-relocate (bookmark)
"Relocate BOOKMARK to another file (reading file name with minibuffer).
This makes an already existing bookmark point to that file, instead of
the one it used to point at. Useful when a file has been renamed
after a bookmark was set in it."
(interactive (bookmark-completing-read "Bookmark to relocate"))
(bookmark-maybe-historicize-string bookmark)
(bookmark-maybe-load-default-file)
(let* ((bmrk-filename (bookmark-get-filename bookmark))
(newloc (expand-file-name
(read-file-name
(format "Relocate %s to: " bookmark)
(file-name-directory bmrk-filename)))))
(bookmark-set-filename bookmark newloc)
(bookmark-bmenu-surreptitiously-rebuild-list)))
;;;###autoload
(defun bookmark-insert-location (bookmark &optional no-history)
"Insert the name of the file associated with BOOKMARK.
Optional second arg NO-HISTORY means don't record this in the
minibuffer history list `bookmark-history'."
(interactive (bookmark-completing-read "Insert bookmark location"))
(or no-history (bookmark-maybe-historicize-string bookmark))
(let ((start (point)))
(prog1
(insert (bookmark-location bookmark)) ; *Return this line*
(if (and (display-color-p) (display-mouse-p))
(add-text-properties start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
'(mouse-face highlight
help-echo "mouse-2: go to this bookmark"))))))
;;;###autoload
(defalias 'bookmark-locate 'bookmark-insert-location)
(defun bookmark-location (bookmark)
"Return the name of the file associated with BOOKMARK."
(bookmark-maybe-load-default-file)
(bookmark-get-filename bookmark))
;;;###autoload
(defun bookmark-rename (old &optional new)
"Change the name of OLD bookmark to NEW name.
If called from keyboard, prompt for OLD and NEW. If called from
menubar, select OLD from a menu and prompt for NEW.
If called from Lisp, prompt for NEW if only OLD was passed as an
argument. If called with two strings, then no prompting is done. You
must pass at least OLD when calling from Lisp.
While you are entering the new name, consecutive C-w's insert
consecutive words from the text of the buffer into the new bookmark
name."
(interactive (bookmark-completing-read "Old bookmark name"))
(bookmark-maybe-historicize-string old)
(bookmark-maybe-load-default-file)
(setq bookmark-current-point (point))
(setq bookmark-yank-point (point))
(setq bookmark-current-buffer (current-buffer))
(let ((newname
(or new ; use second arg, if non-nil
(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)
(bookmark-bmenu-surreptitiously-rebuild-list)
(setq bookmark-alist-modification-count
(1+ bookmark-alist-modification-count))
(if (bookmark-time-to-save-p)
(bookmark-save))))
;;;###autoload
(defun bookmark-insert (bookmark)
"Insert the text of the file pointed to by bookmark BOOKMARK.
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
this."
(interactive (bookmark-completing-read "Insert bookmark contents"))
(bookmark-maybe-historicize-string bookmark)
(bookmark-maybe-load-default-file)
(let ((orig-point (point))
(str-to-insert
(save-excursion
(set-buffer (car (bookmark-jump-noselect bookmark)))
(buffer-string))))
(insert str-to-insert)
(push-mark)
(goto-char orig-point)))
;;;###autoload
(defun bookmark-delete (bookmark &optional batch)
"Delete BOOKMARK from the bookmark list.
Removes only the first instance of a bookmark with that name. If
there are one or more other bookmarks with the same name, they will
not be deleted. Defaults to the \"current\" bookmark \(that is, the
one most recently used in this file, if any\).
Optional second arg BATCH means don't update the bookmark list buffer,
probably because we were called from there."
(interactive
(bookmark-completing-read "Delete bookmark" bookmark-current-bookmark))
(bookmark-maybe-historicize-string bookmark)
(bookmark-maybe-load-default-file)
(let ((will-go (bookmark-get-bookmark bookmark)))
(setq bookmark-alist (delq will-go bookmark-alist))
;; Added by db, nil bookmark-current-bookmark if the last
;; occurrence has been deleted
(or (bookmark-get-bookmark bookmark-current-bookmark)
(setq bookmark-current-bookmark nil)))
;; Don't rebuild the list
(if batch
nil
(bookmark-bmenu-surreptitiously-rebuild-list)
(setq bookmark-alist-modification-count
(1+ bookmark-alist-modification-count))
(if (bookmark-time-to-save-p)
(bookmark-save))))
(defun bookmark-time-to-save-p (&optional last-time)
;; By Gregory M. Saunders <saunders@cis.ohio-state.edu>
;; finds out whether it's time to save bookmarks to a file, by
;; examining the value of variable bookmark-save-flag, and maybe
;; bookmark-alist-modification-count. Returns t if they should be
;; saved, nil otherwise. if last-time is non-nil, then this is
;; being called when emacs is killed.
(cond (last-time
(and (> bookmark-alist-modification-count 0)
bookmark-save-flag))
((numberp bookmark-save-flag)
(>= bookmark-alist-modification-count bookmark-save-flag))
(t
nil)))
;;;###autoload
(defun bookmark-write ()
"Write bookmarks to a file (reading the file name with the minibuffer).
Don't use this in Lisp programs; use `bookmark-save' instead."
(interactive)
(bookmark-maybe-load-default-file)
(bookmark-save t))
;;;###autoload
(defun bookmark-save (&optional parg file)
"Save currently defined bookmarks.
Saves by default in the file defined by the variable
`bookmark-default-file'. With a prefix arg, save it in file FILE
\(second argument\).
If you are calling this from Lisp, the two arguments are PREFIX-ARG
and FILE, and if you just want it to write to the default file, then
pass no arguments. Or pass in nil and FILE, and it will save in FILE
instead. If you pass in one argument, and it is non-nil, then the
user will be interactively queried for a file to save in.
When you want to load in the bookmarks from a file, use
\`bookmark-load\', \\[bookmark-load]. That function will prompt you
for a file, defaulting to the file defined by variable
`bookmark-default-file'."
(interactive "P")
(bookmark-maybe-load-default-file)
(cond
((and (null parg) (null file))
;;whether interactive or not, write to default file
(bookmark-write-file bookmark-default-file))
((and (null parg) file)
;;whether interactive or not, write to given file
(bookmark-write-file file))
((and parg (not file))
;;have been called interactively w/ prefix arg
(let ((file (read-file-name "File to save bookmarks in: ")))
(bookmark-write-file file)))
(t ; someone called us with prefix-arg *and* a file, so just write to file
(bookmark-write-file file)))
;; signal that we have synced the bookmark file by setting this to
;; 0. If there was an error at any point before, it will not get
;; set, which is what we want.
(setq bookmark-alist-modification-count 0))
(defun bookmark-write-file (file)
(save-excursion
(save-window-excursion
(if (>= baud-rate 9600)
(message "Saving bookmarks to file %s..." file))
(set-buffer (let ((enable-local-variables nil))
(find-file-noselect file)))
(goto-char (point-min))
(let ((print-length nil)
(print-level nil))
(delete-region (point-min) (point-max))
(bookmark-insert-file-format-version-stamp)
(pp bookmark-alist (current-buffer))
(let ((version-control
(cond
((null bookmark-version-control) nil)
((eq 'never bookmark-version-control) 'never)
((eq 'nospecial bookmark-version-control) version-control)
(t
t))))
(write-file file)
(kill-buffer (current-buffer))
(if (>= baud-rate 9600)
(message "Saving bookmarks to file %s...done" file)))))))
(defun bookmark-import-new-list (new-list)
;; Walk over the new list, adding each individual bookmark
;; carefully. "Carefully" means checking against the existing
;; bookmark-alist and renaming the new bookmarks with <N> extensions
;; as necessary.
(let ((lst new-list)
(names (bookmark-all-names)))
(while lst
(let* ((full-record (car lst)))
(bookmark-maybe-rename full-record names)
(setq bookmark-alist (nconc bookmark-alist (list full-record)))
(setq names (cons (bookmark-name-from-full-record full-record) names))
(setq lst (cdr lst))))))
(defun bookmark-maybe-rename (full-record names)
;; just a helper for bookmark-import-new-list; it is only for
;; readability that this is not inlined.
;;
;; Once this has found a free name, it sets full-record to that
;; name.
(let ((found-name (bookmark-name-from-full-record full-record)))
(if (member found-name names)
;; We've got a conflict, so generate a new name
(let ((count 2)
(new-name found-name))
(while (member new-name names)
(setq new-name (concat found-name (format "<%d>" count)))
(setq count (1+ count)))
(bookmark-set-name full-record new-name)))))
;;;###autoload
(defun bookmark-load (file &optional overwrite no-msg)
"Load bookmarks from FILE (which must be in bookmark format).
Appends loaded bookmarks to the front of the list of bookmarks. If
optional second argument OVERWRITE is non-nil, existing bookmarks are
destroyed. Optional third arg NO-MSG means don't display any messages
while loading.
If you load a file that doesn't contain a proper bookmark alist, you
will corrupt Emacs's bookmark list. Generally, you should only load
in files that were created with the bookmark functions in the first
place. Your own personal bookmark file, `~/.emacs.bmk', is
maintained automatically by Emacs; you shouldn't need to load it
explicitly.
If you load a file containing bookmarks with the same names as
bookmarks already present in your Emacs, the new bookmarks will get
unique numeric suffixes \"<2>\", \"<3>\", ... following the same
method buffers use to resolve name collisions."
(interactive
(list (read-file-name
(format "Load bookmarks from: (%s) "
bookmark-default-file)
;;Default might not be used often,
;;but there's no better default, and
;;I guess it's better than none at all.
"~/" bookmark-default-file 'confirm)))
(setq file (expand-file-name file))
(if (file-readable-p file)
(save-excursion
(save-window-excursion
(if (and (null no-msg) (>= baud-rate 9600))
(message "Loading bookmarks from %s..." file))
(set-buffer (let ((enable-local-variables nil))
(find-file-noselect file)))
(goto-char (point-min))
(bookmark-maybe-upgrade-file-format)
(let ((blist (bookmark-alist-from-buffer)))
(if (listp blist)
(progn
(if overwrite
(progn
(setq bookmark-alist blist)
(setq bookmark-alist-modification-count 0))
;; else
(bookmark-import-new-list blist)
(setq bookmark-alist-modification-count
(1+ bookmark-alist-modification-count)))
(if (string-equal
(expand-file-name bookmark-default-file)
file)
(setq bookmarks-already-loaded t))
(bookmark-bmenu-surreptitiously-rebuild-list))
(error "Invalid bookmark list in %s" file)))
(kill-buffer (current-buffer)))
(if (and (null no-msg) (>= baud-rate 9600))
(message "Loading bookmarks from %s...done" file)))
(error "Cannot read bookmark file %s" file)))
;;; Code supporting the dired-like bookmark menu. Prefix is
;;; "bookmark-bmenu" for "buffer-menu":
(defvar bookmark-bmenu-bookmark-column nil)
(defvar bookmark-bmenu-hidden-bookmarks ())
(defvar bookmark-bmenu-mode-map nil)
(if bookmark-bmenu-mode-map
nil
(setq bookmark-bmenu-mode-map (make-keymap))
(suppress-keymap bookmark-bmenu-mode-map t)
(define-key bookmark-bmenu-mode-map "q" 'quit-window)
(define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select)
(define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate)
(define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window)
(define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window)
(define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window)
(define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window)
(define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window)
(define-key bookmark-bmenu-mode-map "\C-m" 'bookmark-bmenu-this-window)
(define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window)
(define-key bookmark-bmenu-mode-map "\C-o"
'bookmark-bmenu-switch-other-window)
(define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save)
(define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete)
(define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards)
(define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions)
(define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete)
(define-key bookmark-bmenu-mode-map " " 'next-line)
(define-key bookmark-bmenu-mode-map "n" 'next-line)
(define-key bookmark-bmenu-mode-map "p" 'previous-line)
(define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark)
(define-key bookmark-bmenu-mode-map "?" 'describe-mode)
(define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark)
(define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark)
(define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load)
(define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename)
(define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames)
(define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
(define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations)
(define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)
(define-key bookmark-bmenu-mode-map [mouse-2]
'bookmark-bmenu-other-window-with-mouse))
;; Bookmark Buffer Menu mode is suitable only for specially formatted
;; data.
(put 'bookmark-bmenu-mode 'mode-class 'special)
;; todo: need to display whether or not bookmark exists as a buffer in
;; flag column.
;; Format:
;; FLAGS BOOKMARK [ LOCATION ]
(defun bookmark-bmenu-surreptitiously-rebuild-list ()
"Rebuild the Bookmark List if it exists.
Don't affect the buffer ring order."
(if (get-buffer "*Bookmark List*")
(save-excursion
(save-window-excursion
(bookmark-bmenu-list)))))
;;;###autoload
(defun bookmark-bmenu-list ()
"Display a list of existing bookmarks.
The list is displayed in a buffer named `*Bookmark List*'.
The leftmost column displays a D if the bookmark is flagged for
deletion, or > if it is flagged for displaying."
(interactive)
(bookmark-maybe-load-default-file)
(if (interactive-p)
(switch-to-buffer (get-buffer-create "*Bookmark List*"))
(set-buffer (get-buffer-create "*Bookmark List*")))
(let ((buffer-read-only nil))
(delete-region (point-max) (point-min))
(goto-char (point-min)) ;sure are playing it safe...
(insert "% Bookmark\n- --------\n")
(bookmark-maybe-sort-alist)
(mapcar
(lambda (full-record)
;; if a bookmark has an annotation, prepend a "*"
;; in the list of bookmarks.
(let ((annotation (bookmark-get-annotation
(bookmark-name-from-full-record full-record))))
(if (and annotation (not (string-equal annotation "")))
(insert " *")
(insert " "))
(let ((start (point)))
(insert (bookmark-name-from-full-record full-record))
(if (and (display-color-p) (display-mouse-p))
(add-text-properties start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
'(mouse-face highlight
help-echo "mouse-2: go to this bookmark")))
(insert "\n")
)))
bookmark-alist))
(goto-char (point-min))
(forward-line 2)
(bookmark-bmenu-mode)
(if bookmark-bmenu-toggle-filenames
(bookmark-bmenu-toggle-filenames t)))
;;;###autoload
(defalias 'list-bookmarks 'bookmark-bmenu-list)
;;;###autoload
(defalias 'edit-bookmarks 'bookmark-bmenu-list)
(defun bookmark-bmenu-mode ()
"Major mode for editing a list of bookmarks.
Each line describes one of the bookmarks in Emacs.
Letters do not insert themselves; instead, they are commands.
Bookmark names preceded by a \"*\" have annotations.
\\<bookmark-bmenu-mode-map>
\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
\\[bookmark-bmenu-select] -- select bookmark of line point is on.
Also show bookmarks marked using m in other windows.
\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
\\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
\\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window.
\\[bookmark-bmenu-2-window] -- select this bookmark in one window,
together with bookmark selected before this one in another window.
\\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer.
\\[bookmark-bmenu-other-window] -- select this bookmark in another window,
so the bookmark menu bookmark remains visible in its window.
\\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
\\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
With a prefix arg, prompts for a file to save in.
\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
With prefix argument, also move up one line.
\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
in another buffer.
\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
(kill-all-local-variables)
(use-local-map bookmark-bmenu-mode-map)
(setq truncate-lines t)
(setq buffer-read-only t)
(setq major-mode 'bookmark-bmenu-mode)
(setq mode-name "Bookmark Menu")
(run-hooks 'bookmark-bmenu-mode-hook))
(defun bookmark-bmenu-toggle-filenames (&optional show)
"Toggle whether filenames are shown in the bookmark list.
Optional argument SHOW means show them unconditionally."
(interactive)
(cond
(show
(setq bookmark-bmenu-toggle-filenames nil)
(bookmark-bmenu-show-filenames)
(setq bookmark-bmenu-toggle-filenames t))
(bookmark-bmenu-toggle-filenames
(bookmark-bmenu-hide-filenames)
(setq bookmark-bmenu-toggle-filenames nil))
(t
(bookmark-bmenu-show-filenames)
(setq bookmark-bmenu-toggle-filenames t))))
(defun bookmark-bmenu-show-filenames (&optional force)
(if (and (not force) bookmark-bmenu-toggle-filenames)
nil ;already shown, so do nothing
(save-excursion
(save-window-excursion
(goto-char (point-min))
(forward-line 2)
(setq bookmark-bmenu-hidden-bookmarks ())
(let ((buffer-read-only nil))
(while (< (point) (point-max))
(let ((bmrk (bookmark-bmenu-bookmark)))
(setq bookmark-bmenu-hidden-bookmarks
(cons bmrk bookmark-bmenu-hidden-bookmarks))
(let ((start (save-excursion (end-of-line) (point))))
(move-to-column bookmark-bmenu-file-column t)
;; Strip off `mouse-face' from the white spaces region.
(if (and (display-color-p) (display-mouse-p))
(remove-text-properties start (point)
'(mouse-face nil help-echo nil))))
(delete-region (point) (progn (end-of-line) (point)))
(insert " ")
;; Pass the NO-HISTORY arg:
(bookmark-insert-location bmrk t)
(forward-line 1))))))))
(defun bookmark-bmenu-hide-filenames (&optional force)
(if (and (not force) bookmark-bmenu-toggle-filenames)
;; nothing to hide if above is nil
(save-excursion
(save-window-excursion
(goto-char (point-min))
(forward-line 2)
(setq bookmark-bmenu-hidden-bookmarks
(nreverse bookmark-bmenu-hidden-bookmarks))
(save-excursion
(goto-char (point-min))
(search-forward "Bookmark")
(backward-word 1)
(setq bookmark-bmenu-bookmark-column (current-column)))
(save-excursion
(let ((buffer-read-only nil))
(while bookmark-bmenu-hidden-bookmarks
(move-to-column bookmark-bmenu-bookmark-column t)
(bookmark-kill-line)
(let ((start (point)))
(insert (car bookmark-bmenu-hidden-bookmarks))
(if (and (display-color-p) (display-mouse-p))
(add-text-properties start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
'(mouse-face highlight
help-echo
"mouse-2: go to this bookmark"))))
(setq bookmark-bmenu-hidden-bookmarks
(cdr bookmark-bmenu-hidden-bookmarks))
(forward-line 1))))))))
(defun bookmark-bmenu-check-position ()
;; Returns non-nil if on a line with a bookmark.
;; (The actual value returned is bookmark-alist).
;; Else reposition and try again, else return nil.
(cond ((< (count-lines (point-min) (point)) 2)
(goto-char (point-min))
(forward-line 2)
bookmark-alist)
((and (bolp) (eobp))
(beginning-of-line 0)
bookmark-alist)
(t
bookmark-alist)))
(defun bookmark-bmenu-bookmark ()
;; return a string which is bookmark of this line.
(if (bookmark-bmenu-check-position)
(save-excursion
(save-window-excursion
(goto-char (point-min))
(search-forward "Bookmark")
(backward-word 1)
(setq bookmark-bmenu-bookmark-column (current-column)))))
(if bookmark-bmenu-toggle-filenames
(bookmark-bmenu-hide-filenames))
(save-excursion
(save-window-excursion
(beginning-of-line)
(forward-char bookmark-bmenu-bookmark-column)
(prog1
(buffer-substring-no-properties (point)
(progn
(end-of-line)
(point)))
;; well, this is certainly crystal-clear:
(if bookmark-bmenu-toggle-filenames
(bookmark-bmenu-toggle-filenames t))))))
(defun bookmark-show-annotation (bookmark)
"Display the annotation for bookmark named BOOKMARK in a buffer,
if an annotation exists."
(let ((annotation (bookmark-get-annotation bookmark)))
(if (and annotation (not (string-equal annotation "")))
(save-excursion
(let ((old-buf (current-buffer)))
(pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
(delete-region (point-min) (point-max))
;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n"))
(insert annotation)
(goto-char (point-min))
(pop-to-buffer old-buf))))))
(defun bookmark-show-all-annotations ()
"Display the annotations for all bookmarks in a buffer."
(let ((old-buf (current-buffer)))
(pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
(delete-region (point-min) (point-max))
(mapcar
(lambda (full-record)
(let* ((name (bookmark-name-from-full-record full-record))
(ann (bookmark-get-annotation name)))
(insert (concat name ":\n"))
(if (and ann (not (string-equal ann "")))
;; insert the annotation, indented by 4 spaces.
(progn
(save-excursion (insert ann))
(while (< (point) (point-max))
(beginning-of-line) ; paranoia
(insert " ")
(forward-line)
(end-of-line))))))
bookmark-alist)
(goto-char (point-min))
(pop-to-buffer old-buf)))
(defun bookmark-bmenu-mark ()
"Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
(interactive)
(beginning-of-line)
(if (bookmark-bmenu-check-position)
(let ((buffer-read-only nil))
(delete-char 1)
(insert ?>)
(forward-line 1)
(bookmark-bmenu-check-position))))
(defun bookmark-bmenu-select ()
"Select this line's bookmark; also display bookmarks marked with `>'.
You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
(interactive)
(if (bookmark-bmenu-check-position)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(others ())
tem)
(goto-char (point-min))
(while (re-search-forward "^>" nil t)
(setq tem (bookmark-bmenu-bookmark))
(let ((buffer-read-only nil))
(delete-char -1)
(insert ?\ ))
(or (string-equal tem bmrk)
(member tem others)
(setq others (cons tem others))))
(setq others (nreverse others)
tem (/ (1- (frame-height)) (1+ (length others))))
(delete-other-windows)
(bookmark-jump bmrk)
(bury-buffer menu)
(if others
(while others
(split-window nil tem)
(other-window 1)
(bookmark-jump (car others))
(setq others (cdr others)))
(other-window 1)))))
(defun bookmark-bmenu-save (parg)
"Save the current list into a bookmark file.
With a prefix arg, prompts for a file to save them in."
(interactive "P")
(save-excursion
(save-window-excursion
(bookmark-save parg))))
(defun bookmark-bmenu-load ()
"Load the bookmark file and rebuild the bookmark menu-buffer."
(interactive)
(if (bookmark-bmenu-check-position)
(save-excursion
(save-window-excursion
;; This will call `bookmark-bmenu-list'
(call-interactively 'bookmark-load)))))
(defun bookmark-bmenu-1-window ()
"Select this line's bookmark, alone, in full frame."
(interactive)
(if (bookmark-bmenu-check-position)
(progn
(bookmark-jump (bookmark-bmenu-bookmark))
(bury-buffer (other-buffer))
(delete-other-windows))))
(defun bookmark-bmenu-2-window ()
"Select this line's bookmark, with previous buffer in second window."
(interactive)
(if (bookmark-bmenu-check-position)
(let ((bmrk (bookmark-bmenu-bookmark))
(menu (current-buffer))
(pop-up-windows t))
(delete-other-windows)
(switch-to-buffer (other-buffer))
(let* ((pair (bookmark-jump-noselect bmrk))
(buff (car pair))
(pos (cdr pair)))
(pop-to-buffer buff)
(goto-char pos))
(bury-buffer menu))))
(defun bookmark-bmenu-this-window ()
"Select this line's bookmark in this window."
(interactive)
(if (bookmark-bmenu-check-position)
(bookmark-jump (bookmark-bmenu-bookmark))))
(defun bookmark-bmenu-other-window ()
"Select this line's bookmark in other window, leaving bookmark menu visible."
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark)))
(if (bookmark-bmenu-check-position)
(let* ((pair (bookmark-jump-noselect bookmark))
(buff (car pair))
(pos (cdr pair)))
(switch-to-buffer-other-window buff)
(goto-char pos)
(set-window-point (get-buffer-window buff) pos)
(bookmark-show-annotation bookmark)))))
(defun bookmark-bmenu-switch-other-window ()
"Make the other window select this line's bookmark.
The current window remains selected."
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark))
(pop-up-windows t)
same-window-buffer-names
same-window-regexps)
(if (bookmark-bmenu-check-position)
(let* ((pair (bookmark-jump-noselect bookmark))
(buff (car pair))
(pos (cdr pair)))
(display-buffer buff)
(let ((o-buffer (current-buffer)))
;; save-excursion won't do
(set-buffer buff)
(goto-char pos)
(set-window-point (get-buffer-window buff) pos)
(set-buffer o-buffer))
(bookmark-show-annotation bookmark)))))
(defun bookmark-bmenu-other-window-with-mouse (event)
"Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
(interactive "e")
(save-excursion
(set-buffer (window-buffer (posn-window (event-end event))))
(save-excursion
(goto-char (posn-point (event-end event)))
(bookmark-bmenu-other-window))))
(defun bookmark-bmenu-show-annotation ()
"Show the annotation for the current bookmark in another window."
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark)))
(if (bookmark-bmenu-check-position)
(bookmark-show-annotation bookmark))))
(defun bookmark-bmenu-show-all-annotations ()
"Show the annotation for all bookmarks in another window."
(interactive)
(bookmark-show-all-annotations))
(defun bookmark-bmenu-edit-annotation ()
"Edit the annotation for the current bookmark in another window."
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark)))
(if (bookmark-bmenu-check-position)
(bookmark-edit-annotation bookmark))))
(defun bookmark-bmenu-unmark (&optional backup)
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
(interactive "P")
(beginning-of-line)
(if (bookmark-bmenu-check-position)
(progn
(let ((buffer-read-only nil))
(delete-char 1)
;; any flags to reset according to circumstances? How about a
;; flag indicating whether this bookmark is being visited?
;; well, we don't have this now, so maybe later.
(insert " "))
(forward-line (if backup -1 1))
(bookmark-bmenu-check-position))))
(defun bookmark-bmenu-backup-unmark ()
"Move up and cancel all requested operations on bookmark on line above."
(interactive)
(forward-line -1)
(if (bookmark-bmenu-check-position)
(progn
(bookmark-bmenu-unmark)
(forward-line -1)
(bookmark-bmenu-check-position))))
(defun bookmark-bmenu-delete ()
"Mark bookmark on this line to be deleted.
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
(interactive)
(beginning-of-line)
(if (bookmark-bmenu-check-position)
(let ((buffer-read-only nil))
(delete-char 1)
(insert ?D)
(forward-line 1)
(bookmark-bmenu-check-position))))
(defun bookmark-bmenu-delete-backwards ()
"Mark bookmark on this line to be deleted, then move up one line.
To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
(interactive)
(bookmark-bmenu-delete)
(forward-line -2)
(if (bookmark-bmenu-check-position)
(forward-line 1))
(bookmark-bmenu-check-position))
(defun bookmark-bmenu-execute-deletions ()
"Delete bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
(interactive)
(message "Deleting bookmarks...")
(let ((hide-em bookmark-bmenu-toggle-filenames)
(o-point (point))
(o-str (save-excursion
(beginning-of-line)
(if (looking-at "^D")
nil
(buffer-substring
(point)
(progn (end-of-line) (point))))))
(o-col (current-column)))
(if hide-em (bookmark-bmenu-hide-filenames))
(setq bookmark-bmenu-toggle-filenames nil)
(goto-char (point-min))
(forward-line 1)
(while (re-search-forward "^D" (point-max) t)
(bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
(bookmark-bmenu-list)
(setq bookmark-bmenu-toggle-filenames hide-em)
(if bookmark-bmenu-toggle-filenames
(bookmark-bmenu-toggle-filenames t))
(if o-str
(progn
(goto-char (point-min))
(search-forward o-str)
(beginning-of-line)
(forward-char o-col))
(goto-char o-point))
(beginning-of-line)
(setq bookmark-alist-modification-count
(1+ bookmark-alist-modification-count))
(if (bookmark-time-to-save-p)
(bookmark-save))
(message "Deleting bookmarks...done")
))
(defun bookmark-bmenu-rename ()
"Rename bookmark on current line. Prompts for a new name."
(interactive)
(if (bookmark-bmenu-check-position)
(let ((bmrk (bookmark-bmenu-bookmark))
(thispoint (point)))
(bookmark-rename bmrk)
(bookmark-bmenu-list)
(goto-char thispoint))))
(defun bookmark-bmenu-locate ()
"Display location of this bookmark. Displays in the minibuffer."
(interactive)
(if (bookmark-bmenu-check-position)
(let ((bmrk (bookmark-bmenu-bookmark)))
(message (bookmark-location bmrk)))))
;;; Menu bar stuff. Prefix is "bookmark-menu".
(defun bookmark-menu-build-paned-menu (name entries)
"Build a multi-paned menu named NAME from the strings in ENTRIES.
That is, ENTRIES is a list of strings which appear as the choices
in the menu. The number of panes depends on the number of entries.
The visible entries are truncated to `bookmark-menu-length', but the
strings returned are not."
(let* ((f-height (/ (frame-height) 2))
(pane-list
(let (temp-pane-list
(iter 0))
(while entries
(let (lst
(count 0))
(while (and (< count f-height) entries)
(let ((str (car entries)))
(setq lst (cons
(cons
(if (> (length str) bookmark-menu-length)
(substring str 0 bookmark-menu-length)
str)
str)
lst))
(setq entries (cdr entries))
(setq count (1+ count))))
(setq iter (1+ iter))
(setq
temp-pane-list
(cons
(cons
(format "-*- %s (%d) -*-" name iter)
(nreverse lst))
temp-pane-list))))
(nreverse temp-pane-list))))
;; Return the menu:
(cons (concat "-*- " name " -*-") pane-list)))
(defun bookmark-menu-popup-paned-menu (event name entries)
"Pop up multi-paned menu at EVENT, return string chosen from ENTRIES.
That is, ENTRIES is a list of strings which appear as the choices
in the menu.
The number of panes depends on the number of entries."
(interactive "e")
(x-popup-menu event (bookmark-menu-build-paned-menu name entries)))
(defun bookmark-menu-popup-paned-bookmark-menu (event name)
"Pop up menu of bookmarks, return chosen bookmark.
Pop up at EVENT, menu's name is NAME.
The number of panes depends on the number of bookmarks."
(bookmark-menu-popup-paned-menu event name (bookmark-all-names)))
(defun bookmark-popup-menu-and-apply-function (func-sym menu-label event)
;; help function for making menus that need to apply a bookmark
;; function to a string.
(let* ((choice (bookmark-menu-popup-paned-bookmark-menu
event menu-label)))
(if choice (apply func-sym (list choice)))))
;;;###autoload
(defun bookmark-menu-insert (event)
"Insert the text of the file pointed to by bookmark BOOKMARK.
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
this.
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp \(the one without the
\"-menu-\" in its name\)."
(interactive "e")
(bookmark-popup-menu-and-apply-function
'bookmark-insert "Insert Bookmark Contents" event))
;;;###autoload
(defun bookmark-menu-jump (event)
"Jump to bookmark BOOKMARK (a point in some file).
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
this.
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp \(the one without the
\"-menu-\" in its name\)."
(interactive "e")
(bookmark-popup-menu-and-apply-function
'bookmark-jump "Jump to Bookmark" event))
;;;###autoload
(defun bookmark-menu-locate (event)
"Insert the name of the file associated with BOOKMARK.
\(This is not the same as the contents of that file\).
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp \(the one without the
\"-menu-\" in its name\)."
(interactive "e")
(bookmark-popup-menu-and-apply-function
'bookmark-insert-location "Insert Bookmark Location" event))
;;;###autoload
(defun bookmark-menu-rename (event)
"Change the name of OLD-BOOKMARK to NEWNAME.
If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME.
If called from menubar, OLD-BOOKMARK is selected from a menu, and
prompts for NEWNAME.
If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was
passed as an argument. If called with two strings, then no prompting
is done. You must pass at least OLD-BOOKMARK when calling from Lisp.
While you are entering the new name, consecutive C-w's insert
consecutive words from the text of the buffer into the new bookmark
name.
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp \(the one without the
\"-menu-\" in its name\)."
(interactive "e")
(bookmark-popup-menu-and-apply-function
'bookmark-rename "Rename Bookmark" event))
;;;###autoload
(defun bookmark-menu-delete (event)
"Delete the bookmark named NAME from the bookmark list.
Removes only the first instance of a bookmark with that name. If
there are one or more other bookmarks with the same name, they will
not be deleted. Defaults to the \"current\" bookmark \(that is, the
one most recently used in this file, if any\).
Warning: this function only takes an EVENT as argument. Use the
corresponding bookmark function from Lisp \(the one without the
\"-menu-\" in its name\)."
(interactive "e")
(bookmark-popup-menu-and-apply-function
'bookmark-delete "Delete Bookmark" event))
;; Thanks to Roland McGrath for fixing menubar.el so that the
;; following works, and for explaining what to do to make it work.
;; We MUST autoload EACH form used to set up this variable's value, so
;; that the whole job is done in loaddefs.el.
;; Emacs menubar stuff.
;;;###autoload
(defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions"))
;;;###autoload
(defalias 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map))
;; make bookmarks appear toward the right side of the menu.
(if (boundp 'menu-bar-final-items)
(if menu-bar-final-items
(setq menu-bar-final-items
(cons 'bookmark menu-bar-final-items)))
(setq menu-bar-final-items '(bookmark)))
;;;###autoload
(define-key menu-bar-bookmark-map [load]
'("Load a Bookmark File..." . bookmark-load))
;;;###autoload
(define-key menu-bar-bookmark-map [write]
'("Save Bookmarks As..." . bookmark-write))
;;;###autoload
(define-key menu-bar-bookmark-map [save]
'("Save Bookmarks" . bookmark-save))
;;;###autoload
(define-key menu-bar-bookmark-map [edit]
'("Edit Bookmark List" . bookmark-bmenu-list))
;;;###autoload
(define-key menu-bar-bookmark-map [delete]
'("Delete Bookmark" . bookmark-menu-delete))
;;;###autoload
(define-key menu-bar-bookmark-map [rename]
'("Rename Bookmark" . bookmark-menu-rename))
;;;###autoload
(define-key menu-bar-bookmark-map [locate]
'("Insert Location" . bookmark-menu-locate))
;;;###autoload
(define-key menu-bar-bookmark-map [insert]
'("Insert Contents" . bookmark-menu-insert))
;;;###autoload
(define-key menu-bar-bookmark-map [set]
'("Set Bookmark" . bookmark-set))
;;;###autoload
(define-key menu-bar-bookmark-map [jump]
'("Jump to Bookmark" . bookmark-menu-jump))
;;;; end bookmark menu stuff ;;;;
;;; Load Hook
(defvar bookmark-load-hook nil
"Hook to run at the end of loading bookmark.")
;;; Exit Hook, called from kill-emacs-hook
(defvar bookmark-exit-hook nil
"Hook to run when emacs exits")
(defun bookmark-exit-hook-internal ()
"Save bookmark state, if necessary, at Emacs exit time.
This also runs `bookmark-exit-hooks'."
(and
(progn (run-hooks 'bookmark-exit-hooks) t)
bookmark-alist
(bookmark-time-to-save-p t)
(bookmark-save)))
(add-hook 'kill-emacs-hook 'bookmark-exit-hook-internal)
(run-hooks 'bookmark-load-hook)
(provide 'bookmark)
;;; bookmark.el ends here
|