[cl-org-mode-devel] [PATCH] * src/cl-org-mode.lisp: Added support for link format.

[Ryo Takaishi]

Hello,

I created a banch "work-parse-link" for this patch at cl-net repository.

Thanks,

Ryo TAKAISHI

On Thu, Dec 22, 2011 at 11:53 PM, Ryo TAKAISHI <ryo.takaishi.0 at gmail.com> wrote:
> It can parse "[[link]]" and "[[link][description]]".
> ---
>  src/cl-org-mode.lisp |   60 ++++++++++++++++++++++++++++++++++++++++++++++++-
>  1 files changed, 58 insertions(+), 2 deletions(-)
>
> diff --git a/src/cl-org-mode.lisp b/src/cl-org-mode.lisp
> index b24fdfc..653105f 100644
> --- a/src/cl-org-mode.lisp
> +++ b/src/cl-org-mode.lisp
> @@ -11,7 +11,10 @@
>
>  (defmethod node-dispatchers ((node org-node))
>   (or *dispatchers*
> -      (mapcar #'make-instance '(src-node properties-node outline-node))))
> +      (mapcar #'make-instance '(link-node
> +                                src-node
> +                                properties-node
> +                                outline-node))))
>
>  (defmethod node-prototypes (node)
>   (error "never call"))
> @@ -246,4 +249,57 @@ then stick it in the default node"
>                 (and (typep n 'property-node)
>                      (equal (property-node.property n) key)))
>               (node.children node))))
> -    (when node (property-node.value node))))
> \ No newline at end of file
> +    (when node (property-node.value node))))
> +
> +
> +(defclass link-node (org-parent-node)
> +     ((link :accessor node.link :initform nil :initarg :link)
> +      (description :accessor node.description :initform nil :initarg :description)))
> +
> +(defun at-link-node-p (stack)
> +  (let ((char (first stack))
> +        (stack (rest stack)))
> +    (and (eql char #\[)
> +         (eql (first stack) #\[)
> +         (if (or (null (rest stack))
> +                 (second stack))
> +             (values t (rest stack))
> +             (at-link-node-p (cons char (rest stack)))))))
> +
> +(defmethod node-start ((node link-node) stack)
> +  (multiple-value-bind (pred old-stack)
> +      (at-link-node-p stack)
> +    (if pred
> +        (values
> +         (make-instance (class-of node))
> +         old-stack))))
> +
> +(defmethod node-end ((node link-node) (next-node link-node) stack)
> +  T)
> +
> +(defmethod node-end ((node link-node) (next-node text-node) stack)
> +  T)
> +
> +(defmethod finalize-node ((node link-node) next-node stack)
> +  (setf (node.next-node node)
> +        (if stack
> +            (make-default-node node next-node stack)
> +            next-node)))
> +
> +(defmethod read-next-node ((node link-node) (next-node null) stream)
> +  (let (text c)
> +    (loop for char = (read-char stream nil)
> +          :if (and (eql #\] char)
> +                   (eql #\] (car text)))
> +          :do (if (eql (node.link node) nil)
> +                  (setf (node.link node) (stack->string (cdr text)))
> +                  (setf (node.description node) (stack->string (cdr text))))
> +              (return)
> +          :if (and (eql #\[ char)
> +                   (eql #\] (car text)))
> +          :do (setf (node.link node) (stack->string (cdr text)))
> +          (setf text nil)
> +          :else
> +          :do ;;(unread-char c stream)
> +              (push char text))
> +    (call-next-method)))
> --
> 1.7.8.rc1
>



-- 
Ryo Takaishi