annotate lisp/org/org-mhe.el @ 110523:a5ad4f188e19

Synch Semantic to CEDET 1.0. Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog. * semantic.el (semantic-version): Update to 2.0. (semantic-mode-map): Add "," and "m" bindings. (navigate-menu): Update. * semantic/symref.el (semantic-symref-calculate-rootdir): New function. (semantic-symref-detect-symref-tool): Use it. * semantic/symref/grep.el (semantic-symref-grep-shell): New var. (semantic-symref-perform-search): Use it. Calculate root dir with semantic-symref-calculate-rootdir. (semantic-symref-derive-find-filepatterns): Improve error message. * semantic/symref/list.el (semantic-symref-results-mode-map): New bindings. (semantic-symref-auto-expand-results): New option. (semantic-symref-results-dump): Obey auto-expand. (semantic-symref-list-expand-all, semantic-symref-regexp) (semantic-symref-list-contract-all) (semantic-symref-list-map-open-hits) (semantic-symref-list-update-open-hits) (semantic-symref-list-create-macro-on-open-hit) (semantic-symref-list-call-macro-on-open-hits): New functions. (semantic-symref-list-menu-entries) (semantic-symref-list-menu): New vars. (semantic-symref-list-map-open-hits): Move cursor to beginning of match before calling the mapped function. * semantic/doc.el (semantic-documentation-comment-preceeding-tag): Do nothing if the mode doesn't provide comment-start-skip. * semantic/scope.el (semantic-analyze-scope-nested-tags-default): Strip duplicates. (semantic-analyze-scoped-inherited-tag-map): Take the tag we are looking for as part of the scoped tags list. * semantic/html.el (semantic-default-html-setup): Add senator-step-at-tag-classes. * semantic/decorate/include.el (semantic-decoration-on-unknown-includes): Change light bgcolor. (semantic-decoration-on-includes-highlight-default): Check that the include tag has a postion. * semantic/complete.el (semantic-collector-local-members): (semantic-complete-read-tag-local-members) (semantic-complete-jump-local-members): New class and functions. (semantic-complete-self-insert): Save excursion before completing. * semantic/analyze/complete.el (semantic-analyze-possible-completions-default): If no completions are found, return the raw by-name-only completion list. Add FLAGS arguments. Add support for 'no-tc (type constraint) and 'no-unique, or no stripping duplicates. (semantic-analyze-possible-completions-default): Add FLAGS arg. * semantic/util-modes.el (semantic-stickyfunc-show-only-functions-p): New option. (semantic-stickyfunc-fetch-stickyline): Don't show stickytext for the very first line in a buffer. * semantic/util.el (semantic-hack-search) (semantic-recursive-find-nonterminal-by-name) (semantic-current-tag-interactive): Deleted. (semantic-describe-buffer): Fix expand-nonterminal. Add lex-syntax-mods, type relation separator char, and command separation char. (semantic-sanity-check): Only message if called interactively. * semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the :filename property and the tag position. * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): Add recursion limit. * semantic/imenu.el (semantic-imenu-bucketize-type-members): Make this buffer local, not the obsoleted variable. * semantic/idle.el: Add breadcrumbs support. (semantic-idle-summary-current-symbol-info-default) (semantic-idle-tag-highlight) (semantic-idle-completion-list-default): Use semanticdb-without-unloaded-file-searches for speed, and to conform to the controls that specify if the idle timer is supposed to be parsing unparsed includes. (semantic-idle-symbol-highlight-face) (semantic-idle-symbol-maybe-highlight): Rename from *-summary-*. Callers changed. (semantic-idle-work-parse-neighboring-files-flag): Default to nil. (semantic-idle-work-update-headers-flag): New var. (semantic-idle-work-for-one-buffer): Use it. (semantic-idle-local-symbol-highlight): Rename from semantic-idle-tag-highlight. (semantic-idle-truncate-long-summaries): New option. * semantic/ia.el (semantic-ia-cache) (semantic-ia-get-completions): Deleted. Callers changed. (semantic-ia-show-variants): New command. (semantic-ia-show-doc): If doc is empty, don't make a temp buffer. (semantic-ia-show-summary): If there isn't anything to show, say so. * semantic/grammar.el (semantic-grammar-create-package): Save the buffer even in batch mode. * semantic/fw.el (semanticdb-without-unloaded-file-searches): New macro. * semantic/dep.el (semantic-dependency-find-file-on-path): Fix case dereferencing ede-object when it is a list. * semantic/db-typecache.el (semanticdb-expand-nested-tag) (semanticdb-typecache-faux-namespace): New functions. (semanticdb-typecache-file-tags) (semanticdb-typecache-merge-streams): Use them. (semanticdb-typecache-file-tags): When deriving tags from a file, give the mode a chance to monkey with the tag copy. (semanticdb-typecache-find-default): Wrap find in save-excursion. (semanticdb-typecache-find-by-name-helper): Merge found names down. * semantic/db-global.el (semanticdb-enable-gnu-global-in-buffer): Don't show messages if GNU Global is not available and we don't want to throw an error. * semantic/db-find.el (semanticdb-find-result-nth-in-buffer): When trying to normalize the tag to a buffer, don't error if set-buffer method doesn't exist. * semantic/db-file.el (semanticdb-save-db): Simplify msg. * semantic/db.el (semanticdb-refresh-table): If forcing a refresh on a file not in a buffer, use semantic-find-file-noselect and delete the buffer after use. (semanticdb-current-database-list): When calculating root via hooks, force it through true-filename and skip the list of possible roots. * semantic/ctxt.el (semantic-ctxt-imported-packages): New. * semantic/analyze/debug.el (semantic-analyzer-debug-insert-tag): Reset standard output to current buffer. (semantic-analyzer-debug-global-symbol) (semantic-analyzer-debug-missing-innertype): Change "prefix" to "symbol" in messages. * semantic/analyze/refs.el: (semantic-analyze-refs-impl) (semantic-analyze-refs-proto): When calculating value, make sure the found tag is 'similar' to the originating tag. (semantic--analyze-refs-find-tags-with-parent): Attempt to identify matches via imported symbols of parents. (semantic--analyze-refs-full-lookup-with-parents): Do a deep search during the brute search. * semantic/analyze.el (semantic-analyze-find-tag-sequence-default): Be robust to calculated scopes being nil. * semantic/bovine/c.el (semantic-c-describe-environment): Add project macro symbol array. (semantic-c-parse-lexical-token): Add recursion limit. (semantic-ctxt-imported-packages, semanticdb-expand-nested-tag): New overrides. (semantic-expand-c-tag-namelist): Split a full type from a typedef out to its own tag. (semantic-expand-c-tag-namelist): Do not split out a typedef'd inline type if it is an anonymous type. (semantic-c-reconstitute-token): Use the optional initializers as a clue that some function is probably a constructor. When defining the type of these constructors, split the parent name, and use only the class part, if applicable. * semantic/bovine/c-by.el: * semantic/wisent/python-wy.el: Regenerate.

;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode

;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
;;   Free Software Foundation, Inc.

;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;; Version: 6.33x
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs 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.

;; GNU Emacs 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.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:

;; This file implements links to MH-E messages from within Org-mode.
;; Org-mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.

;;; Code:

(require 'org)

;; Customization variables

(defcustom org-mhe-search-all-folders nil
  "Non-nil means the search for the mh-message may extend to all folders.
When non-nil, the search for a message will extend to all other
folders if it cannot be found in the folder given in the link.
Searching all folders may be slow with the default pick based
search but is very efficient with one of the other search engines
supported by MH-E."
  :group 'org-link-follow
  :type 'boolean)

;; Declare external functions and variables
(declare-function mh-display-msg "mh-show" (msg-num folder-name))
(declare-function mh-find-path "mh-utils" ())
(declare-function mh-get-header-field "mh-utils" (field))
(declare-function mh-get-msg-num "mh-utils" (error-if-no-message))
(declare-function mh-header-display "mh-show" ())
(declare-function mh-index-previous-folder "mh-search" ())
(declare-function mh-normalize-folder-name "mh-utils"
		  (folder &optional empty-string-okay dont-remove-trailing-slash
			  return-nil-if-folder-empty))
(declare-function mh-search "mh-search"
		  (folder search-regexp &optional redo-search-flag
			  window-config))
(declare-function mh-search-choose "mh-search" (&optional searcher))
(declare-function mh-show "mh-show" (&optional message redisplay-flag))
(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer))
(declare-function mh-show-header-display "mh-show" t t)
(declare-function mh-show-msg "mh-show" (msg))
(declare-function mh-show-show "mh-show" t t)
(declare-function mh-visit-folder "mh-folder" (folder &optional
						      range index-data))
(defvar mh-progs)
(defvar mh-current-folder)
(defvar mh-show-folder-buffer)
(defvar mh-index-folder)
(defvar mh-searcher)
(defvar mh-search-regexp-builder)

;; Install the link type
(org-add-link-type "mhe" 'org-mhe-open)
(add-hook 'org-store-link-functions 'org-mhe-store-link)

;; Implementation
(defun org-mhe-store-link ()
  "Store a link to an MH-E folder or message."
  (when (or (equal major-mode 'mh-folder-mode)
	    (equal major-mode 'mh-show-mode))
    (let ((from (org-mhe-get-header "From:"))
	  (to (org-mhe-get-header "To:"))
	  (message-id (org-mhe-get-header "Message-Id:"))
	  (subject (org-mhe-get-header "Subject:"))
	  link desc)
      (org-store-link-props :type "mh" :from from :to to
			    :subject subject :message-id message-id)
      (setq desc (org-email-link-description))
      (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
				(org-remove-angle-brackets message-id)))
      (org-add-link-props :link link :description desc)
      link)))

(defun org-mhe-open (path)
  "Follow an MH-E message link specified by PATH."
  (let (folder article)
    (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
	(error "Error in MH-E link"))
    (setq folder (match-string 1 path)
	  article (match-string 3 path))
    (org-mhe-follow-link folder article)))

;;; mh-e integration based on planner-mode
(defun org-mhe-get-message-real-folder ()
  "Return the name of the real folder for the current message.
So if you use sequences, it will now work."
  (save-excursion
    (let* ((folder
	    (if (equal major-mode 'mh-folder-mode)
		mh-current-folder
	      ;; Refer to the show buffer
	      mh-show-folder-buffer))
	   (end-index
	    (if (boundp 'mh-index-folder)
		(min (length mh-index-folder) (length folder))))
	   )
      ;; a simple test on mh-index-data does not work, because
      ;; mh-index-data is always nil in a show buffer.
      (if (and (boundp 'mh-index-folder)
	       (string= mh-index-folder (substring folder 0 end-index)))
	  (if (equal major-mode 'mh-show-mode)
	      (save-window-excursion
		(let (pop-up-frames)
		  (when (buffer-live-p (get-buffer folder))
		    (progn
		      (pop-to-buffer folder)
		      (org-mhe-get-message-folder-from-index)
		      )
		    )))
	    (org-mhe-get-message-folder-from-index)
	    )
	folder
	)
      )))

(defun org-mhe-get-message-folder-from-index ()
  "Return the name of the message folder in an index folder buffer."
  (save-excursion
    (mh-index-previous-folder)
    (if (re-search-forward "^\\(+.*\\)$" nil t)
	(message "%s" (match-string 1)))))

(defun org-mhe-get-message-folder ()
  "Return the name of the current message folder.
Be careful if you use sequences."
  (save-excursion
    (if (equal major-mode 'mh-folder-mode)
	mh-current-folder
      ;; Refer to the show buffer
      mh-show-folder-buffer)))

(defun org-mhe-get-message-num ()
  "Return the number of the current message.
Be careful if you use sequences."
  (save-excursion
    (if (equal major-mode 'mh-folder-mode)
	(mh-get-msg-num nil)
      ;; Refer to the show buffer
      (mh-show-buffer-message-number))))

(defun org-mhe-get-header (header)
  "Return the field for HEADER of the message in folder mode.
This will create a show buffer for the corresponding message.  If
you have a better idea of how to do this then please let us know."
  (let* ((folder (org-mhe-get-message-folder))
	 (num (org-mhe-get-message-num))
	 (buffer (get-buffer-create (concat "show-" folder)))
	 (header-field))
  (with-current-buffer buffer
    (mh-display-msg num folder)
    (if (equal major-mode 'mh-folder-mode)
	(mh-header-display)
      (mh-show-header-display))
    (set-buffer buffer)
    (setq header-field (mh-get-header-field header))
    (if (equal major-mode 'mh-folder-mode)
	(mh-show)
      (mh-show-show))
    header-field)))

(defun org-mhe-follow-link (folder article)
  "Follow an MH-E link to FOLDER and ARTICLE.
If ARTICLE is nil FOLDER is shown.  If the configuration variable
`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
ARTICLE is searched in all folders.  Indexed searches (swish++,
namazu, and others supported by MH-E) will always search in all
folders."
  (require 'mh-e)
  (require 'mh-search)
  (require 'mh-utils)
  (mh-find-path)
  (if (not article)
      (mh-visit-folder (mh-normalize-folder-name folder))
    (mh-search-choose)
    (if (equal mh-searcher 'pick)
	(progn
	  (setq article (org-add-angle-brackets article))
	  (mh-search folder (list "--message-id" article))
	  (when (and org-mhe-search-all-folders
		     (not (org-mhe-get-message-real-folder)))
	    (kill-this-buffer)
	    (mh-search "+" (list "--message-id" article))))
      (if mh-search-regexp-builder
	  (mh-search "+" (funcall mh-search-regexp-builder
				  (list (cons 'message-id article))))
	(mh-search "+" article)))
    (if (org-mhe-get-message-real-folder)
	(mh-show-msg 1)
      (kill-this-buffer)
      (error "Message not found"))))

(provide 'org-mhe)

;; arch-tag: dcb05484-8627-491d-a8c1-01dbd2bde4ae

;;; org-mhe.el ends here