
;;; d-movement-updown.el

;; Copyright (C) 2014-2015 Davin Pearson

;; Emacs Lisp Archive Entry
;; Filename: d-movement-updown.el
;; Author/Maintainer: Davin Pearson <http://davin.50webs.com>
;; Keywords: up/down movement functionality
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;;; Limitation of Warranty

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Known Bugs:

;; None so far!

;;; Code:

(defun d-movement-noncate-up ()
  (interactive)
  (assert (not truncate-lines))
  (if (d-is-first-line)
      (beep)
    (let (c w fw)
      (d-movement--save-ro-mod (setq fw (frame-width))
                               (if os-type--text-p
                                   (decf fw))
                               (setq c (current-column))
                               (if (>= c fw)
                                   (progn
                                     (setq c (- c fw))
                                     ;;(debug)
                                     (move-to-column c t))
                                 (previous-line 1)
                                 (move-to-column c t)
                                 (setq c (current-column))
                                 (setq w (d-movement--line-width))
                                 (while (< c w)
                                   (setq c (+ c fw)))
                                 (if (>= c fw)
                                     (setq c (- c fw)))
                                 (assert (>= c 0))
                                 ;;(debug)
                                 (move-to-column c t))))))
;;;
;;; NEXT LINE: adfasdkfj sdkljf klasdjf lkasdjf klsdajflkasd jflkasdjfkljsdflksfd
;;; LONG LINE asdflksd  asdlfu sadfkj sldkafj sadkljf laksdj flkasdjf aksdjflkasdj flksdaj fklasdj flkasdjf lkajsdfkljasdl fooooooooooooooooooooooo banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana banana
;;; NEXT LINE: adfasdkfj sdkljf klasdjf lkasdjf klsdajflkasd jflkasdjfkljsdflksfd
;;;

(global-set-key [down] 'd-movement-down)

(defun d-movement-noncate-down ()
  (interactive)
  (assert (not truncate-lines))
  (if (d-is-last-line)
      (beep)
    (let (c w fw)
      (d-movement--save-ro-mod (setq fw (frame-width))
                               (if os-type--text-p
                                   (decf fw))
                               (setq c (current-column))
                               (setq w (d-movement--line-width))

                               (if (> w fw)
                                   (progn
                                     (setq c (+ c fw))
                                     (if (< c w)
                                         (move-to-column c)
                                       (forward-line 1)
                                       (move-to-column (mod c fw) t)
                                       ))
                                 ;;(d-foo)
                                 (forward-line 1)
                                 (move-to-column c t))))))

;;;
;;;
;;; http://www.ripway.com.com/davin/research/2006/mopa2e.html sdafadfj sadlkfj askldjf aklsdfj klsadjf lksadj fklsadj fklsdajf lksdaj flkasdj flksdjflkas djflkjsd flk jadflkjsdlfk
;;;
;;; http://www.ripway.com/mopa2e.html sdafadfj sadlkfj askldjf aklsdfj klsadjf lksadj fklsadj fklsdajf lksdaj flkasdj flksdjflkas djflkjsd flk jadflkjsdlfk asdfasdff
;;; http://www.ripway.com/mopa2e.html sdafadfj sadlkfj askldjf aklsdfj klsadjf lksadj fklsadj fklsdajf lksdaj flkasdj flksdjflkas djflkjsd flk jadflkjsdlfk
;;; sdafkdj sf asdlkfasdlkfsdfsdfasdf kas dkfasdf

(d-quote
 (setq truncate-lines nil)
 (setq truncate-lines t)
 )

(global-set-key [up] 'd-movement-truncate-up)

(defun d-movement-truncate-up ()
  (interactive)
  (setq c (current-column))
  (if (d-is-first-line)
      (beep)
    (d-movement--save-ro-mod (forward-line -1)
                             (setq w (d-movement--line-width))
                             (if (< c w)
                                 (move-to-column c t)
                               (if (> c (frame-width))
                                   (d-movement-end-of-line)
                                 )))))


(global-set-key [down] 'd-movement-truncate-down)

(defun d-movement-truncate-down ()
  (interactive)
  (setq c (current-column))
  (if (d-is-last-line)
      (beep)
    (d-movement--save-ro-mod (forward-line 1)
                             (setq w (d-movement--line-width))
                             (if (< c w)
                                 (move-to-column c t)
                               (if (> c (frame-width))
                                   (d-movement-end-of-line)
                                 )))))

(global-set-key [up] 'd-movement-up)

(defun d-movement-up ()
  (interactive)
  (cond
   ((not (d-movement--is-correct-mode))
    (previous-line 1))
   (truncate-lines
    (d-movement-truncate-up))
   (t
    (d-movement-noncate-up))))

(global-set-key [down] 'd-movement-down)

(defun d-movement-down ()
  (interactive)
  (cond
   ((not (d-movement--is-correct-mode))
    (next-line 1))
   (truncate-lines
    (d-movement-truncate-down))
   (t
    (d-movement-noncate-down))))

(provide 'd-movement-updown)

