;;; lisp file for xyzzy ver0.2.2.233
;;; adjust-column.l ver.0.0.0.2 // crayonzen [2006-06-16]16:23:03(+0900)

(provide "adjust-column")

(in-package "editor")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;adjust column
(export '(set-fill-column-input

	  adjust-region

	  adjust-region-selection
	  adjust-region-left
	  adjust-region-center
	  adjust-region-right
	  adjust-region-mark

	  ;adjust-normal-paragraph
	  adjust-normal-paragraph-left
	  adjust-normal-paragraph-center
	  adjust-normal-paragraph-right
	  adjust-normal-paragraph-mark

	  ;adjust-paragraph
	  adjust-paragraph-left
	  adjust-paragraph-center
	  adjust-paragraph-right
	  adjust-paragraph-mark

	  go-forward-paragraph ;forward 1
	  go-backward-paragraph ;backward 1
	  goto-forward-paragraph ;forward or backward & number
	  check-line-empty

	  *adjust-column-menus*
	  init-adjust-column-menu
	  ))

;;;fill.l:15:(defvar-local fill-column 72)
;;;fill.l:164:(define-key ctl-x-map #\f 'set-fill-column)
;;;M-x: set-fill-column
;;;cmds.l:1016:(define-key esc-map #\x 'execute-extended-command)
;;;(defun record-complex-command (command args)

;;;;;;;;;;;;;;;;
(defun set-fill-column-input (col)
  (interactive "ncolumn: ")
  (unless (<= 4 col 30000)
    (error "僼傿儖僇儔儉偼4埲忋30000埲壓偱偡丅尰嵼~d" fill-column))
  (setq fill-column col)
  (message "僼傿儖僇儔儉偼~d偱偡" fill-column)
  )

;;;;;;;;;;;;;;;;adjust column (selection or region)
(defun adjust-region (from to position)
  (interactive "*")
  (save-excursion
    (goto-char from)
    ;(goto-bol)
    ;(skip-chars-forward " \t丂")
    (setq indentmark (current-column))
    (goto-char to)
    (setq tolinenum (current-line-number))
    )
  (if (> from to)
      (rotatef from to))
  (save-restriction
    (goto-char from)
    (goto-bol)
    (setq sp (point))
    (goto-char to)
    (goto-eol)
    (setq ep (point))
    (narrow-to-region sp ep)
    (goto-char (point-min))
    (while (not (eobp))
      (delete-region (point)
		     (progn
		       (skip-chars-forward " \t丂")
		       (point)))
      (goto-eol)
      (delete-region (point)
		     (progn
		       (skip-chars-backward " \t丂")
		       (point)))
      (let ((n
	     (case position
	       (1 0)
	       (2 (truncate (- fill-column (current-column)) 2))
	       (3 (- fill-column (current-column)))
	       (4 indentmark)
	       (t 0)
	       )))
	(when (plusp n)
	  (goto-bol)
	  (or (eolp)
	      (indent-to n))))
      (unless (forward-line 1)
	(return))))
  (goto-line tolinenum)
  t)

(defun adjust-region-selection (position)
  (interactive "*")
  (cond ((pre-selection-p)
	 (adjust-region (selection-mark) (selection-point) position));selection
	((mark t)
	 (adjust-region (mark) (point) position));region
	(t
	 (adjust-region (point) (point) position));one line
	)
  )

#|
(defun adjust-region-selection (position)
  (interactive "*")
  (if (pre-selection-p)
      (adjust-region (selection-mark) (selection-point) position);selection
    (adjust-region (mark nil) (point) position);region
    ))
|#

(defun adjust-region-left ()
  (interactive "*")
  (adjust-region-selection 1))

(defun adjust-region-center ()
  (interactive "*")
  (adjust-region-selection 2))

(defun adjust-region-right ()
  (interactive "*")
  (adjust-region-selection 3))

(defun adjust-region-mark ()
  (interactive "*")
  (adjust-region-selection 4))

;;;;;;;;;;;;;;;;adjust column paragraph (normal)
(defun adjust-normal-paragraph (position)
  (interactive "*")
  (adjust-region (progn
		   (backward-paragraph)
		   (point))
		 (progn
		   (forward-paragraph)
		   (point))
		 position)
  )

(defun adjust-normal-paragraph-left ()
  (interactive "*")
  (adjust-normal-paragraph 1))

(defun adjust-normal-paragraph-center ()
  (interactive "*")
  (adjust-normal-paragraph 2))

(defun adjust-normal-paragraph-right ()
  (interactive "*")
  (adjust-normal-paragraph 3))

(defun adjust-normal-paragraph-mark ()
  (interactive "*")
  (adjust-normal-paragraph 4))

;;;;;;;;;;;;;;;;adjust column paragraph (line empty)
(defun adjust-paragraph (position)
  (interactive "*")
  (adjust-region (if (check-line-empty -1)
		     (progn
		       (goto-bol)
		       (point))
		   (progn
		     (go-backward-paragraph)
		     (point))
		   )
		 (if (check-line-empty 1)
		     (progn
		       (goto-eol)
		       (point))
		   (progn
		     (go-forward-paragraph)
		     (point))
		   )
		 position)
  )

(defun adjust-paragraph-left ()
  (interactive "*")
  (adjust-paragraph 1))

(defun adjust-paragraph-center ()
  (interactive "*")
  (adjust-paragraph 2))

(defun adjust-paragraph-right ()
  (interactive "*")
  (adjust-paragraph 3))

(defun adjust-paragraph-mark ()
  (interactive "*")
  (adjust-paragraph 4))

(defun go-forward-paragraph ()
  (interactive "p")
  (goto-forward-paragraph 1)
  )

(defun go-backward-paragraph ()
  (interactive "p")
  (goto-forward-paragraph -1)
  )

(defun goto-forward-paragraph (&optional (ntimes));ntimes is skip paragraph number
  (interactive "p")
  (cond ((eq ntimes nil) (setq skipnum 1) (setq n 1))
	((>= ntimes 1) (setq skipnum 1) (setq n (abs ntimes)))
	((< ntimes 1) (setq skipnum -1) (setq n (abs ntimes)))
	(t (setq skipnum 1) (setq n 1)))
  (if (eq skipnum 1)
      (skip-chars-forward " \t\n丂")
    (skip-chars-backward " \t\n丂"))
  (dotimes (i n)
    (while (not (check-line-empty skipnum))
      (forward-line skipnum))
    (if (eq skipnum 1)
	(progn
	  (goto-eol)
	  (skip-chars-forward " \t\n丂"))
      (progn
	(goto-bol)
	(skip-chars-backward " \t\n丂")))
    )
  ;back 1
  (if (eq skipnum 1)
      (skip-chars-backward " \t\n丂")
    (skip-chars-forward " \t\n丂"))
  )

(defun check-line-empty (&optional (arg));nil or 0 is current line ;arg is skip line number
  (interactive)
  (save-excursion
    (if (or (eq nil arg) (= 0 arg))
	(progn
	  (goto-bol)
	  (skip-chars-forward " \t丂")
	  (eolp))
      (progn
	(setq skipflag (forward-line arg))
	(if (eq skipflag arg);next line OK
	    (progn
	      (skip-chars-forward " \t丂")
	      (eolp))
	  t);else over ;non next line ;last line
	))
    )
  )

;;;;;;;;;;;;;;;;menu
(defvar *adjust-column-menus* nil)

(defun init-adjust-column-menu ()
  (or *adjust-column-menus*
      (setq *adjust-column-menus* (create-popup-menu)))

  (init-fill-column-number-popup-menu)

  (setq *adjust-column-menus*
	(define-popup-menu
	  (:item nil"嵍懙偊(&L)"
	   'adjust-region-left)
	  (:item nil "拞墰懙偊(&C)"
	   'adjust-region-center)
	  (:item nil "塃懙偊(&R)"
	   'adjust-region-right)
	  (:item nil "嵍懙偊 习笀蕭u(&M)"
	   'adjust-region-mark)
	  :sep
	  (:popup 'adjust-normal-paragraph-tag "惍宍抜棊乣捠忢(&N)"
	   (:item nil "嵍懙偊抜棊(&L)"
	    'adjust-normal-paragraph-left)
	   (:item nil "拞墰懙偊抜棊(&C)"
	    'adjust-normal-paragraph-center)
	   (:item nil "塃懙偊抜棊(&R)"
	    'adjust-normal-paragraph-right)
	   (:item nil "嵍懙偊抜棊 寞踢埵抲(&M)"
	    'adjust-normal-paragraph-mark))
	  (:popup 'adjust-paragraph-tag "惍宍抜棊乣峴嬻敀偱(&B)"
	   (:item nil "嵍懙偊抜棊(&L)"
	    'adjust-paragraph-left)
	   (:item nil "拞墰懙偊抜棊(&C)"
	    'adjust-paragraph-center)
	   (:item nil "塃懙偊抜棊(&R)"
	    'adjust-paragraph-right)
	   (:item nil "嵍懙偊抜棊 寞踢埵抲(&M)"
	    'adjust-paragraph-mark))
	  :sep
	  (:menu nil "台俣籽(&F)" *fill-column-number-menu*)
	  (:item nil "台俣籽悢抣擖椡(&I)"
	   'set-fill-column-input)
	  (:item nil (format nil "台俣籽set(&S)" fill-column)
	   'set-fill-column)
	  ))
  )

(defvar *fill-column-number-menu* nil)

(defun init-fill-column-number-popup-menu ()
  (interactive)
  (or *fill-column-number-menu*
      (setq *fill-column-number-menu* (create-popup-menu)))

  (let ((menufc *fill-column-number-menu*))
    (setq listnumber '(10 20 30 40 50 60 70 72 80 100 120 140 160 180 200 250 300))

    (flet ((add-menu (nlist menu)
	     (dolist (item nlist)
	       (let ((menuitem item))
		 (add-menu-item menu nil
				(format nil "~S" menuitem)
				#'(lambda () (interactive)
				    (setq fill-column menuitem))
				;(funcall menuitem))
				#'(lambda ()
				    (when (eq fill-column menuitem) :check)))))))
      (add-menu listnumber menufc)
      )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;adjust-left

(export '(adjust-left-mark_indent
	  adjust-left-mark_indent-byte2space
	  adjust-left
	  delete-horizontal-byte2sapce

	  adjust-shift-region
	  adjust-unshift-region
	  adjust-shift-selection
	  adjust-unshift-selection

	  adjust-shift-1-selection
	  ;;//and adjust-shift-1-selection-byte2space
	  adjust-unshift-1-selection
	  adjust-unshift-1-selection-byte2space
	  ;;adjust-ime-unshift-selection

	  leftchar-un2bytespace

	  *adjust-left-menus*
	  init-adjust-left-menu
	  ))

;monkey.l:(set-function-bar-label #\F1 "VC唾踢")
;winhelp.l:(global-set-key #\F1 'find-winhelp)
;monkey.l:(set-function-bar-label #\S-C-F1 "S-C-F1")
;monkey.l:(set-function-bar-label #\C-F1 "唾踢")
;winhelp.l:(global-set-key #\C-F1 'show-winhelp)

#|
(load-library "adjust-left")
(global-set-key #\F1 'adjust-left-mark_indent-byte2space)
(global-set-key #\S-F1 'adjust-shift-1-selection)
(global-set-key #\S-C-F1 'adjust-unshift-1-selection-byte2space)
|#

;;;;;;;;;;;;;;;; selection or region adjust-left
;;(the same "insert indent" as "indent of mark point" complete copy)
(defun adjust-left-mark_indent (&optional 2bytespace)
  (interactive "*")
  (if (pre-selection-p)
      (adjust-left (selection-mark) (selection-point) 2bytespace);selection
    (adjust-left (mark nil) (point) 2bytespace);region
    )
  )

;2byte space adjust-left
(defun adjust-left-mark_indent-byte2space (&optional (2bytespace t))
  (interactive "*")
  (adjust-left-mark_indent 2bytespace)
  )

;; function adjust-left
;; insert space / position mark column
(defun adjust-left (&optional markp pointp 2bytespace)
  (interactive "*")
  (let ((selectionp (pre-selection-p))
	(rotatefpoint nil)
	(endpoint nil))
    (save-excursion
      (goto-char markp)
      (setq adjustcolum (current-column))
      (setq markline (current-line-number))
      (if (> markp pointp)
	  (progn
	    (rotatef markp pointp)
	    (setq rotatefpoint t)))
      (save-restriction
	(narrow-to-region (progn
			    (goto-char markp) (goto-bol) (point))
			  (progn
			    (goto-char pointp) (goto-eol) (point)))
	(goto-char (point-min))
	(while t
	  (goto-bol)
	  (if 2bytespace
	      (delete-horizontal-byte2sapce)
	    (delete-horizontal-spaces))
	  (insert #\SPC adjustcolum)
	  (unless (forward-line)
	    (return)))
	(if rotatefpoint
	    (setq endpoint (point-min))
	  (setq endpoint (point-max)))))
    (if selectionp
	(progn
	  (goto-line markline)
	  (goto-column adjustcolum)
	  (start-selection 2 t)
	  (goto-char endpoint)
	  )
      (progn
	(goto-line markline)
	(goto-column adjustcolum)
	(set-mark)
	(goto-char endpoint)
	)))
  )

;;//delete-horizontal-byte2sapce = ime-delete-horizontal-spaces(in modify-undo-del-mode.l)
(defun delete-horizontal-byte2sapce ()
  (interactive "*")
  (delete-region (progn
		   (skip-chars-backward " \t丂")
		   (point))
		 (progn
		   (skip-chars-forward " \t丂")
		   (point))))

;;;;;;;;;;;;;;;;adjust shift region (modify + one line + byte2space OK)
(defun adjust-shift-region (start end &optional (column (tab-columns (selected-buffer))) (byte2space))
  (interactive "*p")
  (let ((rev nil))
    (cond ((> start end)
	   (setq rev t)
	   (rotatef start end)))
    (save-restriction
      (narrow-to-region (progn
			  (goto-char start)
			  (goto-bol)
			  (point))
			(progn
			  (goto-char end)
			  (goto-eol)
			  (point)))
      (setq column (truncate column))
      (goto-char (point-min))
      (loop
	(if byte2space
	    (skip-chars-forward " \t丂")
	  (skip-chars-forward " \t"))
	(setq newindent (+ (current-column) column))
	(delete-region (point)
		       (progn
			 (goto-bol)
			 (point)))
	(if (plusp newindent)
	    (indent-to newindent))
	(unless (forward-line 1)
	  (return)))
      (setq start (point-min) end (point-max)))
    (goto-char (if rev start end))
    (values start end))
  )

(defun adjust-unshift-region (start end &optional (column (tab-columns (selected-buffer))) (byte2space))
  (interactive "*p")
  (adjust-shift-region start end (- column) (byte2space)))

;;;;;;;;;;;;;;;;adjust shift selection -> adjust-shift-region
(defun adjust-shift-selection (&optional (column (tab-columns (selected-buffer))) (byte2space))
  (interactive "*p")
  (let ((pre (pre-selection-p)))
    (selection-start-end (start end);end = mark point
      (multiple-value-setq (start end)
	(adjust-shift-region start end column byte2space))
      (when start
	(goto-char end)
	;(forward-line 1)
	;(start-selection 1 pre)
	(start-selection 2 pre)
	(goto-char start)))))

(defun adjust-unshift-selection (&optional (column (tab-columns (selected-buffer))) (byte2space))
  (interactive "*p")
  (adjust-shift-selection (- column) byte2space))

;;;;;;;;;;;;;;;; shift 1
(defun adjust-shift-1-selection (&optional (column 1) (byte2space))
  (interactive "*p")
  (cond ((pre-selection-p)
	 (adjust-shift-selection column byte2space));selection
	((mark t)
	 (adjust-shift-region (mark) (point) column byte2space));region
	(t
	 (adjust-shift-region (progn (goto-bol) (point))
			      (progn (goto-eol) (point)) column byte2space));one line
	)
  )

;;//as (defun adjust-shift-1-selection-byte2space (&optional (column 1) (byte2space t))

;;;;;;;;;;;;;;;; unshift 1
(defun adjust-unshift-1-selection (&optional (column -1) (byte2space))
  (interactive "*p")
  (cond ((pre-selection-p)
	 (adjust-shift-selection column byte2space));selection
	((mark t)
	 (adjust-shift-region (mark) (point) column byte2space));region
	(t
	 (adjust-shift-region (progn (goto-bol) (point))
			      (progn (goto-eol) (point)) column byte2space));one line
	)
  )

(defun adjust-unshift-1-selection-byte2space (&optional (column -1) (byte2space t))
  (interactive "*p")
  (adjust-unshift-1-selection column byte2space))

#|
(defun adjust-ime-unshift-selection (&optional (column -1))
  (interactive "*p")
  (cond ((pre-selection-p)
	 ;(leftchar-un2bytespace (selection-mark) (selection-point))
	 (adjust-shift-selection column t));selection
	((mark t)
	 ;(leftchar-un2bytespace (mark) (point))
	 (adjust-shift-region (mark) (point) column t));region
	(t
	 ;(leftchar-un2bytespace (point) (point))
	 (adjust-shift-region (progn (goto-bol) (point))
			      (progn (goto-eol) (point)) column t));one line
	)
  )
|#

;;;;;;;;;;;;;;;; leftchar-un2bytespace (on select lines)
(defun leftchar-un2bytespace (&optional from to)
  (interactive "*")
  (save-excursion
    (cond ((<= from to))
	  ((> from to) (rotatef from to))
	  (t (setq from (point) to (point))))
    (save-restriction
      (narrow-to-region (progn
			  (goto-char from) (goto-bol) (point))
			(progn
			  (goto-char to) (goto-eol) (point)))
      (goto-char (point-min))
      (if (char= (following-char) (character "丂"))
	  (progn
	    (insert #\SPC 2) (delete-char)))
      (while (scan-buffer "\n丂")
	(forward-char)
	(insert #\SPC 2) (delete-char))))
  )

;;;;;;;;;;;;;;;;menu
(defvar *adjust-left-menus* nil)

(defun init-adjust-left-menu ()
  (or *adjust-left-menus*
      (setq *adjust-left-menus* (create-popup-menu)))

  (setq *adjust-left-menus*
	(define-popup-menu
	  (:item nil "嵍懙偊 习笀蕭u偵崌傢偣傞(&M)"
	   'adjust-left-mark_indent-byte2space)
	  (:item nil "塃傊侾寘僔僼僩(&S)"
	   'adjust-shift-1-selection)
	  (:item nil "嵍傊侾寘僔僼僩(&U)"
	   'adjust-unshift-1-selection-byte2space)
	  )
	)
  )

;;;;;;;;;;;;;;;;hook
(add-hook '*init-app-menus-hook*
	  #'(lambda ()
	      (init-adjust-column-menu)
	      (init-adjust-left-menu)
	      (when (and *app-menu*
			 (setq menu (get-menu *app-menu* 'ed::edit)))
		(add-menu-separator menu 'adjust-column-sep)
		(add-popup-menu menu *adjust-column-menus* "惍宍(&J)")
		(add-popup-menu menu *adjust-left-menus* "惍宍乣嵍懙偊丗僔僼僩(&K)")
		)))
