Browse Source

Merge branch 'master-fixes'

Bastien Guerry 12 years ago
parent
commit
e815ab5f8e
7 changed files with 178 additions and 114 deletions
  1. 80 58
      contrib/lisp/org-contacts.el
  2. 8 9
      contrib/lisp/org-panel.el
  3. 1 0
      doc/org.texi
  4. 1 1
      lisp/org-mobile.el
  5. 1 1
      lisp/org-pcomplete.el
  6. 13 0
      lisp/org-w3m.el
  7. 74 45
      lisp/org.el

+ 80 - 58
contrib/lisp/org-contacts.el

@@ -45,12 +45,12 @@
 (require 'org-agenda)
 (require 'org-agenda)
 
 
 (defgroup org-contacts nil
 (defgroup org-contacts nil
-  "Options concerning contacts management."
+  "Options about contacts management."
   :group 'org)
   :group 'org)
 
 
 (defcustom org-contacts-files nil
 (defcustom org-contacts-files nil
   "List of Org files to use as contacts source.
   "List of Org files to use as contacts source.
-If set to nil, all your Org files will be used."
+When set to nil, all your Org files will be used."
   :type '(repeat file)
   :type '(repeat file)
   :group 'org-contacts)
   :group 'org-contacts)
 
 
@@ -70,7 +70,8 @@ If set to nil, all your Org files will be used."
   :group 'org-contacts)
   :group 'org-contacts)
 
 
 (defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
 (defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
-  "Format of the anniversary agenda entry. The following replacements are available:
+  "Format of the anniversary agenda entry.
+The following replacements are available:
 
 
   %h - Heading name
   %h - Heading name
   %l - Link to the heading
   %l - Link to the heading
@@ -146,17 +147,17 @@ This overrides `org-email-link-description-format' if set."
   "Search for a contact maching NAME-MATCH and TAGS-MATCH.
   "Search for a contact maching NAME-MATCH and TAGS-MATCH.
 If both match values are nil, return all contacts."
 If both match values are nil, return all contacts."
   (let* (todo-only
   (let* (todo-only
-	(tags-matcher
-         (if tags-match
-             (cdr (org-make-tags-matcher tags-match))
-           t))
-        (name-matcher
-         (if name-match
-             '(org-string-match-p name-match (org-get-heading t))
-           t))
-        (contacts-matcher
-         (cdr (org-make-tags-matcher org-contacts-matcher)))
-        markers result)
+	 (tags-matcher
+	  (if tags-match
+	      (cdr (org-make-tags-matcher tags-match))
+	    t))
+	 (name-matcher
+	  (if name-match
+	      '(org-string-match-p name-match (org-get-heading t))
+	    t))
+	 (contacts-matcher
+	  (cdr (org-make-tags-matcher org-contacts-matcher)))
+	 markers result)
     (dolist (file (org-contacts-files))
     (dolist (file (org-contacts-files))
       (org-check-agenda-file file)
       (org-check-agenda-file file)
       (with-current-buffer (org-get-agenda-file-buffer file)
       (with-current-buffer (org-get-agenda-file-buffer file)
@@ -188,10 +189,12 @@ If both match values are nil, return all contacts."
                       (point))))
                       (point))))
          (orig (buffer-substring start end))
          (orig (buffer-substring start end))
          (completion-ignore-case org-contacts-completion-ignore-case)
          (completion-ignore-case org-contacts-completion-ignore-case)
-         (group-completion-p (org-string-match-p (concat "^" org-contacts-group-prefix) orig))
+         (group-completion-p (org-string-match-p
+			      (concat "^" org-contacts-group-prefix) orig))
          (completion-list
          (completion-list
           (if group-completion-p
           (if group-completion-p
-              (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group) 'org-contacts-group group))
+              (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group)
+						  'org-contacts-group group))
                       (org-uniquify
                       (org-uniquify
                        (loop for contact in (org-contacts-filter)
                        (loop for contact in (org-contacts-filter)
                              with group-list
                              with group-list
@@ -203,8 +206,8 @@ If both match values are nil, return all contacts."
                   for contact-name = (car contact)
                   for contact-name = (car contact)
                   ;; Build the list of the user email addresses.
                   ;; Build the list of the user email addresses.
                   for email-list = (split-string (or
                   for email-list = (split-string (or
-                                                  (cdr (assoc-string org-contacts-email-property (caddr contact)))
-                                                  ""))
+                                                  (cdr (assoc-string org-contacts-email-property
+								     (caddr contact))) ""))
                   ;; If the user has email addresses…
                   ;; If the user has email addresses…
                   if email-list
                   if email-list
                   ;; … append a list of USER <EMAIL>.
                   ;; … append a list of USER <EMAIL>.
@@ -216,29 +219,35 @@ If both match values are nil, return all contacts."
     (when (and group-completion-p
     (when (and group-completion-p
                (= (length completion-list) 1))
                (= (length completion-list) 1))
       (setq completion-list
       (setq completion-list
-            (list (concat (car completion-list) ";: "
-                          (mapconcat 'identity
-                                     (loop for contact in (org-contacts-filter
-                                                           nil
-                                                           (get-text-property 0 'org-contacts-group (car completion-list)))
-                                           ;; The contact name is always the car of the assoc-list
-                                           ;; returned by `org-contacts-filter'.
-                                           for contact-name = (car contact)
-                                           ;; Grab the first email of the contact
-                                           for email = (car (split-string (or
-                                                                           (cdr (assoc-string org-contacts-email-property (caddr contact)))
-                                                                           "")))
-                                           ;; If the user has an email address, append USER <EMAIL>.
-                                           if email collect (org-contacts-format-email contact-name email))
-                                     ", ")))))
-    (list start end (completion-table-case-fold completion-list (not org-contacts-completion-ignore-case)))))
+            (list (concat
+		   (car completion-list) ";: "
+		   (mapconcat 'identity
+			      (loop for contact in (org-contacts-filter
+						    nil
+						    (get-text-property 0 'org-contacts-group
+								       (car completion-list)))
+				    ;; The contact name is always the car of the assoc-list
+				    ;; returned by `org-contacts-filter'.
+				    for contact-name = (car contact)
+				    ;; Grab the first email of the contact
+				    for email = (car (split-string
+						      (or
+						       (cdr (assoc-string org-contacts-email-property
+									  (caddr contact)))
+						       "")))
+				    ;; If the user has an email address, append USER <EMAIL>.
+				    if email collect (org-contacts-format-email contact-name email))
+			      ", ")))))
+    (list start end
+	  (completion-table-case-fold completion-list
+				      (not org-contacts-completion-ignore-case)))))
 
 
 (defun org-contacts-message-complete-function ()
 (defun org-contacts-message-complete-function ()
   "Function used in `completion-at-point-functions' in `message-mode'."
   "Function used in `completion-at-point-functions' in `message-mode'."
   (let ((mail-abbrev-mode-regexp
   (let ((mail-abbrev-mode-regexp
          "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):"))
          "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):"))
-        (when (mail-abbrev-in-expansion-header-p)
-          (org-contacts-complete-name))))
+    (when (mail-abbrev-in-expansion-header-p)
+      (org-contacts-complete-name))))
 
 
 (defun org-contacts-gnus-get-name-email ()
 (defun org-contacts-gnus-get-name-email ()
   "Get name and email address from Gnus message."
   "Get name and email address from Gnus message."
@@ -433,12 +442,12 @@ Depends on Wanderlust been loaded."
                                           (wl-summary-message-number)
                                           (wl-summary-message-number)
                                           'from)))
                                           'from)))
      ((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
      ((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
-                                      (prog1
-                                          (std11-fetch-field "From")
-                                        (widen))))))
+      (prog1
+	  (std11-fetch-field "From")
+	(widen))))))
 
 
 (defun org-contacts-wl-get-name-email ()
 (defun org-contacts-wl-get-name-email ()
-  "Get name and email address from wanderlust email.
+  "Get name and email address from Wanderlust email.
 See `org-contacts-wl-get-from-header-content' for limitations."
 See `org-contacts-wl-get-from-header-content' for limitations."
   (let ((from (org-contacts-wl-get-from-header-content)))
   (let ((from (org-contacts-wl-get-from-header-content)))
     (when from
     (when from
@@ -447,13 +456,14 @@ See `org-contacts-wl-get-from-header-content' for limitations."
 
 
 (defun org-contacts-template-wl-name (&optional return-value)
 (defun org-contacts-template-wl-name (&optional return-value)
   "Try to return the contact name for a template from wl.
   "Try to return the contact name for a template from wl.
-If not found return RETURN-VALUE or something that would ask the user."
+If not found, return RETURN-VALUE or something that would ask the
+user."
   (or (car (org-contacts-wl-get-name-email))
   (or (car (org-contacts-wl-get-name-email))
       return-value
       return-value
       "%^{Name}"))
       "%^{Name}"))
 
 
 (defun org-contacts-template-wl-email (&optional return-value)
 (defun org-contacts-template-wl-email (&optional return-value)
-  "Try to return the contact email for a template from wl.
+  "Try to return the contact email for a template from Wanderlust.
 If not found return RETURN-VALUE or something that would ask the user."
 If not found return RETURN-VALUE or something that would ask the user."
   (or (cadr (org-contacts-wl-get-name-email))
   (or (cadr (org-contacts-wl-get-name-email))
       return-value
       return-value
@@ -461,7 +471,8 @@ If not found return RETURN-VALUE or something that would ask the user."
 
 
 (defun org-contacts-view-send-email (&optional ask)
 (defun org-contacts-view-send-email (&optional ask)
   "Send email to the contact at point.
   "Send email to the contact at point.
-If ASK is set, ask for the email address even if there's only one address."
+If ASK is set, ask for the email address even if there's only one
+address."
   (interactive "P")
   (interactive "P")
   (let ((marker (org-get-at-bol 'org-hd-marker)))
   (let ((marker (org-get-at-bol 'org-hd-marker)))
     (org-with-point-at marker
     (org-with-point-at marker
@@ -547,14 +558,22 @@ If ASK is set, ask for the email address even if there's only one address."
              `(,org-contacts-nickname-property . org-contacts-completing-read-nickname))
              `(,org-contacts-nickname-property . org-contacts-completing-read-nickname))
 
 
 (defun org-contacts-vcard-escape (str)
 (defun org-contacts-vcard-escape (str)
-  "Escape ; , and \n in STR for use in the VCard format.
-Thanks to http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el for the regexp."
+  "Escape ; , and \n in STR for the VCard format."
+  ;; Thanks to this library for the regexp:
+  ;; http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el
   (when str
   (when str
-    (replace-regexp-in-string "\n" "\\\\n" (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
+    (replace-regexp-in-string
+     "\n" "\\\\n"
+     (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
 
 
 (defun org-contacts-vcard-encode-name (name)
 (defun org-contacts-vcard-encode-name (name)
-  "Try to encode NAME as VCard's N property. The N property expects FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
-Org-contacts does not specify how to encode the name. So we try to do our best."
+  "Try to encode NAME as VCard's N property.
+The N property expects
+
+  FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
+
+Org-contacts does not specify how to encode the name.  So we try
+to do our best."
   (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;"))
   (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;"))
 
 
 (defun org-contacts-vcard-format (contact)
 (defun org-contacts-vcard-format (contact)
@@ -566,7 +585,6 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
 	 (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
 	 (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
 	 (addr (cdr (assoc-string org-contacts-address-property properties)))
 	 (addr (cdr (assoc-string org-contacts-address-property properties)))
 	 (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
 	 (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
-
 	 (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
 	 (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
     (concat head
     (concat head
 	    (when email (format "EMAIL:%s\n" email))
 	    (when email (format "EMAIL:%s\n" email))
@@ -582,12 +600,15 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
 	    "END:VCARD\n\n")))
 	    "END:VCARD\n\n")))
 
 
 (defun org-contacts-export-as-vcard (&optional name file to-buffer)
 (defun org-contacts-export-as-vcard (&optional name file to-buffer)
-  "Export all contacts matching NAME as VCard 3.0. It TO-BUFFER is nil, the content is written to FILE or `org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer is created and the VCard is written into that buffer."
+  "Export all contacts matching NAME as VCard 3.0.
+If TO-BUFFER is nil, the content is written to FILE or
+`org-contacts-vcard-file'.  If TO-BUFFER is non-nil, the buffer
+is created and the VCard is written into that buffer."
   (interactive) ; TODO ask for name?
   (interactive) ; TODO ask for name?
   (let* ((filename (or file org-contacts-vcard-file))
   (let* ((filename (or file org-contacts-vcard-file))
 	 (buffer (if to-buffer
 	 (buffer (if to-buffer
 		     (get-buffer-create to-buffer)
 		     (get-buffer-create to-buffer)
-		     (find-file-noselect filename))))
+		   (find-file-noselect filename))))
 
 
     (message "Exporting...")
     (message "Exporting...")
 
 
@@ -600,23 +621,24 @@ Org-contacts does not specify how to encode the name. So we try to do our best."
       (set-buffer-file-coding-system coding-system-for-write))
       (set-buffer-file-coding-system coding-system-for-write))
 
 
     (loop for contact in (org-contacts-filter name)
     (loop for contact in (org-contacts-filter name)
-	 do (insert (org-contacts-vcard-format contact)))
+	  do (insert (org-contacts-vcard-format contact)))
 
 
     (if to-buffer
     (if to-buffer
 	(current-buffer)
 	(current-buffer)
-	(progn (save-buffer) (kill-buffer)))))
+      (progn (save-buffer) (kill-buffer)))))
 
 
 (defun org-contacts-show-map (&optional name)
 (defun org-contacts-show-map (&optional name)
-  "Show contacts on a map. Requires google-maps-el."
+  "Show contacts on a map.
+Requires google-maps-el."
   (interactive)
   (interactive)
   (unless (fboundp 'google-maps-static-show)
   (unless (fboundp 'google-maps-static-show)
     (error "`org-contacts-show-map' requires `google-maps-el'"))
     (error "`org-contacts-show-map' requires `google-maps-el'"))
   (google-maps-static-show
   (google-maps-static-show
    :markers
    :markers
    (loop
    (loop
-      for contact in (org-contacts-filter name)
-      for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
-      if addr
-      collect (cons (list addr) (list :label (string-to-char (car contact)))))))
+    for contact in (org-contacts-filter name)
+    for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
+    if addr
+    collect (cons (list addr) (list :label (string-to-char (car contact)))))))
 
 
 (provide 'org-contacts)
 (provide 'org-contacts)

+ 8 - 9
contrib/lisp/org-panel.el

@@ -133,8 +133,6 @@ active.)"
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Hook functions etc
 ;;; Hook functions etc
 
 
-;;(defvar orgpan-this-panel-window nil)
-
 (defun orgpan-delete-panel ()
 (defun orgpan-delete-panel ()
  "Remove the panel."
  "Remove the panel."
  (interactive)
  (interactive)
@@ -203,8 +201,7 @@ active.)"
              (unless (and orgpan-point
              (unless (and orgpan-point
                           (= (point) orgpan-point))
                           (= (point) orgpan-point))
                ;; Go backward so it is possible to click on a "button":
                ;; Go backward so it is possible to click on a "button":
-               (orgpan-backward-field)))))
-       (setq orgpan-this-panel-window nil))
+               (orgpan-backward-field))))))
    (error (lwarn 't :warning "orgpan-post: %S" err))))
    (error (lwarn 't :warning "orgpan-post: %S" err))))
 
 
 ;; (defun orgpan-window-config-change ()
 ;; (defun orgpan-window-config-change ()
@@ -294,7 +291,7 @@ active.)"
 
 
 (defun orgpan-check-panel-mode ()
 (defun orgpan-check-panel-mode ()
  (unless (derived-mode-p 'orgpan-mode)
  (unless (derived-mode-p 'orgpan-mode)
-   (error "Not orgpan-mode in buffer: " major-mode)))
+   (error "Not orgpan-mode in buffer: %s" major-mode)))
 
 
 (defun orgpan-display-bindings-help ()
 (defun orgpan-display-bindings-help ()
  (orgpan-check-panel-mode)
  (orgpan-check-panel-mode)
@@ -401,6 +398,9 @@ There can be only one such buffer at any time.")
 (defvar orgpan-point nil)
 (defvar orgpan-point nil)
 ;;(make-variable-buffer-local 'orgpan-point)
 ;;(make-variable-buffer-local 'orgpan-point)
 
 
+(defvar viper-emacs-state-mode-list)
+(defvar viper-new-major-mode-buffer-list)
+
 (defun orgpan-avoid-viper-in-buffer ()
 (defun orgpan-avoid-viper-in-buffer ()
  ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
  ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
  (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
  (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
@@ -598,12 +598,11 @@ button changes the binding of the arrow keys."
                org-mode-map))
                org-mode-map))
  ;;(org-back-to-heading)
  ;;(org-back-to-heading)
  ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
  ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
- (split-window)
+ (setq orgpan-org-window (selected-window))
+ (setq orgpan-panel-window (split-window nil -4 'below))
+ (select-window orgpan-panel-window)
  (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
  (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
- (setq orgpan-panel-window (selected-window))
  ;;(set-window-dedicated-p (selected-window) t)
  ;;(set-window-dedicated-p (selected-window) t)
- (fit-window-to-buffer nil nil 3)
- (setq orgpan-org-window (next-window))
  ;; The minor mode version starts here:
  ;; The minor mode version starts here:
  (when orgpan-minor-mode-version
  (when orgpan-minor-mode-version
    (select-window orgpan-org-window)
    (select-window orgpan-org-window)

+ 1 - 0
doc/org.texi

@@ -9472,6 +9472,7 @@ include your @file{.emacs} file, you could use:
 @example
 @example
 #+INCLUDE: "~/.emacs" src emacs-lisp
 #+INCLUDE: "~/.emacs" src emacs-lisp
 @end example
 @end example
+
 @noindent
 @noindent
 The optional second and third parameter are the markup (e.g., @samp{quote},
 The optional second and third parameter are the markup (e.g., @samp{quote},
 @samp{example}, or @samp{src}), and, if the markup is @samp{src}, the
 @samp{example}, or @samp{src}), and, if the markup is @samp{src}, the

+ 1 - 1
lisp/org-mobile.el

@@ -276,7 +276,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
 		      (list f))
 		      (list f))
 		     (t nil)))
 		     (t nil)))
 		  org-mobile-files)))
 		  org-mobile-files)))
-	 (files (delete
+	 (files (delq
 		 nil
 		 nil
 		 (mapcar (lambda (f)
 		 (mapcar (lambda (f)
 			   (unless (and (not (string= org-mobile-files-exclude-regexp ""))
 			   (unless (and (not (string= org-mobile-files-exclude-regexp ""))

+ 1 - 1
lisp/org-pcomplete.el

@@ -290,7 +290,7 @@ This needs more work, to handle headings with lots of spaces in them."
 	(cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
 	(cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
     (pcomplete-here cpllist
     (pcomplete-here cpllist
 		    (substring pcomplete-stub 1)
 		    (substring pcomplete-stub 1)
-		    (unless (or (not (delete
+		    (unless (or (not (delq
 				      nil
 				      nil
 				      (mapcar (lambda(x)
 				      (mapcar (lambda(x)
 						(string-match (substring pcomplete-stub 1) x))
 						(string-match (substring pcomplete-stub 1) x))

+ 13 - 0
lisp/org-w3m.el

@@ -43,6 +43,19 @@
 
 
 (require 'org)
 (require 'org)
 
 
+(defvar w3m-current-url)
+(defvar w3m-current-title)
+
+(add-hook 'org-store-link-functions 'org-w3m-store-link)
+(defun org-w3m-store-link ()
+  "Store a link to a w3m buffer."
+  (when (eq major-mode 'w3m-mode)
+    (org-store-link-props
+     :type "w3m"
+     :link w3m-current-url
+     :url (url-view-url t)
+     :description (or w3m-current-title w3m-current-url))))
+
 (defun org-w3m-copy-for-org-mode ()
 (defun org-w3m-copy-for-org-mode ()
   "Copy current buffer content or active region with `org-mode' style links.
   "Copy current buffer content or active region with `org-mode' style links.
 This will encode `link-title' and `link-location' with
 This will encode `link-title' and `link-location' with

+ 74 - 45
lisp/org.el

@@ -3882,6 +3882,13 @@ Use customize to modify this, or restart Emacs after changing it."
 	   (string :tag "HTML end tag")
 	   (string :tag "HTML end tag")
 	   (option (const verbatim)))))
 	   (option (const verbatim)))))
 
 
+(defvar org-syntax-table
+  (let ((st (make-syntax-table)))
+    (mapc (lambda(c) (modify-syntax-entry
+		      (string-to-char (car c)) "w p" st))
+	  org-emphasis-alist)
+    st))
+
 (defvar org-protecting-blocks
 (defvar org-protecting-blocks
   '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
   '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
   "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
   "Blocks that contain text that is quoted, i.e. not processed as Org syntax.
@@ -3975,9 +3982,6 @@ Normal means, no org-mode-specific context."
 (declare-function speedbar-line-directory "speedbar" (&optional depth))
 (declare-function speedbar-line-directory "speedbar" (&optional depth))
 (declare-function table--at-cell-p "table" (position &optional object at-column))
 (declare-function table--at-cell-p "table" (position &optional object at-column))
 
 
-(defvar w3m-current-url)
-(defvar w3m-current-title)
-
 (defvar org-latex-regexps)
 (defvar org-latex-regexps)
 
 
 ;;; Autoload and prepare some org modules
 ;;; Autoload and prepare some org modules
@@ -6230,7 +6234,8 @@ in special contexts.
 	      (and org-cycle-level-after-item/entry-creation
 	      (and org-cycle-level-after-item/entry-creation
 		   (or (org-cycle-level)
 		   (or (org-cycle-level)
 		       (org-cycle-item-indentation))))
 		       (org-cycle-item-indentation))))
-    (let* ((limit-level
+    (let* (message-log-max ; Don't populate the *Messages* buffer
+	   (limit-level
 	    (or org-cycle-max-level
 	    (or org-cycle-max-level
 		(and (boundp 'org-inlinetask-min-level)
 		(and (boundp 'org-inlinetask-min-level)
 		     org-inlinetask-min-level
 		     org-inlinetask-min-level
@@ -6345,7 +6350,8 @@ in special contexts.
 (defun org-cycle-internal-global ()
 (defun org-cycle-internal-global ()
   "Do the global cycling action."
   "Do the global cycling action."
   ;; Hack to avoid display of messages for .org  attachments in Gnus
   ;; Hack to avoid display of messages for .org  attachments in Gnus
-  (let ((ga (string-match "\\*fontification" (buffer-name))))
+  (let (message-log-max ; Don't populate the *Messages* buffer
+	(ga (string-match "\\*fontification" (buffer-name))))
     (cond
     (cond
      ((and (eq last-command this-command)
      ((and (eq last-command this-command)
 	   (eq org-cycle-global-status 'overview))
 	   (eq org-cycle-global-status 'overview))
@@ -6377,7 +6383,8 @@ in special contexts.
 
 
 (defun org-cycle-internal-local ()
 (defun org-cycle-internal-local ()
   "Do the local cycling action."
   "Do the local cycling action."
-  (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
+  (let (message-log-max ; Don't populate the *Messages* buffer
+	(goal-column 0) eoh eol eos has-children children-skipped struct)
     ;; First, determine end of headline (EOH), end of subtree or item
     ;; First, determine end of headline (EOH), end of subtree or item
     ;; (EOS), and if item or heading has children (HAS-CHILDREN).
     ;; (EOS), and if item or heading has children (HAS-CHILDREN).
     (save-excursion
     (save-excursion
@@ -7189,6 +7196,9 @@ current headline.  If point is not at the beginning, split the line,
 create the new headline with the text in the current line after point
 create the new headline with the text in the current line after point
 \(but see also the variable `org-M-RET-may-split-line').
 \(but see also the variable `org-M-RET-may-split-line').
 
 
+With a double prefix arg, force the heading to be inserted at the
+end of the parent subtree.
+
 When INVISIBLE-OK is set, stop at invisible headlines when going back.
 When INVISIBLE-OK is set, stop at invisible headlines when going back.
 This is important for non-interactive uses of the command."
 This is important for non-interactive uses of the command."
   (interactive "P")
   (interactive "P")
@@ -7256,7 +7266,10 @@ This is important for non-interactive uses of the command."
 		tags pos)
 		tags pos)
 	    (cond
 	    (cond
 	     (org-insert-heading-respect-content
 	     (org-insert-heading-respect-content
-	      (org-end-of-subtree nil t)
+	      (if (not (equal force-heading '(16)))
+		  (org-end-of-subtree nil t)
+		(org-up-heading-safe)
+		(org-end-of-subtree nil t))
 	      (when (featurep 'org-inlinetask)
 	      (when (featurep 'org-inlinetask)
 		(while (and (not (eobp))
 		(while (and (not (eobp))
 			    (looking-at "\\(\\*+\\)[ \t]+")
 			    (looking-at "\\(\\*+\\)[ \t]+")
@@ -7368,10 +7381,12 @@ This is a list with the following elements:
 (defun org-insert-todo-heading (arg &optional force-heading)
 (defun org-insert-todo-heading (arg &optional force-heading)
   "Insert a new heading with the same level and TODO state as current heading.
   "Insert a new heading with the same level and TODO state as current heading.
 If the heading has no TODO state, or if the state is DONE, use the first
 If the heading has no TODO state, or if the state is DONE, use the first
-state (TODO by default).  Also with prefix arg, force first state."
+state (TODO by default).  Also one prefix arg, force first state.  With two
+prefix args, force inserting at the end of the parent subtree."
   (interactive "P")
   (interactive "P")
   (when (or force-heading (not (org-insert-item 'checkbox)))
   (when (or force-heading (not (org-insert-item 'checkbox)))
-    (org-insert-heading force-heading)
+    (org-insert-heading (or (and (equal arg '(16)) '(16))
+			    force-heading))
     (save-excursion
     (save-excursion
       (org-back-to-heading)
       (org-back-to-heading)
       (outline-previous-heading)
       (outline-previous-heading)
@@ -8870,20 +8885,31 @@ type.  For a simple example of an export function, see `org-bbdb.el'."
 This link is added to `org-stored-links' and can later be inserted
 This link is added to `org-stored-links' and can later be inserted
 into an org-buffer with \\[org-insert-link].
 into an org-buffer with \\[org-insert-link].
 
 
-For some link types, a prefix arg is interpreted:
-For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
-For file links, arg negates `org-context-in-file-links'."
+For some link types, a prefix arg is interpreted.
+For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
+For file links, arg negates `org-context-in-file-links'.
+
+A double prefix arg force skipping storing functions that are not
+part of Org's core."
   (interactive "P")
   (interactive "P")
   (org-load-modules-maybe)
   (org-load-modules-maybe)
   (setq org-store-link-plist nil)  ; reset
   (setq org-store-link-plist nil)  ; reset
   (org-with-limited-levels
   (org-with-limited-levels
-   (let (link cpltxt desc description search txt custom-id agenda-link)
+   (let (link cpltxt desc description search txt custom-id agenda-link sfuns sfunsn)
      (cond
      (cond
-
-      ((run-hook-with-args-until-success 'org-store-link-functions)
-       (setq link (plist-get org-store-link-plist :link)
-	     desc (or (plist-get org-store-link-plist :description) link)))
-
+      ((and (not (equal arg '(16)))
+	    (setq sfuns
+		  (delq
+		   nil (mapcar (lambda (f) (let (fs) (if (funcall f) (push f fs))))
+			       org-store-link-functions))
+		  sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
+	    (or (and (cdr sfuns)
+		     (funcall (intern
+			       (completing-read "Which function for creating the link? "
+						sfunsn t (car sfunsn)))))
+		(funcall (caar sfuns)))
+	    (setq link (plist-get org-store-link-plist :link)
+		  desc (or (plist-get org-store-link-plist :description) link))))
       ((org-src-edit-buffer-p)
       ((org-src-edit-buffer-p)
        (let (label gc)
        (let (label gc)
 	 (while (or (not label)
 	 (while (or (not label)
@@ -8939,11 +8965,6 @@ For file links, arg negates `org-context-in-file-links'."
 	     link (url-view-url t))
 	     link (url-view-url t))
        (org-store-link-props :type "w3" :url (url-view-url t)))
        (org-store-link-props :type "w3" :url (url-view-url t)))
 
 
-      ((eq major-mode 'w3m-mode)
-       (setq cpltxt (or w3m-current-title w3m-current-url)
-	     link w3m-current-url)
-       (org-store-link-props :type "w3m" :url (url-view-url t)))
-
       ((setq search (run-hook-with-args-until-success
       ((setq search (run-hook-with-args-until-success
 		     'org-create-file-search-functions))
 		     'org-create-file-search-functions))
        (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
        (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
@@ -9001,10 +9022,13 @@ For file links, arg negates `org-context-in-file-links'."
 			       (buffer-file-name (buffer-base-buffer)))))
 			       (buffer-file-name (buffer-base-buffer)))))
 	 ;; Add a context search string
 	 ;; Add a context search string
 	 (when (org-xor org-context-in-file-links arg)
 	 (when (org-xor org-context-in-file-links arg)
-	   (setq txt (cond
+	   (let ((e (org-element-at-point)))
+	     (setq txt (cond
 		      ((org-at-heading-p) nil)
 		      ((org-at-heading-p) nil)
+		      ((eq (org-element-type e) 'keyword)
+		       (plist-get (cadr e) :value))
 		      ((org-region-active-p)
 		      ((org-region-active-p)
-		       (buffer-substring (region-beginning) (region-end)))))
+		       (buffer-substring (region-beginning) (region-end))))))
 	   (when (or (null txt) (string-match "\\S-" txt))
 	   (when (or (null txt) (string-match "\\S-" txt))
 	     (setq cpltxt
 	     (setq cpltxt
 		   (concat cpltxt "::"
 		   (concat cpltxt "::"
@@ -9035,14 +9059,19 @@ For file links, arg negates `org-context-in-file-links'."
        (setq link cpltxt))
        (setq link cpltxt))
 
 
       ((org-called-interactively-p 'interactive)
       ((org-called-interactively-p 'interactive)
-       (error "Cannot link to a buffer which is not visiting a file"))
+       (user-error "No method for storing a link from this buffer"))
 
 
       (t (setq link nil)))
       (t (setq link nil)))
 
 
      (if (consp link) (setq cpltxt (car link) link (cdr link)))
      (if (consp link) (setq cpltxt (car link) link (cdr link)))
      (setq link (or link cpltxt)
      (setq link (or link cpltxt)
 	   desc (or desc cpltxt))
 	   desc (or desc cpltxt))
-     (if (equal desc "NONE") (setq desc nil))
+     (cond ((equal desc "NONE") (setq desc nil))
+	   ((string-match org-bracket-link-regexp desc)
+	    (setq desc (replace-regexp-in-string
+			org-bracket-link-regexp
+			(concat "\\3" (if (equal (length (match-string 0 desc))
+						 (length desc)) "*" "")) desc))))
 
 
      (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
      (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
 	 (progn
 	 (progn
@@ -9111,23 +9140,15 @@ according to FMT (default from `org-email-link-description-format')."
 	(setq fmt (replace-match "from %f" t t fmt))))
 	(setq fmt (replace-match "from %f" t t fmt))))
     (org-replace-escapes fmt table)))
     (org-replace-escapes fmt table)))
 
 
-(defun org-make-org-heading-search-string (&optional string heading)
-  "Make search string for STRING or current headline."
-  (interactive)
-  (let ((s (or string (org-get-heading)))
+(defun org-make-org-heading-search-string (&optional string)
+  "Make search string for the current headline or STRING."
+  (let ((s (or string
+	       (and (derived-mode-p 'org-mode)
+		    (save-excursion
+		      (org-back-to-heading t)
+		      (plist-get (cadr (org-element-at-point))
+				 :raw-value)))))
 	(lines org-context-in-file-links))
 	(lines org-context-in-file-links))
-    (unless (and string (not heading))
-      ;; We are using a headline, clean up garbage in there.
-      (if (string-match org-todo-regexp s)
-	  (setq s (replace-match "" t t s)))
-      (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s)
-	  (setq s (replace-match "" t t s)))
-      (setq s (org-trim s))
-      (if (string-match (concat "^\\(" org-quote-string "\\|"
-				org-comment-string "\\)") s)
-	  (setq s (replace-match "" t t s)))
-      (while (string-match org-ts-regexp s)
-	(setq s (replace-match "" t t s))))
     (or string (setq s (concat "*" s)))  ; Add * for headlines
     (or string (setq s (concat "*" s)))  ; Add * for headlines
     (when (and string (integerp lines) (> lines 0))
     (when (and string (integerp lines) (> lines 0))
       (let ((slines (org-split-string s "\n")))
       (let ((slines (org-split-string s "\n")))
@@ -10893,8 +10914,9 @@ SEPARATOR is passed through to `org-format-outline-path'.  It separates
 the different parts of the path and defaults to \"/\".
 the different parts of the path and defaults to \"/\".
 If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
 If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
   (interactive "P")
   (interactive "P")
-  (let* ((bfn (buffer-file-name (buffer-base-buffer)))
-	 (case-fold-search nil)
+  (let* (case-fold-search
+	 message-log-max ; Don't populate the *Messages* buffer
+	 (bfn (buffer-file-name (buffer-base-buffer)))
 	 (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
 	 (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
 	 res)
 	 res)
     (if current (setq path (append path
     (if current (setq path (append path
@@ -18271,6 +18293,7 @@ BEG and END default to the buffer boundaries."
     (org-defkey narrow-map "e" 'org-narrow-to-element)
     (org-defkey narrow-map "e" 'org-narrow-to-element)
   (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element))
   (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element))
 (org-defkey org-mode-map "\C-\M-t"  'org-transpose-element)
 (org-defkey org-mode-map "\C-\M-t"  'org-transpose-element)
+(org-defkey org-mode-map "\M-t"  'org-transpose-words)
 (org-defkey org-mode-map "\M-}"     'org-forward-element)
 (org-defkey org-mode-map "\M-}"     'org-forward-element)
 (org-defkey org-mode-map "\M-{"     'org-backward-element)
 (org-defkey org-mode-map "\M-{"     'org-backward-element)
 (org-defkey org-mode-map "\C-c\C-^" 'org-up-element)
 (org-defkey org-mode-map "\C-c\C-^" 'org-up-element)
@@ -22497,6 +22520,12 @@ ones already marked."
        (org-element-property :begin elem)
        (org-element-property :begin elem)
        (org-element-property :end elem))))))
        (org-element-property :end elem))))))
 
 
+(defun org-transpose-words ()
+  "Transpose words, using `org-mode' syntax table."
+  (interactive)
+  (with-syntax-table org-syntax-table
+    (call-interactively 'transpose-words)))
+
 (defun org-transpose-element ()
 (defun org-transpose-element ()
   "Transpose current and previous elements, keeping blank lines between.
   "Transpose current and previous elements, keeping blank lines between.
 Point is moved after both elements."
 Point is moved after both elements."