emacs/nxhtml/nxhtml/nxhtml-strval.el

   1 ;;; nxhtml-strval.el ---
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: Wed Jun 06 12:42:09 2007
   5 (defconst nxhtml-strval:version "0.3") ;;Version:
   6 ;; LXast-Updated: Sun Jun 10 14:52:50 2007 (7200 +0200)
   7 ;; URL:
   8 ;; Keywords:
   9 ;; Compatibility:
  10 ;;
  11 ;; FXeatures that might be required by this library:
  12 ;;
  13 ;;   None
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;; This is a workaround for a problem caused by that the parser from
  20 ;; `nxml-mode' parses the whole buffer. This workaround handles things
  21 ;; like
  22 ;;
  23 ;;   <a href="<?php title(); ?>">...</a>
  24 ;;
  25 ;; where the string value is not valid XHTML (because of the <).  When
  26 ;; the minor mode `nxhtml-strval-mode' is on this construct will be
  27 ;; replaced by text that are valid XHTML. When writing to file or
  28 ;; copying/yanking this will be replaced with the intended text.
  29 ;;
  30 ;; For a long term solution the parser should be broken up, see also
  31 ;;
  32 ;;   http://sourceforge.net/mailarchive/forum.php?thread_name=4638A428.9010408%40pareto.nl&forum_name=cedet-devel
  33 ;;
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 ;;
  36 ;;; Change log:
  37 ;;
  38 ;;
  39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40 ;;
  41 ;; This program is free software; you can redistribute it and/or
  42 ;; modify it under the terms of the GNU General Public License as
  43 ;; published by the Free Software Foundation; either version 2, or
  44 ;; (at your option) any later version.
  45 ;;
  46 ;; This program is distributed in the hope that it will be useful,
  47 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  48 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  49 ;; General Public License for more details.
  50 ;;
  51 ;; You should have received a copy of the GNU General Public License
  52 ;; along with this program; see the file COPYING.  If not, write to
  53 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  54 ;; Floor, Boston, MA 02110-1301, USA.
  55 ;;
  56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57 ;;
  58 ;;; Code:
  59
  60 (define-minor-mode nxhtml-strval-mode
  61   "Handle some useful, but not XHTML compliant attribute values.
  62 This is mainly for PHP and similar.
  63
  64 Things like
  65
  66    <a href=\"<?php title(); ?>\">...</a>
  67
  68 may be very useful in PHP.  However the string value is not valid
  69 XHTML (because of the <).  This makes it difficult to use XHTML
  70 completion and validation.
  71
  72 This minor mode tries to take care of that by substituting the
  73 <?php and ?> in the buffer while editing with something else.
  74 The screen still shows <?php and ?> and when writing the buffer
  75 to a file the substitutes are reverted to <?php and ?>.
  76
  77 Note that this is a workaround. See the comments in the source
  78 file. There are several \(I hope minor) problems with it. For
  79 example is the buffer marked as modified when turning on/off this
  80 minor mode.
  81
  82 IMPORTANT: Do not edit the replaced string <? or ?>."
  83   :lighter nil
  84   :gropu 'nxhtml
  85   (if nxhtml-strval-mode
  86       (nxhtml-strval-mode-turn-on)
  87     (nxhtml-strval-mode-turn-off)))
  88 (put 'nxhtml-strval-mode 'permanent-local t)
  89
  90 (defcustom nxhtml-strval-replface 'nxhtml-strval-replface
  91   "Face used to mark replaced characters in strings."
  92   :type 'face
  93   :group 'nxhtml)
  94
  95 (defface nxhtml-strval-replface '((t :inherit font-lock-warning-face))
  96   "Default face used to mark replaced characters in strings."
  97   :group 'nxhtml)
  98
  99 (defun nxthml-strval-add-ovl (start end)
 100   (let ((ovl (make-overlay start end nil t nil)))
 101     (overlay-put ovl 'nxhtml-strval t)
 102     (overlay-put ovl 'face font-lock-warning-face)))
 103     ;;(overlay-put ovl 'face 'highlight)))
 104
 105 (defun nxhtml-strval-remove-all-ovls ()
 106   (remove-overlays (point-min) (point-max) 'nxhtml-strval t))
 107
 108 (defun nxhtml-strval-replace-match ()
 109   (let ((s (compose-string "{" nil nil ?<)))
 110     (replace-match s t t nil 1))
 111   (put-text-property (1- (point)) (point) 'font-lock-face 'font-lock-warning-face)
 112   (put-text-property (1- (point)) (point) 'nxhtml-strval-> t)
 113   (nxthml-strval-add-ovl (1- (point)) (point))
 114   (let ((s (compose-string "}" nil nil ?>)))
 115     (replace-match s t t nil 2))
 116   (nxthml-strval-add-ovl (1- (point)) (point))
 117   (put-text-property (1- (point)) (point) 'font-lock-face 'font-lock-warning-face)
 118   (put-text-property (1- (point)) (point) 'nxhtml-strval-> nil))
 119
 120 (defun nxhtml-strval-revert-match ()
 121   (replace-match "<" t t nil 1)
 122   (put-text-property (1- (point)) (point) 'font-lock-face nil)
 123   (put-text-property (1- (point)) (point) 'nxhtml-strval-> nil)
 124   (replace-match ">" t t nil 2)
 125   (put-text-property (1- (point)) (point) 'font-lock-face nil)
 126   (put-text-property (1- (point)) (point) 'nxhtml-strval-> nil))
 127
 128 (defconst nxhtml-strval-on-re  "\"\\(<\\)[^>]*\\(>\\)\"")
 129 (defconst nxhtml-strval-off-re "\"\\({\\)[^>]*\\(}\\)\"")
 130
 131 (defun nxhtml-strval-mode-turn-on ()
 132   (unless (derived-mode-p 'nxml-mode 'php-mode)
 133     (error "%s is not derived from nxml-mode" major-mode))
 134   (add-hook 'write-contents-functions 'nxhtml-strval-write-contents nil t)
 135   (make-local-variable 'buffer-substring-filters)
 136   (add-to-list 'buffer-substring-filters 'nxhtml-strval-buffer-substring-filter)
 137   (nxhtml-strval-replace-values)
 138   (add-hook 'after-change-functions 'nxhtml-strval-after-change nil t))
 139
 140 (defun nxhtml-strval-replace-values ()
 141   (save-excursion
 142     (save-match-data
 143       (save-restriction
 144         (widen)
 145         (goto-char (point-min))
 146         (while (re-search-forward nxhtml-strval-on-re nil t)
 147           (nxhtml-strval-replace-match))))))
 148
 149 (defun nxhtml-strval-mode-turn-off ()
 150   (remove-hook 'after-change-functions 'nxhtml-strval-after-change t)
 151   (nxhtml-strval-revert-values)
 152   (remove-hook 'write-contents-functions 'nxhtml-strval-write-contents t)
 153   (kill-local-variable 'buffer-substring-filters))
 154
 155 (defun nxhtml-strval-revert-values ()
 156   (save-excursion
 157     (save-match-data
 158       (save-restriction
 159         (widen)
 160         (goto-char (point-min))
 161         (while (re-search-forward nxhtml-strval-off-re nil t)
 162           (nxhtml-strval-revert-match))
 163         (nxhtml-strval-remove-all-ovls)))))
 164
 165 (defun nxhtml-strval-write-contents ()
 166   (let ((nxhtml-strval-no-after-change t))
 167     ;;(setq write-contents-functions (delq 'nxhtml-strval-write-contents write-contents-functions))
 168     (remove-hook 'write-contents-functions 'nxhtml-strval-write-contents t)
 169     (undo-boundary)
 170     (nxhtml-strval-revert-values)
 171     ;;(write-file (buffer-file-name))
 172     (save-buffer)
 173     ;; Fix-me: undo
 174     ;;(nxhtml-strval-replace-values)
 175     (undo-start)
 176     (undo-more 1)
 177     (add-hook 'write-contents-functions 'nxhtml-strval-write-contents nil t)
 178     (set-buffer-modified-p nil)
 179     t))
 180
 181 ;;; Clip board etc.
 182 (defun nxhtml-strval-buffer-substring-filter (orig-str)
 183   (let ((str (replace-regexp-in-string "\"{" "\"<" orig-str)))
 184     (setq str (replace-regexp-in-string "}\"" ">\"" str))
 185     str
 186     ))
 187
 188 ;;; Changes
 189 ; after-change-functions
 190 (defun nxhtml-strval-after-change (beg end len)
 191   (unless (and (boundp 'nxhtml-strval-no-after-change)
 192                nxhtml-strval-no-after-change)
 193     (let ((here (point))
 194           (new-beg beg)
 195           (new-end end))
 196       (goto-char beg)
 197       (setq new-beg (line-beginning-position))
 198       (goto-char end)
 199       (setq new-end (line-end-position))
 200       ;; Fix-me: examine old replacements here
 201       (remove-text-properties new-beg new-end '(nxhtml-strval-< nxhtml-strval->))
 202       (goto-char new-beg)
 203       (while (re-search-forward nxhtml-strval-on-re new-end t)
 204         (nxhtml-strval-replace-match))
 205       (goto-char here)
 206       )))
 207
 208 (provide 'nxhtml-strval)
 209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 210 ;;; nxhtml-strval.el ends here