Deriving mode from org-mode

Deriving mode from org-mode

[Anders Waldenborg]

Hi,

isn't creating a new major mode derived from org-mode supported?

I guess that part of the problem is that org-mode-p doesn't use 
derived-mode-p.


For example:
(define-derived-mode org-derived-mode org-mode "Org-Derived")

and then create a new buffer using org-derived-mode and enter a source 
block, like this:

#+BEGIN_SRC emacs-lisp
#+END_SRC

and do org-edit-special (C-c ') in that buffer. When finishing editing 
one gets this message:
"org-edit-src-exit: This is not a sub-editing buffer, something is wrong"

  anders

Re: Deriving mode from org-mode

[Bastien]

Hi Anders,

Anders Waldenborg <anders@0x63.nu> writes:

> isn't creating a new major mode derived from org-mode supported?

Yes it is...

> I guess that part of the problem is that org-mode-p doesn't use 
> derived-mode-p.

(org-mode-p) does the advertized job: checking whether we are in
org-mode major mode.  It would be confusing to also check against 
org derived modes, at least with that function's name.

> For example:
> (define-derived-mode org-derived-mode org-mode "Org-Derived")
>
> and then create a new buffer using org-derived-mode and enter a source 
> block, like this:
>
> #+BEGIN_SRC emacs-lisp
> #+END_SRC
>
> and do org-edit-special (C-c ') in that buffer. When finishing editing 
> one gets this message:
> "org-edit-src-exit: This is not a sub-editing buffer, something is
> wrong"

Fixed, I corrected this directly in `org-edit-src-code', allow source
code to be edited from org-mode derived modes.

Can you share what kind of derived mode you're writing?  What for?

Thanks,

-- 
 Bastien

Re: Deriving mode from org-mode

[Anders Waldenborg]

On 02/15/2011 05:11 AM, Bastien wrote:
> (org-mode-p) does the advertized job: checking whether we are in
> org-mode major mode.  It would be confusing to also check against
> org derived modes, at least with that function's name.

Agreed. Just hope it isn't used like that in other places.

[]

> Fixed, I corrected this directly in `org-edit-src-code', allow source
> code to be edited from org-mode derived modes.

Thanks!

> Can you share what kind of derived mode you're writing?  What for?

It is a "personal wiki" mode. It automatically narrows to current top 
level heading, adds some extra navigation functions and allows creating 
links to new "pages" (= top level heading) in a simple way. Hopefully I 
can clean it up a little bit soon and publish it.

  anders

Re: Deriving mode from org-mode

[Carsten Dominik]

On Feb 22, 2011, at 10:17 AM, Anders Waldenborg wrote:

> On 02/15/2011 05:11 AM, Bastien wrote:
>> (org-mode-p) does the advertized job: checking whether we are in
>> org-mode major mode.  It would be confusing to also check against
>> org derived modes, at least with that function's name.
> 
> Agreed. Just hope it isn't used like that in other places.
> 
> []
> 
>> Fixed, I corrected this directly in `org-edit-src-code', allow source
>> code to be edited from org-mode derived modes.
> 
> Thanks!
> 
>> Can you share what kind of derived mode you're writing?  What for?
> 
> It is a "personal wiki" mode. It automatically narrows to current top level heading, adds some extra navigation functions and allows creating links to new "pages" (= top level heading) in a simple way. Hopefully I can clean it up a little bit soon and publish it.

You might also want to take a look at org-wikinodes.el in
the contrib directory.

- Carsten

Re: Deriving mode from org-mode

[Carsten Dominik]

On Feb 22, 2011, at 10:21 AM, Carsten Dominik wrote:

> 
> On Feb 22, 2011, at 10:17 AM, Anders Waldenborg wrote:
> 
>> On 02/15/2011 05:11 AM, Bastien wrote:
>>> (org-mode-p) does the advertized job: checking whether we are in
>>> org-mode major mode.  It would be confusing to also check against
>>> org derived modes, at least with that function's name.
>> 
>> Agreed. Just hope it isn't used like that in other places.
>> 
>> []
>> 
>>> Fixed, I corrected this directly in `org-edit-src-code', allow source
>>> code to be edited from org-mode derived modes.
>> 
>> Thanks!
>> 
>>> Can you share what kind of derived mode you're writing?  What for?
>> 
>> It is a "personal wiki" mode. It automatically narrows to current top level heading, adds some extra navigation functions and allows creating links to new "pages" (= top level heading) in a simple way. Hopefully I can clean it up a little bit soon and publish it.
> 
> You might also want to take a look at org-wikinodes.el in
> the contrib directory.

Sorry for following up on my own mail.  I want to add a pointer
to the documentation for org-wikinodes.el:

http://orgmode.org/worg/org-contrib/org-wikinodes.html

- Carsten

Re: Deriving mode from org-mode

[Anders Waldenborg]

On 02/22/2011 10:34 AM, Carsten Dominik wrote:
> Sorry for following up on my own mail.  I want to add a pointer
> to the documentation for org-wikinodes.el:
>
> http://orgmode.org/worg/org-contrib/org-wikinodes.html

Thanks.

I've already seen that - I'm not very interesed in camelcase links. 
However I was planning to look at the implementation to get hints on how 
to implement good links. I currently (ab)use radio targets, every top 
level heading is in the format "* <<<Page name>>>", which seems to work 
quite well, but doesnt feel very elegant. My main focus this far has 
been to get narrowing (I really don't want to risk seeing anything that 
may distract me) and a back function so that I can go back to previous page.

  anders

Re: Deriving mode from org-mode

[Bastien]

Hi Anders,

Anders Waldenborg <anders@0x63.nu> writes:

> It is a "personal wiki" mode. It automatically narrows to current top level
> heading, adds some extra navigation functions and allows creating links to
> new "pages" (= top level heading) in a simple way. Hopefully I can clean it
> up a little bit soon and publish it.

That'd be great, thanks!

-- 
 Bastien

Re: [Orgmode] Deriving mode from org-mode

[Anders Waldenborg]

[-- Attachment #1: Type: text/plain, Size: 413 bytes --]

On Tue, Feb 22, 2011 at 12:52:03PM +0100, Bastien wrote:
> > It is a "personal wiki" mode. It automatically narrows to current top level
> > heading, adds some extra navigation functions and allows creating links to
> > new "pages" (= top level heading) in a simple way. Hopefully I can clean it
> > up a little bit soon and publish it.
> 
> That'd be great, thanks!

Here it is, after a "slight" delay.

 anders

[-- Attachment #2: aw-org-pw.el --]
[-- Type: text/plain, Size: 10106 bytes --]

;;;; aw-org-pw.el --- personal wiki major mode derived from org-mode.
;;
;; Copyright (C) 2011 Anders Waldenborg
;;
;; Author: Anders Waldenborg <anders@0x63.nu>
;; Keywords: outlines, calendar, wp
;; Version: 0.1
;;
;; This file NOT is part of GNU Emacs.
;;
;; 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 this program.  If not, see `http://www.gnu.org/licenses/'.
;;
;;
;;; Commentary:
;;
;; This implements the following features on top of org-mode making it
;; feel more like a (personal) wiki:
;;
;;  * Auto narrowing to current section (= first level heading).
;;  * Linking of all section names.
;;  * Creating of new sections when following nonexistant links.
;;  * Recording navigation history and back functionality.
;;
;;
;;; Code:


(require 'org)

(defconst aw-org-pw-frontpage-name "StartPage"
  "Fake name created for the section before first heading")


;;;;
;;;; Random helper functions
;;;;

(defun aw-truncate-list (l n)
  "Destructivly truncates list l to n elements"
  (let ((e (nthcdr (1- n) l)))
    (when e
      (setcdr e nil)))
  l)

(defun aw-org-pw-word-at-point ()
  "Return word at point, or currently marked text if mark is active"
  (interactive)
  (if mark-active
      (buffer-substring-no-properties (point) (mark))
    (when (looking-at "\\w")
      (let ((start (save-excursion (while (not (looking-at "\\b\\w")) (backward-char)) (point)))
            (end (save-excursion (while (not (looking-at "\\w\\b")) (forward-char)) (1+ (point)))))
        (buffer-substring-no-properties start end)))))


;;;;
;;;; Section navigation
;;;;

(defun aw-org-pw-section-regexp (&optional pagename)
  "Return a regexp matching page section (or any section if pagename is nil)"
  (format "^\\* *\\(%s\\)$" (if pagename
                                (regexp-quote pagename)
                              "[^*].*")))

(defun aw-org-pw-get-section-region (name)
  "Find (start . end) points of specified section"
  (let ((case-fold-search t)
	(search (aw-org-pw-section-regexp name)))
    (save-excursion
      (save-restriction
        (widen)
        (goto-char (point-min))
        (aw-org-pw-next-section)
        (if (string-equal name aw-org-pw-frontpage-name)
            (cons (point-min) (point))
          (while (not (looking-at search))
            (forward-line)
            (aw-org-pw-next-section)
            (if (eobp)
                (error "Section not found")))
          (forward-line)
          (let ((start (point)))
            (aw-org-pw-next-section)
            (cons start (point))))))))

(defun aw-org-pw-all-sections ()
  "Return a list with all section names"
  (save-restriction
    (save-excursion
      (widen)
      (let ((res (list aw-org-pw-frontpage-name))
            (re (aw-org-pw-section-regexp)))
        (goto-char (point-min))
        (while (not (eobp))
          (when (looking-at re)
            (setq res (cons (match-string-no-properties 1) res)))
          (forward-line))
        res))))

(defun aw-org-pw-next-section ()
  "Go to next section"
  (let ((re (aw-org-pw-section-regexp)))
    (while (not (or (eobp) (looking-at re)))
      (forward-line))
    (point)))

(defun aw-org-pw-current-section-name ()
  "Find current section name

This is usually same as the variable aw-org-pw-current-section,
but if navigation has happened by other means (e.g isearch) this
function may be needed to get the correct value."
  (save-restriction
    (save-excursion
      (widen)
      (let ((re (aw-org-pw-section-regexp)))
        (while (not (or (bobp) (looking-at re)))
          (forward-line -1))
        (if (bobp)
            aw-org-pw-frontpage-name
          (match-string-no-properties 1))))))


;;;;
;;;; Navigation with history
;;;;

(defun aw-org-pw-back ()
  "Goto previously visited section"
  (interactive)
  (unless aw-org-pw-breadcrumbs-list
    (error "Nowhere to go I think..."))
  (let ((f (pop aw-org-pw-breadcrumbs-list)))
    (aw-org-pw-goto-section-raw (car f))
    (setq aw-org-pw-current-section (car f))
    (goto-char (+ (point-min) (cdr f)))))

(defun aw-org-pw-goto-section-raw (name)
  "Go to specified section without updating history"
  (let ((reg (aw-org-pw-get-section-region name)))
    (narrow-to-region (car reg) (cdr reg))))

(defun aw-org-pw-goto-section-with-history (name offset prevsec)
  "Go to specified section recording provided history"
  (aw-org-pw-goto-section-raw name)
  (push (cons prevsec offset) aw-org-pw-breadcrumbs-list)
  (aw-truncate-list aw-org-pw-breadcrumbs-list 10)
  (setq aw-org-pw-current-section name)
  (goto-char (point-min)))

(defun aw-org-pw-goto-section (name)
  "Go to specified section"
  (aw-org-pw-goto-section-with-history name (- (point) (point-min)) aw-org-pw-current-section))

(defun aw-org-pw-frontpage ()
  "Navigate to front page"
  (interactive)
  (aw-org-pw-goto-section aw-org-pw-frontpage-name))


;;;;
;;;; Links
;;;;

(defun aw-org-pw-follow-link-at-point ()
  ""
  (interactive)
  (cond
   ;; aw-org-pw link -> aw-org-pw-goto-section
   ((get-text-property (point) 'aw-org-pw-linked-text)
    (aw-org-pw-goto-section (get-text-property (point) 'aw-org-pw-linked-text)))

   ;; other kind of org link -> org-open-at-point
   ((eq (get-text-property (point) 'face) 'org-link)
    (org-open-at-point))

   ;; not a link? -> offer to create page
   ((aw-org-pw-word-at-point) (aw-org-pw-create-new-section t))

   ;; bail out
   (t (message "Don't know what to do"))))

(defun aw-org-pw-follow-link-at-mouse (ev)
  "Follow link at mouse"
  (interactive "e")
  (mouse-set-point ev)
  (aw-org-pw-follow-link-at-point))

(defun aw-org-pw-create-new-section (&optional confirm)
  "Create a new section in current file"
  (let ((pagename (aw-org-pw-word-at-point)))
    (if (and confirm (not (y-or-n-p (format "Create new page '%s'? " pagename))))
        (message "Page creation aborted")
      (widen)
      (goto-char (point-max))
      (insert "\n\n* " pagename "\n")
      (aw-org-pw-update-sections-regexp)
      (aw-org-pw-goto-section pagename))))


;;;;
;;;; Link hilighting
;;;;

(defun aw-org-pw-activate-links (limit)
  ""
  (when (derived-mode-p 'aw-org-pw-mode)
    (let ((case-fold-search t))
      (when (re-search-forward aw-org-pw-link-regexp limit t)
	(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
	(add-text-properties (match-beginning 0) (match-end 0)
			     (list 'mouse-face 'highlight
				   'keymap aw-org-pw-link-map
				   'help-echo "Personal wiki link"
				   'aw-org-pw-linked-text (match-string-no-properties 0)))
	(org-rear-nonsticky-at (match-end 0))
	t))))

(add-hook 'org-font-lock-set-keywords-hook
          (lambda ()
            (add-to-list 'org-font-lock-extra-keywords
                         '(aw-org-pw-activate-links (0 'org-link t))
                         t)))

(defun aw-org-pw-update-sections-regexp ()
  "Update regexp used to create all section-links"
  (setq aw-org-pw-link-regexp (regexp-opt (aw-org-pw-all-sections) 'words)))


;;;;
;;;; isearch integration - widen before search starts, and narrow when
;;;;                       done, possibly updating breadcrumbs.
;;;;

(defvar aw-org-pw-isearch-startoff nil
  "Internal variable for storing offset in page when search starts")

(defun aw-org-pw-isearch-start ()
  (setq aw-org-pw-isearch-startoff (- (point) (point-min)))
  (widen))

(defun aw-org-pw-isearch-end ()
  (if isearch-mode-end-hook-quit
      (aw-org-pw-goto-section-raw aw-org-pw-current-section)
    (save-excursion
      (aw-org-pw-goto-section-with-history (aw-org-pw-current-section-name) aw-org-pw-isearch-startoff aw-org-pw-current-section))))


;;;;
;;;; imenu integration
;;;;

(defun aw-org-pw-imenu-entries ()
  (mapcar (lambda (e)
            (cons e 1))
          (aw-org-pw-all-sections)))

(defun aw-org-pw-imenu-goto (name pos &optional rest)
  (aw-org-pw-goto-section name))

;;;;
;;;; Avoid creating top level headers
;;;;
(defun aw-org-star ()
  "Insert two (on beginning of line) or one (otherwise) '*' characters

This works mostly as a reminder that first level headings are
special in aw-org-pw-mode and should not be created manually."
  (interactive)
  (if (bolp)
      (insert "**")
    (insert "*")))

;;;;
;;;; Actual mode definition
;;;;

(define-derived-mode aw-org-pw-mode org-mode "Org-PW" nil
  (make-local-variable 'aw-org-pw-breadcrumbs-list)
  (make-local-variable 'aw-org-pw-current-section)
  (setq aw-org-pw-breadcrumbs-list nil)
  (setq aw-org-pw-current-section "none")

  (setq header-line-format '("[" aw-org-pw-current-section "] back:" (:eval (if aw-org-pw-breadcrumbs-list (caar aw-org-pw-breadcrumbs-list) "no history"))))

  (setq imenu-create-index-function 'aw-org-pw-imenu-entries)
  (setq imenu-default-goto-function 'aw-org-pw-imenu-goto)

  (add-hook 'isearch-mode-hook 'aw-org-pw-isearch-start nil t)
  (add-hook 'isearch-mode-end-hook 'aw-org-pw-isearch-end nil t)

  (widen)
  (show-all)
  (aw-org-pw-update-sections-regexp)
  (aw-org-pw-frontpage))


;;;;
;;;; Keymaps
;;;;

(define-key aw-org-pw-mode-map "\C-c\C-o" 'aw-org-pw-follow-link-at-point)
(define-key aw-org-pw-mode-map "\C-c\C-b" 'aw-org-pw-back)
(define-key aw-org-pw-mode-map "\C-c\C-f" 'aw-org-pw-frontpage)
(define-key aw-org-pw-mode-map "*" 'aw-org-star)

(defvar aw-org-pw-link-map (make-sparse-keymap))
(define-key aw-org-pw-link-map [mouse-2] 'aw-org-pw-follow-link-at-mouse)
(when org-mouse-1-follows-link
  (define-key aw-org-pw-link-map [follow-link] 'mouse-face))

(define-key aw-org-pw-link-map [return] 'aw-org-pw-follow-link-at-point)

(provide 'aw-org-pw)

;;; aw-org-pw.el ends here