narrow-to-here-document

[Masatake YAMATO]

I've written a new function, narrot-to-here-document.  This might be
useful to edit here document region in a script file.

How to you think to add this feature to emacs?

The implementation has two parts.

1. hdoc.el --- Generic here document support
2. sh-script.el and cperl-mode.el adapters

hdoc.el requires two function implementations, here-document-region
and here-document-marker for each major modes in which
narrot-to-here-document is enabled.

I've written the functions for sh-script.el and cperl-mode.el.

;;; hdoc.el --- Generic here document support

;; Copyright (C) 2003 ???
;;  

;; Author: Masatake YAMATO<address@hidden> 

;;; Code:

(defvar here-document-region nil
  "If non-nil, function for `narrow-to-here-document' to call.
This is used to find the beginning and end of the here document region in a
script file (see `narrow-to-here-document'). Major modes can define this
to handle the mode's needs.

The function should return a cons cell; its car is the position of 
beginning and cdr is that of end if the point is in a here document region. 
The function should return `nil' if the point is out of a here document region. 
")

(defvar here-document-marker nil
  "If non-nil, function for `narrow-to-here-document' and 
`make-indirect-buffer-for-here-document' to call.
This is used to find the marker of the here document region in a
script file (see `make-indirect-buffer-for-here-document' and 
`narrow-to-here-document').  A string \"EOF\" is used widely as the marker 
but other string is also OK. Major modes can define this to handle the 
mode's needs.

The function should return a marker string if the point is in a here document 
region. Else it should return `nil'. ")

(define-key ctl-x-map "nh" 'narrow-to-here-document)
(define-key ctl-x-4-map "h" 'make-indirect-buffer-for-here-document)

(defun narrow-to-here-document (&optional change-major-mode)
  "Make text outside current here document region invisible.
Local variable `here-document-region' must be defined in the major 
mode to use this function.

If CHANGE-MAJOR-MODE is non-nil and local variable `here-document-marker' 
is defined in the major mode, major mode for the current buffer will be
switched; new major mode is selected according to the result of 
`here-document-marker'. For example if `here-document-marker' returns
\"EOF.c\", `c-mode' will be selected. Major mode selection is done
by `set-auto-mode'. In `set-auto-mode', `here-document-marker' is used
as the buffer's file name temporally.

To make text outside of the region visible, use \[widen]."
  (interactive "P")
  (unless here-document-region
    (error "%s: `%s' is not supported in this major mode." 
           mode-name
           this-command))
  (let* ((marker (if here-document-marker (funcall here-document-marker)))
         (r      (funcall here-document-region))
         (b      (car r))
         (e      (cdr r)))
    (unless r
      (error "Cannot find here document region"))
    (narrow-to-region b e)
    (if (and change-major-mode marker)
        (let ((buffer-file-name marker))
          (set-auto-mode)))))

(defun make-indirect-buffer-for-here-document (&optional change-major-mode)
  "Create and return an indirect buffer for current here document
region.  In the new indirect buffer, the text outside current here
document region is invisible(narrowed). Local variables `here-document-region' 
and `here-document-marker' must be defined in the major mode to use this 
function.

CHANGE-MAJOR-MODE is passed to `narrow-to-here-document'.
See also `narrow-to-here-document'.

The new indirect buffer name will be 
\"original-buffername<<here-document-marker\"."
  (interactive "P")
  (unless here-document-marker
    (error "%s: `%s' is not supported in this major mode." 
           mode-name
           this-command))
  (let  ((marker  (funcall here-document-marker))
         (p       (point))
         buf 
         bufname)
    (unless marker
      (error "Cannot find here document marker"))
    (setq bufname (format "%s<<%s" (buffer-name) marker))
    (setq buf (make-indirect-buffer (current-buffer) bufname t))
    (pop-to-buffer buf)
    (goto-char p)
    (narrow-to-here-document change-major-mode)))

(provide 'hdoc)
;; hdoc.el ends here

Index: lisp/progmodes/sh-script.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/sh-script.el,v
retrieving revision 1.124
diff -u -r1.124 sh-script.el
--- lisp/progmodes/sh-script.el 16 Jun 2003 21:41:18 -0000      1.124
+++ lisp/progmodes/sh-script.el 20 Jun 2003 13:48:45 -0000
@@ -1332,6 +1332,8 @@
        skeleton-newline-indent-rigidly t
        sh-indent-supported-here nil)
   (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  (set (make-local-variable 'here-document-region) 'sh-here-document-region)
+  (set (make-local-variable 'here-document-marker) 'sh-here-document-marker)
   ;; Parse or insert magic number for exec, and set all variables depending
   ;; on the shell thus determined.
   (let ((interpreter
@@ -3532,6 +3534,27 @@
   (interactive)
   (if (re-search-forward sh-end-of-command nil t)
       (goto-char (match-end 1))))
+
+(defun sh-here-document-region ()
+  "Return here document region around the point.
+Return nil if the point is not in a here document region."
+  (let ((pos (point)))
+    (if (eq 'sh-heredoc-face  (get-text-property pos 'face))
+       (let ((b (previous-single-property-change pos 'face))
+             (e (next-single-property-change pos 'face)))
+         (setq b (if b (1+ b) (point-min)))
+         (setq e (if e (1- e) (point-max)))
+         (cons b e)))))
+
+(defun sh-here-document-marker ()
+  "Return the marker of here document region around the point.
+Return nil if the point is not in a here document region. 
+'EOF' is a typical marker. "
+  (if (eq 'sh-heredoc-face  (get-text-property (point) 'face))
+      (save-excursion
+       (save-match-data
+         (if (re-search-backward sh-here-doc-re (point-min) t) 
+             (match-string 1)))))))
 
 (provide 'sh-script)
 
Index: lisp/progmodes/cperl-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/cperl-mode.el,v
retrieving revision 1.46
diff -u -r1.46 cperl-mode.el
--- lisp/progmodes/cperl-mode.el        6 May 2003 17:43:22 -0000       1.46
+++ lisp/progmodes/cperl-mode.el        20 Jun 2003 13:48:48 -0000
@@ -1540,6 +1540,10 @@
            (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning
            (and auto-fill-function (memq major-mode '(perl-mode cperl-mode))
                 (setq auto-fill-function 'cperl-do-auto-fill))))))
+  (make-local-variable 'here-document-region)
+  (setq here-document-region 'cperl-here-doc-region)
+  (make-local-variable 'here-document-marker)
+  (setq here-document-marker 'cperl-here-doc-delim)
   (if (cperl-enable-font-lock)
       (if (cperl-val 'cperl-font-lock)
          (progn (or cperl-faces-init (cperl-init-faces))
@@ -7268,6 +7272,30 @@
     (string-match ":\\s *\\([0-9.]+\\)" v)
     (substring v (match-beginning 1) (match-end 1)))
   "Version of IZ-supported CPerl package this file is based on.")
+
+(defun cperl-here-doc-region ()
+  "Return here document region around the point.
+Return nil if the point is not in a here document region."
+  (let ((pos (point)))
+    (if (eq 'here-doc  (get-text-property pos 'syntax-type))
+       (let ((b (previous-single-property-change pos 'syntax-type))
+             (e (next-single-property-change pos 'syntax-type)))
+         (setq b (if b b (point-min)))
+         (setq e (if e (1- e) (point-max)))
+         (cons b e)))))
+
+(defun cperl-here-doc-delim ()
+  "Return the delimiter of here document region around the point.
+Return nil if the point is not in a here document region. 
+'EOF' is a typical delimiter. "
+  (when (eq 'here-doc  (get-text-property (point) 'syntax-type))
+    (let* ((b (next-single-property-change (point) 'syntax-type))
+          (e (if b (next-single-property-change b 'syntax-type))))      
+      (when b
+       (if e
+           (buffer-substring b e)
+         (buffer-substring b (point-max)))))))
+         
 
 (provide 'cperl-mode)