text/softtext.el

   1 ;;; softtext.el --- Load/Save translator for soft text files
   2 ;;
   3 ;; $Id$
   4 ;;
   5 ;; Copyright (C) 1999 Stefan Bund
   6
   7 ;; softtext.el is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 2, or (at your
  10 ;; option) any later version.
  11
  12 ;; softtext.el is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;;; Commentary:
  18
  19 ;; Externally soft newlines are represented as ordinary newlines with
  20 ;; a preceding space. For this to work reliably, spaces before
  21 ;; newlines are removed prior to writing a buffer out to it's external
  22 ;; representation and re-inserted as annotations in the buffer
  23 ;; encoding function.
  24
  25 ;;; Change-Log:
  26
  27 ;; $Log$
  28 ;;
  29
  30 ;;; Variables:
  31
  32 ;;; Code:
  33
  34 (defun softtext-convert-external-to-internal (start end)
  35   (let ((mod (buffer-modified-p)))
  36     (save-excursion
  37       (goto-char start)
  38       (if (save-excursion (search-forward "\r\n" nil t))
  39           ;;; Old version compatibility
  40           (while (search-forward "\r\n" end t)
  41             (replace-match "\n")
  42             (set-hard-newline-properties (1- (point)) (point)))
  43         (while (search-forward "\n" end t)
  44           (if (and (> (match-beginning 0) start)
  45                    (eq (string-to-char (buffer-substring-no-properties (1- (match-beginning 0))
  46                                                                            (match-beginning 0)))
  47                        ? ))
  48               (save-excursion
  49                 (goto-char (1- (match-beginning 0)))
  50                 (delete-char 1))
  51             (set-hard-newline-properties (match-beginning 0)
  52                                          (match-end 0))))))
  53     (set-buffer-modified-p mod)))
  54
  55 (defun softtext-convert-internal-to-external (start end &optional buffer)
  56   (let ((mod (buffer-modified-p))
  57         annotations)
  58     (save-excursion
  59       (if buffer (set-buffer buffer))
  60       (save-excursion
  61         (goto-char start)
  62         (while (search-forward "\n" end t)
  63           (if (not (get-text-property (1- (point)) 'hard))
  64               (if buffer
  65                   (setq annotations (cons (cons (- (point) start) " ")
  66                                           annotations))
  67                 (forward-char -1)
  68                 (insert " ")
  69                 (forward-char 1))))))
  70     (if (not buffer) (set-buffer-modified-p mod))
  71     (nreverse annotations)))
  72
  73 (defun softtext-cleanup-buffer ()
  74   (save-excursion
  75     (goto-char (point-min))
  76     (while (re-search-forward " *\n" nil t)
  77       (let ((blanks (- (match-end 0) (match-beginning 0) 1)))
  78         (if (> blanks 0)
  79             (progn
  80               (goto-char (match-beginning 0))
  81               (delete-char blanks)
  82               (forward-char 1)))))))
  83
  84 (defun softtext-hard-newlines-region (start end)
  85   (interactive "r")
  86   (save-excursion
  87     (goto-char start)
  88     (while (search-forward "\n" end t)
  89       (set-hard-newline-properties (1- (point)) (point)))))
  90
  91 (let ((x (assq 'softtext format-alist)))
  92   (if x (setq format-alist (delq x format-alist))))
  93
  94 (let ((elt (assq 'softtext format-alist)))
  95   (if elt (setq format-alist (delq elt format-alist)))
  96   (setq format-alist
  97         (cons '(softtext "Text with hard/soft newlines" nil
  98                          softtext-convert-external-to-internal
  99                          softtext-convert-internal-to-external
 100                          nil nil)
 101               format-alist)))
 102
 103 (define-minor-mode softwrap-mode
 104   "Toggle SoftWrap minor mode.
 105 With no argument, this command toggles SoftWrap mode. A Non-null
 106 prefix argument enables the mode, a null prefix argument disables it.
 107
 108 In SoftWrap mode, emacs differentiates between hard and soft
 109 newlines. On writing out the buffer to its file, soft newlines a
 110 reconverted to ordinary newlines preceded by a single space. Any other
 111 whitspace preceding a newline is removed."
 112   nil
 113   " SoftWrap"
 114   nil
 115   (if softwrap-mode
 116       (when (not (memq 'softtext buffer-file-format))
 117         (softtext-convert-external-to-internal (point-min) (point-max))
 118         (setq buffer-file-format (append buffer-file-format (list 'softtext)))
 119         (setq use-hard-newlines t)
 120         (add-hook 'write-contents-hooks 'softtext-cleanup-buffer))
 121     (when (memq 'softtext buffer-file-format)
 122       (remove-hook 'write-contents-hooks 'softtext-cleanup-buffer)
 123       (setq use-hard-newlines nil)
 124       (setq buffer-file-format (delq 'softtext buffer-file-format))
 125       (softtext-convert-internal-to-external (point-min) (point-max)))))
 126
 127 (define-derived-mode softtext-mode indented-text-mode "Text"
 128   "SoftText Mode is indented-text-mode with SoftWrap minor mode enabled"
 129   (softwrap-mode 1))
 130
 131 (provide 'softtext)