~ubuntu-branches/ubuntu/karmic/emacs-snapshot/karmic

« back to all changes in this revision

Viewing changes to lisp/org/org-attach.el

• browse files at revision 1.1.30
• compare with another revision
• download diff
• download tarball
• view history from revision 1.1.30

Show diffs side-by-side

added

removed

lisp/org/org-attach.el

1

1

;;; org-attach.el --- Manage file attachments to org-mode tasks

2

2

 

3

 

;; Copyright (C) 2008 Free Software Foundation, Inc.

 

3

;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.

4

4

 

5

5

;; Author: John Wiegley <johnw@newartisans.com>

6

6

;; Keywords: org data task

7

 

;; Version: 6.09a

 

7

;; Version: 6.21b

8

8

 

9

9

;; This file is part of GNU Emacs.

10

10

;;

53

53

If this is a relative path, it will be interpreted relative to the directory

54

54

where the Org file lives."

55

55

  :group 'org-attach

56

 

  :type 'direcory)

 

56

  :type 'directory)

57

57

 

58

58

(defcustom org-attach-auto-tag "ATTACH"

59

59

  "Tag that will be triggered automatically when an entry has an attachment."

64

64

 

65

65

(defcustom org-attach-file-list-property "Attachments"

66

66

  "The property used to keep a list of attachment belonging to this entry.

67

 

This is not really needed, so you may set this to nil if you don't want it."

 

67

This is not really needed, so you may set this to nil if you don't want it.

 

68

Also, for entries where children inherit the directory, the list of

 

69

attachments is not kept in this property."

68

70

  :group 'org-attach

69

71

  :type '(choice

70

72

          (const :tag "None" nil)

89

91

  :group 'org-attach

90

92

  :type 'boolean)

91

93

 

 

94

(defcustom org-attach-allow-inheritance t

 

95

  "Non-nil means, allow attachment directories be inherited."

 

96

  :group 'org-attach

 

97

  :type 'boolean)

 

98

  

 

99

 

 

100

(defvar org-attach-inherited nil

 

101

  "Indicates if the last access to the attachment directory was inherited.")

 

102

 

92

103

;;;###autoload

93

104

(defun org-attach ()

94

105

  "The dispatcher for attachment commands.

124

135

 

125

136

d       Delete one attachment, you will be prompted for a file name.

126

137

D       Delete all of a task's attachments.  A safer way is

127

 

        to open the directory in dired and delete from there.")))

128

 

          (shrink-window-if-larger-than-buffer (get-buffer-window "*Org Attach*"))

 

138

        to open the directory in dired and delete from there.

 

139

 

 

140

s       Set a specific attachment directory for this entry.

 

141

i       Make children of the current entry inherit its attachment directory.")))

 

142

          (org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))

129

143

          (message "Select command: [acmlzoOfFdD]")

130

144

          (setq c (read-char-exclusive))

131

145

          (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))

147

161

                              'org-attach-delete-one))

148

162

       ((eq c ?D)            (call-interactively 'org-attach-delete-all))

149

163

       ((eq c ?q)            (message "Abort"))

 

164

       ((memq c '(?s ?\C-s)) (call-interactively

 

165

                              'org-attach-set-directory))

 

166

       ((memq c '(?i ?\C-i)) (call-interactively

 

167

                              'org-attach-set-inherit))

150

168

       (t (error "No such attachment command %c" c))))))

151

169

 

152

170

(defun org-attach-dir (&optional create-if-not-exists-p)

153

171

  "Return the directory associated with the current entry.

 

172

This first checks for a local property ATTACH_DIR, and then for an inherited

 

173

property ATTACH_DIR_INHERIT.  If neither exists, the default mechanism

 

174

using the entry ID will be invoked to access the unique directory for the

 

175

current entry.

154

176

If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil,

155

 

the directory and the corresponding ID will be created."

156

 

  (let ((uuid (org-id-get (point) create-if-not-exists-p)))

157

 

    (when (or uuid create-if-not-exists-p)

158

 

      (unless uuid

159

 

        (let ((uuid-string (shell-command-to-string "uuidgen")))

160

 

          (setf uuid-string

161

 

                (substring uuid-string 0 (1- (length uuid-string))))

162

 

          (org-entry-put (point) "ID" uuid-string)

163

 

          (setf uuid uuid-string)))

164

 

      (let ((attach-dir (expand-file-name

165

 

                         (format "%s/%s"

166

 

                                 (substring uuid 0 2)

167

 

                                 (substring uuid 2))

168

 

                         (expand-file-name org-attach-directory))))

169

 

        (if (and create-if-not-exists-p

170

 

                 (not (file-directory-p attach-dir)))

171

 

            (make-directory attach-dir t))

172

 

        (and (file-exists-p attach-dir)

173

 

             attach-dir)))))

 

177

the directory and (if necessary) the corresponding ID will be created."

 

178

  (let (attach-dir uuid inherit)

 

179

    (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT"))

 

180

    (cond

 

181

     ((setq attach-dir (org-entry-get nil "ATTACH_DIR"))

 

182

      (org-attach-check-absolute-path attach-dir))

 

183

     ((and org-attach-allow-inheritance

 

184

           (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t)))

 

185

      (setq attach-dir

 

186

            (save-excursion

 

187

              (save-restriction

 

188

                (widen)

 

189

                (goto-char org-entry-property-inherited-from)

 

190

                (let (org-attach-allow-inheritance)

 

191

                  (org-attach-dir create-if-not-exists-p)))))

 

192

      (org-attach-check-absolute-path attach-dir)

 

193

      (setq org-attach-inherited t))

 

194

     (t ; use the ID

 

195

      (org-attach-check-absolute-path nil)

 

196

      (setq uuid (org-id-get (point) create-if-not-exists-p))

 

197

      (when (or uuid create-if-not-exists-p)

 

198

        (unless uuid (error "ID retrieval/creation failed"))

 

199

        (setq attach-dir (expand-file-name

 

200

                          (format "%s/%s"

 

201

                                  (substring uuid 0 2)

 

202

                                  (substring uuid 2))

 

203

                          (expand-file-name org-attach-directory))))))

 

204

    (when attach-dir

 

205

      (if (and create-if-not-exists-p

 

206

               (not (file-directory-p attach-dir)))

 

207

          (make-directory attach-dir t))

 

208

      (and (file-exists-p attach-dir)

 

209

           attach-dir))))

 

210

 

 

211

(defun org-attach-check-absolute-path (dir)

 

212

  "Check if we have enough information to root the atachment directory.

 

213

When DIR is given, check also if it is already absolute.  Otherwise,

 

214

assume that it will be relative, and check if `org-attach-directory' is

 

215

absolute, or if at least the current buffer has a file name.

 

216

Throw an error if we cannot root the directory."

 

217

  (or (and dir (file-name-absolute-p dir))

 

218

      (file-name-absolute-p org-attach-directory)

 

219

      (buffer-file-name (buffer-base-buffer))

 

220

      (error "Need absolute `org-attach-directory' to attach in buffers without filename.")))

 

221

 

 

222

(defun org-attach-set-directory ()

 

223

  "Set the ATTACH_DIR property of the current entry.

 

224

The property defines the directory that is used for attachments

 

225

of the entry."

 

226

  (interactive)

 

227

  (let ((dir (org-entry-get nil "ATTACH_DIR")))

 

228

    (setq dir (read-directory-name "Attachment directory: " dir))

 

229

    (org-entry-put nil "ATTACH_DIR" dir)))

 

230

 

 

231

(defun org-attach-set-inherit ()

 

232

  "Set the ATTACH_DIR_INHERIT property of the current entry.

 

233

The property defines the directory that is used for attachments

 

234

of the entry and any children that do not explicitly define (by setting

 

235

the ATTACH_DIR property) their own attachment directory."

 

236

  (interactive)

 

237

  (org-entry-put nil "ATTACH_DIR_INHERIT" "t")

 

238

  (message "Children will inherit attachment directory"))

174

239

 

175

240

(defun org-attach-commit ()

176

241

  "Commit changes to git if `org-attach-directory' is properly initialized.

182

247

                 " git add .; "

183

248

                 " git ls-files --deleted -z | xargs -0 git rm; "

184

249

                 " git commit -m 'Synchronized attachments')")))))

185

 

  

 

250

 

186

251

(defun org-attach-tag (&optional off)

187

252

  "Turn the autotag on or (if OFF is set) off."

188

253

  (when org-attach-auto-tag

201

266

  (interactive "fFile to keep as an attachment: \nP")

202

267

  (setq method (or method org-attach-method))

203

268

  (let ((basename (file-name-nondirectory file)))

204

 

    (when org-attach-file-list-property

 

269

    (when (and org-attach-file-list-property (not org-attach-inherited))

205

270

      (org-entry-add-to-multivalued-property

206

271

       (point) org-attach-file-list-property basename))

207

272

    (let* ((attach-dir (org-attach-dir t))

235

300

  "Create a new attachment FILE for the current task.

236

301

The attachment is created as an Emacs buffer."

237

302

  (interactive "sCreate attachment named: ")

238

 

  (when org-attach-file-list-property

 

303

  (when (and org-attach-file-list-property (not org-attach-inherited))

239

304

    (org-entry-add-to-multivalued-property

240

305

     (point) org-attach-file-list-property file))

241

306

  (let ((attach-dir (org-attach-dir t)))

249

314

  (let* ((attach-dir (org-attach-dir t))

250

315

         (files (org-attach-file-list attach-dir))

251

316

         (file (or file

252

 

                   (completing-read

 

317

                   (org-ido-completing-read

253

318

                    "Delete attachment: "

254

319

                    (mapcar (lambda (f)

255

320

                              (list (file-name-nondirectory f)))

264

329

This actually deletes the entire attachment directory.

265

330

A safer way is to open the directory in dired and delete from there."

266

331

  (interactive "P")

267

 

  (when org-attach-file-list-property

 

332

  (when (and org-attach-file-list-property (not org-attach-inherited))

268

333

    (org-entry-delete (point) org-attach-file-list-property))

269

334

  (let ((attach-dir (org-attach-dir)))

270

 

    (when 

 

335

    (when

271

336

        (and attach-dir

272

337

             (or force

273

338

                 (y-or-n-p "Are you sure you want to remove all attachments of this entry? ")))

281

346

This can be used after files have been added externally."

282

347

  (interactive)

283

348

  (org-attach-commit)

284

 

  (when org-attach-file-list-property

 

349

  (when (and org-attach-file-list-property (not org-attach-inherited))

285

350

    (org-entry-delete (point) org-attach-file-list-property))

286

351

  (let ((attach-dir (org-attach-dir)))

287

352

    (when attach-dir

324

389

         (files (org-attach-file-list attach-dir))

325

390

         (file (if (= (length files) 1)

326

391

                   (car files)

327

 

                 (completing-read "Open attachment: "

 

392

                 (org-ido-completing-read "Open attachment: "

328

393

                                  (mapcar 'list files) nil t))))

329

394

    (org-open-file (expand-file-name file attach-dir) in-emacs)))

330

395

 

334

399

  (interactive)

335

400

  (org-attach-open 'in-emacs))

336

401

 

 

402

(defun org-attach-expand (file)

 

403

  "Return the full path to the current entry's attachment file FILE.

 

404

Basically, this adds the path to the attachment directory."

 

405

  (expand-file-name file (org-attach-dir)))

 

406

 

 

407

(defun org-attach-expand-link (file)

 

408

  "Return a file link pointing to the current entry's attachment file FILE.

 

409

Basically, this adds the path to the attachment directory, and a \"file:\"

 

410

prefix."

 

411

  (concat "file:" (org-attach-expand file)))

 

412

 

337

413

(provide 'org-attach)

338

414

 

 

415

;; arch-tag: fce93c2e-fe07-4fa3-a905-e10dcc7a6248

339

416

;;; org-attach.el ends here

• Older »

Loggerhead is a web-based interface for Breezy
Version: 2.0.1