← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/muse-el/oneiric

« back to all changes in this revision

Viewing changes to lisp/muse.el

  • Committer: Bazaar Package Importer
  • Author(s): Michael W. Olson (GNU address)
  • Date: 2008-01-09 15:51:46 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20080109155146-0wwzermvvzs9rqzo
Tags: 3.11-3ubuntu1
https://launchpad.net/bugs/137284
* Merge with with Debian unstable (LP: #137284). Remaining Ubuntu changes:
  - Keep manual.
  - Set Ubuntu MOTU to be Maintainer

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/muse.el
4
4
 
5
5
;; Emacs Lisp Archive Entry
6
6
;; Filename: muse.el
7
 
;; Version: 3.03
8
 
;; Date: Sun 17-Jun-2007
 
7
;; Version: 3.11
 
8
;; Date: Fri 24-Aug-2007
9
9
;; Keywords: hypermedia
10
10
;; Author: John Wiegley (johnw AT gnu DOT org)
11
11
;; Maintainer: Michael Olson <mwolson@gnu.org>
17
17
 
18
18
;; Emacs Muse is free software; you can redistribute it and/or modify
19
19
;; it under the terms of the GNU General Public License as published
20
 
;; by the Free Software Foundation; either version 2, or (at your
 
20
;; by the Free Software Foundation; either version 3, or (at your
21
21
;; option) any later version.
22
22
 
23
23
;; Emacs Muse is distributed in the hope that it will be useful, but
48
48
;; Indicate that this version of Muse supports nested tags
49
49
(provide 'muse-nested-tags)
50
50
 
51
 
(defvar muse-version "3.03"
 
51
(defvar muse-version "3.11"
52
52
  "The version of Muse currently loaded")
53
53
 
54
54
(defun muse-version (&optional insert)
69
69
 
70
70
(provide 'muse)
71
71
 
 
72
(condition-case nil
 
73
    (require 'derived)
 
74
  (error nil))
72
75
(require 'wid-edit)
73
76
(require 'muse-regexps)
74
77
 
95
98
 
96
99
(defun muse-update-file-extension (sym val)
97
100
  "Update the value of `muse-file-extension'."
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))))
102
 
    ;; remove old auto-mode-alist association
103
 
    (setq auto-mode-alist
104
 
          (delete (cons (concat "\\." (symbol-value sym) "\\'")
105
 
                        'muse-mode-choose-mode)
106
 
                  auto-mode-alist)))
107
 
  (set sym 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))))
113
 
    (add-to-list 'auto-mode-alist
114
 
                 (cons (concat "\\." val "\\'")
115
 
                       'muse-mode-choose-mode)))
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))))
121
 
    (muse-update-ignored-extensions-regexp
122
 
     'muse-ignored-extensions muse-ignored-extensions)))
 
101
  (let ((old (and (boundp sym) (symbol-value sym))))
 
102
    (set sym val)
 
103
    (when (and (featurep 'muse-mode)
 
104
               (or (not (stringp val))
 
105
                   (not (stringp old))
 
106
                   (not (string= old val))))
 
107
      ;; remove old auto-mode-alist association
 
108
      (when (and (boundp sym) (stringp old))
 
109
        (setq auto-mode-alist
 
110
              (delete (cons (concat "\\." old "\\'")
 
111
                            'muse-mode-choose-mode)
 
112
                      auto-mode-alist)))
 
113
      ;; associate the new file extension with muse-mode
 
114
      (when (stringp val)
 
115
        (add-to-list 'auto-mode-alist
 
116
                     (cons (concat "\\." val "\\'")
 
117
                           'muse-mode-choose-mode)))
 
118
      ;; update the ignored extensions regexp
 
119
      (when (fboundp 'muse-update-ignored-extensions-regexp)
 
120
        (muse-update-ignored-extensions-regexp
 
121
         'muse-ignored-extensions muse-ignored-extensions)))))
123
122
 
124
123
(defcustom muse-file-extension "muse"
125
124
  "File extension of Muse files.  Omit the period at the beginning.
130
129
  :set 'muse-update-file-extension
131
130
  :group 'muse)
132
131
 
 
132
(defcustom muse-completing-read-function 'completing-read
 
133
  "Function to call when prompting user to choose between a list of options.
 
134
This should take the same arguments as `completing-read'."
 
135
  :type 'function
 
136
  :group 'muse)
 
137
 
133
138
(defun muse-update-ignored-extensions-regexp (sym val)
134
139
  "Update the value of `muse-ignored-extensions-regexp'."
135
140
  (set sym val)
162
167
(defun muse-update-file-extension-after-init ()
163
168
  ;; This is short, but it has to be a function, otherwise Emacs21
164
169
  ;; does not load it properly when running after-init-hook
165
 
  (muse-update-file-extension 'muse-file-extension muse-file-extension))
 
170
  (unless (string= muse-file-extension "muse")
 
171
    (let ((val muse-file-extension)
 
172
          (muse-file-extension "muse"))
 
173
      (muse-update-file-extension 'muse-file-extension val))))
166
174
 
167
175
;; Once the user's init file has been processed, determine whether
168
176
;; they want a file extension
197
205
 
198
206
(defun muse-page-name (&optional name)
199
207
  "Return the canonical form of a Muse page name.
200
 
All this means is that certain extensions, like .gz, are removed."
 
208
 
 
209
What this means is that the directory part of NAME is removed,
 
210
and the file extensions in `muse-ignored-extensions' are also
 
211
removed from NAME."
201
212
  (save-match-data
202
213
    (unless (and name (not (string= name "")))
203
214
      (setq name (muse-current-file)))
250
261
  "Create a temporary buffer, and evaluate BODY there like `progn'.
251
262
See also `with-temp-file' and `with-output-to-string'.
252
263
 
253
 
Unlike `with-temp-buffer', this will never attempt to save the temp buffer.
254
 
It is meant to be used along with `insert-file-contents'.
 
264
Unlike `with-temp-buffer', this will never attempt to save the
 
265
temp buffer.  It is meant to be used along with
 
266
`insert-file-contents' or `muse-insert-file-contents'.
255
267
 
256
268
Additionally, if `debug-on-error' is set to t, keep the buffer
257
269
around for debugging purposes rather than removing it."
273
285
                      (backtrace))
274
286
                  (muse-display-warning
275
287
                   (format (concat "An error occurred while publishing"
276
 
                                   " %s: %s\n\nSet debug-on-error to"
 
288
                                   " %s:\n  %s\n\nSet debug-on-error to"
277
289
                                   " `t' if you would like a backtrace.")
278
290
                                 (muse-page-name) err))))))
279
291
         (when (buffer-live-p ,temp-buffer)
284
296
(put 'muse-with-temp-buffer 'lisp-indent-function 0)
285
297
(put 'muse-with-temp-buffer 'edebug-form-spec '(body))
286
298
 
 
299
(defun muse-insert-file-contents (filename &optional visit)
 
300
  "Insert the contents of file FILENAME after point.
 
301
Do character code conversion, but none of the other unnecessary
 
302
things like format decoding or `find-file-hook'.
 
303
 
 
304
If VISIT is non-nil, the buffer's visited filename
 
305
and last save file modtime are set, and it is marked unmodified.
 
306
If visiting and the file does not exist, visiting is completed
 
307
before the error is signaled."
 
308
  (let ((format-alist nil)
 
309
        (after-insert-file-functions nil)
 
310
        (find-buffer-file-type-function
 
311
         (if (fboundp 'find-buffer-file-type)
 
312
             (symbol-function 'find-buffer-file-type)
 
313
           nil))
 
314
        (inhibit-file-name-handlers
 
315
         (append '(jka-compr-handler image-file-handler)
 
316
                 inhibit-file-name-handlers))
 
317
        (inhibit-file-name-operation 'insert-file-contents))
 
318
    (unwind-protect
 
319
         (progn
 
320
           (fset 'find-buffer-file-type (lambda (filename) t))
 
321
           (insert-file-contents filename visit))
 
322
      (if find-buffer-file-type-function
 
323
          (fset 'find-buffer-file-type find-buffer-file-type-function)
 
324
        (fmakunbound 'find-buffer-file-type)))))
 
325
 
 
326
(defun muse-write-file (filename)
 
327
  "Write current buffer into file FILENAME.
 
328
Unlike `write-file', this does not visit the file, try to back it
 
329
up, or interact with vc.el in any way.
 
330
 
 
331
If the file was not written successfully, return nil.  Otherwise,
 
332
return non-nil."
 
333
  (let ((backup-inhibited t)
 
334
        (buffer-file-name filename)
 
335
        (buffer-file-truename (file-truename filename)))
 
336
    (save-current-buffer
 
337
      (save-restriction
 
338
        (widen)
 
339
        (if (not (file-writable-p buffer-file-name))
 
340
            (prog1 nil
 
341
              (muse-display-warning
 
342
               (format "Cannot write file %s:\n  %s" buffer-file-name
 
343
                       (let ((dir (file-name-directory buffer-file-name)))
 
344
                         (if (not (file-directory-p dir))
 
345
                             (if (file-exists-p dir)
 
346
                                 (format "%s is not a directory" dir)
 
347
                               (format "No directory named %s exists" dir))
 
348
                           (if (not (file-exists-p buffer-file-name))
 
349
                               (format "Directory %s write-protected" dir)
 
350
                             "File is write-protected"))))))
 
351
          (let ((coding-system-for-write
 
352
                 (or (and (boundp 'save-buffer-coding-system)
 
353
                          save-buffer-coding-system)
 
354
                     coding-system-for-write)))
 
355
            (write-region (point-min) (point-max) buffer-file-name))
 
356
          (when (boundp 'last-file-coding-system-used)
 
357
            (when (boundp 'buffer-file-coding-system-explicit)
 
358
              (setq buffer-file-coding-system-explicit
 
359
                    last-coding-system-used))
 
360
            (if save-buffer-coding-system
 
361
                (setq save-buffer-coding-system last-coding-system-used)
 
362
              (setq buffer-file-coding-system last-coding-system-used)))
 
363
          t)))))
 
364
 
287
365
(defun muse-collect-alist (list element &optional test)
288
366
  "Collect items from LIST whose car is equal to ELEMENT.
289
367
If TEST is specified, use it to compare ELEMENT."
310
388
The rating is stripped out in the returned list.
311
389
Default sorting is highest-first.
312
390
 
313
 
If TEST if specified, use it to sort the list."
 
391
If TEST if specified, use it to sort the list.  The default test is '>."
314
392
  (unless test (setq test '>))
315
393
  (mapcar (function cdr)
316
394
          (muse-sort-with-closure
446
524
If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
447
525
If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
448
526
  (cond
449
 
   ((fboundp 'replace-in-string)
 
527
   ((and (featurep 'xemacs) (fboundp 'replace-in-string))
450
528
    (replace-in-string text regexp replacement literal))
451
529
   ((fboundp 'replace-regexp-in-string)
452
530
    (replace-regexp-in-string regexp replacement text fixedcase literal))
497
575
         t)
498
576
        (t nil)))
499
577
 
 
578
(if (fboundp 'delete-and-extract-region)
 
579
    (defalias 'muse-delete-and-extract-region 'delete-and-extract-region)
 
580
  (defun muse-delete-and-extract-region (start end)
 
581
    "Delete the text between START and END and return it."
 
582
    (prog1 (buffer-substring start end)
 
583
      (delete-region start end))))
 
584
 
500
585
;; Set face globally in a predictable fashion
501
586
(defun muse-copy-face (old new)
502
587
  "Copy face OLD to NEW."
723
808
                  (or (and (match-beginning 1)
724
809
                           (or (get-text-property
725
810
                                (muse-list-item-critical-point 1) 'muse-link)
726
 
                               (get-text-property
727
 
                                (muse-list-item-critical-point 1) 'face)))
 
811
                               (and (derived-mode-p 'muse-mode)
 
812
                                    (get-text-property
 
813
                                     (muse-list-item-critical-point 1)
 
814
                                     'face))))
728
815
                      ;; skip nested items
729
816
                      (and (not no-skip-nested)
730
817
                           (muse-forward-list-item-1 type empty-line
761
848
          (match-found nil))
762
849
      (while (and (> nesting 0)
763
850
                  (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))))
 
851
        ;; for the sake of font-locking code, skip matches in comments
 
852
        (unless (get-text-property (match-beginning 0) 'muse-comment)
 
853
          (if (string-equal (match-string 2) "/")
 
854
              (setq nesting (1- nesting))
 
855
            (setq nesting (1+ nesting)))))
767
856
      match-found)))
768
857
 
769
858
;;; muse.el ends here