[elpa] master a05fca0 247/433: Initial revision, from Joe Kesley.

[Dmitry Gutov]

branch: master
commit a05fca09e8abf5e61652bc6a6dc2375cb31e4601
Author: viritrilbia <viritrilbia>
Commit: viritrilbia <viritrilbia>

    Initial revision, from Joe Kesley.
---
 mmm-noweb.el | 346 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 346 insertions(+)

diff --git a/mmm-noweb.el b/mmm-noweb.el
new file mode 100644
index 0000000..8af8a02
--- /dev/null
+++ b/mmm-noweb.el
@@ -0,0 +1,346 @@
+;;; mmm-noweb.el --- MMM submode class for Noweb programs
+;;
+;; Copyright 2003 Joe Kelsey <address@hidden>
+;;
+;; The filling, completion and chunk motion commands either taken
+;; directly from or inspired by code in:
+;; noweb-mode.el - edit noweb files with GNU Emacs
+;; Copyright 1995 by Thorsten.Ohl @ Physik.TH-Darmstadt.de
+;;     with a little help from Norman Ramsey <address@hidden>
+;; 
+
+;;{{{ GPL
+
+;; This file 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.
+
+;; This file 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 file contains the definition of an MMM Mode submode class for
+;; editing Noweb programs.
+
+;;; Code:
+
+(require 'mmm-region)
+(require 'mmm-vars)
+(require 'mmm-mode)
+
+;;{{{ Variables
+
+(defvar mmm-noweb-code-mode 'fundamental-mode
+  "*Major mode for editing code chunks.
+This is set to FUNDAMENTAL-MODE by default, but you might want to change
+this in the Local Variables section of your file to something more
+appropriate, like C-MODE, FORTRAN-MODE, or even INDENTED-TEXT-MODE.")
+
+(defvar mmm-noweb-quote-mode nil
+  "*Major mode for quoted code chunks within documentation chunks.
+If nil, defaults to `mmm-noweb-code-mode', which see.")
+
+(defvar mmm-noweb-quote-string "quote"
+  "*String used to form quoted code submode region names.
+See `mmm-noweb-quote'.")
+
+(defvar mmm-noweb-quote-number 0
+  "*Starting value appended to `mmm-noweb-quote-string'.
+See `mmm-noweb-quote'.")
+
+(defvar mmm-noweb-narrowing nil
+  "*Narrow the region to the current pair of chunks.")
+
+;;}}}
+;;{{{ Support for mmm submode stuff
+
+(defun mmm-noweb-chunk (form)
+  "Return the noweb code mode chosen by the user.
+If the next 100 characters of the buffer contain a string of the form
+\"-*- MODE -*-\", then return MODE as the chosen mode, otherwise
+return the value of `mmm-noweb-code-mode'."
+  ;; Look for -*- mode -*- in the first two lines.
+  ;; 120 chars = 40 chars for #! + 80 chars for following line...
+  (if (re-search-forward "-\\*-\\s +\\(\\w+\\)\\s +-\\*-" (+ (point) 120) t)
+      (let* ((string (match-string-no-properties 1))
+            (modestr (intern (if (string-match "mode\\'" string)
+                                 string
+                               (concat string "-mode")))))
+       (or (mmm-ensure-modename modestr)
+           (signal 'mmm-no-matching-submode nil)))
+    mmm-noweb-code-mode))
+
+(defun mmm-noweb-quote (form)
+  "Create a unique name for a quoted code region within a documentation chunk."
+  (or mmm-noweb-quote-mode
+      mmm-noweb-code-mode))
+
+(defun mmm-noweb-quote-name (form)
+  "Create a unique name for a quoted code region within a documentation chunk."
+  (setq mmm-noweb-quote-number (1+ mmm-noweb-quote-number))
+  (concat mmm-noweb-quote-string "-"
+         (number-to-string mmm-noweb-quote-number)))
+
+(defun mmm-noweb-chunk-name (form)
+  "Get the chunk name from FRONT-FORM."
+  (string-match "<<\\(.*\\)>>=" form)
+  (match-string-no-properties 1 form))
+
+;;}}}
+;;{{{ mmm noweb submode group
+
+;; We assume that the global document mode is latex or whatever, the
+;; user wants.  This class controls the code chunk submodes.  We use
+;; match-submode to either return the value in mmm-noweb-code-mode or to
+;; look at the first line of the chunk for a submode setting.  We reset
+;; case-fold-search because chunk names are case sensitive.  The front
+;; string identifies the chunk name between the <<>>.  Since this is
+;; done, name-match can use the same functions as save-matches for back.
+;; Our insert skeleton places a new code chunk and the skel-name lets us
+;; optimize the skelton naming to use the inserted string.
+
+(mmm-add-group
+ 'noweb
+ '((noweb-chunk
+    :match-submode mmm-noweb-chunk
+    :case-fold-search nil
+    :front "^<<\\(.*\\)>>="
+    :name-match "~1"
+    :save-name 1
+    :front-offset (end-of-line 1)
+    :back "address@hidden( \\|$\\|\\( %def .*$\\)\\)"
+    :insert ((?c noweb-code "Code Chunk Name: "
+               "\n" @ "<<" str ">>=" @ "\n" _ "\n" @ "@ " @ "\n"))
+    :skel-name t
+    )
+   (noweb-quote
+    :match-submode mmm-noweb-quote
+    :face mmm-special-submode-face
+    :front "\\[\\["
+    :name-match mmm-noweb-quote-name
+    :back "\\]\\]"
+    :insert ((?q noweb-quote nil @ "[[" @ _ @ "]]" @))
+    )
+   ))
+
+;;}}}
+;;{{{ Noweb regions
+
+(defun mmm-noweb-regions (start stop regexp &optional delim)
+  "Return a liat of regions of the form \(NAME BEG END) that exclude
+names which match REGEXP."
+  (let* ((remove-next nil)
+        (regions
+         (maplist #'(lambda (pos-list)
+                      (if (cdr pos-list)
+                          (if remove-next
+                              (setq remove-next nil)
+                            (let ((name (or (mmm-name-at (car pos-list) 'beg)
+                                            (symbol-name mmm-primary-mode))))
+                              (if (and regexp (string-match regexp name) )
+                                  (progn
+                                    (setq remove-next t)
+                                    nil)
+                                (list name
+                                      (car pos-list) (cadr pos-list)))))))
+                  (mmm-submode-changes-in start stop t delim))))
+    ;; The above loop leaves lots of nils in the list...
+    ;; Removing them saves us from having to do the (last x 2)
+    ;; trick that mmm-regions-in does.
+    (setq regions (delq nil regions))))
+
+;;}}}
+;;{{{ Filling, etc
+
+(defun mmm-noweb-narrow-to-doc-chunk ()
+  "Narrow to the current doc chunk.
+The current chunk includes all quoted code chunks (i.e., \[\[...\]\]).
+This function is only valid when called with point in a doc chunk or
+quoted code chunk."
+  (interactive)
+  (let ((name (mmm-name-at (point))))
+    (if (or (null name) (string-match "^quote" name))
+       (let ((prev (cond
+                    ((= (point) (point-min)) (point))
+                    (t (cadar (last (mmm-noweb-regions (point-min) (point)
+                                                       "^quote"))))))
+             (next (cond
+                    ((= (point) (point-max)) (point))
+                    (t (save-excursion
+                         (goto-char (cadr
+                                     (cadr (mmm-noweb-regions (point)
+                                                              (point-max)
+                                                              "^quote"))))
+                         (forward-line -1)
+                         (point))))))
+         (narrow-to-region prev next)))))
+
+(defun mmm-noweb-fill-chunk (&optional justify)
+  "Fill the current chunk according to mode.
+Run `fill-region' on documentation chunks and `indent-region' on code
+chunks."
+  (interactive "P")
+  (save-restriction
+    (let ((name (mmm-name-at (point))))
+      (if (and name (not (string-match "^quote" name)))
+         (if (or indent-region-function indent-line-function)
+             (progn
+               (mmm-space-other-regions)
+               (indent-region (overlay-start mmm-current-overlay)
+                              (overlay-end mmm-current-overlay) nil))
+           (error "No indentation functions defined in %s!" major-mode))
+       (progn
+         (mmm-word-other-regions)
+         (fill-paragraph justify)))
+      (mmm-undo-syntax-other-regions))))
+
+(defun mmm-noweb-fill-paragraph-chunk (&optional justify)
+  "Fill a paragraph in the current chunk."
+  (interactive "P")
+  (save-restriction
+    (let ((name (mmm-name-at (point))))
+      (if (and name (not (string-match "^quote" name)))
+         (progn
+           (mmm-space-other-regions)
+           (fill-paragraph justify))
+       (progn
+         (mmm-word-other-regions)
+         (fill-paragraph justify)))
+      (mmm-undo-syntax-other-regions))))
+
+(defun mmm-noweb-fill-named-chunk (&optional justify)
+  "Fill the region containing the named chunk."
+  (interactive "P")
+  (save-restriction
+    (let* ((name (or (mmm-name-at) (symbol-name mmm-primary-mode)))
+          (list (cdr (assoc name (mmm-names-alist (point-min) (point-max))))))
+      (if (or (string= name (symbol-name mmm-primary-mode))
+             (string-match "^quote" name))
+         (progn
+           (mmm-word-other-regions)
+           (do-auto-fill))
+       (progn
+         (mmm-space-other-regions)
+         (indent-region (caar list) (cadar (last list)) nil)))
+      (mmm-undo-syntax-other-regions))))
+
+(defun mmm-noweb-auto-fill-doc-chunk ()
+  "Replacement for `do-auto-fill'."
+  (save-restriction
+    (mmm-noweb-narrow-to-doc-chunk)
+    (mmm-word-other-regions)
+    (do-auto-fill)
+    (mmm-undo-syntax-other-regions)))
+
+(defun mmm-noweb-auto-fill-doc-mode ()
+  "Install the improved auto fill function, iff necessary."
+  (if auto-fill-function
+      (setq auto-fill-function 'mmm-noweb-auto-fill-doc-chunk)))
+
+(defun mmm-noweb-auto-fill-code-mode ()
+  "Install the default auto fill function, iff necessary."
+  (if auto-fill-function
+      (setq auto-fill-function 'do-auto-fill)))
+
+;;}}}
+;;{{{ Functions on named chunks
+
+(defun mmm-noweb-complete-chunk ()
+  "Try to complete the chunk name."
+  (interactive)
+  (let ((end (point))
+       (beg (save-excursion
+              (if (re-search-backward "<<"
+                                      (save-excursion
+                                        (beginning-of-line)
+                                        (point))
+                                      t)
+                  (match-end 0)
+                nil))))
+       (if beg
+           (let* ((pattern (buffer-substring beg end))
+                  (alist (mmm-names-alist (point-min) (point-max)))
+                  (completion (try-completion pattern alist)))
+             (cond ((eq completion t))
+                   ((null completion)
+                    (message "Can't find completion for \"%s\"" pattern)
+                    (ding))
+                   ((not (string= pattern completion))
+                    (delete-region beg end)
+                    (insert completion)
+                    (if (not (looking-at ">>"))
+                        (insert ">>")))
+                   (t
+                    (message "Making completion list...")
+                    (with-output-to-temp-buffer "*Completions*"
+                      (display-completion-list
+                       (all-completions pattern alist)))
+                    (message "Making completion list...%s" "done"))))
+         (message "Not at chunk name..."))))
+
+(defvar mmm-noweb-chunk-history nil
+  "History for `mmm-noweb-goto-chunk'.")
+
+(defun mmm-noweb-goto-chunk ()
+  "Goto the named chunk."
+  (interactive)
+  (widen)
+  (let* ((completion-ignore-case t)
+        (alist (mmm-names-alist (point-min) (point-max)))
+        (chunk (completing-read
+                "Chunk: " alist nil t
+                (mmm-name-at (point))
+                mmm-noweb-chunk-history)))
+    (goto-char (caadr (assoc chunk alist)))))
+
+(defun mmm-noweb-goto-next (&optional cnt)
+  "Goto the continuation of the current chunk."
+  (interactive "p")
+  (widen)
+  (let ((name (mmm-name-at (point))))
+    (if name
+       (let ((list (cdr (assoc name (mmm-names-alist
+                                     (overlay-end mmm-current-overlay)
+                                     (point-max))))))
+         (if list
+             (goto-char (caar (nthcdr (1- cnt) list))))))))
+
+(defun mmm-noweb-goto-previous (&optional cnt)
+  "Goto the continuation of the current chunk."
+  (interactive "p")
+  (widen)
+  (let ((name (mmm-name-at (point))))
+    (if name
+       (let ((list (reverse
+                    (cdr (assoc name
+                                (mmm-names-alist (point-min)
+                                                 (overlay-start
+                                                  mmm-current-overlay)))))))
+         (if list
+             (goto-char (cadar (nthcdr cnt list))))))))
+
+(mmm-define-key ?d 'mmm-noweb-narrow-to-doc-chunk)
+(mmm-define-key ?n 'mmm-noweb-goto-next)
+(mmm-define-key ?p 'mmm-noweb-goto-previous)
+(mmm-define-key ?q 'mmm-noweb-fill-chunk)
+;; Cannot use C-g as goto command, so use C-s.
+(mmm-define-key ?s 'mmm-noweb-goto-chunk)
+
+(define-key mmm-mode-prefix-map "\t" 'mmm-noweb-complete-chunk)
+
+;;}}}
+
+(provide 'mmm-noweb)
+
+;;; mmm-noweb.el ends here
\ No newline at end of file