-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathlinkd.el
1280 lines (1129 loc) · 52.4 KB
/
linkd.el
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
;;; linkd.el --- Make hypertext with active links in any buffer
;;
;; Filename: linkd.el
;; Description: Make hypertext with active links in any buffer
;; Author: David O'Toole <dto@gnu.org>
;; Additional code by Eduardo Ochs <eduardoochs@gmail.com>
;; Maintainer: Shaun Johnson <shaun@slugfest.demon.co.uk>
;; Copyright (C) 2007, David O'Toole.
;; Copyright (C) 2008-2009, Drew Adams.
;; Copyright (C) 2009, Shaun Johnson.
;; Created: Fri Mar 14 07:56:32 2008 (Pacific Daylight Time)
;; Version: $Id: linkd.el,v 1.64 2008/03/14 $
;; Last-Updated: Sun Mar 7 11:48:30 2010 (-0800)
;; By: dradams
;; Update #: 629
;; Package-Version: 0.9
;; Website, original version: http://dto.github.com/notebook/linkd.html
;; URL: http://www.emacswiki.org/cgi-bin/wiki/linkd.el
;; URL: http://www.emacswiki.org/emacs/linkd.tar.gz
;; Keywords: hypermedia help
;; Compatibility: GNU Emacs 21.x, GNU Emacs 22.x
;;
;; Features that might be required by this library:
;;
;; `easymenu'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Make hypertext with active links in any buffer
;;
;;
;;(@* "Overview") ----------------------------------------------------
;;
;; Linkd-mode is a major mode that automatically recognizes and
;; processes certain S-expressions, called "links", embedded in plain
;; text files. Links may be followed by invoking certain interactive
;; functions when point is on the link text. Links may also be
;; interpreted as marking up the surrounding text. Different types
;; of links have different behaviors when followed, and they may have
;; different interpretations as markup.
;;
;; With Linkd mode, you can do the following:
;; * Embed hyperlinks to files, webpages, or documentation into
;; any type of text file in any major mode.
;; * Delimit and name regions of text ("blocks") in these text files.
;; See (@> "Stars")
;; * Extract and send blocks to other programs for processing.
;; See (@> "Processing blocks")
;; * Identify and mark locations and concepts in source code.
;; See (@> "Tags")
;; * Embed active data objects ("datablocks") into text files.
;; See (@> "Datablocks")
;; * Convert Lisp source-code listings to LaTeX for publication.
;; See (@> "Exporting to LaTeX")
;; * Define new link behaviors.
;;
;; For detailed information about using linkd-mode, see the online
;; manual: http://dto.github.com/notebook/linkd.html.
;;
;;
;;(@* "TODO") --------------------------------------------------------
;;
;; * Should have a proper history of link navigation, like in Info,
;; for forward and backward link following, instead of just saving
;; the previous location.
;;
;; * Should have a link follow behavior that takes you from @> to the
;; corresponding @*, not just to the next link (@* or @>).
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; 2010/03/07 dadams
;; linkd-render-link:
;; Don't render unless the (@...) is really a function call. Thx to eeeickythump.
;; 2010/02/28 dadams
;; linkd-match: Incorporated bug fix from Emacs Wiki by eeeickythump: Ensure sexp is symbol.
;; Incorporated addition of autoloads by Daniel Hackney (from Emacs Wiki 2010-02-06).
;; 2009/03/12 sjohnson
;; Updated embedded URLs.
;; 2009/02/17 sjohnson
;; Removed test for linkd-mode from menu - un-needed.
;; 2009/02/16 dadams
;; linkd-html-export: Do nothing if htmlize.el is not available.
;; Show Linkd menu only in Linkd mode.
;; linkd-enable-linkd-mode-in-target: Added :tags
;; linkd-use-menu: Changed default value to t.
;; 2009/02/15 sjohnson
;; Added: linkd-use-menu, linkd-enable-linkd-mode-in-target, linkd-maybe-enable-in-target,
;; linkd-menu.
;; Restored require of easymenu - used now.
;; 2009/02/10 dadams
;; Renamed: linkd-insertion-schemes to linkd-type-keywords-alist,
;; linkd-export-formats to linkd-export-formats-alist.
;; Changed defvars to defcustoms: linkd-use-icons, linkd-icons-directory,
;; linkd-generic-regexp, linkd-type-keywords-alist, linkd-default-bullet-string,
;; linkd-star-search-string, linkd-block-file-name, linkd-shell-buffer-name,
;; linkd-export-heading-regexp, linkd-export-commentary-regexp, linkd-export-link-regexp,
;; linkd-export-formats-alist, linkd-file-handler-alist, linkd-wiki-extensions,
;; linkd-wiki-directory.
;; linkd-file-handler-alist:
;; Default value no longer nil - now covers .el files, find-library, finder-commentary.
;; @file: Treat :to also for the handler case (since handler just opens the file).
;; Turn on Linkd mode for the target file.
;; Removed: (require 'easymenu) - doesn't seem to be used.
;; 2008/04/18 dadams
;; linkd-overlay:
;; Put keymap property back on the overlay (for RET etc.). Thx to Shaun Johnson.
;; 2008/04/16 dadams
;; linkd-overlay: Add keymap property of linkd-overlay-map to the display property.
;; Remove keymap property from the overlay itself.
;; linkd-map: Removed linkd-follow-mouse binding to mouse-2.
;; 2008/03/21 dadams
;; linkd-back: Reset linkd-previous-point.
;; linkd-map: Bind mouse-2 here also, as workaround for Emacs bug. Remove when bug fixed.
;; 2008/03/14 dadams
;; linkd-follow-mouse: Go to the buffer of clicked window.
;; linkd(-overlay)-map: Bound linkd-follow-mouse to mouse-2 and linkd-back to mouse-4.
;; linkd-(enable|disable):
;; Ensure add/remove text props doesn't count as buffer modification.
;; linkd-overlay: Added mouse-face to links.
;; Renamed faces, to remove -face suffix and be more specific.
;; Removed all face variables - just use faces.
;; Changed face default definitions, to be less gaudy. Still needs work (dark/light bg).
;; linkd-send-block-to-shell: goto-char point-max instead of end-of-buffer.
;; Changed require cl to eval-when-compile require.
;; linkd-activate-datablock: Added missing right paren. Removed extra one elsewhere.
;; linkd-use-datablocks: defvar, not defun (!).
;; Collected defvars together and gave them doc strings.
;; Added doc strings, cleaned up doc strings (still some missing or unclear).
;; Use header2.el header.
;; Code cleanup (cosmetic).
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 3, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;; This file is not part of GNU Emacs.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(eval-when-compile (require 'cl)) ;; block, case
(require 'easymenu) ;; easy-menu-define
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (@* "Faces") ------------------------------------------------------
(defgroup linkd nil
"Hypertext links."
:prefix "linkd-"
:group 'convenience :group 'help
:link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/linkd.el")
:link '(url-link :tag "Download (with icons)" " http://www.emacswiki.org/emacs/linkd.tar.gz")
:link '(emacs-commentary-link :tag "Doc" "linkd"))
(defface linkd-generic-link '((t (:foreground "blue")))
"Face for linkd links." :group 'linkd :group 'faces)
(defface linkd-generic-link-name '((t (:foreground "blue")))
"Face for linkd links." :group 'linkd :group 'faces)
(defface linkd-star `((t (:foreground ,(frame-parameter nil 'background-color))))
"Face for star delimiters." :group 'linkd :group 'faces)
(defface linkd-star-name '((t (:foreground "blue" :background "Pink")))
"Face for star names." :group 'linkd :group 'faces)
(defface linkd-tag `((t (:foreground ,(frame-parameter nil 'background-color))))
"Face for tags." :group 'linkd :group 'faces)
(defface linkd-tag-name '((t (:foreground "blue" :underline t)))
"Face for tag names." :group 'linkd :group 'faces)
(defface linkd-icon '((t (:underline nil)))
"Face for icons." :group 'linkd :group 'faces)
(defface linkd-wiki '((t (:foreground "FireBrick" :underline t)))
"Face for camel-case wiki links." :group 'linkd :group 'faces)
(defface linkd-command '((t (:foreground "red" :underline t)))
"Face for command links." :group 'linkd :group 'faces)
;; (@* "User Options") -----------------------------------------------
(defcustom linkd-use-icons nil
"Non-nil means icons, instead of text bullets, are displayed for links."
:type 'boolean :group 'linkd)
(defcustom linkd-icons-directory "~/.linkd-icons" "Directory where linkd's icons are kept."
:type 'directory :group 'linkd)
(defcustom linkd-use-menu t
"Non-nil means show the Linkd menu in the menu bar."
:type 'boolean :group 'linkd)
(defcustom linkd-enable-linkd-mode-in-target t
"Whether to turn on Linkd mode for the target of a @file link.
* t - turn linkd mode on unconditionally.
* nil - don't turn linkd mode on.
* A list of major mode symbols, Turn on linkd mode if the target
buffer's mode is in this list.
* A function to be called in the context of the target buffer.
Turn on linkd mode if it returns a non-nil value."
:type '(choice
(const :tag "Turn on Linkd mode unconditionally" t)
(const :tag "Do not turn on Linkd mode" nil)
(repeat :tag "Modes to use Linkd"
(symbol :tag "Major mode for which to turn on Linkd mode"))
(function :tag "Turn on Linkd mode if this function returns non-nil"))
:group 'linkd)
(defcustom linkd-generic-regexp (concat "\(" "@" "[^)]*\)")
"Regexp to find links."
:type 'regexp :group 'linkd)
(defcustom linkd-type-keywords-alist '(("file" :file-name :to :display)
("man" :page :to :display)
("info" :file-name :node :to :display)
("url" :file-name :display))
"Alist of possible link types and their associated Linkd keywords.
Each key is a link type name.
Each value is a list of Linkd keywords to use for that type (key)."
:type '(alist
:key-type (string :tag "Link type")
:value-type (repeat (symbol :tag "Linkd keywords for this type")))
:group 'linkd)
(defcustom linkd-default-bullet-string "."
"Default string to use to display a bullet."
:type 'string :group 'linkd)
(defcustom linkd-star-search-string (concat "\(" "\@\*")
"Regexp that matches a Linkd star."
:type 'string :group 'linkd)
(defcustom linkd-block-file-name "~/.linkd-block"
"File where temporary block text is stored for external processing."
:type 'file :group 'linkd)
(defcustom linkd-shell-buffer-name "*Linkd Shell*"
"Name of shell buffer used by Linkd."
:type 'string :group 'linkd)
;; Used for export to LaTeX and HTML.
(defcustom linkd-export-heading-regexp (concat "(" "@\\* \"\\([^\"]*\\)\")")
"Regexp to match section headings in the buffer."
:type 'regexp :group 'linkd)
;; Used for export to LaTeX and HTML.
(defcustom linkd-export-commentary-regexp "^;;"
"Regexp to match commentary lines in a buffer."
:type 'string :group 'linkd)
;; Used for export to LaTeX and HTML.
;; Of course no regexp can correctly recognize matched parentheses.
;; But our links are always on a single line, so we can sort of make it work.
(defcustom linkd-export-link-regexp (concat "(" "@" ".*)$")
"Regexp to match Linkd links."
:type 'string :group 'linkd)
;; Used for export to LaTeX and HTML.
(defcustom linkd-export-formats-alist '(("html" . linkd-html-export)
("tex" . linkd-latex-export))
"Alist of file extensions and associated export formats, for Linkd."
:type '(alist
:key-type (string :tag "File-name extension")
:value-type (symbol :tag "Export function"))
:group 'linkd)
(defcustom linkd-file-handler-alist
'(("el" . (lambda (file-name)
(let ((curr-mode major-mode))
(condition-case nil
(if (eq curr-mode 'finder-mode)
(condition-case nil
(finder-commentary file-name)
(error (find-library file-name)))
(find-library file-name))
(error (find-file file-name)))))))
"Alist that maps file extensions to functions that open files.
Each such function should accept a file name as its argument."
:type '(alist
:key-type (string :tag "File extension (no period)")
:value-type (symbol :tag "Handler function for such files"))
:group 'linkd)
(defcustom linkd-wiki-extensions '("linkd" "org" "el")
"List of file-name extensions to try, to look for a given wiki page."
:type '(repeat string) :group 'linkd)
(defcustom linkd-wiki-directory "~/linkd-wiki"
"Default directory to look for wiki pages in."
:type 'directory :group 'linkd)
;; (@* "Internal Variables") -----------------------------------------
(defvar linkd-previous-buffer nil "Last buffer being shown.")
(defvar linkd-previous-point nil "Value of point before link following.")
;; We may attach keybindings to an overlay, so that the keybindings
;; are in effect whenever point is within the overlay. For rapid
;; navigation, we will eventually attach some quick single-character
;; commands to the links, using the following keymap:
(defvar linkd-overlay-map nil "Keymap for Linkd overlays.")
(unless linkd-overlay-map
(setq linkd-overlay-map (make-sparse-keymap))
(define-key linkd-overlay-map (kbd "RET") 'linkd-follow-at-point)
;; $$$$(define-key linkd-overlay-map [down-mouse-2] 'ignore)
(define-key linkd-overlay-map [mouse-2] 'linkd-follow-mouse)
(define-key linkd-overlay-map [mouse-4] 'linkd-back)
(define-key linkd-overlay-map (kbd "b") 'linkd-back)
(define-key linkd-overlay-map (kbd "l") 'linkd-back)
(define-key linkd-overlay-map (kbd "[") 'linkd-previous-link)
(define-key linkd-overlay-map (kbd "]") 'linkd-next-link))
(defvar linkd-process-block-function nil
"Function called by `linkd-process-block'.
Argument is the contents of the block around point as a string.
You can set this in the `Local Variables' section of a file.")
(make-variable-buffer-local 'linkd-process-block-function)
(defvar linkd-use-datablocks nil "When non-nil, Linkd uses datablocks in the current buffer.")
(make-variable-buffer-local 'linkd-use-datablocks)
(defvar linkd-datablocks-activated nil "When non-nil, Linkd activates datablocks.")
(make-variable-buffer-local 'linkd-datablocks-activated)
;; Used for export to LaTeX.
(defvar linkd-latex-in-verbatim nil "Non-nil means we are inside a LaTeX verbatim section.")
(defvar linkd-map nil "Keymap used by Linkd mode.")
(when (null linkd-map)
(setq linkd-map (make-sparse-keymap))
(define-key linkd-map (kbd "C-c *") 'linkd-process-block)
(define-key linkd-map (kbd "C-c [") 'linkd-previous-link)
(define-key linkd-map (kbd "C-c ]") 'linkd-next-link)
(define-key linkd-map (kbd "C-c '") 'linkd-follow-at-point)
(define-key linkd-map [mouse-4] 'linkd-back)
(define-key linkd-map (kbd "C-c , b") 'linkd-back)
(define-key linkd-map (kbd "C-c , ,") 'linkd-insert-link)
(define-key linkd-map (kbd "C-c , t") 'linkd-insert-tag)
(define-key linkd-map (kbd "C-c , s") 'linkd-insert-star)
(define-key linkd-map (kbd "C-c , w") 'linkd-insert-wiki)
(define-key linkd-map (kbd "C-c , l") 'linkd-insert-lisp)
(define-key linkd-map (kbd "C-c , e") 'linkd-edit-link-at-point)
(define-key linkd-map (kbd "C-c , x") 'linkd-escape-datablock))
;; Linkd menu for menu bar.
(easy-menu-define linkd-menu linkd-map "Linkd"
'("Linkd"
:visible linkd-use-menu
["Follow" linkd-follow-at-point :active (get-char-property (point) 'linkd)]
["Back" linkd-back :active (get-char-property (point) 'linkd)]
["Previous link" linkd-previous-link :active (get-char-property (point) 'linkd)]
["Next link" linkd-next-link :active (get-char-property (point) 'linkd)]
("Insert"
["Tag" linkd-insert-tag]
["Star" linkd-insert-star]
["Link" linkd-insert-link])
["Edit" linkd-edit-link-at-point :active (get-char-property (point) 'linkd)]))
;; (@* "Versioning") -------------------------------------------------
;;;###autoload
(defun linkd-version ()
"Display Linkd version."
(interactive)
;; (message "$Id: linkd.el,v 1.63 2007/05/19 00:16:17 dto Exp dto $"))
(message "$Id: linkd.el,v 1.64 2008/03/14 $"))
;; (@* "Recognizing Links") ------------------------------------------
;;
;; In working with Emacs' font-lock code to obtain automatic
;; recognition of a construct, one typically uses a regular expression
;; to match the construct. But recall that we are looking to match
;; S-expressions, which cannot be matched by any regular
;; expression. To overcome this difficulty, we can supply font-lock
;; with a function to perform the search, instead of a regular
;; expression. If this function uses the system's built-in Lisp
;; reader, we can then match proper S-expressions.
;;
;; Below is a function that Emacs' font-locking can use to find and
;; highlight links. See (@> "Fontlocking") below.
(defun linkd-match (limit)
"Try to read link sexp between point and LIMIT.
Return non-nil if a link is found. Set match-data appropriately."
(let ((sexp nil))
(when (search-forward (concat "(" "@") limit t) (backward-char 2))
(let ((begin-point (point)))
(condition-case nil (setq sexp (read (current-buffer))) ((error nil)))
(when (and (symbolp (car-safe sexp))
(string-match "@.*" (symbol-name (car-safe sexp))))
(let ((begin-marker (make-marker))
(end-marker (make-marker)))
(set-marker begin-marker begin-point)
(set-marker end-marker (point))
(set-match-data (list begin-marker end-marker)))
t))))
;; Function to extract link data from plain text. It determines the
;; presence of a link by searching for the `linkd' text property,
;; instead of using the regular expression given above. This is
;; because of the way link rendering works. When the activation of
;; Linkd mode triggers fontification of a buffer containing links, the
;; links are matched by the font-locking code, and marked with the
;; `linkd' text property. All the other functions that deal with
;; links can then use the `linkd' text property, which is simpler than
;; using regexps throughout. See (@> "Rendering links with overlays")
;; and (@> "Fontlocking").
(defun linkd-link-at-point ()
"Return link around point as a sexp. Return nil if no link found."
(when (get-char-property (point) 'linkd)
(save-excursion (read (current-buffer)))))
;; (@* "Following Links") --------------------------------------------
;;
;; Each link is an S-expression. When this S-expression is evaluated,
;; the result is a property list whose keys represent possible user
;; actions, and whose values are functions to be invoked when the
;; corresponding key is chosen. To follow a link, we evaluate the
;; link's S-expression and invoke the function corresponding to the
;; `:follow' property in the resulting property list.
;;
;; The results of following a link will often change the currently
;; displayed buffer, so we remember which is the current buffer before
;; switching, and provide a function, `linkd-back', to return to the
;; old buffer.
(defun linkd-follow (sexp)
"Follow the link represented by SEXP."
(let* ((plist (eval sexp))
(follower (plist-get plist :follow)))
(when follower
;; save current spot so that we can go back if needed
(setq linkd-previous-buffer (current-buffer))
(setq linkd-previous-point (point))
(funcall follower))))
;;;###autoload
(defun linkd-back ()
"Return to the buffer being viewed before the last link was followed."
(interactive)
(when linkd-previous-buffer
(switch-to-buffer linkd-previous-buffer)
(let ((start (point)))
(goto-char linkd-previous-point)
(setq linkd-previous-point start))))
;;;###autoload
(defun linkd-follow-at-point ()
"Follow the link at point."
(interactive)
(linkd-follow (linkd-link-at-point)))
(defun linkd-follow-mouse (event)
"Follow the clicked link."
(interactive "e")
(when event
(select-window (posn-window (event-start event)))
(set-buffer (window-buffer (posn-window (event-start event))))
(goto-char (posn-point (event-start event)))
;;; $$$$ (beginning-of-line)
(linkd-follow (linkd-link-at-point))))
(defun linkd-maybe-enable-in-target ()
"Conditionally enable linkd mode in the target of an @file link."
(when (or (and (booleanp linkd-enable-linkd-mode-in-target)
linkd-enable-linkd-mode-in-target)
(and (functionp linkd-enable-linkd-mode-in-target)
(funcall linkd-enable-linkd-mode-in-target))
(and (listp linkd-enable-linkd-mode-in-target)
(memq major-mode linkd-enable-linkd-mode-in-target)))
(linkd-mode 1)))
;; (@* "Navigating Links") -------------------------------------------
;;
;; Instead of manually positioning point on each link, we can navigate
;; directly between links. The following interactive functions jump
;; from link to link.
;;;###autoload
(defun linkd-next-link ()
"Move point to the next link, if any."
(interactive)
(forward-char 1)
(let ((inhibit-point-motion-hooks nil))
;; get out of the current overlay if needed
(when (get-char-property (point) 'linkd)
(while (and (not (eobp)) (get-char-property (point) 'linkd))
(goto-char (min (next-overlay-change (point))
(next-single-char-property-change (point) 'linkd)))))
;; now find the next linkd overlay
(while (and (not (eobp)) (not (get-char-property (point) 'linkd)))
(goto-char (min (next-overlay-change (point))
(next-single-char-property-change (point) 'linkd))))))
;;;###autoload
(defun linkd-previous-link ()
"Move point to the previous link, if any."
(interactive)
(let ((inhibit-point-motion-hooks nil))
;; get out of the current overlay if needed
(when (get-char-property (point) 'linkd)
(while (and (not (bobp)) (get-char-property (point) 'linkd))
(goto-char (max (previous-overlay-change (point))
(previous-single-char-property-change (point) 'linkd)))))
;; now find the previous linkd overlay
(while (and (not (bobp)) (not (get-char-property (point) 'linkd)))
(goto-char (max (previous-overlay-change (point))
(previous-single-char-property-change (point) 'linkd))))))
;; (@* "Inserting and Editing Links Interactively") ------------------
;;
;; It is not necessary to type the links manually. With these
;; functions, the user may create and edit links interactively.
;;;###autoload
(defun linkd-insert-single-arg-link (type-string argument)
"Insert a link containing ARGUMENT."
(insert (if (not (string= "" argument))
(format (concat "(" "@%s %S)") type-string argument)
(format (concat "(" "@%s)") type-string))))
;;;###autoload
(defun linkd-insert-tag (tag-name)
"Insert a tag."
(interactive "sTag name: ")
(linkd-insert-single-arg-link ">" tag-name))
;;;###autoload
(defun linkd-insert-star (star-name)
"Insert a star."
(interactive "sStar name: ")
(linkd-insert-single-arg-link "*" star-name))
;;;###autoload
(defun linkd-insert-wiki (wiki-name)
"Insert a wiki link."
(interactive "sWiki page: ")
(linkd-insert-single-arg-link "!" wiki-name))
;;;###autoload
(defun linkd-insert-lisp (sexp)
"Insert a Lisp sexp."
(interactive "xLisp expression: ")
(linkd-insert-single-arg-link "L" sexp))
;;;###autoload
(defun linkd-insert-link (&optional type current-values)
"Insert a link.
Optional arg TYPE is the link type.
Optional arg CURRENT-VALUES is a property list of current values."
(interactive)
(let* ((type (or type (completing-read "Link type: " linkd-type-keywords-alist)))
(keys (cdr (assoc type linkd-type-keywords-alist)))
(key (car keys))
(link-args nil))
(while key
;; read an argument value
(let ((value (read-from-minibuffer (format "%S " key) (plist-get current-values key))))
(when (not (string= "" value)) (setq link-args (plist-put link-args key value))))
;; next
(setq keys (cdr keys))
(setq key (car keys)))
;; format and insert the link
(insert (format (concat "(" "@%s %s)") type (mapconcat (lambda (sexp) (format "%S" sexp))
link-args
" ")))))
;;;###autoload
(defun linkd-edit-link-at-point ()
"Edit the Linkd link at point."
(interactive)
(let ((link (linkd-link-at-point)))
(when link
(if (keywordp (car (cdr link)))
(save-excursion ; it's a general link. drop the @ sign
(linkd-insert-link (substring (format "%S" (car link)) 1) (cdr link)))
;; it's a single-arg link
(let ((new-value (read-from-minibuffer "New value: " (car (cdr link)))))
(insert (format "%S" (list (car link) new-value)))))
;; now erase old link
(re-search-backward linkd-generic-regexp)
(delete-region (match-beginning 0) (match-end 0)))))
;; (@* "Rendering Links with Overlays") ------------------------------
;;
;; Emacs' overlays allow us to render a link onscreen in ways that make
;; the meaning of the link clearer. We can do this by hiding the somewhat
;; ugly link syntax, color-coding the text, and optionally by
;; displaying graphical icons to help in determining the type of link.
;;
;; This is one of the trickiest parts of linkd-mode, as the use of
;; overlays requires attention to detail in order for things to work
;; right.
;;
;; First some preliminary definitions.
(defun linkd-insert (string)
"Insert STRING, removing its text properties."
(insert (substring-no-properties string)))
;; The following utility function is our standard way of applying
;; linkd-style overlays to the text of a link.
(defun linkd-overlay (beg end display-text
&optional display-face bullet-text bullet-face bullet-icon)
"Apply Linkd overlay to link text.
$$$$$ FIXME: document args."
(let ((overlay (make-overlay beg end)))
(overlay-put
overlay 'display (propertize display-text
'face (or display-face 'linkd-generic-link-name)
'keymap linkd-overlay-map)) ; add speed-navigation keys
(overlay-put overlay 'mouse-face 'highlight)
(overlay-put overlay 'linkd t) ; mark overlay so that we can find it later
(overlay-put overlay 'keymap linkd-overlay-map) ; add speed-navigation keys
(when bullet-text ; add bullet, if appropriate
(let* ((face (if (and bullet-icon linkd-use-icons) 'linkd-icon bullet-face))
(b1 (if face (propertize bullet-text 'face face) bullet-text))
(b2 (if (and bullet-icon linkd-use-icons)
(propertize b1 'display
`(image :file ,bullet-icon :type xpm :ascent center))
b1)))
(overlay-put overlay 'before-string (concat b2 " "))))
(overlay-put overlay 'evaporate t)
(overlay-put overlay 'modification-hooks ; defontify if the user edits the text
(list (lambda (ov foo beg end &rest ignore)
(delete-overlay ov)
(remove-text-properties (point-at-bol) (point-at-eol)
(list 'fontified nil
'linkd-fontified nil
'linkd nil)))))))
;; (@* "Decorating Links with Graphical Icons") ----------------------
;;
;; I have drawn a set of 16x16 icons for use with linkd-mode. When the
;; icon feature is enabled, an appropriate icon is displayed to the
;; left of the link.
;;
;; The icons are included in the linkd download at:
;; http://www.emacswiki.org/emacs/linkd.tar.gz
(defun linkd-icon (icon-name)
"Returns the name of the icon file for ICON-NAME."
(concat (file-name-as-directory linkd-icons-directory) "linkd-" icon-name ".xpm"))
(defun linkd-file-icon (file-name)
"Choose an appropriate icon for FILE-NAME based on the name or extension.
Returns the file-name to the icon image file."
(let* ((dir (file-name-as-directory linkd-icons-directory))
(icon (concat dir "linkd-file-" (file-name-extension file-name) ".xpm")))
(if (file-exists-p icon)
icon
(concat dir "linkd-file-generic.xpm"))))
;; (@* "Stars") ------------------------------------------------------
;;
;; Stars delimit (and optionally name) blocks of text. A block of text
;; is the region between one star and the next. We may think of blocks
;; as dividing a text file into sections.
(defun @* (&optional star-name)
"$$$$$$$$$$$$ FIXME"
`(:follow
(lambda () (linkd-find-next-tag-or-star ,star-name))
:render
(lambda (beg end)
(linkd-overlay
beg end
,(if star-name star-name " ") ; leave space so fontified link won't disappear
',(if star-name 'linkd-star-name 'default)
"*" 'linkd-star ,(linkd-icon "star")))))
;; (@* "Tags") -------------------------------------------------------
;;
;; Tags can be used to navigate within source code. You can mark
;; those parts of a program that relate to a given concept with a
;; `tag' link that names the concept.
;;
;; Following a `tag' link navigates to the next tag (or star) with the
;; same name, cycling to the beginning of the buffer when the end is
;; reached. You can think of following tag links as tracing a concept
;; through different parts of a program by jumping between related
;; pieces of code.
(defun linkd-find-next-tag-or-star (name)
"Find next Linkd tag or star."
(let* ((regexp (concat "\(\@\\(\*\\|>\\) \"" name))
(found-position
(save-excursion
(goto-char (point-at-eol))
(if (re-search-forward regexp nil t)
(match-beginning 0)
(goto-char (point-min)) ; start over at the beginning of the buffer
(when (re-search-forward regexp nil t) (match-beginning 0))))))
(when found-position (goto-char found-position))))
(defun @> (tag-name)
"$$$$$$$$ FIXME"
`(:follow
(lambda () (linkd-find-next-tag-or-star ,tag-name))
:render
(lambda (beg end) (linkd-overlay beg end ,tag-name 'linkd-tag-name
">" 'linkd-tag ,(linkd-icon "tag")))))
;; (@* "Processing Blocks") ------------------------------------------
;;
;; You can divide a text file into sections using stars, and then
;; selectively process certain of those blocks of text, perhaps with
;; an external program. You can use this facility to experiment with
;; such external programs or to develop interactive scripts. For
;; example, you can send a block of shell-script commands to a shell
;; window for immediate execution.
;;
;; The operation to be performed is determined by the value of the
;; buffer-local variable `linkd-process-block-function'. You can set
;; this to an appropriate value in a file's `Local Variables' section.
(defun linkd-block-around-point ()
"Return the block around point as a string."
(interactive)
(let ((beg (save-excursion
(search-backward linkd-star-search-string) (beginning-of-line) (point)))
(end (save-excursion (search-forward linkd-star-search-string) (point))))
(buffer-substring-no-properties beg end)))
(defun linkd-write-block-to-file (block-text)
"Write the BLOCK-TEXT to the file named by linkd-block-file-name."
(interactive)
(with-temp-buffer
(insert block-text)
(write-file linkd-block-file-name)))
(defun linkd-process-block ()
"Process the Linkd block around point."
(interactive)
(funcall linkd-process-block-function (linkd-block-around-point)))
(defun linkd-send-block-to-shell (block-text)
"Send the Linkd block around point to the shell."
(interactive)
;; create shell if needed, but not in this window
(unless (get-buffer-window linkd-shell-buffer-name)
(save-window-excursion (shell linkd-shell-buffer-name))
(display-buffer linkd-shell-buffer-name))
(linkd-write-block-to-file block-text)
(save-selected-window
(select-window (get-buffer-window linkd-shell-buffer-name))
(goto-char (point-max))
(insert (concat ". " linkd-block-file-name)) ; make the shell source the temp file
(call-interactively (key-binding "\r"))))
;; (@* "Datablocks") -------------------------------------------------
;;
;; A datablock is an embedded object of a user-defined type. It
;; consists of a "type symbol" followed by a printed representation of
;; a Lisp object called the "embedded object". The type symbol is a
;; symbol whose `symbol-function' determines the appearance and
;; behavior of the region of the buffer that contains the embedded
;; object. By convention, a type symbol's name begins with a caret
;; (`^').
;;
;; When a datablock is "activated", the embedded object is read from
;; the buffer and fed to the type symbol's function. This function
;; can temporarily replace the region with an interactive
;; representation of the embedded object, which can then be
;; manipulated by the user. The behavior of this representation may
;; be effected by various uses of Emacs' text properties.
;;
;; When a datablock is "deactivated", the interface is replaced with a
;; plain-text representation of the new embedded object. You can
;; arrange for the automatic activation and deactivation of datablocks
;; - for example, upon saving and loading files that contain them.
;;
;; Datablocks must be activated on a per-file basis via a `Local
;; Variables' section in the file.
;; Function to extract the embedded object at point.
(defun linkd-datablock-object-at-point ()
"Returns the Linkd datablock object at point."
(get-text-property (point) 'linkd-datablock-object))
;; A function to insert a template datablock. This is what you use to
;; create new datablocks with specified contents.
(defun linkd-insert-datablock-template (&optional object)
"Insert a new datablock with OBJECT as the printed contents."
(insert (format "(^begin ^cell)\n%S\n(^end)" object)))
;; This function governs the interaction of linkd-mode's datablock
;; system with the ``modules'' that implement various types of
;; embedded objects. First the type symbol and embedded object are
;; read in from the text. The function value of the module's type
;; symbol is obtained, and the embedded object is fed to the function
;; in order to activate or deactivate the datablock as needed. The
;; function is also passed some markers that delimit the region to
;; which the module should confine its rendering activity.
(defun linkd-activate-datablock (action)
"When ACTION is :begin, activate the current datablock. When
ACTION is :end, deactivate the datablock."
(interactive)
(when (search-forward (concat "(^" "begin ") nil t)
;; first read in the datablock
(let* ((type-symbol (read (current-buffer)))
(datablock-begin (match-beginning 0))
(datablock-object (progn (forward-line) (read (current-buffer))))
(datablock-end (progn (search-forward "(^end)") (match-end 0)))
(activate (symbol-function type-symbol)))
(goto-char datablock-begin)
(case action
(:begin ; insert markers; datablock display happens in between them
(let* ((inhibit-read-only t)
(beg (make-marker))
(end (make-marker)))
(set-marker beg (save-excursion (goto-char datablock-begin) (point-at-eol)))
(set-marker end (save-excursion (goto-char datablock-end) (point-at-bol)))
;; make the delimiters invisible
(add-text-properties datablock-begin beg '(invisible t))
(add-text-properties end datablock-end '(invisible t))
;; start the datablock going, tell it what region it is to manage
(let ((object (funcall activate :begin datablock-object beg end)))
(when (null object) (error "Null object."))
;; save datablock details for later lookup
(add-text-properties beg end (list 'linkd-datablock-object object)))
;; move into the region
(goto-char (+ 1 datablock-begin))
(message "%S" (linkd-datablock-object-at-point))))
(:end ; stop managing the region and write the sexp back
(forward-line)
(let ((object (funcall activate :end datablock-object))
(inhibit-read-only t)
(inhibit-point-motion-hooks t))
(delete-region datablock-begin datablock-end)
(insert (format (concat "(^" "begin %S)\n%S\n(^end)") type-symbol object))))))))
(defun linkd-begin-datablock ()
"Begin a Linkd datablock."
(linkd-activate-datablock :begin))
(defun linkd-end-datablock ()
"End a Linkd datablock."
(linkd-activate-datablock :end))
(defun linkd-escape-datablock ()
"Find the previous datablock beginning."
(interactive)
(search-backward (concat "(" "^begin "))
(forward-line -1))
(defun linkd-activate-all-datablocks ()
"Activate all Linkd datablocks."
(interactive)
(when (and linkd-use-datablocks (not linkd-datablocks-activated))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(linkd-begin-datablock)
(forward-line))
(setq linkd-datablocks-activated t))))
(defun linkd-deactivate-all-datablocks ()
"Deactivate all Linkd datablocks."
(interactive)
(when (and linkd-use-datablocks linkd-datablocks-activated)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(linkd-end-datablock)
(forward-line))
(setq linkd-datablocks-activated nil))))
;; (@* "Exporting to Other Formats") ---------------------------------
;;
;; Linkd supports export to LaTeX and HTML. What follows are some
;; functions basic to the export process.
(defun linkd-export (export-function output-file-name)
"Export the current-buffer using EXPORT-FUNCTION and write
output to OUTPUT-FILE-NAME. EXPORT-FUNCTION should convert to
the output format, do any required postprocessing, and return
the buffer with the ouput."
(with-current-buffer (funcall export-function)
(write-file (expand-file-name output-file-name))))
;;;###autoload
(defun linkd-export-default ()
"Export the current buffer with default settings to all available formats."
(interactive)
(dolist (format linkd-export-formats-alist)
(let* ((extension (car format))
(output-file (concat (buffer-file-name) "." extension))
(export-function (cdr format)))
(linkd-export export-function output-file))))
;; (@* "Exporting to LaTeX") -----------------------------------------
;;
;; This section contains routines to transform Lisp source code files
;; into beautiful LaTeX documents in (roughly) the style of Donald
;; Knuth's "Literate Programming". To take advantage of this feature,
;; the source code to be transformed should contain alternating
;; regions of commentary and code, with appropriate star headings to
;; group these regions into document sections.
;;
;; FIXME: There is no such function: `linkd-latex-render'
;;
;; The interactive function `linkd-latex-render' transforms the source
;; code in a temporary buffer and writes the result to a corresponding
;; LaTeX file. Where tags appear in Commentary, they are prettified
;; in the LaTeX output.
;;
;; The purist might object that true literate programming requires a
;; tool capable of resequencing code fragments and performing macro
;; expansion, neither of which are implemented here. In response to
;; this objection I (David O'Toole) point out the following: (i) there
;; is little need for resequencing in a language like Lisp, where
;; declarations can be ordered more or less as you please; (ii) Lisp
;; already has a powerful macro expansion facility; and (iii) there is
;; no reason why a system that deviates somewhat from the
;; traditionally accepted definition of literate programming should
;; not still contribute to the writing of better programs.
;;
;; FIXME: No such `require' in this file: The `fancyvrb' package is
;; required.
(defun linkd-latex-begin-verbatim ()
"Insert LaTeX `Verbatim' start tag."
(setq linkd-latex-in-verbatim t)
(insert (concat "\\" "begin{Verbatim}[fontsize=\\small]\n")))
(defun linkd-latex-end-verbatim ()
"Insert LaTeX `Verbatim' end tag."
(setq linkd-latex-in-verbatim nil)
(insert (concat "\\" "end{Verbatim}\n")))
(defun linkd-latex-do-section (title)
"Insert LaTeX section tag."
(insert (format "\\section{%s}\n" title)))
(defun linkd-latex-toggle-verbatim ()
"Insert LaTeX `Verbatim' begin or end tag, as needed."
(if linkd-latex-in-verbatim (linkd-latex-end-verbatim) (linkd-latex-begin-verbatim)))
;;;###autoload
(defun linkd-latex-export ()
"Render a buffer as a LaTeX book chapter."
(interactive)
(let* ((output-buffer (get-buffer-create "*linkd-litprog*"))
(source-buffer (current-buffer)))
(with-current-buffer output-buffer
(let ((linkd-use-datablocks nil))
(delete-region (point-min) (point-max)) ; clean up any previous output
(insert-buffer-substring-no-properties source-buffer) ; make a copy of the source
;; delete everything before first heading
(goto-char (point-min))
(re-search-forward linkd-export-heading-regexp)
(previous-line)
(end-of-line)
(delete-region (point-min) (point))
;; now process each block in turn.