Re: narrow-to-here-document

[Masatake YAMATO]

I've reflected suggestions to my code.

Richard Stallman: 
1. The first line of a doc string is supposed to be complete in itself.
2. "here-document" is too long. 

Kevin Rodgers:
3. 
    Would INCLUDE/IGNORE/CDATA marked sections in SGML/XML/HTML qualify?

    <![CDATA[
    No <tag>s or &entity; references are recognized here.
    ]]>

About narrow-to-string, I do nothing yet.
I wonder what should I do.

Regards,
Masatake
p.s. Next time, I'll use diff&patch. 

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

;; Copyright (C) 2003
;;  

;; Author: Masatake YAMATO<address@hidden> 

;;; Commentary:

;;; Code:

(defvar hdoc-region 'here-document-region-default
  "If non-nil, function for `narrow-to-hdoc' to call.
This is used to find the beginning and end of the here document region in a
script file (see `narrow-to-hdoc'). 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 hdoc-marker 'here-document-marker-default
  "If non-nil, function for `narrow-to-hdoc' and 
`make-indirect-buffer-for-hdoc' to call.
This is used to find the marker of the here document region in a
script file (see `make-indirect-buffer-for-hdoc' and 
`narrow-to-hdoc').  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-hdoc)
(define-key ctl-x-4-map "h" 'make-indirect-buffer-for-hdoc)

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

If CHANGE-MAJOR-MODE is non-nil and local variable `hdoc-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 
`hdoc-marker'. For example if `hdoc-marker' returns
\"EOF.c\", `c-mode' will be selected. Major mode selection is done
by `set-auto-mode'. In `set-auto-mode', `hdoc-marker' is used
as the buffer's file name temporally.

To make text outside of the region visible, use \[widen]."
  (interactive "P")
  (let* ((marker (funcall hdoc-marker))
         (r      (funcall hdoc-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-hdoc (&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 `hdoc-region' 
and `hdoc-marker' must be defined in the major mode to use this function.

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

The new indirect buffer name will be \"original-buffername<<hdoc-marker\"."
  (interactive "P")
  (let  ((marker  (funcall hdoc-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-hdoc change-major-mode)))

(defun here-document-region-default ()
  (cond 
   ((eq major-mode 'sh-mode)
    (sh-here-document-region))
   ((eq major-mode 'cperl-mode)
    (cperl-here-doc-region))
   ((or (eq major-mode 'html-mode)
        (eq major-mode 'sgml-mode))
    (sgml-here-document-region))
   (t
    (error "%s: `%s' is not supported in this major mode." 
           mode-name
           this-command))))

(defun here-document-marker-default ()
  (cond 
   ((eq major-mode 'sh-mode)
    (sh-here-document-marker))
   ((eq major-mode 'cperl-mode)
    (cperl-here-doc-delim))
   ((or (eq major-mode 'html-mode)
        (eq major-mode 'sgml-mode))
    (sgml-here-document-marker))
   (t
    (error "%s: `%s' is not supported in this major mode." 
           mode-name
           this-command))))

;;
;; sh-mode
;;
(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))))))
;;
;; cperl-mode
;;
(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)))))))

;;
;; sgml-mode
;;
(defvar sgml-here-document-beginning-regexp "<!\\[\\([A-Z]+\\)\\[")
(defvar sgml-here-document-end-regexp "]]>")
(defun sgml-here-document-region ()
  (let (beginning end)
    (save-excursion
      (save-match-data
        (when (re-search-backward
               sgml-here-document-beginning-regexp
               (point-min) t)
          (setq beginning (match-end 0))
          (when (re-search-forward 
                 sgml-here-document-end-regexp
                 (point-max) t)
            (setq end (match-beginning 0))))))    
    (if (and beginning end (<= (point) end))
        (cons beginning end))))

(defun sgml-here-document-marker ()
  (if (sgml-here-document-region)
      (save-excursion
        (save-match-data
          (when (re-search-backward
                 sgml-here-document-beginning-regexp
                 (point-min) t)
            (match-string 1))))))

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