« back to all changes in this revision
Viewing changes to lisp/muse.el
- browse files at revision 1.1.3
- compare with another revision
- compare with revision 6
- download diff
- download tarball
- view history from revision 1.1.3
- Committer: Bazaar Package Importer
- Author(s): Michael W. Olson (GNU address)
- Date: 2007-06-25 08:17:44 UTC
- mto: This revision was merged to the branch mainline in revision 5.
- Revision ID: james.westby@ubuntu.com-20070625081744-h7ajew6icqoiltfp
Tags: upstream-3.03
Import upstream version 3.03
- files added:
- ChangeLog.1
- etc
- texi
- files removed:
- ChangeLog.2004
- files modified:
- AUTHORS
added
removed
lisp/muse.el
1
1
;;; muse.el --- an authoring and publishing tool for Emacs
2
2
3
;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
3
;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
4
5
5
;; Emacs Lisp Archive Entry
6
6
;; Filename: muse.el
7
;; Version: 3.02.8
8
;; Date: Tue 10-Oct-2006
7
;; Version: 3.03
8
;; Date: Sun 17-Jun-2007
9
9
;; Keywords: hypermedia
10
10
;; Author: John Wiegley (johnw AT gnu DOT org)
11
;; Maintainer: Michael Olson (mwolson AT gnu DOT org)
11
;; Maintainer: Michael Olson <mwolson@gnu.org>
12
12
;; Description: An authoring and publishing tool for Emacs
13
;; URL: http://www.mwolson.org/projects/EmacsMuse.html
13
;; URL: http://mwolson.org/projects/EmacsMuse.html
14
14
;; Compatibility: Emacs21 XEmacs21 Emacs22
15
15
16
16
;; This file is part of Emacs Muse. It is not part of GNU Emacs.
45
45
46
46
;;; Code:
47
47
48
(defvar muse-version "3.02.8"
48
;; Indicate that this version of Muse supports nested tags
49
(provide 'muse-nested-tags)
50
51
(defvar muse-version "3.03"
49
52
"The version of Muse currently loaded")
50
53
51
54
(defun muse-version (&optional insert)
64
67
65
68
(defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
66
69
70
(provide 'muse)
71
67
72
(require 'wid-edit)
68
73
(require 'muse-regexps)
69
74
75
(defvar muse-update-values-hook nil
76
"Hook for values that are automatically generated.
77
This is to be used by add-on modules for Muse.
78
It is run just before colorizing or publishing a buffer.")
79
70
80
;; Default file extension
71
81
82
;; By default, use the .muse file extension.
83
;;;###autoload (add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
84
85
;; We need to have this at top-level, as well, so that any Muse or
86
;; Planner documents opened during init will just work.
87
(add-to-list 'auto-mode-alist '("\\.muse\\'" . muse-mode-choose-mode))
88
72
89
(eval-when-compile
73
90
(defvar muse-ignored-extensions))
74
91
78
95
79
96
(defun muse-update-file-extension (sym val)
80
97
"Update the value of `muse-file-extension'."
81
(when (and (boundp sym) (symbol-value sym))
98
(when (and (featurep 'muse-mode)
99
(boundp sym) (stringp (symbol-value sym))
100
(or (not (stringp val))
101
(not (string= (symbol-value sym) val))))
82
102
;; remove old auto-mode-alist association
83
103
(setq auto-mode-alist
84
104
(delete (cons (concat "\\." (symbol-value sym) "\\'")
85
105
'muse-mode-choose-mode)
86
106
auto-mode-alist)))
87
107
(set sym val)
88
;; associate .muse with muse-mode
89
(when val
108
;; associate the new file extension with muse-mode
109
(when (and (featurep 'muse-mode)
110
(stringp val)
111
(or (not (stringp (symbol-value sym)))
112
(not (string= (symbol-value sym) val))))
90
113
(add-to-list 'auto-mode-alist
91
114
(cons (concat "\\." val "\\'")
92
115
'muse-mode-choose-mode)))
93
(when (fboundp 'muse-update-ignored-extensions-regexp)
116
;; update the ignored extensions regexp
117
(when (and (fboundp 'muse-update-ignored-extensions-regexp)
118
(or (not (stringp (symbol-value sym)))
119
(not (stringp val))
120
(not (string= (symbol-value sym) val))))
94
121
(muse-update-ignored-extensions-regexp
95
122
'muse-ignored-extensions muse-ignored-extensions)))
96
123
97
124
(defcustom muse-file-extension "muse"
98
"File extension of Muse files. Omit the period at the beginning."
125
"File extension of Muse files. Omit the period at the beginning.
126
If you don't want Muse files to have an extension, set this to nil."
99
127
:type '(choice
100
128
(const :tag "None" nil)
101
129
(string))
116
144
(concat "\\.\\(" muse-file-extension "\\)\\'")
117
145
nil))))
118
146
147
(add-hook 'muse-update-values-hook
148
(lambda ()
149
(muse-update-ignored-extensions-regexp
150
'muse-ignored-extensions muse-ignored-extensions)))
151
119
152
(defcustom muse-ignored-extensions '("bz2" "gz" "[Zz]")
120
153
"A list of extensions to omit from the ending of a Muse page name.
121
154
These are regexps.
126
159
:set 'muse-update-ignored-extensions-regexp
127
160
:group 'muse)
128
161
162
(defun muse-update-file-extension-after-init ()
163
;; This is short, but it has to be a function, otherwise Emacs21
164
;; does not load it properly when running after-init-hook
165
(muse-update-file-extension 'muse-file-extension muse-file-extension))
166
167
;; Once the user's init file has been processed, determine whether
168
;; they want a file extension
169
(add-hook 'after-init-hook 'muse-update-file-extension-after-init)
170
129
171
;; URL protocols
130
172
131
173
(require 'muse-protocols)
132
174
133
;;; Return an list of known wiki names and the files they represent.
175
;; Helper functions
134
176
135
177
(defsubst muse-delete-file-if-exists (file)
136
178
(when (file-exists-p file)
173
215
(if (featurep 'xemacs)
174
216
'warning
175
217
:warning))
176
(message message)))
218
(let ((buf (get-buffer-create "*Muse warnings*")))
219
(with-current-buffer buf
220
(goto-char (point-max))
221
(insert "Warning (muse): " message)
222
(unless (bolp)
223
(newline)))
224
(display-buffer buf)
225
(sit-for 0))))
177
226
178
227
(defun muse-eval-lisp (form)
179
228
"Evaluate the given form and return the result as a string."
200
249
(defmacro muse-with-temp-buffer (&rest body)
201
250
"Create a temporary buffer, and evaluate BODY there like `progn'.
202
251
See also `with-temp-file' and `with-output-to-string'.
252
203
253
Unlike `with-temp-buffer', this will never attempt to save the temp buffer.
204
It is meant to be used along with `insert-file-contents'."
254
It is meant to be used along with `insert-file-contents'.
255
256
Additionally, if `debug-on-error' is set to t, keep the buffer
257
around for debugging purposes rather than removing it."
205
258
(let ((temp-buffer (make-symbol "temp-buffer")))
206
259
`(let ((,temp-buffer (generate-new-buffer " *muse-temp*")))
207
260
(unwind-protect
227
280
(with-current-buffer ,temp-buffer
228
281
(set-buffer-modified-p nil))
229
282
(unless debug-on-error (kill-buffer ,temp-buffer)))))))
283
230
284
(put 'muse-with-temp-buffer 'lisp-indent-function 0)
231
285
(put 'muse-with-temp-buffer 'edebug-form-spec '(body))
232
286
287
(defun muse-collect-alist (list element &optional test)
288
"Collect items from LIST whose car is equal to ELEMENT.
289
If TEST is specified, use it to compare ELEMENT."
290
(unless test (setq test 'equal))
291
(let ((items nil))
292
(dolist (item list)
293
(when (funcall test element (car item))
294
(setq items (cons item items))))
295
items))
296
297
(defmacro muse-sort-with-closure (list predicate closure)
298
"Sort LIST, stably, comparing elements using PREDICATE.
299
Returns the sorted list. LIST is modified by side effects.
300
PREDICATE is called with two elements of list and CLOSURE.
301
PREDICATE should return non-nil if the first element should sort
302
before the second."
303
`(sort ,list (lambda (a b) (funcall ,predicate a b ,closure))))
304
305
(put 'muse-sort-with-closure 'lisp-indent-function 0)
306
(put 'muse-sort-with-closure 'edebug-form-spec '(form function-form form))
307
308
(defun muse-sort-by-rating (rated-list &optional test)
309
"Sort RATED-LIST according to the rating of each element.
310
The rating is stripped out in the returned list.
311
Default sorting is highest-first.
312
313
If TEST if specified, use it to sort the list."
314
(unless test (setq test '>))
315
(mapcar (function cdr)
316
(muse-sort-with-closure
317
rated-list
318
(lambda (a b closure)
319
(let ((na (numberp (car a)))
320
(nb (numberp (car b))))
321
(cond ((and na nb) (funcall closure (car a) (car b)))
322
(na (not nb))
323
(t nil))))
324
test)))
325
326
(defun muse-escape-specials-in-string (specials string &optional reverse)
327
"Apply the transformations in SPECIALS to STRING.
328
329
The transforms should form a fully reversible and non-ambiguous
330
syntax when STRING is parsed from left to right.
331
332
If REVERSE is specified, reverse an already-escaped string."
333
(let ((rules (mapcar (lambda (rule)
334
(cons (regexp-quote (if reverse
335
(cdr rule)
336
(car rule)))
337
(if reverse (car rule) (cdr rule))))
338
specials)))
339
(with-temp-buffer
340
(insert string)
341
(goto-char (point-min))
342
(save-match-data
343
(while (not (eobp))
344
(unless (catch 'found
345
(dolist (rule rules)
346
(when (looking-at (car rule))
347
(replace-match (cdr rule) t t)
348
(throw 'found t))))
349
(forward-char))))
350
(buffer-string))))
351
352
(defun muse-trim-whitespace (string)
353
"Return a version of STRING with no initial nor trailing whitespace."
354
(muse-replace-regexp-in-string
355
(concat "\\`[" muse-regexp-blank "]+\\|[" muse-regexp-blank "]+\\'")
356
"" string))
357
358
(defun muse-path-sans-extension (path)
359
"Return PATH sans final \"extension\".
360
361
The extension, in a file name, is the part that follows the last `.',
362
except that a leading `.', if any, doesn't count.
363
364
This differs from `file-name-sans-extension' in that it will
365
never modify the directory part of the path."
366
(concat (file-name-directory path)
367
(file-name-nondirectory (file-name-sans-extension path))))
368
233
369
;; The following code was extracted from cl
234
370
235
371
(defun muse-const-expr-p (x)
280
416
281
417
;; Compatibility functions
282
418
283
(defun muse-looking-back (regexp &optional limit)
284
(if (fboundp 'looking-back)
285
(looking-back regexp limit)
419
(if (fboundp 'looking-back)
420
(defalias 'muse-looking-back 'looking-back)
421
(defun muse-looking-back (regexp &optional limit &rest ignored)
286
422
(save-excursion
287
423
(re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
288
424
289
(defun muse-line-end-position (&optional n)
425
(eval-and-compile
290
426
(if (fboundp 'line-end-position)
291
(line-end-position n)
292
(save-excursion (end-of-line n) (point))))
427
(defalias 'muse-line-end-position 'line-end-position)
428
(defun muse-line-end-position (&optional n)
429
(save-excursion (end-of-line n) (point))))
293
430
294
(defun muse-line-beginning-position (&optional n)
295
431
(if (fboundp 'line-beginning-position)
296
(line-beginning-position n)
297
(save-excursion (beginning-of-line n) (point))))
432
(defalias 'muse-line-beginning-position 'line-beginning-position)
433
(defun muse-line-beginning-position (&optional n)
434
(save-excursion (beginning-of-line n) (point))))
298
435
299
(defun muse-match-string-no-properties (num &optional string)
300
436
(if (fboundp 'match-string-no-properties)
301
(match-string-no-properties num string)
302
(match-string num string)))
437
(defalias 'muse-match-string-no-properties 'match-string-no-properties)
438
(defun muse-match-string-no-properties (num &optional string)
439
(match-string num string))))
303
440
304
441
(defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
305
442
"Replace REGEXP with REPLACEMENT in TEXT.
443
444
Return a new string containing the replacements.
445
306
446
If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
307
447
If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
308
448
(cond
449
((fboundp 'replace-in-string)
450
(replace-in-string text regexp replacement literal))
309
451
((fboundp 'replace-regexp-in-string)
310
452
(replace-regexp-in-string regexp replacement text fixedcase literal))
311
((fboundp 'replace-in-string)
312
(replace-in-string text regexp replacement literal))
313
(t (while (string-match regexp text)
314
(setq text (replace-match replacement fixedcase literal text)))
453
(t (let ((repl-len (length replacement))
454
start)
455
(unless (string= regexp "")
456
(save-match-data
457
(while (setq start (string-match regexp text start))
458
(setq start (+ start repl-len)
459
text (replace-match replacement fixedcase literal
460
text))))))
315
461
text)))
316
462
317
(defun muse-add-to-invisibility-spec (element)
318
"Add ELEMENT to `buffer-invisibility-spec'.
463
(if (fboundp 'add-to-invisibility-spec)
464
(defalias 'muse-add-to-invisibility-spec 'add-to-invisibility-spec)
465
(defun muse-add-to-invisibility-spec (element)
466
"Add ELEMENT to `buffer-invisibility-spec'.
319
467
See documentation for `buffer-invisibility-spec' for the kind of elements
320
468
that can be added."
321
(if (fboundp 'add-to-invisibility-spec)
322
(add-to-invisibility-spec element)
323
469
(if (eq buffer-invisibility-spec t)
324
470
(setq buffer-invisibility-spec (list t)))
325
471
(setq buffer-invisibility-spec
326
472
(cons element buffer-invisibility-spec))))
327
473
328
(defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial)
329
"Read directory name - see `read-file-name' for details."
330
(if (fboundp 'read-directory-name)
331
(read-directory-name prompt dir default-dirname mustmatch initial)
474
(if (fboundp 'read-directory-name)
475
(defalias 'muse-read-directory-name 'read-directory-name)
476
(defun muse-read-directory-name (prompt &optional dir default-dirname mustmatch initial)
477
"Read directory name - see `read-file-name' for details."
332
478
(unless dir
333
479
(setq dir default-directory))
334
480
(read-file-name prompt dir (or default-dirname
336
482
dir))
337
483
mustmatch initial)))
338
484
485
(defun muse-file-remote-p (file)
486
"Test whether FILE specifies a location on a remote system.
487
Return non-nil if the location is indeed remote.
488
489
For example, the filename \"/user@host:/foo\" specifies a location
490
on the system \"/user@host:\"."
491
(cond ((fboundp 'file-remote-p)
492
(file-remote-p file))
493
((fboundp 'tramp-handle-file-remote-p)
494
(tramp-handle-file-remote-p file))
495
((and (boundp 'ange-ftp-name-format)
496
(string-match (car ange-ftp-name-format) file))
497
t)
498
(t nil)))
499
500
;; Set face globally in a predictable fashion
501
(defun muse-copy-face (old new)
502
"Copy face OLD to NEW."
503
(if (featurep 'xemacs)
504
(copy-face old new 'all)
505
(copy-face old new)))
506
339
507
;; Widget compatibility functions
340
508
341
509
(defun muse-widget-type-value-create (widget)
362
530
363
531
;; Link-handling functions and variables
364
532
533
(defun muse-get-link (&optional target)
534
"Based on the match data, retrieve the link.
535
Use TARGET to get the string, if it is specified."
536
(muse-match-string-no-properties 1 target))
537
538
(defun muse-get-link-desc (&optional target)
539
"Based on the match data, retrieve the link description.
540
Use TARGET to get the string, if it is specified."
541
(muse-match-string-no-properties 2 target))
542
543
(defvar muse-link-specials
544
'(("[" . "%5B")
545
("]" . "%5D")
546
("%" . "%%"))
547
"Syntax used for escaping and unescaping links.
548
This allows brackets to occur in explicit links as long as you
549
use the standard Muse functions to create them.")
550
365
551
(defun muse-link-escape (text)
366
552
"Escape characters in TEXT that conflict with the explicit link
367
553
regexp."
368
(if text
369
(progn
370
(muse-replace-regexp-in-string "\\[" "%5B" text t t)
371
(muse-replace-regexp-in-string "\\]" "%5D" text t t)
372
text)
373
""))
554
(when (stringp text)
555
(muse-escape-specials-in-string muse-link-specials text)))
374
556
375
557
(defun muse-link-unescape (text)
376
558
"Un-escape characters in TEXT that conflict with the explicit
377
559
link regexp."
378
(if text
379
(progn
380
(muse-replace-regexp-in-string "%5B" "[" text t t)
381
(muse-replace-regexp-in-string "%5D" "]" text t t)
382
text)
383
""))
560
(when (stringp text)
561
(muse-escape-specials-in-string muse-link-specials text t)))
384
562
385
563
(defun muse-handle-url (&optional string)
386
564
"If STRING or point has a URL, match and return it."
404
582
By default, Muse handles URLs only.
405
583
If you want to handle WikiWords, load muse-wiki.el.
406
584
407
This function modifies the match data so that match 1 is the
408
link. Match 2 will usually be nil, unless the description is
409
embedded in the text of the buffer.
585
This function modifies the match data so that match 0 is the
586
link.
410
587
411
588
The match data is restored after each unsuccessful handler
412
589
function call. If LINK is specified, only restore at very end.
436
613
"Handle explicit links. If LINK is not specified, look at point.
437
614
An explicit link is one that looks [[like][this]] or [[this]].
438
615
439
This function modifies the match data so that match 1 is the link
440
and match 2 is the description. Perhaps someday match 3 might be
441
the text to use for the alt element of an <a> or <img> tag.
442
443
The match data is saved. If no handlers are able to process
616
The match data is preserved. If no handlers are able to process
444
617
LINK, return LINK (if specified) or the 1st match string. If
445
618
LINK is not specified, it is assumed that Muse has matched
446
619
against `muse-explicit-link-regexp' before calling this
456
629
(muse-link-unescape
457
630
(if res
458
631
res
459
(or link (match-string 1))))))
460
461
(provide 'muse)
632
(or link (muse-get-link))))))
633
634
;; Movement functions
635
636
(defun muse-list-item-type (str)
637
"Determine the type of list given STR.
638
Returns either 'ul, 'ol, 'dl-term, 'dl-entry, or nil."
639
(save-match-data
640
(cond ((or (string= str "")
641
(< (length str) 2))
642
nil)
643
((string-match muse-dl-entry-regexp str)
644
'dl-entry)
645
((string-match muse-dl-term-regexp str)
646
'dl-term)
647
((string-match muse-ol-item-regexp str)
648
'ol)
649
((string-match muse-ul-item-regexp str)
650
'ul)
651
(t nil))))
652
653
(defun muse-list-item-critical-point (&optional offset)
654
"Figure out where the important markup character for the
655
currently-matched list item is.
656
657
If OFFSET is specified, it is the number of groupings outside of
658
the contents of `muse-list-item-regexp'."
659
(unless offset (setq offset 0))
660
(if (match-end (+ offset 2))
661
;; at a definition list
662
(match-end (+ offset 2))
663
;; at a different kind of list
664
(match-beginning (+ offset 1))))
665
666
(defun muse-forward-paragraph (&optional pattern)
667
"Move forward safely by one paragraph, or according to PATTERN."
668
(when (get-text-property (point) 'end-list)
669
(goto-char (next-single-property-change (point) 'end-list)))
670
(setq pattern (if pattern
671
(concat "^\\(?:" pattern "\\|\n\\|\\'\\)")
672
"^\\s-*\\(\n\\|\\'\\)"))
673
(let ((next-list-end (or (next-single-property-change (point) 'end-list)
674
(point-max))))
675
(forward-line 1)
676
(if (re-search-forward pattern nil t)
677
(goto-char (match-beginning 0))
678
(goto-char (point-max)))
679
(when (> (point) next-list-end)
680
(goto-char next-list-end))))
681
682
(defun muse-forward-list-item-1 (type empty-line indented-line)
683
"Determine whether a nested list item is after point."
684
(if (match-beginning 1)
685
;; if we are given a dl entry, skip past everything on the same
686
;; level, except for other dl entries
687
(and (eq type 'dl-entry)
688
(not (eq (char-after (match-beginning 2)) ?\:)))
689
;; blank line encountered with no list item on the same
690
;; level after it
691
(let ((beg (point)))
692
(forward-line 1)
693
(if (save-match-data
694
(and (looking-at indented-line)
695
(not (looking-at empty-line))))
696
;; found that this blank line is followed by some
697
;; indentation, plus other text, so we'll keep
698
;; going
699
t
700
(goto-char beg)
701
nil))))
702
703
(defun muse-forward-list-item (type indent &optional no-skip-nested)
704
"Move forward to the next item of TYPE.
705
Return non-nil if successful, nil otherwise.
706
The beginning indentation is given by INDENT.
707
708
If NO-SKIP-NESTED is non-nil, do not skip past nested items.
709
Note that if you desire this behavior, you will also need to
710
provide a very liberal INDENT value, such as
711
\(concat \"[\" muse-regexp-blank \"]*\")."
712
(let* ((list-item (format muse-list-item-regexp indent))
713
(empty-line (concat "^[" muse-regexp-blank "]*\n"))
714
(indented-line (concat "^" indent "[" muse-regexp-blank "]"))
715
(list-pattern (concat "\\(?:" empty-line "\\)?"
716
"\\(" list-item "\\)")))
717
(while (progn
718
(muse-forward-paragraph list-pattern)
719
;; make sure we don't go past boundary
720
(and (not (or (get-text-property (point) 'end-list)
721
(>= (point) (point-max))))
722
;; move past markup that is part of another construct
723
(or (and (match-beginning 1)
724
(or (get-text-property
725
(muse-list-item-critical-point 1) 'muse-link)
726
(get-text-property
727
(muse-list-item-critical-point 1) 'face)))
728
;; skip nested items
729
(and (not no-skip-nested)
730
(muse-forward-list-item-1 type empty-line
731
indented-line))))))
732
(cond ((or (get-text-property (point) 'end-list)
733
(>= (point) (point-max)))
734
;; at a list boundary, so stop
735
nil)
736
((let ((str (when (match-beginning 2)
737
;; get the entire line
738
(save-excursion
739
(goto-char (match-beginning 2))
740
(buffer-substring (muse-line-beginning-position)
741
(muse-line-end-position))))))
742
(and str (eq type (muse-list-item-type str))))
743
;; same type, so indicate that there are more items to be
744
;; parsed
745
(goto-char (match-beginning 1)))
746
(t
747
(when (match-beginning 1)
748
(goto-char (match-beginning 1)))
749
;; move to just before foreign list item markup
750
nil))))
751
752
(defun muse-goto-tag-end (tag nested)
753
"Move forward past the end of TAG.
754
755
If NESTED is non-nil, look for other instances of this tag that
756
may be nested inside of this tag, and skip past them."
757
(if (not nested)
758
(search-forward (concat "</" tag ">") nil t)
759
(let ((nesting 1)
760
(tag-regexp (concat "\\(<\\(/?\\)" tag ">\\)"))
761
(match-found nil))
762
(while (and (> nesting 0)
763
(setq match-found (re-search-forward tag-regexp nil t)))
764
(if (string-equal (match-string 2) "/")
765
(setq nesting (1- nesting))
766
(setq nesting (1+ nesting))))
767
match-found)))
462
768
463
769
;;; muse.el ends here
Loggerhead is a web-based interface for Breezy
Version: 2.0.1