;;; -*- Mode: Lisp; Package: USER -*-
;;;
;;; This file is not part of xyzzy.
;;;
;;;   freecursor.l - フリーカーソルもどきマイナーモード
;;;

(provide "freecursor")

;;; カーソル移動の可能な最大桁（0 なら制限無し）
(defvar *free-cursor-max-column* 82)

;;; バッファに末尾で改行を入れる
(defvar *free-cursor-next-line-add-newlines* nil)

;;; free-cursor-mode 終了時に行末の半角スペースを削除
(defvar *free-cursor-delete-eol-spaces* nil)

(defvar-local *free-cursor-mode* nil)
(defvar *free-cursor-mode-map* nil)

(unless *free-cursor-mode-map*
  (setq *free-cursor-mode-map* (make-sparse-keymap))
  (define-key *free-cursor-mode-map* #\Right 'free-cursor-right)
  (define-key *free-cursor-mode-map* #\Up 'free-cursor-up)
  (define-key *free-cursor-mode-map* #\Down 'free-cursor-down))

(defun free-cursor-mode (&optional (arg nil sv))
  (interactive "*p")
  (ed::toggle-mode '*free-cursor-mode* arg sv)
  (update-mode-line t)
  (if *free-cursor-mode*
      (progn
	(set-minor-mode-map *free-cursor-mode-map*)
	(overwrite-mode t))
    (progn
      (unset-minor-mode-map *free-cursor-mode-map*)
      (when *free-cursor-delete-eol-spaces*
	(free-cursor-delete-eol-spaces))
      (overwrite-mode nil)))
  t)

(pushnew '(*free-cursor-mode* . "FreeCursor") *minor-mode-alist* :key #'car)

(defun free-cursor-right ()
  (interactive "*")
  (if (eolp)
      (if (plusp *free-cursor-max-column*)
	  (when (< (current-column) *free-cursor-max-column*)
	    (insert " "))
	(insert " "))
    (forward-char)))

(defun free-cursor-up ()
  (interactive "*")
  (let ((clm (if (plusp *free-cursor-max-column*)
		 (min *free-cursor-max-column* (current-column))
	       (current-column))))
    (previous-virtual-line)
    (when (eolp)
      (let ((sa (- clm (free-cursor-this-column))))
	(when (plusp sa)
	  (insert " " sa))))))

(defun free-cursor-down ()
  (interactive "*")
  (let ((clm (if (plusp *free-cursor-max-column*)
		 (min *free-cursor-max-column* (current-column))
	       (current-column))))
    (if (next-virtual-line)
	(when (eolp)
	  (let ((sa (- clm (free-cursor-this-column))))
	    (when (plusp sa)
	      (insert " " sa))))
      (when *free-cursor-next-line-add-newlines*
	(goto-eol)
	(newline)
	(insert " " clm)))))

(defun free-cursor-this-column ()
  (save-excursion
    (goto-eol)
    (current-column)))

(defun free-cursor-delete-eol-spaces ()
  (save-excursion
    (goto-char (point-min))
    (replace-regexp " *$" "" t))
  t)